| 1 | EASMTL10 ;MIN/TCM ALB/SCK,AMA - AUTOMATED MEANS TEST LETTERS - RERUN LETTERS ; 7/17/01
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,15,28,80**;Mar 15, 2001;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | RERUN ; Main entry point to rerun a processing date
|
|---|
| 5 | N EASDDD,EASLOC,EATYP,XX
|
|---|
| 6 | ;
|
|---|
| 7 | D:'$G(IOF) HOME^%ZIS
|
|---|
| 8 | W @IOF
|
|---|
| 9 | F XX=1:1:7 W !?2,$P($T(NOTICE+XX),";;",2)
|
|---|
| 10 | ;
|
|---|
| 11 | Q:'$$FILTER(.EASLOC) ; Select Filter action, quit on uparrow
|
|---|
| 12 | Q:'$$LTRTYPE(.EATYP) ; Select type of letter to reprint, quit on uparrow
|
|---|
| 13 | Q:'$$ASKDT(EATYP,.EASDDD) ; Select date to reprint letters from, quit on uparrow
|
|---|
| 14 | D QUE1
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | FILTER(EASLOC) ; Filter by Patient Preferred Location
|
|---|
| 18 | ; Input: None
|
|---|
| 19 | ;
|
|---|
| 20 | ; Output: EASLOC -1 if an error occurred
|
|---|
| 21 | ; 0 if not filtering by location
|
|---|
| 22 | ; nnn IEN of filtered facility in the INSTITUTION File
|
|---|
| 23 | ;
|
|---|
| 24 | ; RESULT 1 if result of function Ok
|
|---|
| 25 | ; 0 if user enters "^" or exits
|
|---|
| 26 | ;
|
|---|
| 27 | N DIR,DIRUT
|
|---|
| 28 | ;
|
|---|
| 29 | S EASLOC=-1
|
|---|
| 30 | I $$GET1^DIQ(713,1,8,"I") D Q:$D(DIRUT) 0
|
|---|
| 31 | . S DIR(0)="YAO",DIR("A")="Filter letters by Preferred Facility? "
|
|---|
| 32 | . S DIR("B")="NO"
|
|---|
| 33 | . S DIR("?")="Enter 'YES' to limit letters to a specific Facility or 'NO' to print all letters"
|
|---|
| 34 | . D ^DIR K DIR
|
|---|
| 35 | . Q:$D(DIRUT)
|
|---|
| 36 | . I 'Y S EASLOC=0 Q
|
|---|
| 37 | . S DIR(0)="P^EAS(713,1,2,:QEM"
|
|---|
| 38 | . S EASLOC=$$FACNUM^EASMTL6
|
|---|
| 39 | E D
|
|---|
| 40 | . S EASLOC=0
|
|---|
| 41 | Q 1
|
|---|
| 42 | ;
|
|---|
| 43 | ASKDT(EATYP,EASDDD) ; Ask for processing date to look for letters
|
|---|
| 44 | ; Input EATYP Type of letter to be reprinted
|
|---|
| 45 | ;
|
|---|
| 46 | ; Output EASDDD Selected processing date for type of letter
|
|---|
| 47 | ; to be reprinted
|
|---|
| 48 | ;
|
|---|
| 49 | ; RESULT 1 if result of function Ok
|
|---|
| 50 | ; 0 if user enters "^" or exits
|
|---|
| 51 | ;
|
|---|
| 52 | N EASDT,RSLT,EAX,EASOFST
|
|---|
| 53 | ;
|
|---|
| 54 | S RSLT=0
|
|---|
| 55 | AGN S EASDT=$$GETDT
|
|---|
| 56 | G:EASDT<0 ASKQ
|
|---|
| 57 | ;
|
|---|
| 58 | S EASOFST=$S(EATYP=2:30,EATYP=4:60,1:0)
|
|---|
| 59 | S EAX=$$FMADD^XLFDT(EASDT,-EASOFST,0,0,-1)
|
|---|
| 60 | S EAX=$O(^EAS(713.2,"AD",EAX))
|
|---|
| 61 | I 'EAX D G AGN
|
|---|
| 62 | . W !!,"No valid processing date could be found for ",$S(EATYP=2:30,EATYP=4:0,1:60),"-day letters for ",$$FMTE^XLFDT(EASDT),"."
|
|---|
| 63 | . W !,"Please select another date."
|
|---|
| 64 | ;
|
|---|
| 65 | W !!,"To re-print "_$S(EATYP=2:30,EATYP=4:0,1:60)_"-day letters for "_$$FMTE^XLFDT(EASDT)
|
|---|
| 66 | W !,"the Search/Processing date of "_$$FMTE^XLFDT(EAX)_" will be used."
|
|---|
| 67 | ;EAS*1.0*80 -- to avoid confusion, changed "ALL" to "all valid"
|
|---|
| 68 | W !,"Please note: all valid "_$S(EATYP=2:30,EATYP=4:0,1:60)_"-day letters for this processing date will print"
|
|---|
| 69 | ;
|
|---|
| 70 | S DIR(0)="YAO"
|
|---|
| 71 | S DIR("?")="Enter 'YES' to use the "_$$FMTE^XLFDT(EAX)_" date. Enter 'NO' to select a different date."
|
|---|
| 72 | S DIR("A")="Do you wish to use this date? "
|
|---|
| 73 | S DIR("B")="YES"
|
|---|
| 74 | D ^DIR K DIR
|
|---|
| 75 | I $D(DIRUT) G ASKQ
|
|---|
| 76 | I 'Y G AGN
|
|---|
| 77 | ;
|
|---|
| 78 | S EASDDD=EAX
|
|---|
| 79 | S RSLT=1
|
|---|
| 80 | ASKQ Q RSLT
|
|---|
| 81 | ;
|
|---|
| 82 | GETDT() ;
|
|---|
| 83 | N DIR,DIRUT
|
|---|
| 84 | ;
|
|---|
| 85 | S DIR(0)="DAO^:DT:EP"
|
|---|
| 86 | S DIR("?")="Select the date for the letters you wish to re-print."
|
|---|
| 87 | S DIR("A")="Enter re-print date: "
|
|---|
| 88 | D ^DIR K DIR
|
|---|
| 89 | S:$D(DIRUT) Y=-1
|
|---|
| 90 | Q +Y
|
|---|
| 91 | ;
|
|---|
| 92 | LTRTYPE(EATYP) ; Ask for a specific type of letter to print
|
|---|
| 93 | ; Input None
|
|---|
| 94 | ;
|
|---|
| 95 | ; Output EATYP Type of letter to reprint
|
|---|
| 96 | ; 1 - 60-day letter
|
|---|
| 97 | ; 2 - 30-day letter
|
|---|
| 98 | ; 4 - 0-day letter
|
|---|
| 99 | ;
|
|---|
| 100 | ; RESULT 1 if result of function Ok
|
|---|
| 101 | ; 0 if user enters "^" or exits
|
|---|
| 102 | ;
|
|---|
| 103 | N DIR,DIRUT
|
|---|
| 104 | ;
|
|---|
| 105 | S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
|
|---|
| 106 | S DIR("A")="Select letter type",DIR("A",1)=""
|
|---|
| 107 | S DIR("?")="Select the type of letter to re-print "
|
|---|
| 108 | D ^DIR K DIR
|
|---|
| 109 | Q:$D(DIRUT) 0
|
|---|
| 110 | S EATYP=+Y
|
|---|
| 111 | Q 1
|
|---|
| 112 | ;
|
|---|
| 113 | QUE1 ; Queue off the print job
|
|---|
| 114 | K IOP,IO("Q")
|
|---|
| 115 | N POP ;EAS*1.0*80
|
|---|
| 116 | ;
|
|---|
| 117 | S %ZIS="QP",%ZIS("B")=$$GET1^DIQ(713,1,5)
|
|---|
| 118 | D ^%ZIS K %ZIS
|
|---|
| 119 | Q:POP
|
|---|
| 120 | I $D(IO("Q")) D QUEIT Q
|
|---|
| 121 | D EN1
|
|---|
| 122 | D ^%ZISC
|
|---|
| 123 | Q
|
|---|
| 124 | ;
|
|---|
| 125 | QUEIT ;
|
|---|
| 126 | N ZTRTN,ZTDESC,EASX,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED
|
|---|
| 127 | ;
|
|---|
| 128 | S ZTRTN="EN1^EASMTL10"
|
|---|
| 129 | S ZTDESC="EAS MT LETTERS REPRINT"
|
|---|
| 130 | F EASX="EASDDD","EATYP","EASLOC" S ZTSAVE(EASX)=""
|
|---|
| 131 | S ZTDTH="NOW"
|
|---|
| 132 | ;
|
|---|
| 133 | D ^%ZTLOAD
|
|---|
| 134 | I $D(ZTSK)[0 W !!?5,"Reprint canceled"
|
|---|
| 135 | E W !!?5,"Letters queued, [",ZTSK,"]"
|
|---|
| 136 | D HOME^%ZIS
|
|---|
| 137 | Q
|
|---|
| 138 | ;
|
|---|
| 139 | EN1 ; Queued entry point for letter rerun
|
|---|
| 140 | N EASIEN,EASABRT,EASTMP
|
|---|
| 141 | ;
|
|---|
| 142 | S EASTMP="^TMP(""EASRP"",$J)"
|
|---|
| 143 | K @EASTMP
|
|---|
| 144 | ;
|
|---|
| 145 | I '$D(ZTQUEUED) W !,"...Gathering letters to re-print..."
|
|---|
| 146 | D BLD(EATYP,EASLOC,EASDDD,EASTMP)
|
|---|
| 147 | I '$D(ZTQUEUED),'$D(@EASTMP) D Q
|
|---|
| 148 | . W !?3,$CHAR(7),">> No letters found to reprint for these parameters.",!
|
|---|
| 149 | D PRINT(EASTMP,EATYP)
|
|---|
| 150 | K @EASTMP
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | PRINT(EASTMP,EATYP) ;
|
|---|
| 154 | N EASIEN,EASABRT
|
|---|
| 155 | ;
|
|---|
| 156 | U IO
|
|---|
| 157 | S EASIEN=0
|
|---|
| 158 | F S EASIEN=$O(@EASTMP@(EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
|
|---|
| 159 | . D LETTER^EASMTL6A(EASIEN,EATYP)
|
|---|
| 160 | . I '$D(IO("Q")),$E(IOST,1,2)="C-" D
|
|---|
| 161 | . . S DIR(0)="E"
|
|---|
| 162 | . . D ^DIR K DIR
|
|---|
| 163 | . . S:'Y EASABRT=1
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | BLD(EATYP,EASLOC,EASDDD,EASTMP) ; Sort letters for processing date in groups by type
|
|---|
| 167 | N EASIEN,EASPTR,DFN,EASLTR
|
|---|
| 168 | ;
|
|---|
| 169 | S EASIEN=0
|
|---|
| 170 | F S EASIEN=$O(^EAS(713.2,"AD",EASDDD,EASIEN)) Q:'EASIEN D
|
|---|
| 171 | . ; Begin Checks
|
|---|
| 172 | . S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
|
|---|
| 173 | . S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
|
|---|
| 174 | . ;; Filter by site, Quit if filter not met
|
|---|
| 175 | . I +$G(EASLOC)>0 Q:$$GET1^DIQ(2,DFN,27.02,"I")'=+EASLOC
|
|---|
| 176 | . Q:'$$THRSHLD^EASMTL6(EATYP,EASIEN) ; Quit if letter threshold not met
|
|---|
| 177 | . Q:$D(^EAS(713.2,"AC",1,EASIEN)) ; Quit if MT has been returned
|
|---|
| 178 | . Q:$D(^EAS(713.1,"AP",1,EASPTR)) ; Quit if prohibit flag set
|
|---|
| 179 | . Q:$$CHECKMT^EASMTUTL(EASPTR,EASIEN) ; Quit if MT no longer required
|
|---|
| 180 | . Q:$$FUTMT^EASMTUTL(EASIEN) ; Quit if future MT on file
|
|---|
| 181 | . Q:$$DECEASED^EASMTUTL(EASIEN) ; Quit if patient deceased
|
|---|
| 182 | . I $$CHKADR^EASMTL6A(EASPTR),EATYP'=3 Q ; Quit if bad address
|
|---|
| 183 | . ;EAS*1.0*80 -- copied User Enrollee check from BLD^EASMTL6
|
|---|
| 184 | . N EASUE S EASUE=$$UESTAT^EASUER(DFN)
|
|---|
| 185 | . Q:(EASUE'=1) ; Quit if User Enrollee site is not this facility
|
|---|
| 186 | . S @EASTMP@(EASIEN)=EATYP
|
|---|
| 187 | Q
|
|---|
| 188 | ;
|
|---|
| 189 | SINGLE ; Rerun a single letter
|
|---|
| 190 | N Y,DIR,DIRUT,EASPTR,DFN,EASIEN,ZTSAVE,EASLOC,IOP,EAX,PRNOVRD
|
|---|
| 191 | ;
|
|---|
| 192 | ASKPAT ; Select patient to reprint a letter for
|
|---|
| 193 | S DIR(0)="PAO^713.1:EMZ"
|
|---|
| 194 | S DIR("A")="Select PATIENT: "
|
|---|
| 195 | S DIR("?")="Select Patient Letter status entry to reprint"
|
|---|
| 196 | D ^DIR K DIR
|
|---|
| 197 | Q:$D(DIRUT)
|
|---|
| 198 | S EASPTR=+Y ; Ptr to file 713.1
|
|---|
| 199 | S DFN=+Y(0)
|
|---|
| 200 | Q:'DFN
|
|---|
| 201 | ;
|
|---|
| 202 | I $D(^EAS(713.1,"AP",1,EASPTR)) D Q
|
|---|
| 203 | . W !!?4,$CHAR(7),"The Prohibit flag is set for this patient"
|
|---|
| 204 | I $$DECEASED^EASMTUTL("",DFN) D Q
|
|---|
| 205 | . W !!?4,$CHAR(7),"Patient is deceased"
|
|---|
| 206 | ;
|
|---|
| 207 | ASKLTR ; Select LETTER STATUS file entry
|
|---|
| 208 | S DIR(0)="P^713.2:EMZ"
|
|---|
| 209 | S DIR("?",1)="Select Processing Date: "
|
|---|
| 210 | S DIR("A")="Select the letter processing date for this patient"
|
|---|
| 211 | S DIR("S")="I $P(^(0),U,2)=EASPTR" ; Set screen for selected patient
|
|---|
| 212 | D ^DIR K DIR
|
|---|
| 213 | Q:$D(DIRUT)
|
|---|
| 214 | S EASIEN=+Y
|
|---|
| 215 | ;
|
|---|
| 216 | I $$GET1^DIQ(713.2,EASIEN,4,"I") D Q
|
|---|
| 217 | . W !!?4,$CHAR(7),"A Means Test has already been returned by this patient"
|
|---|
| 218 | ;
|
|---|
| 219 | I $$CHECKMT^EASMTUTL(EASPTR,EASIEN) D Q
|
|---|
| 220 | . W !!?4,$CHAR(7),"Patient's Means Test is no longer required"
|
|---|
| 221 | ;
|
|---|
| 222 | ASKTYP ; Allow only letters already sent to be reprinted
|
|---|
| 223 | N EASSC,EAX
|
|---|
| 224 | ;
|
|---|
| 225 | F EAX=6,4,"Z" D
|
|---|
| 226 | . I $P(^EAS(713.2,EASIEN,EAX),U,3) D
|
|---|
| 227 | . . I EAX=6 S EASSC=$G(EASSC)_"1:60-Day;"
|
|---|
| 228 | . . I EAX=4 S EASSC=$G(EASSC)_"2:30-Day;"
|
|---|
| 229 | . . I EAX="Z" S EASSC=$G(EASSC)_"4:0-Day"
|
|---|
| 230 | I $G(EASSC)']"" D Q
|
|---|
| 231 | . W !!?4,$CHAR(7),"There are no letters to re-print for this patient"
|
|---|
| 232 | ;
|
|---|
| 233 | S DIR(0)="SO^"_EASSC,DIR("A")="Select letter type"
|
|---|
| 234 | S DIR("?")="Select letter type to re-print"
|
|---|
| 235 | D ^DIR K DIR
|
|---|
| 236 | Q:$D(DIRUT)
|
|---|
| 237 | S EATYP=+Y
|
|---|
| 238 | ;
|
|---|
| 239 | QUE2 ; Que off print letter
|
|---|
| 240 | S ZTSAVE("EASIEN")="",ZTSAVE("EASPTR")="",ZTSAVE("EATYP")="",ZTSAVE("EASLOC")=""
|
|---|
| 241 | D EN^XUTMDEVQ("EN2^EASMTL10","EAS MT RERUN SINGLE LETTER",.ZTSAVE)
|
|---|
| 242 | Q
|
|---|
| 243 | ;
|
|---|
| 244 | EN2 ; Queued entry point to re-run a single letter
|
|---|
| 245 | ;
|
|---|
| 246 | D LETTER^EASMTL6A(EASIEN,EATYP)
|
|---|
| 247 | Q
|
|---|
| 248 | ;
|
|---|
| 249 | LIST ; List last processing dates for the Letter Status file
|
|---|
| 250 | N EAX
|
|---|
| 251 | ;
|
|---|
| 252 | W !!,"Available Processing Dates:"
|
|---|
| 253 | S EAX=0
|
|---|
| 254 | F S EAX=$O(^EAS(713.2,"AD",EAX)) Q:'EAX D
|
|---|
| 255 | . W !?6,$$FMTE^XLFDT(EAX,"2D")
|
|---|
| 256 | Q
|
|---|
| 257 | ;
|
|---|
| 258 | NOTICE ;
|
|---|
| 259 | ;;Means Test Letters are indexed by the date on which the MT Letter search
|
|---|
| 260 | ;;occurred and is dependent on the frequency the search job is run at your
|
|---|
| 261 | ;;site. When you select the reprint date for a letter, the software will
|
|---|
| 262 | ;;try to determine the appropriate search (processing) date required to print
|
|---|
| 263 | ;;the desired letters. If the letters printed are not the desired letters,
|
|---|
| 264 | ;;you may need to try a later date.
|
|---|
| 265 | ;;
|
|---|
