DVBCREQ3.m

DVBCREQ3 ;ALB/GTS-557/THM-NEW REQUESTS RECAP SHEET ; 6/18/91  1:23 PM

 ;;2.7;AMIE;**193**;Apr 10, 1995;Build 84

 ;

EN S P1=0,PG=0,$P(PLINE,"-",75)="-" D HDR

 ;

 ;AJF ; Adding REROUTED Request to Recap Sheet;

RECAP F X="NEW","MODIFIED","ADDITIONAL","REROUTED" S P1=P1+1 D

 .W !!,X,$S(P1=3:" exams",1:" requests"),":",!! S (PNAM,SSN)=""

 .F SM=1:1 S PNAM=$O(^TMP($J,X,PNAM)) Q:PNAM=""  D

 ..F SN=0:0 S SSN=$O(^TMP($J,X,PNAM,SSN)) Q:SSN=""  D RECAP1

 I IOST?1"C-".E D TERM^DVBCUTL3

 ;

EXIT K P1,COL,SM,SN,PNAM,SSN,CNUM,CN,PG,PLINE,X,^TMP($J),DVBCSSNO Q

 ;

RECAP1 F CN=0:0 S CNUM=$O(^TMP($J,X,PNAM,SSN,CNUM)) Q:CNUM=""  S COL=$S(SM>9:0,1:1) D SSNOUT^DVBCUTIL W ?COL,SM,". ",PNAM,?40,DVBCSSNO,?63,CNUM,! I $Y>55 W @IOF,!

 Q

 ;

HDR S PG=PG+1 W @IOF,!,"New Request Recap Sheet for Run Date ",DVBCDT(0),?63,"Page: ",PG,!!!

 W ?1,"Veteran Name",?40,"S S #",?63,"C-Number",!,PLINE,!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBCREQ3   896     printed  Apr 09, 2024@20:50:16                                                                                                                                                                                                     Page 2

DVBCREQ3  ;ALB/GTS-557/THM-NEW REQUESTS RECAP SHEET ; 6/18/91  1:23 PM

 +1       ;;2.7;AMIE;**193**;Apr 10, 1995;Build 84

 +2       ;

EN         SET P1=0

           SET PG=0

           SET $PIECE(PLINE,"-",75)="-"

           DO HDR

 +1       ;

 +2       ;AJF ; Adding REROUTED Request to Recap Sheet;

RECAP      FOR X="NEW","MODIFIED","ADDITIONAL","REROUTED"

               SET P1=P1+1

               Begin DoDot:1

 +1                WRITE !!,X,$SELECT(P1=3:" exams",1:" requests"),":",!!

                   SET (PNAM,SSN)=""

 +2                FOR SM=1:1

                       SET PNAM=$ORDER(^TMP($JOB,X,PNAM))

                       if PNAM=""

                           QUIT 

                       Begin DoDot:2

 +3                        FOR SN=0:0

                               SET SSN=$ORDER(^TMP($JOB,X,PNAM,SSN))

                               if SSN=""

                                   QUIT 

                               DO RECAP1

                       End DoDot:2

               End DoDot:1

 +4        IF IOST?1"C-".E

               DO TERM^DVBCUTL3

 +5       ;

EXIT       KILL P1,COL,SM,SN,PNAM,SSN,CNUM,CN,PG,PLINE,X,^TMP($JOB),DVBCSSNO

           QUIT 

 +1       ;

RECAP1     FOR CN=0:0

               SET CNUM=$ORDER(^TMP($JOB,X,PNAM,SSN,CNUM))

               if CNUM=""

                   QUIT 

               SET COL=$SELECT(SM>9:0,1:1)

               DO SSNOUT^DVBCUTIL

               WRITE ?COL,SM,". ",PNAM,?40,DVBCSSNO,?63,CNUM,!

               IF $Y>55

                   WRITE @IOF,!

 +1        QUIT 

 +2       ;

HDR        SET PG=PG+1

           WRITE @IOF,!,"New Request Recap Sheet for Run Date ",DVBCDT(0),?63,"Page: ",PG,!!!

 +1        WRITE ?1,"Veteran Name",?40,"S S #",?63,"C-Number",!,PLINE,!

 +2        QUIT