Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMETH.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMETH.m
r628 r636 1 PXRMETH ; SLC/PJH - Reminder Extract History ; 10/11/20072 ;;2.0;CLINICAL REMINDERS;**4 ,6**;Feb 04, 2005;Build 1231 PXRMETH ; SLC/PJH - Reminder Extract History ;08/15/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 3 ; 4 4 ;Main entry point for PXRM EXTRACT HISTORY 5 START(EDIEN) ; 6 ;EDIEN is the extract definition IEN. 5 START(IEN) ; 7 6 N VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD 8 7 ;Details of last run 9 8 N DATA,NPERIOD,NSDATE,NTAS,PXRMVIEW 10 S DATA=$G(^PXRM(810.2, EDIEN,0))9 S DATA=$G(^PXRM(810.2,IEN,0)) 11 10 S NPERIOD=$P(DATA,U,6),NSDATE=$P(DATA,U,7) 12 11 ;Default view is in date created order … … 18 17 Q 19 18 ; 20 DELETE ;Delete an extract, called by protocol PXRM EXTRACT SUMMARY DELETE.21 N CLASS,IEN,IENLIST,IND22 S IENLIST=$$LMSEL23 F IND=1:1:$L(IENLIST,U) D24 .S IEN=$P(IENLIST,U,IND)25 .D DELETE^PXRMETXU(IEN)26 ;Rebuild workfile27 D BLDLIST^PXRMETH1(EDIEN)28 ;Refresh29 S VALMBCK="R"30 Q31 ;32 19 ENTRY ;Entry code 33 D BLDLIST^PXRMETH1( EDIEN),XQORM20 D BLDLIST^PXRMETH1(IEN),XQORM 34 21 Q 35 22 ; … … 42 29 Q 43 30 ; 44 EXTRACT(EDIEN) ;Run Extract/Transmission 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 ; 45 115 ;Reset screen mode 46 116 W IORESET … … 51 121 N ANS,DATA,DUOUT,DTOUT,EDATE,EXSUMPUG,FREQ,MODE 52 122 N NAME,NAT,NEXT,PLISTPUG,RTN,REPL,STATUS,SNEXT,TEXT,XMIT 53 S DATA=$G(^PXRM(810.2, EDIEN,0))54 S NAT=$P($G(^PXRM(810.2, EDIEN,100)),U)123 S DATA=$G(^PXRM(810.2,IEN,0)) 124 S NAT=$P($G(^PXRM(810.2,IEN,100)),U) 55 125 ;Determine Extract Name and Frequency 56 126 S NAME=$P(DATA,U),FREQ=$P(DATA,U,3),NEXT=$P(DATA,U,6),RTN="PXRMETX" … … 93 163 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE 94 164 S ZTDESC="Reminder Extract "_NAME 95 S ZTRTN="RUN^PXRMETX( EDIEN,NEXT,MODE,EXSUMPUG)"96 S ZTSAVE(" EDIEN")=""165 S ZTRTN="RUN^PXRMETX(IEN,NEXT,MODE,EXSUMPUG)" 166 S ZTSAVE("IEN")="" 97 167 S ZTSAVE("MODE")="" 98 168 S ZTSAVE("NEXT")="" … … 117 187 D ^%ZTLOAD 118 188 W !,"Task number ",ZTSK," queued." H 2 189 ; 119 190 S VALMBCK="Q" 120 191 Q 121 192 ; 122 HDR ; Header code123 N VIEW124 S VIEW=$S(PXRMVIEW="D":"Creation Date Order",1:"Extract Period Order")125 S VALMHDR(2)=" Extract Name: "_$P($G(^PXRM(810.2,EDIEN,0)),U)126 S VALMHDR(3)=" Next Extract Period: "_NPERIOD127 S VALMHDR(4)=" Scheduled to Run: "_$$FMTE^XLFDT(NSDATE,"5Z")128 S VALMHDR(4)=$$LJ^XLFSTR(VALMHDR(4),45)_" View: "_VIEW129 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"130 Q131 ;132 HLP ;Help code133 N ORU,ORUPRMT,SUB,XQORM134 S SUB="PXRMETHH"135 D EN^VALM("PXRM EXTRACT HELP")136 Q137 ;138 INIT ;Init139 S VALMCNT=0140 Q141 ;142 LMSEL() ;Return selection list143 N IENLIST,IND,VALMY,XIEN144 D EN^VALM2(XQORNOD(0))145 ;If there is no list quit.146 I '$D(VALMY) Q ""147 S PXRMDONE=0,IENLIST=""148 S IND=""149 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D150 .;Get the ien.151 .S XIEN=^TMP("PXRMETH",$J,"SEL",IND)152 .S IENLIST=$S(IENLIST'="":IENLIST_U_XIEN,1:XIEN)153 Q IENLIST154 ;155 PEXIT ;PXRM EXCH MENU protocol exit code156 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"157 D XQORM158 Q159 ;160 193 SELECT(FREQ,SEL) ;Select extract period 194 ; 161 195 N BDATE,EDATE,DA,DIE,DIK,DIR,DR,FDATE,VALID,X 162 196 ;Get the new name. … … 184 218 Q 185 219 ; 186 TLIST ;Extract summary display 187 N IEN,IENLIST,IND 188 S IENLIST=$$LMSEL 189 F IND=1:1:$L(IENLIST,U) D 190 .S IEN=$P(IENLIST,U,IND) 191 .D START^PXRMETT(IEN) 192 .S VALMBCK="R" 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 ; 193 233 S VALMBCK="R" 194 234 Q 195 235 ; 196 236 TRANS ;Run Transmission 197 N IEN,IENLIST,IND 198 S IENLIST=$$LMSEL 199 F IND=1:1:$L(IENLIST,U) D 200 .S IEN=$P(IENLIST,U,IND) 201 .I $P($G(^PXRMXT(810.3,IEN,100)),U)'="N" D Q 202 ..W !,"Local extracts cannot be transmitted to AAC." H 2 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 203 248 .;Transmit extract summary 204 249 .N ANS,DUOUT,DTOUT,RTN,TEXT 205 250 .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH" 206 251 .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT) 207 .I ANS D TRANS^PXRMETX( IEN)252 .I ANS D TRANS^PXRMETX(PXRMXIEN) 208 253 ; 209 254 ;Rebuild workfile 210 D BLDLIST^PXRMETH1( EDIEN)255 D BLDLIST^PXRMETH1(IEN) 211 256 ;Refresh 212 257 S VALMBCK="R" … … 214 259 ; 215 260 TRHIST ;Transmission History 216 N IEN,IENLIST,IND 217 S IENLIST=$$LMSEL 218 F IND=1:1:$L(IENLIST,U) D 219 .S IEN=$P(IENLIST,U,IND) 220 .D START^PXRMETHL(IEN) 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 ; 221 273 S VALMBCK="R" 222 274 Q … … 241 293 ; 242 294 VIEW ;Select view 295 ; 243 296 W IORESET 244 S VALMBCK="R" 297 ; 298 S VALMBCK="R" 299 ; 245 300 N X,Y,CODE,DIR 246 301 K DIROUT,DIRUT,DTOUT,DUOUT … … 259 314 ; 260 315 ;Rebuild Workfile 261 D BLDLIST^PXRMETH1( EDIEN),HDR316 D BLDLIST^PXRMETH1(IEN),HDR 262 317 Q 263 318 ; … … 273 328 W !!,"WARNING -This period is not complete until "_FDATE 274 329 Q 275 XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT HISTORY SELECT ENTRY",0))_U_"1:"_VALMCNT276 S XQORM("A")="Select Item: "277 Q278 ;279 XSEL ;PXRM EXTRACT HISTORY SELECT ENTRY validation280 N SEL,PXRMSIEN281 S SEL=$P(XQORNOD(0),"=",2)282 ;Remove trailing ,283 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)284 ;Invalid selection285 I SEL["," D Q286 .W $C(7),!,"Only one item number allowed." H 2287 .S VALMBCK="R"288 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q289 .W $C(7),!,SEL_" is not a valid item number." H 2290 .S VALMBCK="R"291 ;292 ;Get the list ien.293 ;S PXRMSIEN=^TMP("PXRMETH",$J,"IDX",SEL,SEL)294 S PXRMSIEN=^TMP("PXRMETH",$J,"SEL",SEL)295 ;296 ;Full screen mode297 D FULL^VALM1298 ;299 ;Options300 N X,Y,DIR,OPTION K DIROUT,DIRUT,DTOUT,DUOUT301 S DIR(0)="SBM"_U_"DE:Delete Extract;"302 S DIR(0)=DIR(0)_"ES:Extract Summary;"303 S DIR(0)=DIR(0)_"MT:Manual Transmission;"304 S DIR(0)=DIR(0)_"TH:Transmission History;"305 S DIR("A")="Select Action"306 S DIR("B")="ES"307 S DIR("?")="Select from the codes displayed. For detailed help type ??"308 S DIR("??")=U_"D HELP^PXRMETH1(1)"309 D ^DIR K DIR310 I $D(DIROUT) S DTOUT=1311 I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q312 S OPTION=Y313 ;314 ;Delete an extract315 I OPTION="DE" D316 .D DELETE^PXRMETXU(PXRMSIEN)317 .;Rebuild workfile318 .D BLDLIST^PXRMETH1(PXRMSIEN)319 .;Refresh320 .S VALMBCK="R"321 ;322 ;Display Extract Summary323 I OPTION="ES" D START^PXRMETT(PXRMSIEN)324 ;325 ;Transmission option326 I OPTION="MT" D327 .N ANS,DUOUT,DTOUT,RTN,TEXT328 .I $P($G(^PXRMXT(810.3,PXRMSIEN,100)),U)'="N" D Q329 ..W !,"Local extracts cannot be transmitted to AAC" H 2 Q330 .S TEXT="Transmit this extract to AAC",ANS="",RTN="PXRMETH"331 .S ANS=$$ASKYN^PXRMEUT("N",TEXT,RTN,3) Q:$D(DUOUT)!$D(DTOUT)332 .I ANS D TRANS^PXRMETX(PXRMSIEN)333 ;334 ;Transmission History335 I OPTION="TH" D START^PXRMETHL(PXRMSIEN)336 ;337 S VALMBCK="R"338 Q339 ;
Note:
See TracChangeset
for help on using the changeset viewer.