source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTRP1.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1EASMTRP1 ;ALB/GAH - MEANS TEST DAILY EXPIRATION REPORT ; 10/10/2006
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,13,46,77**;MAR 15,2001;Build 11
3 ;
4EN ; Interactive report generation, select date range
5 N EDATE,ERROR,MTREC,PIEN,VARR,RCNT,ACNT,DGARRAY,SDCNT,I
6 ;
7 D HOME^%ZIS
8 W @IOF
9 ;
10 ; Get beginning date of date range, default to TODAY
11 W !,$CHAR(7),"Enter date range for anniversary date search"
12 S DIR(0)="D^::EX",DIR("?")="^D HELP^%DTC",DIR("B")=$$FMTE^XLFDT(DT)
13 S DIR("A")=" Start Date"
14 D ^DIR K DIR
15 Q:$D(DIRUT)
16 S EASBEG=Y
17 ;
18 ; Get ending date of date range, default to TODAY
19 S DIR(0)="D^::EX",DIR("?")="^D HELP^%DTC",DIR("B")=$$FMTE^XLFDT(DT)
20 S DIR("A")=" End Date"
21 D ^DIR K DIR
22 Q:$D(DIRUT)
23 S EASEND=Y
24 ;
25 S EAX=$$GET1^DIQ(713,1,5)
26 S:EAX]"" %ZIS("B")=EAX
27 S ZTSAVE("EASBEG")="",ZTSAVE("EASEND")=""
28 D EN^XUTMDEVQ("BLD^EASMTRP1","EAS MT EXPIRATION RPT",.ZTSAVE,.%ZIS)
29 Q
30 ;
31QUE ; Queued report generation
32 N ZTSAVE,ZTRTN,ZTDESC,EAX,%ZIS
33 ;
34 S (EASBEG,EASEND)=$$FMADD^XLFDT($$DT^XLFDT,-1)
35 S ZTSAVE("EASBEG")="",ZTSAVE("EASEND")=""
36 S IOP=""
37 D EN^XUTMDEVQ("BLD^EASMTRP1","EAS MT EXPIRATION RPT",.ZTSAVE)
38 Q
39 ;
40BLD ; Build the list of MT expirations to TMP global
41 N EASIEN,EASANV,EASLST,EASENDT,DFN,EASTMP,EASDT,EASENDT
42 ;
43 K ^TMP("EASEXP",$J)
44 ;
45 S EASENDT=$$FMADD^XLFDT(EASEND,-365)
46 S EASANV=$$FMADD^XLFDT(EASBEG,-365,"",-1) ; Subtract 1 minute to capture the 1st day
47 F S EASANV=$O(^DGMT(408.31,"B",EASANV)) Q:'EASANV!(EASANV>EASENDT) D
48 . S EASIEN=0
49 . F S EASIEN=$O(^DGMT(408.31,"B",EASANV,EASIEN)) Q:'EASIEN D
50 . . S DFN=$$GET1^DIQ(408.31,EASIEN,.02,"I") Q:+DFN=0
51 . . S EASLST=$$LST^DGMTU(DFN)
52 . . Q:+EASLST'=EASIEN ; Quit it this MT is not the last MT on file
53 . . Q:$$DECEASED^EASMTUTL("",DFN) ; Quit if patient is deceased
54 . . Q:"N,P"[$P(EASLST,U,4) ; Quit if MT No longer Required or Pending Adjudication
55 . . ; Quit if Cat C, agrees to deductible and MT later the 10-5-99
56 . . I $P(EASLST,U,4)="C",$$GET1^DIQ(408.31,+EASLST,.11,"I"),$P(EASLST,U,2)>2991005 Q
57 . . ;;Q:$$FUTMT^EASMTUTL("","",DFN) ; Quit if future MT on file
58 . . S ^TMP("EASEXP",$J,EASANV,EASIEN)=DFN_U_EASLST
59 ;
60 S EASTMP="^TMP(""EASEXP"","_$J_")"
61 S EASDT("BEG")=EASBEG,EASDT("END")=EASEND
62 D BLDSD ; Call Scheduling API
63 D PRT(EASTMP,.EASDT) ; Call print report
64 K DGARRAY,SDCNT,VARR,I,^TMP($J,"SDAMA")
65 Q
66 ;
67BLDSD ;
68 N EDATE,ERROR,MTREC,PIEN,VARR,RCNT,ACNT,DGARRAY,SDCNT,I
69 S ACNT=1,RCNT=0
70 S EDATE=0 F S EDATE=$O(^TMP("EASEXP",$J,EDATE)) Q:'EDATE D
71 .S MTREC=0 F S MTREC=$O(^TMP("EASEXP",$J,EDATE,MTREC)) Q:'MTREC D
72 ..S PIEN=+^TMP("EASEXP",$J,EDATE,MTREC)
73 ..Q:'$D(^DPT(PIEN,0))
74 ..S RCNT=RCNT+1,VARR(ACNT)=$G(VARR(ACNT))_PIEN_";"
75 ..; Group DFNs by no more than twenty records
76 ..I RCNT>19 S ACNT=ACNT+1,RCNT=0
77 ;
78 ; Call SD API by array of Patient DFNs
79 S ERROR=""
80 K DGARRAY
81 S DGARRAY(1)=DT,DGARRAY("SORT")="P",DGARRAY("FLDS")="1;2"
82 F I=1:1 Q:'$D(VARR(I))!(ERROR'="") D
83 .S DGARRAY(4)=VARR(I)
84 .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
85 . I SDCNT>0 M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")
86 . I SDCNT<0 D
87 . . S ERROR=$O(^TMP($J,"SDAMA301",""))
88 . . S ^TMP($J,"SDAMA","ERROR")=^TMP($J,"SDAMA301",ERROR)
89 .K ^TMP($J,"SDAMA301")
90 Q
91 ;
92PRT(EASTMP,EASDT) ;
93 N EASANV,EASIEN,PAGE,DFN,EASP,EASABRT
94 ;
95 S EASANV=0,PAGE=0
96 D HDR(.EASDT)
97 ;
98 I '$D(@EASTMP) D Q
99 . W !!?3,">> No Means Test expirations for the selected date range."
100 ;
101 F S EASANV=$O(@EASTMP@(EASANV)) Q:'EASANV D Q:$G(EASABRT)
102 . S EASIEN=0
103 . F S EASIEN=$O(@EASTMP@(EASANV,EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
104 . . S EASDAT=@EASTMP@(EASANV,EASIEN)
105 . . D PRTLINE(EASANV,EASDAT) ; Get data and format print line
106 . . I $E(IOST,1,2)="C-",($Y+5)>IOSL D
107 . . . S DIR(0)="E"
108 . . . D ^DIR K DIR
109 . . . I 'Y S EASABRT=1 Q
110 . . . D HDR(.EASDT)
111 Q
112 ;
113PRTLINE(EASANV,EASDAT) ; Format and print report line
114 N DFN,EASNAME,EASTAT,EASAPT,EASF,EACL
115 ;
116 S DFN=$P(EASDAT,U)
117 S EASNAME=$$GET1^DIQ(2,DFN,.01)
118 W !,$E(EASNAME,1,20)
119 ;
120 D PID^VADPT6
121 W ?22,VA("PID")
122 ;
123 W ?35,$TR($$FMTE^XLFDT($$FMADD^XLFDT(EASANV,365),"2F")," ","0")
124 S EASTAT=$P(EASDAT,U,5)
125 W ?46,$S(EASTAT="C":"MT CPR",EASTAT="A":"MT CPE",EASTAT="R":"REQD",EASTAT="N":"NA",EASTAT="P":"PEND",EASTAT="G":"GMT CPR",1:"")
126 ;
127 I $D(^TMP($J,"SDAMA","ERROR")) Q
128 D GETAPT(DFN,.EASAPT)
129 I $D(EASAPT) D
130 . S EACL=0 F S EACL=$O(EASAPT(EACL)) Q:'EACL D
131 . . W:$G(EASF) !
132 . . W ?55,$E($$GET1^DIQ(44,EACL,.01),1,15)," ",$$FMTE^XLFDT(EASAPT(EACL),"2D")
133 . . S EASF=1
134 ;
135 D KVA^VADPT
136 Q
137 ;
138GETAPT(DFN,EASAPT) ; Get future appointments for patient
139 N EASAP,EASND,EASCL
140 Q:'$D(^TMP($J,"SDAMA",DFN))
141 S EASAP=0 F S EASAP=$O(^TMP($J,"SDAMA",DFN,EASAP)) Q:'EASAP D
142 .S EASND=^TMP($J,"SDAMA",DFN,EASAP)
143 .S EASCL=+$P(EASND,U,2),EASAPT(EASCL)=+EASND
144 Q
145 ;
146HDR(EASDT) ; Print report header
147 N ERROR,LINE,SPACE,TXT,HDR,TAB
148 ;
149 I $E(IOST,1,2)="C-" W @IOF
150 S TXT="Means Test Expiration Report"
151 S SPACE=(IOM-$L(TXT))/2
152 S $P(HDR," ",SPACE)="",HDR=HDR_TXT
153 W !,HDR K HDR
154 ;
155 S TXT="Anniversary Date(s): "_$$FMTE^XLFDT(EASDT("BEG"),"5D")_" - "_$$FMTE^XLFDT(EASDT("END"),"5D")
156 S SPACE=(IOM-$L(TXT))/2
157 S $P(HDR," ",SPACE)="",HDR=HDR_TXT
158 W !,HDR K HDR
159 ;
160 W !!,"Printed: "_$$FMTE^XLFDT($$NOW^XLFDT)
161 S PAGE=$G(PAGE)+1
162 S TAB=IOM-8
163 W ?TAB,"Page "_PAGE
164 S ERROR=$G(^TMP($J,"SDAMA","ERROR"))
165 W:ERROR'="" !,"Appointment Error: ",ERROR
166 ;
167 W !,"Patient",?25,"SSN",?35,"MT Expired",?46,"Status",?57,"Future Appts"
168 S $P(LINE,"=",IOM)="" W !,LINE
169 Q
Note: See TracBrowser for help on using the repository browser.