DGENACL1 ;ALB/MRY,JAM,JAM - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
;;5.3;Registration;**779,788,978,996**;08/13/93;Build 47
;
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
. . ; jam DG*5.3*978 - modified column header - remove "1010EZ" from "APPT. REQUEST DATE" column
. . D EN^DDIOL("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
. . ; jam DG*5.3*978 - modified column headers text - "APPT. REQUEST" and "SCHEDULED APPT. DATE" column
. . ; added column ORIGINAL APPT. REQUEST
. . ; jam DG*5.3*996 - remove column ORIGINAL APPT. REQUEST - adjust positions of remaining columns
. . D EN^DDIOL("SCHEDULED","","!!?57")
. . D EN^DDIOL("APPT.","","!?47"),EN^DDIOL("APPT.","","?57"),EN^DDIOL("#","","?67"),EN^DDIOL("REQ","","?72")
. . D EN^DDIOL("NAME"),EN^DDIOL("EP/CV","","?41"),EN^DDIOL("REQUEST","","?47"),EN^DDIOL("DATE","","?57"),EN^DDIOL("DAYS","","?67"),EN^DDIOL("STA","","?72")
. . D EN^DDIOL("======================================"),EN^DDIOL("=====","","?41"),EN^DDIOL("=========","","?47"),EN^DDIOL("=========","","?57"),EN^DDIOL("====","","?67"),EN^DDIOL("===","","?72")
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
. ; jam DG*5.3*978 - modified field label - remove "1010EZ" from "APPT. REQUEST DATE"
. D EN^DDIOL("APPT. REQUEST DATE: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?28") D ADD Q:QUIT
. ; jam DG*5.3*978 - add Original Appt. Request Date field to the report - display the field only if 1010.1512 is 1 (YES)
. D EN^DDIOL("ORIGINAL APPT. REQUEST DATE: ") D:$$GET1^DIQ(2,DFNIEN,1010.1512,"I")=1 EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1513),"","?30") 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
. ; jam DG*5.3*996 - remove Original Appt. Request Date field - adjust positions of remaining fields - NAME field expanded 10 chars
. D EN^DDIOL(DGNAMX) I $L(DGNAMX)>39 D EN^DDIOL("","","!") D ADD Q:QUIT
. ; jam DG*5.3*978 added new column ORIGINAL APPT REQUEST DATE field 1010.1513
. ; this requires changes for the date fields to print out in mm/dd/yy format
. ;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
. D EN^DDIOL(DATA3,"","?41"),EN^DDIOL($$FMTE^XLFDT($$GET1^DIQ(2,DFNIEN,1010.1511,"I"),"2DZ"),"","?47")
. ; DG*5.3*978 only display the field if ORIGINAL APPT REQUEST (field 1010.1512) is 1 (YES)
. ; jam DG*5.3*996 - remove Original Appt. Request Date field
. ;I $$GET1^DIQ(2,DFNIEN,1010.1512,"I")=1 D EN^DDIOL($$FMTE^XLFDT($$GET1^DIQ(2,DFNIEN,1010.1513,"I"),"2DZ"),"","?47")
. D EN^DDIOL($$FMTE^XLFDT(SDADTI,"2DZ"),"","?57"),EN^DDIOL($J(DGDAYS,3)_$S(DGFLG:"*",1:""),"","?67"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?73") 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENACL1 8240 printed Sep 23, 2025@20:18:15 Page 2
DGENACL1 ;ALB/MRY,JAM,JAM - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
+1 ;;5.3;Registration;**779,788,978,996**;08/13/93;Build 47
+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 ; jam DG*5.3*978 - modified column header - remove "1010EZ" from "APPT. REQUEST DATE" column
+9 DO EN^DDIOL("APPT.","","?30")
DO EN^DDIOL("REQ","","?45")
DO EN^DDIOL("RESIDENCE","","?52")
DO EN^DDIOL("CELLULAR","","?67")
+10 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")
+11 DO EN^DDIOL("","","!")
End DoDot:2
End DoDot:1
+12 IF DGRPT=2
Begin DoDot:1
+13 SET Y=DGBEG
DO DD^%DT
SET DG1=Y
+14 SET Y=DGEND
DO DD^%DT
SET DG2=Y
+15 DO EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST TRACKING REPORT","","!?10")
+16 SET Y=DT
DO DD^%DT
DO EN^DDIOL("Date: "_Y,"","?60")
+17 DO EN^DDIOL(DG1_" TO "_DG2,"","!?20")
DO EN^DDIOL("Page: "_PAGE,"","?60")
+18 if DGPFTFLG
DO EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!")
+19 IF ($GET(DGFMT2)="D")
Begin DoDot:2
+20 ; jam DG*5.3*978 - modified column headers text - "APPT. REQUEST" and "SCHEDULED APPT. DATE" column
+21 ; added column ORIGINAL APPT. REQUEST
+22 ; jam DG*5.3*996 - remove column ORIGINAL APPT. REQUEST - adjust positions of remaining columns
+23 DO EN^DDIOL("SCHEDULED","","!!?57")
+24 DO EN^DDIOL("APPT.","","!?47")
DO EN^DDIOL("APPT.","","?57")
DO EN^DDIOL("#","","?67")
DO EN^DDIOL("REQ","","?72")
+25 DO EN^DDIOL("NAME")
DO EN^DDIOL("EP/CV","","?41")
DO EN^DDIOL("REQUEST","","?47")
DO EN^DDIOL("DATE","","?57")
DO EN^DDIOL("DAYS","","?67")
DO EN^DDIOL("STA","","?72")
+26 DO EN^DDIOL("======================================")
DO EN^DDIOL("=====","","?41")
DO EN^DDIOL("=========","","?47")
DO EN^DDIOL("=========","","?57")
DO EN^DDIOL("====","","?67")
DO EN^DDIOL("===","","?72")
End DoDot:2
End DoDot:1
+27 IF +DGERROR
Begin DoDot:1
+28 DO EN^DDIOL($PIECE(DGERROR,"^",2),"","!!!")
+29 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE
End DoDot:1
QUIT
+30 SET PAGE=PAGE+1
+31 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 ; jam DG*5.3*978 - modified field label - remove "1010EZ" from "APPT. REQUEST DATE"
+14 DO EN^DDIOL("APPT. REQUEST DATE: ")
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?28")
DO ADD
if QUIT
QUIT
+15 ; jam DG*5.3*978 - add Original Appt. Request Date field to the report - display the field only if 1010.1512 is 1 (YES)
+16 DO EN^DDIOL("ORIGINAL APPT. REQUEST DATE: ")
if $$GET1^DIQ(2,DFNIEN,1010.1512,"I")=1
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1513),"","?30")
DO ADD
if QUIT
QUIT
+17 DO EN^DDIOL("REQUEST STATUS: ")
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161),"","?18")
DO ADD
if QUIT
QUIT
+18 DO EN^DDIOL("COMMENT: "_$$GET1^DIQ(2,DFNIEN,1010.163))
DO ADD
if QUIT
QUIT
+19 DO EN^DDIOL("PHONE [RESIDENCE]: "_$$GET1^DIQ(2,DFNIEN,.131))
+20 DO EN^DDIOL("PHONE [CELLULAR]: "_$$GET1^DIQ(2,DFNIEN,.134),"","?44")
DO ADD
if QUIT
QUIT
+21 DO EN^DDIOL("PREFERRED FACILITY: "_DGPFTF)
DO ADD
if QUIT
QUIT
+22 ;D EN^DDIOL("PREFERRED FACILITY: "_$$GET1^DIQ(2,DFNIEN,27.02)) D ADD Q:QUIT
+23 DO EN^DDIOL("---------------------------------------------------------------","","!?4")
DO ADD
if QUIT
QUIT
End DoDot:1
+24 IF DGRPT=1
IF ($GET(DGFMT1)="S")
Begin DoDot:1
+25 DO EN^DDIOL(DGNAMX)
IF $LENGTH(DGNAMX)>29
DO EN^DDIOL("","","!")
DO ADD
if QUIT
QUIT
+26 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?30")
+27 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?46")
+28 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,.131),"","?51")
+29 DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,.134),"","?66")
+30 DO ADD
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+31 IF DGRPT=2
IF ($GET(DGFMT2)="D")
Begin DoDot:1
+32 ; jam DG*5.3*996 - remove Original Appt. Request Date field - adjust positions of remaining fields - NAME field expanded 10 chars
+33 DO EN^DDIOL(DGNAMX)
IF $LENGTH(DGNAMX)>39
DO EN^DDIOL("","","!")
DO ADD
if QUIT
QUIT
+34 ; jam DG*5.3*978 added new column ORIGINAL APPT REQUEST DATE field 1010.1513
+35 ; this requires changes for the date fields to print out in mm/dd/yy format
+36 ;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
+37 DO EN^DDIOL(DATA3,"","?41")
DO EN^DDIOL($$FMTE^XLFDT($$GET1^DIQ(2,DFNIEN,1010.1511,"I"),"2DZ"),"","?47")
+38 ; DG*5.3*978 only display the field if ORIGINAL APPT REQUEST (field 1010.1512) is 1 (YES)
+39 ; jam DG*5.3*996 - remove Original Appt. Request Date field
+40 ;I $$GET1^DIQ(2,DFNIEN,1010.1512,"I")=1 D EN^DDIOL($$FMTE^XLFDT($$GET1^DIQ(2,DFNIEN,1010.1513,"I"),"2DZ"),"","?47")
+41 DO EN^DDIOL($$FMTE^XLFDT(SDADTI,"2DZ"),"","?57")
DO EN^DDIOL($JUSTIFY(DGDAYS,3)_$SELECT(DGFLG:"*",1:""),"","?67")
DO EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?73")
DO ADD
if QUIT
QUIT
+42 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
+43 SET DGLN=1
+44 QUIT
+45 ;
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
