000100 IDENTIFICATION DIVISION.                                         
000200 PROGRAM-ID.                                                      
000300     CM105M.                                                      
000400 AUTHOR.                                                          
000500     FEDERAL COMPILER TESTING CENTER.                             
000600 INSTALLATION.                                                    
000700     GENERAL SERVICES ADMINISTRATION                              
000800     AUTOMATED DATA AND TELECOMMUNICATION SERVICE.                
000900     SOFTWARE DEVELOPMENT OFFICE.                                 
001000     5203 LEESBURG PIKE  SUITE 1100                               
001100     FALLS CHURCH VIRGINIA 22041.                                 
001200                                                                  
001300     PHONE   (703) 756-6153                                       
001400                                                                  
001500     " HIGH       ".                                              
001600 DATE-WRITTEN.                                                    
001700     CCVS-74 VERSION 4.0 - 1980 JULY 1.                           
001800     CREATION DATE     /    VALIDATION DATE                       
001900     "4.2 ".                                                      
002000 SECURITY.                                                        
002100     NONE.                                                        
002200 ENVIRONMENT DIVISION.                                            
002300 CONFIGURATION SECTION.                                           
002400 SOURCE-COMPUTER.                                                 
002500     Card0130.                                                    
002600 OBJECT-COMPUTER.                                                 
002700     Card0131.                                                    
002800 INPUT-OUTPUT SECTION.                                            
002900 FILE-CONTROL.                                                    
003000     SELECT PRINT-FILE ASSIGN TO                                  
003100     "C0085" .                                                    
003200 DATA DIVISION.                                                   
003300 FILE SECTION.                                                    
003400 FD  PRINT-FILE                                                   
003500     LABEL RECORDS                                                
003600     Card0132                                                     
003700     DATA RECORD IS PRINT-REC DUMMY-RECORD.                       
003800 01  PRINT-REC PICTURE X(120).                                    
003900 01  DUMMY-RECORD PICTURE X(120).                                 
004000 WORKING-STORAGE SECTION.                                         
004100 77  P    PIC X(12).                                              
004200 77  PP   PIC X(24).                                              
004300 77  PPP  PIC X(36).                                              
004400 77  PS   PIC X(24).                                              
004500 77  PSP  PIC X(36).                                              
004600 77  PPS  PIC X(36).                                              
004700 01  QUEUE-NAMES.                                                 
004800     02  PPPP PIC X(48) VALUE                                     
004900     "C0056" .                                                    
005000     02  PPPS PIC X(48) VALUE                                     
005100     "C0057" .                                                    
005200     02  PPSP PIC X(48) VALUE                                     
005300     "C0064" .                                                    
005400     02  PSPP PIC X(48) VALUE                                     
005500     "C0065" .                                                    
005600 01  QUEUE-NAMES-TABLE REDEFINES QUEUE-NAMES.                     
005700     02  NAME-SET PIC X(48) OCCURS 4 TIMES INDEXED BY I1.         
005800 01  TEST-RESULTS.                                                
005900     02 FILLER                    PICTURE X VALUE SPACE.          
006000     02 FEATURE                   PICTURE X(18).                  
006100     02 FILLER                    PICTURE X VALUE SPACE.          
006200     02 P-OR-F                    PICTURE X(5).                   
006300     02 FILLER                    PICTURE X  VALUE SPACE.         
006400     02  PAR-NAME PIC X(20).                                      
006500     02 FILLER                    PICTURE X VALUE SPACE.          
006600     02  COMPUTED-A.                                              
006700         03  FILLER PIC X(9) VALUE SPACE.                         
006800         03  STAT PIC XX.                                         
006900         03  FILLER PIC X(9) VALUE SPACE.                         
007000     02 FILLER                    PICTURE X VALUE SPACE.          
007100     02  CORRECT-A.                                               
007200         03  FILLER PIC X(8).                                     
007300         03  CORRECT-QUEUE PIC X(4).                              
007400         03  FILLER PIC X(8).                                     
007500     02 FILLER                    PICTURE X VALUE SPACE.          
007600     02  RE-MARK.                                                 
007700         03  QUEUE-KEY PIC X(4).                                  
007800         03  FILLER PIC X(26).                                    
007900 01  COLUMNS-LINE-1.                                              
008000     02  FILLER PIC X(3) VALUE SPACES.                            
008100     02  FILLER PIC X(17) VALUE "FEATURE TESTED".                 
008200     02  FILLER PIC X(9) VALUE "RESLT".                           
008300     02  FILLER PIC X(21) VALUE "PARAGRAPH NAME".                 
008400     02  FILLER PIC X(22) VALUE "COMPUTED DATA".                  
008500     02  FILLER PIC X(29) VALUE "CORRECT DATA".                   
008600     02  FILLER PIC X(7) VALUE "REMARKS".                         
008700 01  COLUMNS-LINE-2.                                              
008800     02  FILLER PIC X VALUE SPACE.                                
008900     02  FILLER PIC X(18) VALUE ALL "-".                          
009000     02  FILLER PIC X VALUE SPACE.                                
009100     02  FILLER PIC X(5) VALUE ALL "-".                           
009200     02  FILLER PIC X VALUE SPACE.                                
009300     02  FILLER PIC X(20) VALUE ALL "-".                          
009400     02  FILLER PIC X VALUE SPACE.                                
009500     02  FILLER PIC X(20) VALUE ALL "-".                          
009600     02  FILLER PIC X VALUE SPACE.                                
009700     02  FILLER PIC X(20) VALUE ALL "-".                          
009800     02  FILLER PIC X VALUE SPACE.                                
009900     02  FILLER PIC X(31) VALUE ALL "-".                          
010000 01  REC-SKL-SUB PICTURE 9(2) VALUE ZERO.                         
010100 01  REC-CT PICTURE 99 VALUE ZERO.                                
010200 01  DELETE-CNT                   PICTURE 999  VALUE ZERO.        
010300 01  ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO.                  
010400 01  INSPECT-COUNTER PIC 999 VALUE ZERO.                          
010500 01  PASS-COUNTER PIC 999 VALUE ZERO.                             
010600 01  TOTAL-ERROR PIC 999 VALUE ZERO.                              
010700 01  ERROR-HOLD PIC 999 VALUE ZERO.                               
010800 01  DUMMY-HOLD PIC X(120) VALUE SPACE.                           
010900 01  RECORD-COUNT PIC 9(5) VALUE ZERO.                            
011000 01  CCVS-H-1.                                                    
011100     02  FILLER   PICTURE X(27)  VALUE SPACE.                     
011200     02 FILLER PICTURE X(67) VALUE                                
011300     " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION  
011400-    " SYSTEM".                                                   
011500     02  FILLER     PICTURE X(26)  VALUE SPACE.                   
011600 01  CCVS-H-2.                                                    
011700     02 FILLER PICTURE X(52) VALUE IS                             
011800     "CCVS74 NCC  COPY, NOT FOR DISTRIBUTION.".                   
011900     02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET-  ".   
012000     02 TEST-ID PICTURE IS X(9).                                  
012100     02 FILLER PICTURE IS X(40) VALUE IS SPACE.                   
012200 01  CCVS-H-3.                                                    
012300     02  FILLER PICTURE X(34) VALUE                               
012400     " FOR OFFICIAL USE ONLY    ".                                
012500     02  FILLER PICTURE X(58) VALUE                               
012600     "COBOL 85 VERSION 4.2, Apr  1993 SSVG                      ".
012700     02  FILLER PICTURE X(28) VALUE                               
012800     "  COPYRIGHT   1974 ".                                       
012900 01  CCVS-E-1.                                                    
013000     02 FILLER PICTURE IS X(52) VALUE IS SPACE.                   
013100     02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST-  ".        
013200     02 ID-AGAIN PICTURE IS X(9).                                 
013300     02 FILLER PICTURE X(45) VALUE IS                             
013400     " NTIS DISTRIBUTION COBOL 74".                               
013500 01  CCVS-E-2.                                                    
013600     02  FILLER                   PICTURE X(31)  VALUE            
013700     SPACE.                                                       
013800     02  FILLER                   PICTURE X(21)  VALUE SPACE.     
013900     02 CCVS-E-2-2.                                               
014000         03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE.            
014100         03 FILLER PICTURE IS X VALUE IS SPACE.                   
014200         03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED".      
014300 01  CCVS-E-3.                                                    
014400     02  FILLER PICTURE X(22) VALUE                               
014500     " FOR OFFICIAL USE ONLY".                                    
014600     02  FILLER PICTURE X(12) VALUE SPACE.                        
014700     02  FILLER PICTURE X(58) VALUE                               
014800     "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH.     ".
014900     02  FILLER PICTURE X(13) VALUE SPACE.                        
015000     02 FILLER PIC X(15) VALUE " COPYRIGHT 1974".                 
015100 01  CCVS-E-4.                                                    
015200     02 CCVS-E-4-1 PIC XXX VALUE SPACE.                           
015300     02 FILLER PIC XXXX VALUE " OF ".                             
015400     02 CCVS-E-4-2 PIC XXX VALUE SPACE.                           
015500     02 FILLER PIC X(40) VALUE                                    
015600      "  TESTS WERE EXECUTED SUCCESSFULLY".                       
015700 01  XXINFO.                                                      
015800     02 FILLER PIC X(30) VALUE "        *** INFORMATION  ***".    
015900     02 INFO-TEXT.                                                
016000     04 FILLER PIC X(20) VALUE SPACE.                             
016100     04 XXCOMPUTED PIC X(20).                                     
016200     04 FILLER PIC X(5) VALUE SPACE.                              
016300     04 XXCORRECT PIC X(20).                                      
016400 01  HYPHEN-LINE.                                                 
016500     02 FILLER PICTURE IS X VALUE IS SPACE.                       
016600     02 FILLER PICTURE IS X(65) VALUE IS "************************
016700-    "*****************************************".                 
016800     02 FILLER PICTURE IS X(54) VALUE IS "************************
016900-    "******************************".                            
017000 01  CCVS-PGM-ID PIC X(6) VALUE                                   
017100     "CM105M".                                                    
017200 01  MAIN-QUEUE-NAME.                                             
017300     02 MAIN-QUEUE   PIC X(12).                                   
017400     02 FILLER       PIC X(36) VALUE SPACE.                       
017500*COMMUNICATION SECTION.                                           
017600*CD  CM-INQUE-1 INPUT STATUS KEY IS IN-STAT SUB-QUEUE-3           
017700*    IS-OF-NO-INTEREST COUNT NAMED-BELOW SOURCE NOT-USED.         
017800 01  INQUE-RECORD.                                                
017900    02  QUEUE-SET PIC X(48).                                     
018000    02  FILLER PIC X(33).                                        
018100    02  MSG-COUNT-N PIC 9(6).                                    
018200    02  MSG-CNT REDEFINES MSG-COUNT-N.                           
018300        03  FILLER PIC X(4).                                     
018400        03  MSG-COUNT PIC XX.                                    
018500 PROCEDURE    DIVISION.                                           
018600 SECT-CM105M-0001 SECTION.                                        
018700 CM105M-INIT.                                                     
018800     OPEN     OUTPUT PRINT-FILE.                                  
018900     MOVE "CM105M     " TO TEST-ID.                               
019000     MOVE     TEST-ID TO ID-AGAIN.                                
019100     MOVE    SPACE TO TEST-RESULTS.                               
019200     PERFORM HEAD-ROUTINE.                                        
019300     PERFORM COLUMN-NAMES-ROUTINE.                                
019400     MOVE                                                         
019500     "C0048"                                                      
019600     TO MAIN-QUEUE.                                               
019700     MOVE MAIN-QUEUE-NAME TO QUEUE-SET.                           
019800*    ENABLE INPUT CM-INQUE-1 KEY                                  
019900*    "C0049" .                                                    
020000     PERFORM BUILD-UP-QUEUES VARYING I1 FROM 1 BY 1               
020100         UNTIL I1 IS GREATER THAN 4.                              
020200     GO TO BEGIN-TESTS.                                           
020300 BUILD-UP-QUEUES.                                                 
020400     MOVE NAME-SET (I1) TO QUEUE-SET.                             
020500     ACCEPT CM-INQUE-1 COUNT.                                     
020600     IF MSG-COUNT IS LESS THAN 10 GO TO BUILD-UP-QUEUES.          
020700 BEGIN-TESTS.                                                     
020800*    DISABLE INPUT CM-INQUE-1 KEY                                 
020900*    "C0049" .                                                    
021000     MOVE PPPP TO  P  PP  PPP.                                    
021100     MOVE PPSP TO  PPS.                                           
021200     MOVE PSPP TO  PS  PSP.                                       
021300 QUEUE-TEST-01.                                                   
021400     MOVE "QUEUE SERIES PPPP" TO FEATURE.                         
021500     MOVE PPPP TO QUEUE-SET.                                      
021600     PERFORM RECEIVE-A-MSG.                                       
021700     IF QUEUE-KEY IS EQUAL TO "PPPP"                              
021800         PERFORM PASS GO TO QUEUE-TEST-WRITE-01.                  
021900     MOVE "PPPP" TO CORRECT-QUEUE.                                
022000     PERFORM FAIL.                                                
022100 QUEUE-TEST-WRITE-01.                                             
022200     MOVE "QUEUE-TEST-01" TO PAR-NAME.                            
022300     PERFORM PRINT-DETAIL.                                        
022400 QUEUE-TEST-02.                                                   
022500     MOVE "QUEUE SERIES PPPS" TO FEATURE.                         
022600     MOVE PPPS TO QUEUE-SET.                                      
022700     PERFORM RECEIVE-A-MSG.                                       
022800     IF QUEUE-KEY IS EQUAL TO "PPPS"                              
022900         PERFORM PASS   GO TO QUEUE-TEST-WRITE-02.                
023000     MOVE "PPPS" TO CORRECT-QUEUE.                                
023100     PERFORM FAIL.                                                
023200 QUEUE-TEST-WRITE-02.                                             
023300     MOVE "QUEUE-TEST-02" TO PAR-NAME.                            
023400     PERFORM PRINT-DETAIL.                                        
023500 QUEUE-TEST-03.                                                   
023600     MOVE "QUEUE SERIES PPSP" TO FEATURE.                         
023700     MOVE PPSP TO QUEUE-SET.                                      
023800     PERFORM RECEIVE-A-MSG.                                       
023900     IF QUEUE-KEY IS EQUAL TO "PPSP"                              
024000         PERFORM PASS   GO TO QUEUE-TEST-WRITE-03.                
024100     MOVE "PPSP" TO CORRECT-QUEUE.                                
024200     PERFORM FAIL.                                                
024300 QUEUE-TEST-WRITE-03.                                             
024400     MOVE "QUEUE-TEST-03" TO PAR-NAME.                            
024500     PERFORM PRINT-DETAIL.                                        
024600 QUEUE-TEST-04.                                                   
024700     MOVE "QUEUE SERIES PSPP" TO FEATURE.                         
024800     MOVE PSPP TO QUEUE-SET.                                      
024900     PERFORM RECEIVE-A-MSG.                                       
025000     IF QUEUE-KEY IS EQUAL TO "PSPP"                              
025100         PERFORM PASS   GO TO QUEUE-TEST-WRITE-04.                
025200     MOVE "PSPP" TO CORRECT-QUEUE.                                
025300     PERFORM FAIL.                                                
025400 QUEUE-TEST-WRITE-04.                                             
025500     MOVE "QUEUE-TEST-04" TO PAR-NAME.                            
025600     PERFORM PRINT-DETAIL.                                        
025700 QUEUE-TEST-05.                                                   
025800     MOVE "QUEUE SERIES P" TO FEATURE.                            
025900     MOVE P TO QUEUE-SET.                                         
026000     PERFORM RECEIVE-A-MSG.                                       
026100     IF QUEUE-KEY IS EQUAL TO "PPPP"                              
026200         PERFORM PASS   GO TO QUEUE-TEST-WRITE-05.                
026300     MOVE "PPPP" TO CORRECT-QUEUE.                                
026400     PERFORM FAIL.                                                
026500 QUEUE-TEST-WRITE-05.                                             
026600     MOVE "QUEUE-TEST-05" TO PAR-NAME.                            
026700     PERFORM PRINT-DETAIL.                                        
026800 QUEUE-TEST-06.                                                   
026900     MOVE "QUEUE SERIES PP" TO FEATURE.                           
027000     MOVE PP TO QUEUE-SET.                                        
027100     PERFORM RECEIVE-A-MSG.                                       
027200     IF QUEUE-KEY IS EQUAL TO "PPPP"                              
027300         PERFORM PASS   GO TO QUEUE-TEST-WRITE-06.                
027400     MOVE "PPPP" TO CORRECT-QUEUE.                                
027500     PERFORM FAIL.                                                
027600 QUEUE-TEST-WRITE-06.                                             
027700     MOVE "QUEUE-TEST-06" TO PAR-NAME.                            
027800     PERFORM PRINT-DETAIL.                                        
027900 QUEUE-TEST-07.                                                   
028000     MOVE "QUEUE SERIES PPP" TO FEATURE.                          
028100     MOVE PPP TO QUEUE-SET.                                       
028200     PERFORM RECEIVE-A-MSG.                                       
028300     IF QUEUE-KEY IS EQUAL TO "PPPP"                              
028400         PERFORM PASS   GO TO QUEUE-TEST-WRITE-07.                
028500     MOVE "PPPP" TO CORRECT-QUEUE.                                
028600     PERFORM FAIL.                                                
028700 QUEUE-TEST-WRITE-07.                                             
028800     MOVE "QUEUE-TEST-07" TO PAR-NAME.                            
028900     PERFORM PRINT-DETAIL.                                        
029000 QUEUE-TEST-08.                                                   
029100     MOVE "QUEUE SERIES PS" TO FEATURE.                           
029200     MOVE PS TO QUEUE-SET.                                        
029300     PERFORM RECEIVE-A-MSG.                                       
029400     IF QUEUE-KEY IS EQUAL TO "PSPP"                              
029500         PERFORM PASS   GO TO QUEUE-TEST-WRITE-08.                
029600     MOVE "PSPP" TO CORRECT-QUEUE.                                
029700     PERFORM FAIL.                                                
029800 QUEUE-TEST-WRITE-08.                                             
029900     MOVE "QUEUE-TEST-08" TO PAR-NAME.                            
030000     PERFORM PRINT-DETAIL.                                        
030100 QUEUE-TEST-09.                                                   
030200     MOVE "QUEUE SERIES PSP" TO FEATURE.                          
030300     MOVE PSP TO QUEUE-SET.                                       
030400     PERFORM RECEIVE-A-MSG.                                       
030500     IF QUEUE-KEY IS EQUAL TO "PSPP"                              
030600         PERFORM PASS   GO TO QUEUE-TEST-WRITE-09.                
030700     MOVE "PSPP" TO CORRECT-QUEUE.                                
030800     PERFORM FAIL.                                                
030900 QUEUE-TEST-WRITE-09.                                             
031000     MOVE "QUEUE-TEST-09" TO PAR-NAME.                            
031100     PERFORM PRINT-DETAIL.                                        
031200 QUEUE-TEST-10.                                                   
031300     MOVE "QUEUE SERIES PPS" TO FEATURE.                          
031400     MOVE PPS TO QUEUE-SET.                                       
031500     PERFORM RECEIVE-A-MSG.                                       
031600     IF QUEUE-KEY IS EQUAL TO "PPSP"                              
031700         PERFORM PASS  GO TO QUEUE-TEST-WRITE-10.                 
031800     MOVE "PPSP" TO CORRECT-QUEUE.                                
031900     PERFORM FAIL.                                                
032000 QUEUE-TEST-WRITE-10.                                             
032100     MOVE "QUEUE-TEST-10" TO PAR-NAME.                            
032200     PERFORM PRINT-DETAIL.                                        
032300 ACCEPT-TEST-01.                                                  
032400     MOVE "ACCEPT GROUP QUEUE" TO FEATURE.                        
032500     MOVE PPPP TO QUEUE-SET.                                      
032600     ACCEPT CM-INQUE-1 COUNT.                                     
032700     IF IN-STAT IS NOT EQUAL TO "00"                              
032800         MOVE IN-STAT TO STAT                                     
032900         MOVE "BAD STATUS FOR PPPP" TO RE-MARK                    
033000         ELSE                                                     
033100         MOVE MSG-COUNT TO STAT                                   
033200         MOVE "COUNT FOR PPPP" TO RE-MARK.                        
033300     PERFORM ACCEPT-WRITE-01.                                     
033400     MOVE PPPS TO QUEUE-SET.                                      
033500     ACCEPT CM-INQUE-1 COUNT.                                     
033600     IF IN-STAT IS NOT EQUAL TO "00"                              
033700         MOVE IN-STAT TO STAT                                     
033800         MOVE "BAD STATUS FOR PPPS" TO RE-MARK                    
033900         ELSE                                                     
034000         MOVE MSG-COUNT TO STAT                                   
034100         MOVE "COUNT FOR PPPS" TO RE-MARK.                        
034200     PERFORM ACCEPT-WRITE-01.                                     
034300     MOVE PPSP TO QUEUE-SET.                                      
034400     ACCEPT CM-INQUE-1 COUNT.                                     
034500     IF IN-STAT IS NOT EQUAL TO "00"                              
034600         MOVE IN-STAT TO STAT                                     
034700         MOVE "BAD STATUS FOR PPSP"  TO RE-MARK                   
034800         ELSE                                                     
034900         MOVE MSG-COUNT TO STAT                                   
035000         MOVE "COUNT FOR PPSP" TO RE-MARK.                        
035100     PERFORM ACCEPT-WRITE-01.                                     
035200     MOVE PSPP TO QUEUE-SET.                                      
035300     ACCEPT CM-INQUE-1 COUNT.                                     
035400     IF IN-STAT IS NOT EQUAL TO "00"                              
035500         MOVE IN-STAT TO STAT                                     
035600         MOVE "BAD STATUS FOR PSPP" TO RE-MARK                    
035700         ELSE                                                     
035800         MOVE MSG-COUNT TO STAT                                   
035900         MOVE "COUNT FOR PSPP" TO RE-MARK.                        
036000     PERFORM ACCEPT-WRITE-01.                                     
036100     MOVE P TO QUEUE-SET.                                         
036200     ACCEPT CM-INQUE-1 COUNT.                                     
036300     IF IN-STAT IS NOT EQUAL TO "00"                              
036400         MOVE IN-STAT TO STAT                                     
036500         MOVE "BAD STATUS FOR P" TO RE-MARK                       
036600         ELSE                                                     
036700         MOVE MSG-COUNT TO STAT                                   
036800         MOVE "COUNT FOR P" TO RE-MARK.                           
036900     PERFORM ACCEPT-WRITE-01.                                     
037000     MOVE PP TO QUEUE-SET.                                        
037100     ACCEPT CM-INQUE-1 COUNT.                                     
037200     IF IN-STAT IS NOT EQUAL TO "00"                              
037300         MOVE IN-STAT TO STAT                                     
037400         MOVE "BAD STATUS FOR PP" TO STAT                         
037500         ELSE                                                     
037600         MOVE MSG-COUNT TO STAT                                   
037700         MOVE "COUNT FOR PP" TO RE-MARK.                          
037800     PERFORM ACCEPT-WRITE-01.                                     
037900     MOVE PPP TO QUEUE-SET.                                       
038000     ACCEPT CM-INQUE-1 COUNT.                                     
038100     IF IN-STAT IS NOT EQUAL TO "00"                              
038200         MOVE IN-STAT TO STAT                                     
038300         MOVE "BAD STATUS FOR PPP" TO STAT                        
038400         ELSE                                                     
038500         MOVE MSG-COUNT TO STAT                                   
038600         MOVE "COUNT FOR PPP" TO RE-MARK.                         
038700     PERFORM ACCEPT-WRITE-01.                                     
038800     MOVE PS TO QUEUE-SET.                                        
038900     ACCEPT CM-INQUE-1 COUNT.                                     
039000     IF IN-STAT IS NOT EQUAL TO "00"                              
039100         MOVE IN-STAT TO STAT                                     
039200         MOVE "BAD STATUS FOR PS" TO STAT                         
039300         ELSE                                                     
039400         MOVE MSG-COUNT TO STAT                                   
039500         MOVE "COUNT FOR PS" TO RE-MARK.                          
039600     PERFORM ACCEPT-WRITE-01.                                     
039700     MOVE PSP TO QUEUE-SET.                                       
039800     ACCEPT CM-INQUE-1 COUNT.                                     
039900     IF IN-STAT IS NOT EQUAL TO "00"                              
040000         MOVE IN-STAT TO STAT                                     
040100         MOVE "BAD STATUS FOR PSP" TO STAT                        
040200         ELSE                                                     
040300         MOVE MSG-COUNT TO STAT                                   
040400         MOVE "COUNT FOR PSP" TO RE-MARK.                         
040500     PERFORM ACCEPT-WRITE-01.                                     
040600     MOVE PPS TO QUEUE-SET.                                       
040700     ACCEPT CM-INQUE-1 COUNT.                                     
040800     IF IN-STAT IS NOT EQUAL TO "00"                              
040900         MOVE IN-STAT TO STAT                                     
041000         MOVE "BAD STATUS FOR PPS" TO STAT                        
041100         ELSE                                                     
041200         MOVE MSG-COUNT TO STAT                                   
041300         MOVE "COUNT FOR PPS" TO RE-MARK.                         
041400     PERFORM ACCEPT-WRITE-01.                                     
041500     GO TO CM105-FINI.                                            
041600 ACCEPT-WRITE-01.                                                 
041700     MOVE "ACCEPT-TEST-01" TO PAR-NAME.                           
041800     MOVE "INFO" TO P-OR-F.                                       
041900     PERFORM PRINT-DETAIL.                                        
042000 CM105-FINI.                                                      
042100     PERFORM END-ROUTINE THRU END-ROUTINE-4.                      
042200     CLOSE PRINT-FILE.                                            
042300     STOP RUN.                                                    
042400 RECEIVE-A-MSG.                                                   
042500     MOVE SPACE TO RE-MARK.                                       
042600*    RECEIVE CM-INQUE-1 MESSAGE INTO RE-MARK                      
042700*        NO DATA MOVE "NOTHING RECEIVED FROM MCS" TO RE-MARK.     
042800 COMMON-SUBROUTINES SECTION.                                      
042900 PASS.                                                            
043000     MOVE "PASS" TO P-OR-F.                                       
043100 FAIL.                                                            
043200     MOVE " SEE REMARKS COLUMN " TO COMPUTED-A.                   
043300     ADD      1 TO ERROR-COUNTER.                                 
043400     MOVE "FAIL*" TO P-OR-F.                                      
043500 PRINT-DETAIL.                                                    
043600     MOVE     TEST-RESULTS TO PRINT-REC.                          
043700     PERFORM WRITE-LINE.                                          
043800     MOVE     SPACE TO P-OR-F.                                    
043900     MOVE     SPACE TO COMPUTED-A.                                
044000     MOVE SPACE TO CORRECT-A.                                     
044100     MOVE SPACE TO RE-MARK.                                       
044200 COLUMN-NAMES-ROUTINE.                                            
044300     MOVE     COLUMNS-LINE-1 TO DUMMY-RECORD.                     
044400     PERFORM WRITE-LINE.                                          
044500     MOVE     COLUMNS-LINE-2 TO DUMMY-RECORD.                     
044600     PERFORM WRITE-LINE.                                          
044700     PERFORM  BLANK-LINE-PRINT.                                   
044800 END-ROUTINE.                                                     
044900     MOVE     HYPHEN-LINE TO DUMMY-RECORD.                        
045000     PERFORM WRITE-LINE.                                          
045100 PARA-Z.                                                          
045200     PERFORM  BLANK-LINE-PRINT 4 TIMES.                           
045300     MOVE     CCVS-E-1 TO DUMMY-RECORD.                           
045400     PERFORM WRITE-LINE.                                          
045500 END-ROUTINE-1.                                                   
045600     PERFORM  BLANK-LINE-PRINT.                                   
045700     IF       ERROR-COUNTER IS EQUAL TO ZERO                      
045800              GO TO END-ROUTINE-2.                                
045900     MOVE     ERROR-COUNTER TO ERROR-TOTAL.                       
046000     GO TO    END-ROUTINE-3.                                      
046100 END-ROUTINE-2.                                                   
046200     MOVE " NO" TO ERROR-TOTAL.                                   
046300 END-ROUTINE-3.                                                   
046400     MOVE     CCVS-E-2 TO DUMMY-RECORD.                           
046500     PERFORM WRITE-LINE.                                          
046600     IF DELETE-CNT IS EQUAL TO ZERO                               
046700         MOVE " NO" TO ERROR-TOTAL  ELSE                          
046800     MOVE DELETE-CNT TO ERROR-TOTAL.                              
046900     MOVE "TESTS DELETED     " TO ENDER-DESC.                     
047000     MOVE CCVS-E-2 TO DUMMY-RECORD.                               
047100     PERFORM WRITE-LINE.                                          
047200 END-ROUTINE-4.                                                   
047300     MOVE CCVS-E-3 TO DUMMY-RECORD.                               
047400     PERFORM WRITE-LINE.                                          
047500 BLANK-LINE-PRINT.                                                
047600     MOVE     SPACE TO DUMMY-RECORD.                              
047700     PERFORM WRITE-LINE.                                          
047800 WRITE-LINE.                                                      
047900     WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE.                   
048000 HEAD-ROUTINE.                                                    
048100     MOVE CCVS-H-1 TO PRINT-REC                                   
048200     WRITE PRINT-REC                                              
048300         AFTER ADVANCING PAGE.                                    
048400     MOVE CCVS-H-2 TO PRINT-REC.                                  
048500     WRITE PRINT-REC                                              
048600         AFTER 2 LINES.                                           
048700     MOVE CCVS-H-3 TO PRINT-REC.                                  
048800     WRITE PRINT-REC                                              
048900         AFTER 5 LINES.                                           
049000     MOVE HYPHEN-LINE TO PRINT-REC.                               
049100     PERFORM WRITE-LINE.