DGENACL1 ;ALB/MRY - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;
PRINT N DGLN,PAGE,QUIT,DGTOTAL
S QUIT=""
U IO
I $E(IOST,1,2)="C-" D EN^DDIOL("","","@IOF")
S DGLN=0
S PAGE=1
D HEADER:'DGPFTFLG
D DATA
I DGLN=0 D
. D EN^DDIOL("No data to report.","","!!!?30")
. I $E(IOST,1,2)="C-" D PAUSE
I ('DGPFTFLG),(DGLN>0),('QUIT) D SUMARY
Q
;
N DG1,DG2,Y
I DGRPT=1 D
. D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST CALL LIST","","!?15")
. S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
. D EN^DDIOL("Page: "_PAGE,"","!?60")
. D:DGPFTFLG EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!") D EN^DDIOL("","","!!")
. I ($G(DGFMT1)="S") D
. . D EN^DDIOL("1010EZ APPT.","","?30"),EN^DDIOL("REQ","","?45"),EN^DDIOL("RESIDENCE","","?52"),EN^DDIOL("CELLULAR","","?67")
. . D EN^DDIOL("NAME(SSN)"),EN^DDIOL("REQUEST DATE","","?30"),EN^DDIOL("STA","","?45"),EN^DDIOL("PHONE","","?54"),EN^DDIOL("PHONE","","?68")
. . D EN^DDIOL("","","!")
I DGRPT=2 D
. S Y=DGBEG D DD^%DT S DG1=Y
. S Y=DGEND D DD^%DT S DG2=Y
. D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST TRACKING REPORT","","!?10")
. S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
. D EN^DDIOL(DG1_" TO "_DG2,"","!?20"),EN^DDIOL("Page: "_PAGE,"","?60")
. D:DGPFTFLG EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!")
. I ($G(DGFMT2)="D") D
. . D EN^DDIOL("1010EZ APPT.","","!!?37"),EN^DDIOL("SCHEDULED","","?54"),EN^DDIOL("#","","?71"),EN^DDIOL("REQ","","?76")
. . D EN^DDIOL("NAME"),EN^DDIOL("EP/CV","","?31"),EN^DDIOL("REQUEST DATE","","?37"),EN^DDIOL("APPOINTMENT DATE","","?51"),EN^DDIOL("DAYS","","?70"),EN^DDIOL("STA","","?76")
. . D EN^DDIOL("============================"),EN^DDIOL("=====","","?31"),EN^DDIOL("============","","?37"),EN^DDIOL("==================","","?51"),EN^DDIOL("====","","?70"),EN^DDIOL("===","","?76")
I +DGERROR D Q
. D EN^DDIOL($P(DGERROR,"^",2),"","!!!")
. I $E(IOST,1,2)="C-" D PAUSE
S PAGE=PAGE+1
Q
DATA ;
N DFN,DGNAM,DGSSN,DGI,DATAEP,DGFLG,DGRDTI,DGDAYS,DFNIEN,SDADTI,SDADT,DGDAYS,DGENPRI,DGENCVEL,DATA3,DGSTA
F DGI="C","E","F","I","NULL" S DGTOTAL(DGI)=0
S DGPFTF=""
F S DGPFTF=$O(^TMP($J,"DGEN NEACL",DGPFTF)) Q:(DGPFTF="") D Q:QUIT
. I DGPFTFLG F DGI="C","E","F","I","NULL" S DGTOTAL(DGI)=0
. D TOP:((DGPFTFLG)&(PAGE>1)) D HEADER:((DGPFTFLG)&(PAGE=1))
. S DGI=0
. F S DGI=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI)) Q:(DGI="") D Q:QUIT
.. S DGRDTI=0 F S DGRDTI=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI)) Q:'DGRDTI D Q:QUIT
... S DGNAM="" F S DGNAM=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM)) Q:DGNAM="" D Q:QUIT
.... S DFNIEN="" F S DFNIEN=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN)) Q:DFNIEN="" D Q:QUIT
..... S SDADTI=$G(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN))
..... S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I") I DGSTA="" S DGSTA="NULL"
..... I DGSTA="C" S SDADTI=$$GET1^DIQ(2,DFNIEN,1010.162,"I")
..... S DGDAYS=$$DAYS(SDADTI,DGRDTI) S Y=SDADTI X ^DD("DD") S SDADT=Y
..... S DGFLG=0 I 'SDADTI S DGFLG=1
..... S DATAEP=$G(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN,"PRIORITY"))
..... S DGENPRI=$P(DATAEP,"^",3),DGENCVEL=$P(DATAEP,"^",4)
..... S DATA3="/" S:+DGENPRI $P(DATA3,"/")=$E(" ",$L(+DGENPRI)+1,2)_+DGENPRI S:DGENCVEL $P(DATA3,"/",2)="EL" I DATA3="/" S DATA3=""
..... S DGTOTAL(DGSTA)=DGTOTAL(DGSTA)+1
..... D ADD I '(QUIT) D LINE
. I DGPFTFLG D SUMARY I $E(IOST,1,2)="C-" D PAUSE
Q
PAUSE ;
N DIR,DIRUT,X,Y
F Q:$Y>(IOSL-3) W !
S DIR(0)="E"
D ^DIR
I ('(+Y))!($D(DIRUT)) S QUIT=1
Q
TOP ;
D EN^DDIOL("","","@IOF")
D HEADER
Q
ADD ;
I $E(IOST,1,2)="C-",($Y>(IOSL-3)) D
. D PAUSE
. Q:QUIT
. D TOP
I $E(IOST,1,2)'="C-",($Y>(IOSL-3)) D TOP
Q
LINE ;add a line to the report
N DGNAMX,DPTDFN,DGCMT
I DGRPT=2 S DGNAMX=$P(DGNAM,",")
E S DGNAMX=DGNAM
S DGNAMX=DGNAMX_"("_$E($$GET1^DIQ(2,DFNIEN,.09),6,9)_")"
I DGRPT=1,($G(DGFMT1)="D") D
. D EN^DDIOL(DGNAMX,"","!") D ADD Q:QUIT
. S (Y,DPTDFN)=DFNIEN
. I $$TESTPAT^VADPT(+Y) D EN^DDIOL("WARNING : You have selected a test patient."),ADD Q:QUIT
. I $$BADADR^DGUTL3(+Y) D EN^DDIOL("WARNING : ** This patient has been flagged with a Bad Address Indicator."),ADD Q:QUIT
. I $D(^DPT("AXFFP",1,+Y)) S DGCLIST=1 D FFP^DPTLK5 K DGCLIST D ADD Q:QUIT
. D ENR^DPTLK,ADD Q:QUIT
. D CV^DPTLK,ADD Q:QUIT
. D EN^DDIOL("1010EZ APPT. REQUEST DATE: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?28") D ADD Q:QUIT
. D EN^DDIOL("REQUEST STATUS: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161),"","?18") D ADD Q:QUIT
. D EN^DDIOL("COMMENT: "_$$GET1^DIQ(2,DFNIEN,1010.163)) D ADD Q:QUIT
. D EN^DDIOL("PHONE [RESIDENCE]: "_$$GET1^DIQ(2,DFNIEN,.131))
. D EN^DDIOL("PHONE [CELLULAR]: "_$$GET1^DIQ(2,DFNIEN,.134),"","?44") D ADD Q:QUIT
. D EN^DDIOL("PREFERRED FACILITY: "_DGPFTF) D ADD Q:QUIT
. ;D EN^DDIOL("PREFERRED FACILITY: "_$$GET1^DIQ(2,DFNIEN,27.02)) D ADD Q:QUIT
. D EN^DDIOL("---------------------------------------------------------------","","!?4") D ADD Q:QUIT
I DGRPT=1,($G(DGFMT1)="S") D Q:QUIT
. D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
. D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?30")
. D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?46")
. D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.131),"","?51")
. D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.134),"","?66")
. D ADD Q:QUIT
I DGRPT=2,($G(DGFMT2)="D") D
. D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
. D EN^DDIOL(DATA3,"","?31"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?37"),EN^DDIOL(SDADT,"","?51"),EN^DDIOL($J(DGDAYS,3)_$S(DGFLG:"*",1:""),"","?71"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?77") D ADD Q:QUIT
. S DGCMT=$$GET1^DIQ(2,DFNIEN,1010.163) I $G(DGCMT)'="" D EN^DDIOL("COMMENT: "_DGCMT,"","!?3") D ADD Q:QUIT
S DGLN=1
Q
;
SUMARY ;display totals
;K DGFMT1 S DGFMT2="S"
D ADD2 Q:QUIT
D EN^DDIOL("SUMMARY","","!!!")
D EN^DDIOL("==============================================================================")
S DGI="" F S DGI=$O(DGTOTAL(DGI)) Q:DGI="" D
. I (DGRPT=1)&((DGI="C")!(DGI="F")) Q
. D EN^DDIOL("Total number of veteran's "_$S(DGI="NULL":"",1:"with ")_$S(DGI="C":"CANCELLED",DGI="E":"EWL",DGI="F":"FILLED",DGI="I":"CONTACTED - IN PROCESS",1:"PENDING ACTION")_$S(DGI="NULL":"",1:" request status"))
. D EN^DDIOL($J(DGTOTAL(DGI),4),"","?73")
Q
;
ADD2 ;
I $E(IOST,1,2)="C-",($Y>(IOSL-8)) D
. D PAUSE
. Q:QUIT
. D TOP
I $E(IOST,1,2)'="C-",($Y>(IOSL-8)) D TOP
Q
DAYS(X1,X2) ;Compute # of days
S X1=$G(X1),X2=$G(X2)
I X1="" S X1=DT
D ^%DTC
Q X
Q Q
DGENACL1 ;ALB/MRY - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;
PRINT NEW DGLN,PAGE,QUIT,DGTOTAL
+1 SET QUIT=""
+2 USE IO
+3 IF $EXTRACT(IOST,1,2)="C-"
DO EN^DDIOL("","","@IOF")
+4 SET DGLN=0
+5 SET PAGE=1
+6 IF 'DGPFTFLG
DO HEADER
+7 DO DATA
+8 IF DGLN=0
Begin DoDot:1
+9 DO EN^DDIOL("No data to report.","","!!!?30")
+10 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE
End DoDot:1
+11 IF ('DGPFTFLG)
IF (DGLN>0)
IF ('QUIT)
DO SUMARY
+12 QUIT
+13 ;
+1 NEW DG1,DG2,Y
+2 IF DGRPT=1
Begin DoDot:1
+3 DO EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST CALL LIST","","!?15")
+4 SET Y=DT
DO DD^%DT
DO EN^DDIOL("Date: "_Y,"","?60")
+5 DO EN^DDIOL("Page: "_PAGE,"","!?60")
+6 IF DGPFTFLG
DO EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!")
DO EN^DDIOL("","","!!")
+7 IF ($GET(DGFMT1)="S")
Begin DoDot:2
+8 DO EN^DDIOL("1010EZ APPT.","","?30")
DO EN^DDIOL("REQ","","?45")
DO EN^DDIOL("RESIDENCE","","?52")
DO EN^DDIOL("CELLULAR","","?67")
+9 DO EN^DDIOL("NAME(SSN)")
DO EN^DDIOL("REQUEST DATE","","?30")
DO EN^DDIOL("STA","","?45")
DO EN^DDIOL("PHONE","","?54")
DO EN^DDIOL("PHONE","","?68")
+10 DO EN^DDIOL("","","!")
End DoDot:2
End DoDot:1
+11 IF DGRPT=2
Begin DoDot:1
+12 SET Y=DGBEG
DO DD^%DT
SET DG1=Y
+13 SET Y=DGEND
DO DD^%DT
SET DG2=Y
+14 DO EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST TRACKING REPORT","","!?10")
+15 SET Y=DT
DO DD^%DT
DO EN^DDIOL("Date: "_Y,"","?60")
+16 DO EN^DDIOL(DG1_" TO "_DG2,"","!?20")
DO EN^DDIOL("Page: "_PAGE,"","?60")
+17 IF DGPFTFLG
DO EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!")
+18 IF ($GET(DGFMT2)="D")
Begin DoDot:2
+19 DO EN^DDIOL("1010EZ APPT.","","!!?37")
DO EN^DDIOL("SCHEDULED","","?54")
DO EN^DDIOL("#","","?71")
DO EN^DDIOL("REQ","","?76")
+20 DO EN^DDIOL("NAME")
DO EN^DDIOL("EP/CV","","?31")
DO EN^DDIOL("REQUEST DATE","","?37")
DO EN^DDIOL("APPOINTMENT DATE","","?51")
DO EN^DDIOL("DAYS","","?70")
DO EN^DDIOL("STA","","?76")
+21 DO EN^DDIOL("============================")
DO EN^DDIOL("=====","","?31")
DO EN^DDIOL("============","","?37")
DO EN^DDIOL("==================","","?51")
DO EN^DDIOL("====","","?70")
DO EN^DDIOL("===","","?76")
End DoDot:2
End DoDot:1
+22 IF +DGERROR
Begin DoDot:1
+23 DO EN^DDIOL($PIECE(DGERROR,"^",2),"","!!!")
+24 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE
End DoDot:1
QUIT
+25 SET PAGE=PAGE+1
+26 QUIT
DATA ;
+1 NEW DFN,DGNAM,DGSSN,DGI,DATAEP,DGFLG,DGRDTI,DGDAYS,DFNIEN,SDADTI,SDADT,DGDAYS,DGENPRI,DGENCVEL,DATA3,DGSTA
+2 FOR DGI="C","E","F","I","NULL"
SET DGTOTAL(DGI)=0
+3 SET DGPFTF=""
+4 FOR
SET DGPFTF=$ORDER(^TMP($JOB,"DGEN NEACL",DGPFTF))
IF (DGPFTF="")
QUIT
Begin DoDot:1
+5 IF DGPFTFLG
FOR DGI="C","E","F","I","NULL"
SET DGTOTAL(DGI)=0
+6 IF ((DGPFTFLG)&(PAGE>1))
DO TOP
IF ((DGPFTFLG)&(PAGE=1))
DO HEADER
+7 SET DGI=0
+8 FOR
SET DGI=$ORDER(^TMP($JOB,"DGEN NEACL",DGPFTF,DGI))
IF (DGI="")
QUIT
Begin DoDot:2
+9 SET DGRDTI=0
FOR
SET DGRDTI=$ORDER(^TMP($JOB,"DGEN NEACL",DGPFTF,DGI,DGRDTI))
IF 'DGRDTI
QUIT
Begin DoDot:3
+10 SET DGNAM=""
FOR
SET DGNAM=$ORDER(^TMP($JOB,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM))
IF DGNAM=""
QUIT
Begin DoDot:4
+11 SET DFNIEN=""
FOR
SET DFNIEN=$ORDER(^TMP($JOB,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN))
IF DFNIEN=""
QUIT
Begin DoDot:5
+12 SET SDADTI=$GET(^TMP($JOB,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN))
+13 SET DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
IF DGSTA=""
SET DGSTA="NULL"
+14 IF DGSTA="C"
SET SDADTI=$$GET1^DIQ(2,DFNIEN,1010.162,"I")
+15 SET DGDAYS=$$DAYS(SDADTI,DGRDTI)
SET Y=SDADTI
XECUTE ^DD("DD")
SET SDADT=Y
+16 SET DGFLG=0
IF 'SDADTI
SET DGFLG=1
+17 SET DATAEP=$GET(^TMP($JOB,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN,"PRIORITY"))
+18 SET DGENPRI=$PIECE(DATAEP,"^",3)
SET DGENCVEL=$PIECE(DATAEP,"^",4)
+19 SET DATA3="/"
IF +DGENPRI
SET $PIECE(DATA3,"/")=$EXTRACT(" ",$LENGTH(+DGENPRI)+1,2)_+DGENPRI
IF DGENCVEL
SET $PIECE(DATA3,"/",2)="EL"
IF DATA3="/"
SET DATA3=""
+20 SET DGTOTAL(DGSTA)=DGTOTAL(DGSTA)+1
+21 DO ADD
IF '(QUIT)
DO LINE
End DoDot:5
IF QUIT
QUIT
End DoDot:4
IF QUIT
QUIT
End DoDot:3
IF QUIT
QUIT
End DoDot:2
IF QUIT
QUIT
+22 IF DGPFTFLG
DO SUMARY
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE
End DoDot:1
IF QUIT
QUIT
+23 QUIT
PAUSE ;
+1 NEW DIR,DIRUT,X,Y
+2 FOR
IF $Y>(IOSL-3)
QUIT
WRITE !
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 IF ('(+Y))!($DATA(DIRUT))
SET QUIT=1
+6 QUIT
TOP ;
+1 DO EN^DDIOL("","","@IOF")
+2 DO HEADER
+3 QUIT
ADD ;
+1 IF $EXTRACT(IOST,1,2)="C-"
IF ($Y>(IOSL-3))
Begin DoDot:1
+2 DO PAUSE
+3 IF QUIT
QUIT
+4 DO TOP
End DoDot:1
+5 IF $EXTRACT(IOST,1,2)'="C-"
IF ($Y>(IOSL-3))
DO TOP
+6 QUIT
LINE ;add a line to the report
+1 NEW DGNAMX,DPTDFN,DGCMT
+2 IF DGRPT=2
SET DGNAMX=$PIECE(DGNAM,",")
+3 IF '$TEST
SET DGNAMX=DGNAM
+4 SET DGNAMX=DGNAMX_"("_$EXTRACT($$GET1^DIQ(2,DFNIEN,.09),6,9)_")"
+5 IF DGRPT=1
IF ($GET(DGFMT1)="D")
Begin DoDot:1
+6 DO EN^DDIOL(DGNAMX,"","!")
DO ADD
IF QUIT
QUIT
+7 SET (Y,DPTDFN)=DFNIEN
+8 IF $$TESTPAT^VADPT(+Y)
DO EN^DDIOL("WARNING : You have selected a test patient.")
DO ADD
IF QUIT
QUIT
+9 IF $$BADADR^DGUTL3(+Y)
DO EN^DDIOL("WARNING : ** This patient has been flagged with a Bad Address Indicator.")
DO ADD
IF QUIT
QUIT
+10 IF $DATA(^DPT("AXFFP",1,+Y))
SET DGCLIST=1
DO FFP^DPTLK5
KILL DGCLIST
DO ADD
IF QUIT
QUIT
+11 DO ENR^DPTLK
DO ADD
IF QUIT
QUIT
+12 DO CV^DPTLK
DO ADD
IF QUIT
QUIT
+13 DO EN^DDIOL("1010EZ APPT. REQUEST DATE: ")
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?28")
DO ADD
IF QUIT
QUIT
+14 DO EN^DDIOL("REQUEST STATUS: ")
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161),"","?18")
DO ADD
IF QUIT
QUIT
+15 DO EN^DDIOL("COMMENT: "_$$GET1^DIQ(2,DFNIEN,1010.163))
DO ADD
IF QUIT
QUIT
+16 DO EN^DDIOL("PHONE [RESIDENCE]: "_$$GET1^DIQ(2,DFNIEN,.131))
+17 DO EN^DDIOL("PHONE [CELLULAR]: "_$$GET1^DIQ(2,DFNIEN,.134),"","?44")
DO ADD
IF QUIT
QUIT
+18 DO EN^DDIOL("PREFERRED FACILITY: "_DGPFTF)
DO ADD
IF QUIT
QUIT
+19 ;D EN^DDIOL("PREFERRED FACILITY: "_$$GET1^DIQ(2,DFNIEN,27.02)) D ADD Q:QUIT
+20 DO EN^DDIOL("---------------------------------------------------------------","","!?4")
DO ADD
IF QUIT
QUIT
End DoDot:1
+21 IF DGRPT=1
IF ($GET(DGFMT1)="S")
Begin DoDot:1
+22 DO EN^DDIOL(DGNAMX)
IF $LENGTH(DGNAMX)>29
DO EN^DDIOL("","","!")
DO ADD
IF QUIT
QUIT
+23 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?30")
+24 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?46")
+25 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,.131),"","?51")
+26 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,.134),"","?66")
+27 DO ADD
IF QUIT
QUIT
End DoDot:1
IF QUIT
QUIT
+28 IF DGRPT=2
IF ($GET(DGFMT2)="D")
Begin DoDot:1
+29 DO EN^DDIOL(DGNAMX)
IF $LENGTH(DGNAMX)>29
DO EN^DDIOL("","","!")
DO ADD
IF QUIT
QUIT
+30 DO EN^DDIOL(DATA3,"","?31")
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?37")
DO EN^DDIOL(SDADT,"","?51")
DO EN^DDIOL($JUSTIFY(DGDAYS,3)_$SELECT(DGFLG:"*",1:""),"","?71")
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?77")
DO ADD
IF QUIT
QUIT
+31 SET DGCMT=$$GET1^DIQ(2,DFNIEN,1010.163)
IF $GET(DGCMT)'=""
DO EN^DDIOL("COMMENT: "_DGCMT,"","!?3")
DO ADD
IF QUIT
QUIT
End DoDot:1
+32 SET DGLN=1
+33 QUIT
+34 ;
SUMARY ;display totals
+1 ;K DGFMT1 S DGFMT2="S"
+2 DO ADD2
IF QUIT
QUIT
+3 DO EN^DDIOL("SUMMARY","","!!!")
+4 DO EN^DDIOL("==============================================================================")
+5 SET DGI=""
FOR
SET DGI=$ORDER(DGTOTAL(DGI))
IF DGI=""
QUIT
Begin DoDot:1
+6 IF (DGRPT=1)&((DGI="C")!(DGI="F"))
QUIT
+7 DO EN^DDIOL("Total number of veteran's "_$SELECT(DGI="NULL":"",1:"with ")_$SELECT(DGI="C":"CANCELLED",DGI="E":"EWL",DGI="F":"FILLED",DGI="I":"CONTACTED - IN PROCESS",1:"PENDING ACTION")_$SELECT(DGI="NULL":"",1:" request status"))
+8 DO EN^DDIOL($JUSTIFY(DGTOTAL(DGI),4),"","?73")
End DoDot:1
+9 QUIT
+10 ;
ADD2 ;
+1 IF $EXTRACT(IOST,1,2)="C-"
IF ($Y>(IOSL-8))
Begin DoDot:1
+2 DO PAUSE
+3 IF QUIT
QUIT
+4 DO TOP
End DoDot:1
+5 IF $EXTRACT(IOST,1,2)'="C-"
IF ($Y>(IOSL-8))
DO TOP
+6 QUIT
DAYS(X1,X2) ;Compute # of days
+1 SET X1=$GET(X1)
SET X2=$GET(X2)
+2 IF X1=""
SET X1=DT
+3 DO ^%DTC
+4 QUIT X
Q QUIT
