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 ---[H[J[2J[HDVBCREQ3 896 printed Dec 13, 2024@01:48:28 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
