source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENACL.m@ 1578

Last change on this file since 1578 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1DGENACL ;ALB/MRY - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
2 ;;5.3;Registration;**779**;08/13/93;Build 11
3 ;
4EDIT ;-Entry point - Edit Appointment Request Status and Comment option
5 N DIC,DIE,DA,DR,Y,DFN
6 S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y
7 S DIE=DIC,DA=+Y,DR="[DGEN NEACL]" D ^DIE W !!
8 G EDIT
9Q Q
10 ;
11REPORT(DGRPT) ;-Entry point - Call List/Tracking reports
12 ;
13 ; DGRPT: 1 = Call List: New enrollee appt. request/no appt. assigned.
14 ; 2 = Tracking Report: New enrollee appt. request/by date range
15 ;
16 N DGBEG,DGEND,DTOUT,DUOUT,DIRUT,DGFMT1,DGFMT2
17 S (DGBEG,DGEND)=""
18 I $G(DGRPT)'=1&($G(DGRPT)'=2) G Q
19 I DGRPT=1 D FMT1 I $D(DTOUT)!($D(DUOUT)) G Q
20 I DGRPT=2 D FMT2,DATE I $D(DTOUT)!($D(DUOUT)) G Q
21 N ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZUSR,ZTDTH,POP,X,ERR
22 K IOP,%ZIS
23 S %ZIS="Q" D ^%ZIS G:POP EXIT
24 I $D(IO("Q")) D Q
25 . S (ZTSAVE("DGRPT"),ZTSAVE("DGFMT1"),ZTSAVE("DGFMT2"),ZTSAVE("DGBEG"),ZTSAVE("DGEND"))=""
26 . S ZTRTN="BUILD^DGENACL",ZTDESC="NEW ENROLLEE APPT. CALL LIST REPORT",ZTDTH=$H
27 . D ^%ZTLOAD
28 . D ^%ZISC,HOME^%ZIS
29 . W !,$S($D(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
30 D BUILD
31EXIT D ^%ZISC,HOME^%ZIS
32 Q
33 ;
34BUILD ;-Build temp global
35 K ^TMP($J,"DGEN NEACL")
36 N DFNIEN,DGDT,DGEDT
37 I DGRPT=1 S DFNIEN=0 F S DFNIEN=$O(^DPT("AEAR",1,DFNIEN)) Q:'DFNIEN D
38 . I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
39 I DGRPT=2 D
40 . S DGDT=DGBEG-.01,DGEDT=DGEND_.999
41 . F S DGDT=$O(^DPT("AEACL",DGDT)) Q:'DGDT!(DGDT>DGEDT) D
42 .. S DFNIEN=0 F S DFNIEN=$O(^DPT("AEACL",DGDT,DFNIEN)) Q:'DFNIEN D
43 ... I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
44 D PRINT^DGENACL1
45 Q
46 ;
47EXTRACT ;
48 N DGNAM,DGSSN,DGRDTI,DGENRIEN,DGENR,DGENCAT,DGENSTA,DGENPRI,DGENCV,DGENCVDT,DGENCVEL,DGSTA,DGCOM
49 N SDCNT,SDADT,SDARRY,SDCL,Y,FDATA
50 ;if call list, don't list if appointment made or request status
51 ;'filled' or 'completed'.
52 D APPTCK Q:'DGRDTI
53 S SDADT=$G(SDADT) I DGRPT=1 Q:(SDCNT>0)!(DGSTA="C")!(DGSTA="F")
54 S DGNAM=$$GET1^DIQ(2,DFNIEN,.01),DGSSN=$E($$GET1^DIQ(2,DFNIEN,.09),6,9)
55 S DGENRIEN=$$FINDCUR^DGENA(DFNIEN)
56 I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment arry
57 ;I DGENR("APP"))>3050731 D
58 S DGENCAT=$$CATEGORY^DGENA4(,$G(DGENR("STATUS"))) ;enrollment category
59 I DGENCAT'="E" Q
60 S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
61 S DGENSTA=$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:"")
62 S DGENPRI=$S($G(DGENR("PRIORITY")):DGENR("PRIORITY"),1:"")_$S($G(DGENR("SUBGRP")):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:"")
63 S DGENCV=$$CVEDT^DGCV(DFNIEN),DGENCVDT=$P($G(DGENCV),"^",2),DGENCVEL=$P($G(DGENCV),"^",3)
64 S ^TMP($J,"DGEN NEACL",$S(DGSTA="":1,DGSTA="I":2,DGSTA="E":3,DGSTA="F":4,1:DGSTA),DGRDTI,DGNAM,DFNIEN)=SDADT
65 I $G(DGENCAT)'=""!($G(DGENSTA)'="")!($G(DGENPRI)'="")!($G(DGENCVEL)'="") D
66 . S ^TMP($J,"DGEN NEACL",$S(DGSTA="":1,DGSTA="I":2,DGSTA="E":3,DGSTA="F":4,1:DGSTA),DGRDTI,DGNAM,DFNIEN,"PRIORITY")=DGENCAT_"^"_DGENSTA_"^"_DGENPRI_"^"_DGENCVEL
67 Q
68 ;
69APPTCK ;If appointment (SDCNT), get appointment date/time (SDADT).
70 K ^TMP($J,"SDAMA301")
71 ;quit, if no 'date appointment questioned asked?'
72 S DGRDTI=$$GET1^DIQ(2,DFNIEN,1010.1511,"I") Q:'DGRDTI
73 S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
74 S SDARRY(1)=DGRDTI_";",SDARRY(4)=DFNIEN,SDARRY("FLDS")=1,SDARRY("MAX")=1
75 S SDCNT=$$SDAPI^SDAMA301(.SDARRY) Q:(SDCNT'>0)
76 S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL)) Q:'SDCL D
77 . S SDADT=$O(^TMP($J,"SDAMA301",DFNIEN,SDCL,0))
78 ;if appointment and no status or EWL, set status to 'filled'.
79 ;I (DGSTA="")!(DGSTA="E") D
80 ;if appointment and status '="filled", set status to 'filled'
81 I DGSTA'="F" D
82 . S DGCOM=$$GET1^DIQ(2,DFNIEN,1010.163)
83 . S DGCOM=DGCOM_$S(DGCOM'="":"<>",1:"")_"AutoComm:"_$S(DGSTA="":"null",1:$S($$GET1^DIQ(2,DFNIEN,1010.161,"I")="I":"IN PROGRESS",1:$$GET1^DIQ(2,DFNIEN,1010.161)))_"|FILLED"
84 . S FDATA(2,DFNIEN_",",1010.161)="F"
85 . S FDATA(2,DFNIEN_",",1010.163)=DGCOM
86 . D FILE^DIE("","FDATA","DPTERR")
87 . S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I")
88 Q
89 ;
90DATE N X1,X2,DIROUT
91 S DIR(0)="DAO^,"_DT_",::EX"
92 S X1=DT,X2=-7 D C^%DTC
93 S Y=X D DD^%DT
94 S DIR("A")="APPOINTMENT REQUEST ON 1010EZ START DATE: "
95 S DIR("B")=Y
96 S DIR("?")="Enter a date that an enrollee was asked question."
97 D ^DIR K DIR
98 I $D(DIROUT) S DTOUT=1
99 I $D(DTOUT)!($D(DUOUT)) Q
100 S DGBEG=Y
101 S DIR(0)="DAO^"_DGBEG_","_DT_"::EX"
102 S Y=DT D DD^%DT S DGDT=Y
103 S DIR("B")=DGDT
104 S DIR("A")="APPOINTMENT REQUEST ON 1010EZ END DATE: "
105 S DIR("?")="Enter a date that an enrollee was asked question."
106 D ^DIR K DIR
107 I $D(DIROUT) S DTOUT=1
108 I $D(DTOUT)!($D(DUOUT)) Q
109 S DGEND=Y
110 I $G(DGBEG)']""!($G(DGEND)']"") W !!,"DATE RANGE NOT SET. EXITING" S DUOUT=1
111 Q
112FMT1 ;Call List D/S
113 N DIR
114 K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SHORT"
115 S DIR("?",1)="SHORT format lists enrollee appointment requests w/o an appointment."
116 S DIR("?")="DETAILED format, in addition, lists patient lookup information."
117 S DIR("B")="SHORT" D ^DIR Q:$D(DIRUT)
118 S DGFMT1=Y
119 Q
120FMT2 ;Tracking Report D/S
121 N DIR
122 K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SUMMARY"
123 S DIR("?",1)="SUMMARY format lists totals of enrollee appointment requests."
124 S DIR("?")="DETAILED format, lists individual enrollee appointment requests."
125 S DIR("B")="SUMMARY" D ^DIR Q:$D(DIRUT)
126 S DGFMT2=Y
127 Q
128BCKJOB(DGRPT) ;Queued entry point
129 S DGRPT=$G(DGRPT) I DGRPT'=1 Q
130 S DGFMT1="D"
131 D BUILD
132 Q
Note: See TracBrowser for help on using the repository browser.