Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENACL

DGENACL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EDIT ;-Entry point - Edit Appointment Request Status and Comment option
  1. N DIC,DIE,DA,DR,Y,DFN
  1. S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y
  1. S DIE=DIC,DA=+Y,DR="[DGEN NEACL]" D ^DIE W !!
  1. G EDIT
  1. Q Q
  1. ;
  1. REPORT(DGRPT) ;-Entry point - Call List/Tracking reports
  1. ;
  1. ; DGRPT: 1 = Call List: New enrollee appt. request/no appt. assigned.
  1. ; 2 = Tracking Report: New enrollee appt. request/by date range
  1. ;
  1. N DGBEG,DGEND,DTOUT,DUOUT,DIRUT,DGFMT1,DGFMT2,DGERROR,DGPFTF,DGPFTFLG,DGSITE
  1. S (DGBEG,DGEND,DGERROR)="",DGSITE=+$P($$SITE^VASITE(),U,3)
  1. I $G(DGRPT)'=1&($G(DGRPT)'=2) G Q
  1. I DGRPT=1 D FMT1 I $D(DTOUT)!($D(DUOUT)) G Q
  1. I DGRPT=2 D FMT2 I $D(DTOUT)!($D(DUOUT)) G Q
  1. D PFTF I $D(DTOUT)!($D(DUOUT)) G Q
  1. I DGPFTFLG,'$O(DGPFTF("")) G Q
  1. N ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZUSR,ZTDTH,POP,X,ERR,V
  1. K IOP,%ZIS
  1. S %ZIS="Q" D ^%ZIS G:POP EXIT
  1. I $D(IO("Q")) D Q
  1. . F V="DGSITE","DGRPT","DGFMT1","DGFMT2","DGBEG","DGEND","DGPFTF(","DGERROR","DGPFTFLG" S ZTSAVE(V)=""
  1. . S ZTRTN="BUILD^DGENACL",ZTDESC="NEW ENROLLEE APPT. CALL LIST REPORT",ZTDTH=$H
  1. . D ^%ZTLOAD
  1. . D ^%ZISC,HOME^%ZIS
  1. . W !,$S($D(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
  1. D BUILD
  1. EXIT D ^%ZISC,HOME^%ZIS
  1. Q
  1. ;
  1. BUILD ;-Build temp global
  1. K ^TMP($J,"DGEN NEACL")
  1. N DFNIEN,DGDT,DGEDT
  1. I DGRPT=1 S DFNIEN=0 F S DFNIEN=$O(^DPT("AEAR",1,DFNIEN)) Q:'DFNIEN D Q:+DGERROR
  1. . I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
  1. I DGRPT=2 D
  1. . S DGDT=DGBEG-.01,DGEDT=DGEND_.999
  1. . F S DGDT=$O(^DPT("AEACL",DGDT)) Q:'DGDT!(DGDT>DGEDT) D Q:+DGERROR
  1. .. S DFNIEN=0 F S DFNIEN=$O(^DPT("AEACL",DGDT,DFNIEN)) Q:'DFNIEN D Q:+DGERROR
  1. ... I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
  1. D PRINT^DGENACL1
  1. Q
  1. ;
  1. EXTRACT ;
  1. D EXTRACT^DGENACL2
  1. Q
  1. ;
  1. DATE N X1,X2
  1. S DIR(0)="DAO^,"_DT_",::EX"
  1. S X1=DT,X2=-7 D C^%DTC
  1. S Y=X D DD^%DT
  1. ; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST START DATE"
  1. S DIR("A")="APPOINTMENT REQUEST START DATE: "
  1. S DIR("B")=Y
  1. S DIR("?")="Enter a date that an enrollee was asked question."
  1. D ^DIR K DIR
  1. I $D(DIRUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S DGBEG=Y
  1. S DIR(0)="DAO^"_DGBEG_","_DT_"::EX"
  1. S Y=DT D DD^%DT S DGDT=Y
  1. S DIR("B")=DGDT
  1. ; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST END DATE"
  1. S DIR("A")="APPOINTMENT REQUEST END DATE: "
  1. S DIR("?")="Enter a date that an enrollee was asked question."
  1. D ^DIR K DIR
  1. I $D(DIRUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S DGEND=Y
  1. I $G(DGBEG)']""!($G(DGEND)']"") W !!,"DATE RANGE NOT SET. EXITING" S DUOUT=1
  1. Q
  1. FMT1 ;Call List D/S
  1. N DIR
  1. K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SHORT"
  1. S DIR("?",1)="SHORT format lists enrollee appointment requests w/o an appointment."
  1. S DIR("?")="DETAILED format, in addition, lists patient lookup information."
  1. S DIR("B")="SHORT" D ^DIR K DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S DGFMT1=Y
  1. Q
  1. FMT2 ;Tracking Report D/S
  1. N DIR
  1. K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SUMMARY"
  1. S DIR("?",1)="SUMMARY format lists totals of enrollee appointment requests."
  1. S DIR("?")="DETAILED format, lists individual enrollee appointment requests."
  1. S DIR("B")="SUMMARY" D ^DIR K DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S DGFMT2=Y
  1. D DATE
  1. Q
  1. PFTF ;Ask Preferred Facility?
  1. S DGPFTFLG=0
  1. S DIR("A")="Select individual Preferred Facilities",DIR(0)="Y",DIR("B")="NO"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. I Y=1 S DGPFTFLG=1
  1. I DGPFTFLG D
  1. . K DGPFTF
  1. . S DIR("A")="Preferred Facility",DIR(0)="PO^4:EMZ",DIR("S")="I $$PFTF^DGREGDD(Y),(+DGSITE=+$$GET1^DIQ(4,Y,99))"
  1. . F D ^DIR Q:(+Y<0)!($D(DTOUT))!($D(DUOUT)) S DGPFTF(+Y)=""
  1. Q
  1. BCKJOB(DGRPT) ;Queued entry point
  1. N DGERROR,DGPFTFLG,DGFMT1,DGSITE
  1. S DGRPT=$G(DGRPT) I DGRPT'=1 Q
  1. S DGFMT1="D"
  1. S (DGERROR,DGPFTFLG)="",DGSITE=+$P($$SITE^VASITE(),U,3)
  1. D BUILD
  1. Q
  1. ;