- 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 Jan 18, 2025@03:43:04 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 ;