DGENACL ;ALB/MRY,LBD,JAM - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;6/9/10 2:09pm
;;5.3;Registration;**779,788,824,978**;08/13/93;Build 19
;
EDIT ;-Entry point - Edit Appointment Request Status and Comment option
N DIC,DIE,DA,DR,Y,DFN
S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y
S DIE=DIC,DA=+Y,DR="[DGEN NEACL]" D ^DIE W !!
G EDIT
Q Q
;
REPORT(DGRPT) ;-Entry point - Call List/Tracking reports
;
; DGRPT: 1 = Call List: New enrollee appt. request/no appt. assigned.
; 2 = Tracking Report: New enrollee appt. request/by date range
;
N DGBEG,DGEND,DTOUT,DUOUT,DIRUT,DGFMT1,DGFMT2,DGERROR,DGPFTF,DGPFTFLG,DGSITE
S (DGBEG,DGEND,DGERROR)="",DGSITE=+$P($$SITE^VASITE(),U,3)
I $G(DGRPT)'=1&($G(DGRPT)'=2) G Q
I DGRPT=1 D FMT1 I $D(DTOUT)!($D(DUOUT)) G Q
I DGRPT=2 D FMT2 I $D(DTOUT)!($D(DUOUT)) G Q
D PFTF I $D(DTOUT)!($D(DUOUT)) G Q
I DGPFTFLG,'$O(DGPFTF("")) G Q
N ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZUSR,ZTDTH,POP,X,ERR,V
K IOP,%ZIS
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D Q
. F V="DGSITE","DGRPT","DGFMT1","DGFMT2","DGBEG","DGEND","DGPFTF(","DGERROR","DGPFTFLG" S ZTSAVE(V)=""
. S ZTRTN="BUILD^DGENACL",ZTDESC="NEW ENROLLEE APPT. CALL LIST REPORT",ZTDTH=$H
. D ^%ZTLOAD
. D ^%ZISC,HOME^%ZIS
. W !,$S($D(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
D BUILD
EXIT D ^%ZISC,HOME^%ZIS
Q
;
BUILD ;-Build temp global
K ^TMP($J,"DGEN NEACL")
N DFNIEN,DGDT,DGEDT
I DGRPT=1 S DFNIEN=0 F S DFNIEN=$O(^DPT("AEAR",1,DFNIEN)) Q:'DFNIEN D Q:+DGERROR
. I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
I DGRPT=2 D
. S DGDT=DGBEG-.01,DGEDT=DGEND_.999
. F S DGDT=$O(^DPT("AEACL",DGDT)) Q:'DGDT!(DGDT>DGEDT) D Q:+DGERROR
.. S DFNIEN=0 F S DFNIEN=$O(^DPT("AEACL",DGDT,DFNIEN)) Q:'DFNIEN D Q:+DGERROR
... I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
D PRINT^DGENACL1
Q
;
D EXTRACT^DGENACL2
Q
;
DATE N X1,X2
S DIR(0)="DAO^,"_DT_",::EX"
S X1=DT,X2=-7 D C^%DTC
S Y=X D DD^%DT
; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST START DATE"
S DIR("A")="APPOINTMENT REQUEST START DATE: "
S DIR("B")=Y
S DIR("?")="Enter a date that an enrollee was asked question."
D ^DIR K DIR
I $D(DIRUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S DGBEG=Y
S DIR(0)="DAO^"_DGBEG_","_DT_"::EX"
S Y=DT D DD^%DT S DGDT=Y
S DIR("B")=DGDT
; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST END DATE"
S DIR("A")="APPOINTMENT REQUEST END DATE: "
S DIR("?")="Enter a date that an enrollee was asked question."
D ^DIR K DIR
I $D(DIRUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S DGEND=Y
I $G(DGBEG)']""!($G(DGEND)']"") W !!,"DATE RANGE NOT SET. EXITING" S DUOUT=1
Q
FMT1 ;Call List D/S
N DIR
K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SHORT"
S DIR("?",1)="SHORT format lists enrollee appointment requests w/o an appointment."
S DIR("?")="DETAILED format, in addition, lists patient lookup information."
S DIR("B")="SHORT" D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) Q
S DGFMT1=Y
Q
FMT2 ;Tracking Report D/S
N DIR
K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SUMMARY"
S DIR("?",1)="SUMMARY format lists totals of enrollee appointment requests."
S DIR("?")="DETAILED format, lists individual enrollee appointment requests."
S DIR("B")="SUMMARY" D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) Q
S DGFMT2=Y
D DATE
Q
PFTF ;Ask Preferred Facility?
S DGPFTFLG=0
S DIR("A")="Select individual Preferred Facilities",DIR(0)="Y",DIR("B")="NO"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) Q
I Y=1 S DGPFTFLG=1
I DGPFTFLG D
. K DGPFTF
. S DIR("A")="Preferred Facility",DIR(0)="PO^4:EMZ",DIR("S")="I $$PFTF^DGREGDD(Y),(+DGSITE=+$$GET1^DIQ(4,Y,99))"
. F D ^DIR Q:(+Y<0)!($D(DTOUT))!($D(DUOUT)) S DGPFTF(+Y)=""
Q
BCKJOB(DGRPT) ;Queued entry point
N DGERROR,DGPFTFLG,DGFMT1,DGSITE
S DGRPT=$G(DGRPT) I DGRPT'=1 Q
S DGFMT1="D"
S (DGERROR,DGPFTFLG)="",DGSITE=+$P($$SITE^VASITE(),U,3)
D BUILD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENACL 4032 printed Apr 09, 2024@21:57:12 Page 2
DGENACL ;ALB/MRY,LBD,JAM - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;6/9/10 2:09pm
+1 ;;5.3;Registration;**779,788,824,978**;08/13/93;Build 19
+2 ;
EDIT ;-Entry point - Edit Appointment Request Status and Comment option
+1 NEW DIC,DIE,DA,DR,Y,DFN
+2 SET DIC="^DPT("
SET DIC(0)="AEQMZ"
DO ^DIC
if Y'>0
GOTO Q
SET DFN=+Y
+3 SET DIE=DIC
SET DA=+Y
SET DR="[DGEN NEACL]"
DO ^DIE
WRITE !!
+4 GOTO EDIT
Q QUIT
+1 ;
REPORT(DGRPT) ;-Entry point - Call List/Tracking reports
+1 ;
+2 ; DGRPT: 1 = Call List: New enrollee appt. request/no appt. assigned.
+3 ; 2 = Tracking Report: New enrollee appt. request/by date range
+4 ;
+5 NEW DGBEG,DGEND,DTOUT,DUOUT,DIRUT,DGFMT1,DGFMT2,DGERROR,DGPFTF,DGPFTFLG,DGSITE
+6 SET (DGBEG,DGEND,DGERROR)=""
SET DGSITE=+$PIECE($$SITE^VASITE(),U,3)
+7 IF $GET(DGRPT)'=1&($GET(DGRPT)'=2)
GOTO Q
+8 IF DGRPT=1
DO FMT1
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q
+9 IF DGRPT=2
DO FMT2
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q
+10 DO PFTF
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q
+11 IF DGPFTFLG
IF '$ORDER(DGPFTF(""))
GOTO Q
+12 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZUSR,ZTDTH,POP,X,ERR,V
+13 KILL IOP,%ZIS
+14 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+15 IF $DATA(IO("Q"))
Begin DoDot:1
+16 FOR V="DGSITE","DGRPT","DGFMT1","DGFMT2","DGBEG","DGEND","DGPFTF(","DGERROR","DGPFTFLG"
SET ZTSAVE(V)=""
+17 SET ZTRTN="BUILD^DGENACL"
SET ZTDESC="NEW ENROLLEE APPT. CALL LIST REPORT"
SET ZTDTH=$HOROLOG
+18 DO ^%ZTLOAD
+19 DO ^%ZISC
DO HOME^%ZIS
+20 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
End DoDot:1
QUIT
+21 DO BUILD
EXIT DO ^%ZISC
DO HOME^%ZIS
+1 QUIT
+2 ;
BUILD ;-Build temp global
+1 KILL ^TMP($JOB,"DGEN NEACL")
+2 NEW DFNIEN,DGDT,DGEDT
+3 IF DGRPT=1
SET DFNIEN=0
FOR
SET DFNIEN=$ORDER(^DPT("AEAR",1,DFNIEN))
if 'DFNIEN
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(2,DFNIEN,1010.159,"I")
DO EXTRACT
End DoDot:1
if +DGERROR
QUIT
+5 IF DGRPT=2
Begin DoDot:1
+6 SET DGDT=DGBEG-.01
SET DGEDT=DGEND_.999
+7 FOR
SET DGDT=$ORDER(^DPT("AEACL",DGDT))
if 'DGDT!(DGDT>DGEDT)
QUIT
Begin DoDot:2
+8 SET DFNIEN=0
FOR
SET DFNIEN=$ORDER(^DPT("AEACL",DGDT,DFNIEN))
if 'DFNIEN
QUIT
Begin DoDot:3
+9 IF $$GET1^DIQ(2,DFNIEN,1010.159,"I")
DO EXTRACT
End DoDot:3
if +DGERROR
QUIT
End DoDot:2
if +DGERROR
QUIT
End DoDot:1
+10 DO PRINT^DGENACL1
+11 QUIT
+12 ;
+1 DO EXTRACT^DGENACL2
+2 QUIT
+3 ;
DATE NEW X1,X2
+1 SET DIR(0)="DAO^,"_DT_",::EX"
+2 SET X1=DT
SET X2=-7
DO C^%DTC
+3 SET Y=X
DO DD^%DT
+4 ; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST START DATE"
+5 SET DIR("A")="APPOINTMENT REQUEST START DATE: "
+6 SET DIR("B")=Y
+7 SET DIR("?")="Enter a date that an enrollee was asked question."
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET DGBEG=Y
+12 SET DIR(0)="DAO^"_DGBEG_","_DT_"::EX"
+13 SET Y=DT
DO DD^%DT
SET DGDT=Y
+14 SET DIR("B")=DGDT
+15 ; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST END DATE"
+16 SET DIR("A")="APPOINTMENT REQUEST END DATE: "
+17 SET DIR("?")="Enter a date that an enrollee was asked question."
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DIRUT)
SET DTOUT=1
+20 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+21 SET DGEND=Y
+22 IF $GET(DGBEG)']""!($GET(DGEND)']"")
WRITE !!,"DATE RANGE NOT SET. EXITING"
SET DUOUT=1
+23 QUIT
FMT1 ;Call List D/S
+1 NEW DIR
+2 KILL DIR
SET DIR("A")="Select report format"
SET DIR(0)="S^D:DETAILED;S:SHORT"
+3 SET DIR("?",1)="SHORT format lists enrollee appointment requests w/o an appointment."
+4 SET DIR("?")="DETAILED format, in addition, lists patient lookup information."
+5 SET DIR("B")="SHORT"
DO ^DIR
KILL DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 SET DGFMT1=Y
+8 QUIT
FMT2 ;Tracking Report D/S
+1 NEW DIR
+2 KILL DIR
SET DIR("A")="Select report format"
SET DIR(0)="S^D:DETAILED;S:SUMMARY"
+3 SET DIR("?",1)="SUMMARY format lists totals of enrollee appointment requests."
+4 SET DIR("?")="DETAILED format, lists individual enrollee appointment requests."
+5 SET DIR("B")="SUMMARY"
DO ^DIR
KILL DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 SET DGFMT2=Y
+8 DO DATE
+9 QUIT
PFTF ;Ask Preferred Facility?
+1 SET DGPFTFLG=0
+2 SET DIR("A")="Select individual Preferred Facilities"
SET DIR(0)="Y"
SET DIR("B")="NO"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+5 IF Y=1
SET DGPFTFLG=1
+6 IF DGPFTFLG
Begin DoDot:1
+7 KILL DGPFTF
+8 SET DIR("A")="Preferred Facility"
SET DIR(0)="PO^4:EMZ"
SET DIR("S")="I $$PFTF^DGREGDD(Y),(+DGSITE=+$$GET1^DIQ(4,Y,99))"
+9 FOR
DO ^DIR
if (+Y<0)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
SET DGPFTF(+Y)=""
End DoDot:1
+10 QUIT
BCKJOB(DGRPT) ;Queued entry point
+1 NEW DGERROR,DGPFTFLG,DGFMT1,DGSITE
+2 SET DGRPT=$GET(DGRPT)
IF DGRPT'=1
QUIT
+3 SET DGFMT1="D"
+4 SET (DGERROR,DGPFTFLG)=""
SET DGSITE=+$PIECE($$SITE^VASITE(),U,3)
+5 DO BUILD
+6 QUIT
+7 ;
