| [623] | 1 | PXRMETH ; SLC/PJH - Reminder Extract History ;08/15/2006
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| 3 | ;
|
|---|
| 4 | ;Main entry point for PXRM EXTRACT HISTORY
|
|---|
| 5 | START(IEN) ;
|
|---|
| 6 | N VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
|
|---|
| 7 | ;Details of last run
|
|---|
| 8 | N DATA,NPERIOD,NSDATE,NTAS,PXRMVIEW
|
|---|
| 9 | S DATA=$G(^PXRM(810.2,IEN,0))
|
|---|
| 10 | S NPERIOD=$P(DATA,U,6),NSDATE=$P(DATA,U,7)
|
|---|
| 11 | ;Default view is in date created order
|
|---|
| 12 | S PXRMVIEW="D"
|
|---|
| 13 | S X="IORESET"
|
|---|
| 14 | D ENDR^%ZISS
|
|---|
| 15 | S VALMCNT=0
|
|---|
| 16 | D EN^VALM("PXRM EXTRACT HISTORY")
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | ENTRY ;Entry code
|
|---|
| 20 | D BLDLIST^PXRMETH1(IEN),XQORM
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | EXIT ;Exit code
|
|---|
| 24 | K ^TMP("PXRMETH",$J)
|
|---|
| 25 | K ^TMP("PXRMETHH",$J)
|
|---|
| 26 | D CLEAN^VALM10
|
|---|
| 27 | D FULL^VALM1
|
|---|
| 28 | S VALMBCK="Q"
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | HDR ; Header code
|
|---|
| 32 | N VIEW
|
|---|
| 33 | S VIEW=$S(PXRMVIEW="D":"Creation Date Order",1:"Extract Period Order")
|
|---|
| 34 | S VALMHDR(2)=" Extract Name: "_$P($G(^PXRM(810.2,IEN,0)),U)
|
|---|
| 35 | S VALMHDR(3)=" Next Extract Period: "_NPERIOD
|
|---|
| 36 | S VALMHDR(4)=" Scheduled to Run: "_NSDATE
|
|---|
| 37 | S VALMHDR(4)=$$LJ^XLFSTR(VALMHDR(4),45)_" View: "_VIEW
|
|---|
| 38 | S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | HLP ;Help code
|
|---|
| 42 | N ORU,ORUPRMT,SUB,XQORM
|
|---|
| 43 | S SUB="PXRMETHH"
|
|---|
| 44 | D EN^VALM("PXRM EXTRACT HELP")
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | INIT ;Init
|
|---|
| 48 | S VALMCNT=0
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | PEXIT ;PXRM EXCH MENU protocol exit code
|
|---|
| 52 | S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
|
|---|
| 53 | D XQORM
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT HISTORY SELECT ENTRY",0))_U_"1:"_VALMCNT
|
|---|
| 57 | S XQORM("A")="Select Item: "
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | XSEL ;PXRM EXTRACT HISTORY SELECT ENTRY validation
|
|---|
| 61 | N SEL,PXRMSIEN
|
|---|
| 62 | S SEL=$P(XQORNOD(0),"=",2)
|
|---|
| 63 | ;Remove trailing ,
|
|---|
| 64 | I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
|
|---|
| 65 | ;Invalid selection
|
|---|
| 66 | I SEL["," D Q
|
|---|
| 67 | .W $C(7),!,"Only one item number allowed." H 2
|
|---|
| 68 | .S VALMBCK="R"
|
|---|
| 69 | I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
|
|---|
| 70 | .W $C(7),!,SEL_" is not a valid item number." H 2
|
|---|
| 71 | .S VALMBCK="R"
|
|---|
| 72 | ;
|
|---|
| 73 | ;Get the list ien.
|
|---|
| 74 | S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",SEL,SEL)
|
|---|
| 75 | ;
|
|---|
| 76 | ;Full screen mode
|
|---|
| 77 | D FULL^VALM1
|
|---|
| 78 | ;
|
|---|
| 79 | ;Options
|
|---|
| 80 | N X,Y,DIR,OPTION K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 81 | S DIR(0)="SBM"_U_"ES:Extract Summary;"
|
|---|
| 82 | S DIR(0)=DIR(0)_"MT:Manual Transmission;"
|
|---|
| 83 | S DIR(0)=DIR(0)_"TH:Transmission History;"
|
|---|
| 84 | S DIR("A")="Select Action"
|
|---|
| 85 | S DIR("B")="ES"
|
|---|
| 86 | S DIR("?")="Select from the codes displayed. For detailed help type ??"
|
|---|
| 87 | S DIR("??")=U_"D HELP^PXRMETH1(1)"
|
|---|
| 88 | D ^DIR K DIR
|
|---|
| 89 | I $D(DIROUT) S DTOUT=1
|
|---|
| 90 | I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
|
|---|
| 91 | S OPTION=Y
|
|---|
| 92 | ;
|
|---|
| 93 | ;Display Extract Summary
|
|---|
| 94 | I OPTION="ES" D
|
|---|
| 95 | .D START^PXRMETT(PXRMSIEN)
|
|---|
| 96 | ;
|
|---|
| 97 | ;Transmission option
|
|---|
| 98 | I OPTION="MT" D
|
|---|
| 99 | .N ANS,DUOUT,DTOUT,RTN,TEXT
|
|---|
| 100 | .I $P($G(^PXRMXT(810.3,PXRMSIEN,100)),U)'="N" D Q
|
|---|
| 101 | ..W !,"Local extracts cannot be transmitted to AAC" H 2 Q
|
|---|
| 102 | .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
|
|---|
| 103 | .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 104 | .I ANS D TRANS^PXRMETX(PXRMSIEN)
|
|---|
| 105 | ;
|
|---|
| 106 | ;Transmission History
|
|---|
| 107 | I OPTION="TH" D
|
|---|
| 108 | .D START^PXRMETHL(PXRMSIEN)
|
|---|
| 109 | ;
|
|---|
| 110 | S VALMBCK="R"
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | EXTRACT(IEN) ;Run Extract/Transmission
|
|---|
| 114 | ;
|
|---|
| 115 | ;Reset screen mode
|
|---|
| 116 | W IORESET
|
|---|
| 117 | ;Refresh on exit
|
|---|
| 118 | S VALMBCK="R"
|
|---|
| 119 | ;
|
|---|
| 120 | ;Get details from parameter file
|
|---|
| 121 | N ANS,DATA,DUOUT,DTOUT,EDATE,EXSUMPUG,FREQ,MODE
|
|---|
| 122 | N NAME,NAT,NEXT,PLISTPUG,RTN,REPL,STATUS,SNEXT,TEXT,XMIT
|
|---|
| 123 | S DATA=$G(^PXRM(810.2,IEN,0))
|
|---|
| 124 | S NAT=$P($G(^PXRM(810.2,IEN,100)),U)
|
|---|
| 125 | ;Determine Extract Name and Frequency
|
|---|
| 126 | S NAME=$P(DATA,U),FREQ=$P(DATA,U,3),NEXT=$P(DATA,U,6),RTN="PXRMETX"
|
|---|
| 127 | ;Save next scheduled extract
|
|---|
| 128 | S SNEXT=NEXT
|
|---|
| 129 | ;Select extract period
|
|---|
| 130 | EXSEL D SELECT(FREQ,.NEXT) Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 131 | ;Warn if period is still open
|
|---|
| 132 | D WARN(NEXT,.STATUS)
|
|---|
| 133 | ;Option to continue
|
|---|
| 134 | S TEXT="Are you sure you want to run a "_NAME_" extract for "_$TR(NEXT,"/"," ")
|
|---|
| 135 | SURE ;
|
|---|
| 136 | S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,1) Q:$D(DUOUT)!$D(DTOUT) Q:'ANS
|
|---|
| 137 | ;Purge options
|
|---|
| 138 | PLIST ;
|
|---|
| 139 | S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
|
|---|
| 140 | G:$D(DUOUT) SURE Q:$D(DTOUT)
|
|---|
| 141 | S EXSUMPUG="N" D ASK^PXRMXD(.EXSUMPUG,"Purge Extract Summary after 5 years?: ",5)
|
|---|
| 142 | G:$D(DUOUT) PLIST Q:$D(DTOUT)
|
|---|
| 143 | ;Option to transmit
|
|---|
| 144 | S TEXT="Transmit extract results to AAC"
|
|---|
| 145 | I NAT="N" S XMIT=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 146 | E S XMIT=0
|
|---|
| 147 | ;Option to replace scheduled run
|
|---|
| 148 | S REPL=0
|
|---|
| 149 | I XMIT,SNEXT=NEXT,STATUS="COMPLETE" D Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 150 | .S TEXT="Does this extract replace the scheduled extract"
|
|---|
| 151 | .S REPL=$$ASKYN^PXRMEUT("N",TEXT,RTN,4) Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 152 | ;
|
|---|
| 153 | ;Note that the manual extract does not update 810.2
|
|---|
| 154 | ;exept if the selected period is the same as the scheduled
|
|---|
| 155 | ;period AND this period is complete
|
|---|
| 156 | ;
|
|---|
| 157 | ;Default is to extract and transmit and not update 810.2
|
|---|
| 158 | S MODE=2 I 'XMIT S MODE=3
|
|---|
| 159 | ;Update 810.2 if this extract is for current completed period
|
|---|
| 160 | I REPL S MODE=0 I 'XMIT S MODE=1
|
|---|
| 161 | ;
|
|---|
| 162 | ;Extract/transmission run
|
|---|
| 163 | N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
|
|---|
| 164 | S ZTDESC="Reminder Extract "_NAME
|
|---|
| 165 | S ZTRTN="RUN^PXRMETX(IEN,NEXT,MODE,EXSUMPUG)"
|
|---|
| 166 | S ZTSAVE("IEN")=""
|
|---|
| 167 | S ZTSAVE("MODE")=""
|
|---|
| 168 | S ZTSAVE("NEXT")=""
|
|---|
| 169 | S ZTSAVE("PLISTPUG")=""
|
|---|
| 170 | S ZTSAVE("EXSUMPUG")=""
|
|---|
| 171 | S ZTIO=""
|
|---|
| 172 | ;
|
|---|
| 173 | ;Select and verify start date/time for task
|
|---|
| 174 | N DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y
|
|---|
| 175 | S MINDT=$$NOW^XLFDT
|
|---|
| 176 | W !,"Queue a "_ZTDESC_" for "_NEXT
|
|---|
| 177 | S DIR("A",1)="Enter the date and time you want the job to start."
|
|---|
| 178 | S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
|
|---|
| 179 | S DIR("A")="Start the task at: "
|
|---|
| 180 | S DIR(0)="DAU"_U_MINDT_"::RSX"
|
|---|
| 181 | D ^DIR
|
|---|
| 182 | I $D(DTOUT)!$D(DUOUT) Q
|
|---|
| 183 | S SDTIME=Y
|
|---|
| 184 | ;
|
|---|
| 185 | ;Put the task into the queue.
|
|---|
| 186 | S ZTDTH=SDTIME
|
|---|
| 187 | D ^%ZTLOAD
|
|---|
| 188 | W !,"Task number ",ZTSK," queued." H 2
|
|---|
| 189 | ;
|
|---|
| 190 | S VALMBCK="Q"
|
|---|
| 191 | Q
|
|---|
| 192 | ;
|
|---|
| 193 | SELECT(FREQ,SEL) ;Select extract period
|
|---|
| 194 | ;
|
|---|
| 195 | N BDATE,EDATE,DA,DIE,DIK,DIR,DR,FDATE,VALID,X
|
|---|
| 196 | ;Get the new name.
|
|---|
| 197 | F D Q:$D(DTOUT)!$D(DUOUT) Q:SEL]""
|
|---|
| 198 | .S DIR("A")="Select EXTRACT PERIOD "
|
|---|
| 199 | .I FREQ="M" D
|
|---|
| 200 | ..S DIR("A")=DIR("A")_"(Mnn/yyyy)"
|
|---|
| 201 | ..S DIR(0)="F"_U_"7:8"_U_"K:'$$VALID^PXRMETH(FREQ,X) X"
|
|---|
| 202 | .I FREQ="Q" D
|
|---|
| 203 | ..S DIR("A")=DIR("A")_"(Qnn/yyyy)"
|
|---|
| 204 | ..S DIR(0)="F"_U_"7:7"_U_"K:'$$VALID^PXRMETH(FREQ,X) X"
|
|---|
| 205 | .I FREQ="Y" D
|
|---|
| 206 | ..S DIR("A")=DIR("A")_"(yyyy)"
|
|---|
| 207 | ..S DIR(0)="N"_U_"2000:2050"_U_"K:(X'?4N) X"
|
|---|
| 208 | .;Default is next period
|
|---|
| 209 | .S DIR("B")=NEXT
|
|---|
| 210 | .W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT)
|
|---|
| 211 | .;Calculate beginning and end dates for period
|
|---|
| 212 | .S Y=$$UP^XLFSTR(Y) D CALC^PXRMEUT(Y,.BDATE,.EDATE)
|
|---|
| 213 | .;Abort if period has not started
|
|---|
| 214 | .I $$FMDIFF^XLFDT(BDATE,$$NOW^XLFDT)>0 D Q
|
|---|
| 215 | ..S FDATE=$$FMTE^XLFDT(BDATE,5)
|
|---|
| 216 | ..W !,"ERROR -This period does not start until "_FDATE,*7
|
|---|
| 217 | .S SEL=Y
|
|---|
| 218 | Q
|
|---|
| 219 | ;
|
|---|
| 220 | TLIST ;Extract Totals
|
|---|
| 221 | N IND,PXRMSIEN,VALMY
|
|---|
| 222 | D EN^VALM2(XQORNOD(0))
|
|---|
| 223 | ;If there is no list quit.
|
|---|
| 224 | I '$D(VALMY) Q
|
|---|
| 225 | ;PXRMDONE is newed in PXRMLPM
|
|---|
| 226 | S PXRMDONE=0
|
|---|
| 227 | S IND=""
|
|---|
| 228 | F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
|
|---|
| 229 | .;Get the ien.
|
|---|
| 230 | .S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",IND,IND)
|
|---|
| 231 | .D START^PXRMETT(PXRMSIEN)
|
|---|
| 232 | ;
|
|---|
| 233 | S VALMBCK="R"
|
|---|
| 234 | Q
|
|---|
| 235 | ;
|
|---|
| 236 | TRANS ;Run Transmission
|
|---|
| 237 | N IND,PXRMXIEN,VALMY
|
|---|
| 238 | D EN^VALM2(XQORNOD(0))
|
|---|
| 239 | ;If there is no list quit.
|
|---|
| 240 | I '$D(VALMY) Q
|
|---|
| 241 | S PXRMDONE=0
|
|---|
| 242 | S IND=""
|
|---|
| 243 | F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
|
|---|
| 244 | .;Get the ien.
|
|---|
| 245 | .S PXRMXIEN=^TMP("PXRMETH",$J,"IDX",IND,IND)
|
|---|
| 246 | .I $P($G(^PXRMXT(810.3,PXRMXIEN,100)),U)'="N" D Q
|
|---|
| 247 | ..W !,"Local extracts cannot be transmitted to AAC." H 1
|
|---|
| 248 | .;Transmit extract summary
|
|---|
| 249 | .N ANS,DUOUT,DTOUT,RTN,TEXT
|
|---|
| 250 | .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"
|
|---|
| 251 | .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 252 | .I ANS D TRANS^PXRMETX(PXRMXIEN)
|
|---|
| 253 | ;
|
|---|
| 254 | ;Rebuild workfile
|
|---|
| 255 | D BLDLIST^PXRMETH1(IEN)
|
|---|
| 256 | ;Refresh
|
|---|
| 257 | S VALMBCK="R"
|
|---|
| 258 | Q
|
|---|
| 259 | ;
|
|---|
| 260 | TRHIST ;Transmission History
|
|---|
| 261 | N IND,PXRMSIEN,VALMY
|
|---|
| 262 | D EN^VALM2(XQORNOD(0))
|
|---|
| 263 | ;If there is no list quit.
|
|---|
| 264 | I '$D(VALMY) Q
|
|---|
| 265 | ;PXRMDONE is newed in PXRMLPM
|
|---|
| 266 | S PXRMDONE=0
|
|---|
| 267 | S IND=""
|
|---|
| 268 | F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
|
|---|
| 269 | .;Get the ien.
|
|---|
| 270 | .S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",IND,IND)
|
|---|
| 271 | .D START^PXRMETHL(PXRMSIEN)
|
|---|
| 272 | ;
|
|---|
| 273 | S VALMBCK="R"
|
|---|
| 274 | Q
|
|---|
| 275 | ;
|
|---|
| 276 | VALID(FREQ,INP) ;Validate Period input
|
|---|
| 277 | W !
|
|---|
| 278 | N PERIOD,YEAR
|
|---|
| 279 | ;Convert to upper case
|
|---|
| 280 | S INP=$$UP^XLFSTR(INP)
|
|---|
| 281 | ;General format
|
|---|
| 282 | I $E(INP)'=FREQ D EN^DDIOL("Format should be "_FREQ_"nn/yyyy") Q 0
|
|---|
| 283 | S PERIOD=$P(INP,"/"),YEAR=$P(INP,"/",2)
|
|---|
| 284 | S PERIOD=$P(PERIOD,FREQ,2)
|
|---|
| 285 | ;All runs
|
|---|
| 286 | I (YEAR<2000)!(YEAR>2050) D EN^DDIOL("Year should be in range 2000-2050") Q 0
|
|---|
| 287 | ;Quarterly run
|
|---|
| 288 | I FREQ="Q",(PERIOD>4)!(PERIOD<1) D EN^DDIOL("Quarter should be in range 1-4") Q 0
|
|---|
| 289 | ;Monthly run
|
|---|
| 290 | I FREQ="M",(PERIOD>12)!(PERIOD<1) D EN^DDIOL("Month should be in range 1-12") Q 0
|
|---|
| 291 | ;Otherwise
|
|---|
| 292 | Q 1
|
|---|
| 293 | ;
|
|---|
| 294 | VIEW ;Select view
|
|---|
| 295 | ;
|
|---|
| 296 | W IORESET
|
|---|
| 297 | ;
|
|---|
| 298 | S VALMBCK="R"
|
|---|
| 299 | ;
|
|---|
| 300 | N X,Y,CODE,DIR
|
|---|
| 301 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 302 | S DIR(0)="S"_U_"D:Sort by Creation Date;"
|
|---|
| 303 | S DIR(0)=DIR(0)_"P:Sort by Extract Period;"
|
|---|
| 304 | S DIR("A")="TYPE OF VIEW"
|
|---|
| 305 | S DIR("B")=$S(PXRMVIEW="P":"D",1:"P")
|
|---|
| 306 | S DIR("?")="Select from the codes displayed. For detailed help type ??"
|
|---|
| 307 | ;BOOKMARK - HELP NEEDS MOVING
|
|---|
| 308 | S DIR("??")=U_"D HELP^PXRMSEL2(3)"
|
|---|
| 309 | D ^DIR K DIR
|
|---|
| 310 | I $D(DIROUT) S DTOUT=1
|
|---|
| 311 | I $D(DTOUT)!($D(DUOUT)) Q
|
|---|
| 312 | ;Change display type
|
|---|
| 313 | S PXRMVIEW=Y
|
|---|
| 314 | ;
|
|---|
| 315 | ;Rebuild Workfile
|
|---|
| 316 | D BLDLIST^PXRMETH1(IEN),HDR
|
|---|
| 317 | Q
|
|---|
| 318 | ;
|
|---|
| 319 | WARN(NEXT,STATUS) ;Warn if period is not completed
|
|---|
| 320 | N BDATE,EDATE,FDATE
|
|---|
| 321 | ;Calculate beginning and end dates for period
|
|---|
| 322 | D CALC^PXRMEUT(NEXT,.BDATE,.EDATE)
|
|---|
| 323 | ;No warning if period end date is a prior date
|
|---|
| 324 | I $$FMDIFF^XLFDT($$NOW^XLFDT,EDATE)>0 S STATUS="COMPLETE" Q
|
|---|
| 325 | ;Else Format date
|
|---|
| 326 | S FDATE=$$FMTE^XLFDT(EDATE,5),STATUS="INCOMPLETE"
|
|---|
| 327 | ;And Warn that period end date is a future date
|
|---|
| 328 | W !!,"WARNING -This period is not complete until "_FDATE
|
|---|
| 329 | Q
|
|---|
