| [613] | 1 | EASMTL6 ; ALB/SCK,BRM,LBD,PHH - AUTOMATED MEANS TEST LETTER-INTERACTIVE PRINT ; 5/22/03 9:52am
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,25,22,54**;MAR 15,2001
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; Main entry point
|
|---|
| 5 | ; Input, set in option call, if not passed in, or called interactively, user is asked to specify.
|
|---|
| 6 | ; EATYP - Used for selective printing of letters and forms
|
|---|
| 7 | ; 1 : 60-Day
|
|---|
| 8 | ; 2 : 30-Day
|
|---|
| 9 | ; 4 : 0-Day
|
|---|
| 10 | ;
|
|---|
| 11 | N DIR,DIRUT,POP,EASLOC,Y
|
|---|
| 12 | ;
|
|---|
| 13 | ;; Select type of letter to print
|
|---|
| 14 | I '$G(EATYP) D Q:$D(DIRUT)
|
|---|
| 15 | . S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
|
|---|
| 16 | . S DIR("?")="Select the type of letter to print"
|
|---|
| 17 | . D ^DIR K DIR
|
|---|
| 18 | . S EATYP=+Y
|
|---|
| 19 | ;
|
|---|
| 20 | ;; Select facility filter if appropriate
|
|---|
| 21 | S EASLOC=-1
|
|---|
| 22 | I $$GET1^DIQ(713,1,8,"I") D Q:$D(DIRUT)
|
|---|
| 23 | . S DIR(0)="YAO",DIR("A")="Filter letters by Preferred Facility? "
|
|---|
| 24 | . S DIR("B")="NO"
|
|---|
| 25 | . S DIR("?")="Enter 'YES' to limit letters to a specific Facility or 'NO' to print all letters."
|
|---|
| 26 | . D ^DIR K DIR
|
|---|
| 27 | . Q:$D(DIRUT)!('Y)
|
|---|
| 28 | . S EASLOC=$$FACNUM
|
|---|
| 29 | ;
|
|---|
| 30 | K IOP,IO("Q")
|
|---|
| 31 | ;
|
|---|
| 32 | S %ZIS="QP",%ZIS("B")=$$GET1^DIQ(713,1,5)
|
|---|
| 33 | D ^%ZIS K %ZIS
|
|---|
| 34 | Q:POP
|
|---|
| 35 | I $D(IO("Q")) D QUE Q
|
|---|
| 36 | D LTR
|
|---|
| 37 | D ^%ZISC
|
|---|
| 38 | K EATYP
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | QUE ; Queue the report
|
|---|
| 42 | N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED
|
|---|
| 43 | ;
|
|---|
| 44 | S ZTRTN="LTR^EASMTL6"
|
|---|
| 45 | S ZTDESC="EAS MT LETTERS PRINT JOB"
|
|---|
| 46 | S ZTSAVE("EATYP")="",ZTSAVE("EASLOC")=""
|
|---|
| 47 | S ZTDTH="NOW"
|
|---|
| 48 | ;
|
|---|
| 49 | D ^%ZTLOAD
|
|---|
| 50 | I $D(ZTSK)[0 W !!?5,"Letters canceled!"
|
|---|
| 51 | E W !!?5,"Letters queued! [ ",ZTSK," ]"
|
|---|
| 52 | D HOME^%ZIS
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | LTR ; Main entry point
|
|---|
| 56 | N EASTMP,EASKP
|
|---|
| 57 | ;
|
|---|
| 58 | S EASTMP="^TMP(""EASMT"",$J)"
|
|---|
| 59 | K @EASTMP
|
|---|
| 60 | ;
|
|---|
| 61 | I '$D(ZTQUEUED) W !,"...Gathering letters to print...Please wait"
|
|---|
| 62 | D BLD(EATYP,EASLOC,EASTMP,.EASKP)
|
|---|
| 63 | D RESULT(.EASKP,EATYP)
|
|---|
| 64 | I '$D(ZTQUEUED) W !,"...Printing letters..."
|
|---|
| 65 | D PRINT(EASTMP,EATYP)
|
|---|
| 66 | K @EASTMP,EATYP
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | RESULT(EASKP,EATYP) ; Send results of letter printing to mail group
|
|---|
| 70 | N MSG,XMSUB,XMY,XMTEXT,XMDUZ,TOT,X1
|
|---|
| 71 | ;
|
|---|
| 72 | S MSG(1)="Letters to print: "_$J($FN(EASKP("CNT"),","),8)
|
|---|
| 73 | S MSG(2)="Letters where the print date has not reached: "_$J($FN(EASKP("T"),","),8)
|
|---|
| 74 | S MSG(2.5)=""
|
|---|
| 75 | S MSG(3)="The following letters were found but not printed for the following reasons:"
|
|---|
| 76 | S MSG(4)="Incomplete/Bad Addr : "_$J($FN(EASKP("I"),","),8)
|
|---|
| 77 | S MSG(5)="Deceased : "_$J($FN(EASKP("D"),","),8)
|
|---|
| 78 | S MSG(6)="MT Changed: "_$J($FN(EASKP("C"),","),8)
|
|---|
| 79 | S MSG(7)="Prohibit flag set: "_$J($FN(EASKP("P"),","),8)
|
|---|
| 80 | S MSG(8)="Not a User Enrollee: "_$J($FN(EASKP("U"),","),8)
|
|---|
| 81 | S MSG(8.5)="Not a User Enrollee of this facility: "_$J($FN(EASKP("O"),","),8)
|
|---|
| 82 | S MSG(9)=""
|
|---|
| 83 | S TOT=0 F X1="I","D","C","P","O","T","U","CNT" S TOT=TOT+EASKP(X1)
|
|---|
| 84 | S MSG(10)="Total Letters Processed: "_$J($FN(TOT,","),8)_" (MT not returned)"
|
|---|
| 85 | ;
|
|---|
| 86 | S XMSUB=$S(EATYP=1:"60-Day",EATYP=2:"30-Day",1:"0-Day")_" Print Letter Results"
|
|---|
| 87 | S XMTEXT="MSG("
|
|---|
| 88 | S XMY("G.EAS MTLETTERS")=""
|
|---|
| 89 | S XMDUZ="AUTOMATED MT LETTERS"
|
|---|
| 90 | D ^XMD
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | BLD(EATYP,EASLOC,EASTMP,EASKP) ; Build TMP array of letters to print
|
|---|
| 94 | N DFN,EASIEN,COUNT,EAX2,EASPTR,EASABRT,EASUE
|
|---|
| 95 | ;
|
|---|
| 96 | F EAX2="P","D","C","F","T","I","O","U","CNT" S EASKP(EAX2)=0
|
|---|
| 97 | S COUNT=0
|
|---|
| 98 | ;
|
|---|
| 99 | S EASIEN=0 ; Begin loop through un-returned means tests
|
|---|
| 100 | F S EASIEN=$O(^EAS(713.2,"AC",0,EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
|
|---|
| 101 | . S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I") ; Pointer to File 713.1
|
|---|
| 102 | . ; begin checks
|
|---|
| 103 | . Q:EASPTR<0 ; SAFETY CHECK
|
|---|
| 104 | . Q:$$LTRTYP^EASMTL6B(EASIEN)'=EATYP ; Check for appropriate letter type
|
|---|
| 105 | . S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I") Q:'DFN
|
|---|
| 106 | . ;; Filter by site, quit if filter not met
|
|---|
| 107 | . I +$G(EASLOC)>0 Q:$$GET1^DIQ(2,DFN,27.02,"I")'=+EASLOC
|
|---|
| 108 | . I $D(^EAS(713.1,"AP",1,EASPTR)) D Q ; Check Prohibit letter
|
|---|
| 109 | . . D CLRFLG^EASMTUTL(0,EASIEN)
|
|---|
| 110 | . . S EASKP("P")=EASKP("P")+1
|
|---|
| 111 | . I $$DECEASED^EASMTUTL(EASIEN) D Q ; Check Deceased
|
|---|
| 112 | . . D CLRFLG^EASMTUTL(0,EASIEN)
|
|---|
| 113 | . . S EASKP("D")=EASKP("D")+1
|
|---|
| 114 | . I $$CHECKMT^EASMTUTL(EASPTR,EASIEN) D Q ; Check MT changed?
|
|---|
| 115 | . . D CLRFLG^EASMTUTL(0,EASIEN)
|
|---|
| 116 | . . S EASKP("C")=EASKP("C")+1 Q
|
|---|
| 117 | . I $$FUTMT^EASMTUTL(EASIEN) D Q ; Check for a Future MT
|
|---|
| 118 | . . D CLRFLG^EASMTUTL(0,EASIEN)
|
|---|
| 119 | . . S EASKP("F")=EASKP("F")+1
|
|---|
| 120 | . I '$$THRSHLD(EATYP,EASIEN) D Q ; Quit if letter threshold not reached
|
|---|
| 121 | . . S EASKP("T")=EASKP("T")+1
|
|---|
| 122 | . ; Get User Enrollee status (0=not UE; 1=UE; 2=UE, not this site)
|
|---|
| 123 | . S EASUE=$$UESTAT^EASUER(DFN)
|
|---|
| 124 | . I 'EASUE D Q ; Quit if not User Enrollee
|
|---|
| 125 | . . D NOPRT(EATYP,EASIEN)
|
|---|
| 126 | . . S EASKP("U")=EASKP("U")+1
|
|---|
| 127 | . I EASUE'=1 D Q ; Quit if User Enrollee site is not this facility
|
|---|
| 128 | . . D NOPRT(EATYP,EASIEN)
|
|---|
| 129 | . . S EASKP("O")=EASKP("O")+1
|
|---|
| 130 | . I $$CHKADR^EASMTL6A(EASPTR) D Q ; Check for valid address
|
|---|
| 131 | . . S EASKP("I")=EASKP("I")+1
|
|---|
| 132 | . S @EASTMP@(EASIEN)=EATYP ; Build entry
|
|---|
| 133 | . S EASKP("CNT")=EASKP("CNT")+1
|
|---|
| 134 | . I $D(IO("Q")),$$S^%ZTLOAD("STOPPED BY USER") S EASABRT=1
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | OWNED(PTR1,EAIEN) ; Check - Does this facility "own" this means test
|
|---|
| 138 | ; Returns '1' if means test 'owned' by facility
|
|---|
| 139 | ; '0' if not owned
|
|---|
| 140 | ;
|
|---|
| 141 | N MTNODE,MTLST,MTOWN,RSLT
|
|---|
| 142 | ;
|
|---|
| 143 | S RSLT=0
|
|---|
| 144 | S MTLST=$$LST^DGMTU(PTR1)
|
|---|
| 145 | I $P(MTLST,U,1)>0 D
|
|---|
| 146 | . S MTNODE=$G(^DGMT(408.31,$P(MTLST,U,1),0))
|
|---|
| 147 | . S MTOWN=$$GET1^DIQ(408.34,$P(MTNODE,U,23),.01)
|
|---|
| 148 | . I MTOWN="VAMC" S RSLT=1 Q
|
|---|
| 149 | . I MTOWN="DCD",$$VERSION^XPDUTL("IVMC") S RSLT=1
|
|---|
| 150 | ;
|
|---|
| 151 | ;; If another facility 'owns' this MT, update MT Status information
|
|---|
| 152 | I 'RSLT D
|
|---|
| 153 | . Q:'EAIEN
|
|---|
| 154 | . S DIE="^EAS(713.2,",DA=EAIEN
|
|---|
| 155 | . S DR="4///YES;5///TODAY;7///MT 'OWNED' BY ANOTHER FACILITY;9///NO;12///NO;18///NO"
|
|---|
| 156 | . D ^DIE K DIE
|
|---|
| 157 | ;
|
|---|
| 158 | Q RSLT
|
|---|
| 159 | ;
|
|---|
| 160 | PRINT(EASTMP,EATYP) ; Print letters
|
|---|
| 161 | N EASIEN,EASABRT,Y
|
|---|
| 162 | ;
|
|---|
| 163 | U IO
|
|---|
| 164 | S EASIEN=0
|
|---|
| 165 | F S EASIEN=$O(@EASTMP@(EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
|
|---|
| 166 | . D LETTER^EASMTL6A(EASIEN,EATYP) ; Print letter
|
|---|
| 167 | . D UPDSTAT(EASIEN,EATYP) ; Update Letter status file, #713.2
|
|---|
| 168 | . I $D(IO("Q")),$$S^%ZTLOAD("STOPPED BY USER") S EASABRT=1 Q
|
|---|
| 169 | . I '$D(IO("Q")),$E(IOST,1,2)="C-" D
|
|---|
| 170 | . . S DIR(0)="E"
|
|---|
| 171 | . . D ^DIR K DIR
|
|---|
| 172 | . . S:'Y EASABRT=1
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | THRSHLD(EATYP,EASIEN) ; Check threshold for letter types
|
|---|
| 176 | ; Input
|
|---|
| 177 | ; EATYP - Letter type to print
|
|---|
| 178 | ; EASIEN - IEN for file #713.2
|
|---|
| 179 | ;
|
|---|
| 180 | ; Output
|
|---|
| 181 | ; RSLT = 1: Letter is inside threshold to print
|
|---|
| 182 | ; 0: Letter is outside threshold (Don't print)
|
|---|
| 183 | ;
|
|---|
| 184 | N DIFF,THRESH,RSLT,ANVDT,MTDT
|
|---|
| 185 | ;
|
|---|
| 186 | S RSLT=1
|
|---|
| 187 | Q:'$G(EATYP)
|
|---|
| 188 | S THRESH=$S(EATYP=1:60,EATYP=2:30,1:0)
|
|---|
| 189 | S MTDT=$$GET1^DIQ(713.2,EASIEN,3,"I")
|
|---|
| 190 | S ANVDT=$$ADDLEAP^EASMTUTL(MTDT)
|
|---|
| 191 | S DIFF=$$FMDIFF^XLFDT(ANVDT,$$DT^XLFDT)
|
|---|
| 192 | I DIFF>THRESH S RSLT=0
|
|---|
| 193 | Q RSLT
|
|---|
| 194 | ;
|
|---|
| 195 | NOPRT(EATYP,EASIEN) ; Letter not printed, update Letter Status file #713.2
|
|---|
| 196 | ; Input
|
|---|
| 197 | ; EATYP - Letter type to print
|
|---|
| 198 | ; EASIEN - IEN for file #713.2
|
|---|
| 199 | ;
|
|---|
| 200 | N DIE,DR,DA,LTR
|
|---|
| 201 | Q:'$G(EATYP) Q:'$G(EASIEN)
|
|---|
| 202 | S DIE="^EAS(713.2,",DA=EASIEN
|
|---|
| 203 | S LTR=$S(EATYP=1:9,EATYP=2:12,EATYP=4:18,1:0)
|
|---|
| 204 | Q:'LTR
|
|---|
| 205 | ; Set current letter print statuses = "N"
|
|---|
| 206 | S DR=LTR_"///0;"_(LTR+1)_"///0"
|
|---|
| 207 | ; If current letter is not 0-day letter, set next letter print = "Y"
|
|---|
| 208 | S:LTR'=18 DR=DR_";"_$S(LTR=9:12,1:18)_"///1"
|
|---|
| 209 | D ^DIE
|
|---|
| 210 | Q
|
|---|
| 211 | ;
|
|---|
| 212 | UPDSTAT(EASN,EAX) ; Update Letter status file, #713.2
|
|---|
| 213 | N DIE,DR,DA,EAPD,EAFLG,NXTFLG
|
|---|
| 214 | ;
|
|---|
| 215 | S DIE="^EAS(713.2,",DA=EASN
|
|---|
| 216 | S DR=$S(EAX=1:10,EAX=2:13,EAX=4:19,1:0)
|
|---|
| 217 | Q:'DR
|
|---|
| 218 | S EAPD=DR_".5",EAFLG=DR-1
|
|---|
| 219 | S DR=DR_"///1;"_EAPD_"///^S X=$$DT^XLFDT;"_EAFLG_"///0"
|
|---|
| 220 | S NXTFLG=$S(EAFLG=9:12,EAFLG=12:18,1:0)
|
|---|
| 221 | S:NXTFLG>0 DR=DR_";"_NXTFLG_"///1"
|
|---|
| 222 | D ^DIE K DIE
|
|---|
| 223 | D CLRFLG^EASMTUTL(EAX,EASN)
|
|---|
| 224 | Q
|
|---|
| 225 | ;
|
|---|
| 226 | FACNUM() ; Get facility number
|
|---|
| 227 | N RSLT,DIR,Y
|
|---|
| 228 | ;
|
|---|
| 229 | S DIR(0)="P^4:EMZ"
|
|---|
| 230 | S DIR("S")="I '$P($G(^DIC(4,Y,99)),U,4)"
|
|---|
| 231 | D ^DIR K DIR
|
|---|
| 232 | I $D(DIRUT) S RSLT=0
|
|---|
| 233 | E S RSLT=+Y_"^"_$P($G(^DIC(4,+Y,99)),U,1)
|
|---|
| 234 | ;
|
|---|
| 235 | Q RSLT
|
|---|
| 236 | ;
|
|---|
| 237 | GETFAC(EADFN,EASARY) ; set facility return address information
|
|---|
| 238 | N EASFAC,EAX,EASF,EAS4
|
|---|
| 239 | ;
|
|---|
| 240 | I $$GET1^DIQ(713,1,9,"I") D
|
|---|
| 241 | . S EASFAC=$$GET1^DIQ(2,EADFN,27.02,"I")
|
|---|
| 242 | . Q:'EASFAC
|
|---|
| 243 | . ;; Check for inactive flag
|
|---|
| 244 | . Q:$$GET1^DIQ(4,EASFAC,101,"I")
|
|---|
| 245 | . D GETS^DIQ(4,EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
|
|---|
| 246 | . S EASF=EASFAC_","
|
|---|
| 247 | . ;; Check for valid address information
|
|---|
| 248 | . I EAS4(4,EASF,1.01,"E")]"",EAS4(4,EASF,1.03,"E")]"",EAS4(4,EASF,.02,"E")]"" S EASARY("TYP")="P"
|
|---|
| 249 | ;
|
|---|
| 250 | I $G(EASARY("TYP"))'="P" D
|
|---|
| 251 | . S EASFAC=$$SITE^VASITE
|
|---|
| 252 | . D GETS^DIQ(4,+EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
|
|---|
| 253 | . S EASARY("TYP")="F"
|
|---|
| 254 | ;
|
|---|
| 255 | S EASARY("FACNUM")=+EASFAC
|
|---|
| 256 | S EASARY("FAC")=$$GET1^DIQ(4,+EASFAC,.01,"I")
|
|---|
| 257 | F EAX=1.01,1.02,1.03,1.04,100 D
|
|---|
| 258 | . S EASARY(EAX)=EAS4(4,+EASFAC_",",EAX,"E")
|
|---|
| 259 | S EASARY(.02)=EAS4(4,+EASFAC_",",.02,"E")_"^"_$$GET1^DIQ(5,EAS4(4,+EASFAC_",",.02,"I"),1)
|
|---|
| 260 | Q
|
|---|
