Changeset 623 for WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBO1.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBO1.m (modified) (1 diff)

WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBO1.m

@@ -1 @@
-PSBO1   ;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004
-        ;;3.0;BAR CODE MED ADMIN;**4,13,32,2,43**;Mar 2004;Build 2
-        ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
-        ; Reference/IA
-        ; FILE^DICN/10009
-        ;
-NEW(RESULTS,PSBRTYP)    ; Create a new report request
-        ; Called interactively and via RPCBroker
-        K RESULTS
-        ; Check Type
-        I '$F("DL^MD^MH^ML^MM^MV^MT^PE^PM^WA^BL^PI^AL^DO^VT^PF^XA^IV^CM^CP^CE^CI^BZ^",PSBRTYP) S RESULTS(0)="-1^Invalid Report Type" Q
-        I '+$G(DUZ) S RESULTS(0)="-1^Undefined User" Q
-        I '$G(DUZ(2)) S RESULTS(0)="-1^Undefined Division" Q
-        ; Lock Log
-        L +(^PSB(53.69,0)):$S($G(DILOCKTM)>30:DILOCKTM,1:30)
-        E  S RESULTS(0)="-1^Request Log Locked" Q
-        ; Generate Unique Entry and Create
-        F  D NOW^%DTC S X=$E(%_"000000",1,14) S X=(1700+$E(X,1,3))_$E(X,4,14),X=PSBRTYP_"-"_$TR(X,".","-") Q:'$D(^PSB(53.69,"B",X))
-        S DIC="^PSB(53.69,",DIC(0)="L"
-        S DIC("DR")=".02///N;.03////^S X=DUZ;.04////^S X=DUZ(2);.05///^S X=PSBRTYP"
-        K DD,DO D FILE^DICN
-        L -(^PSB(53.69,0))
-        ; Okay, setup return and Boogie
-        I +Y<1 S RESULTS(0)="-1^Error Creating Request"
-        E  S RESULTS(0)=Y
-        Q
-        ;
-PRINT   ;
-        N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,DA
-        S DA=+PSBRPT(0)
-        S IOP=$$GET1^DIQ(53.69,DA_",",.06,"I"),PSBSIO=0 I IOP]"" D
-        .S IOP="`"_IOP,%ZIS="N"
-        .D ^%ZIS
-        .I IO=IO(0) S PSBSIO=1
-        .D HOME^%ZIS K IOP
-        I $$GET1^DIQ(53.69,DA_",",.06)["BROWSER"!(PSBSIO=1) S IOP=$$GET1^DIQ(53.69,DA_",",.06)_";132" D ^%ZIS U IO D DQ^PSBO(DA) D ^%ZISC K IOP Q
-        W @IOF,"Submitting Your Report Request to Taskman..."
-        S ZTIO=$$GET1^DIQ(53.69,DA_",",.06)_";132"
-        S ZTDTH=$S($$GET1^DIQ(53.69,DA_",",.07,"I")]"":$$GET1^DIQ(53.69,DA_",",.07,"I"),1:$H)
-        S ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05)
-        S ZTRTN="DQ^PSBO("_DA_")"
-        F I="PSBDFN","PSBTYPE" S ZTSAVE(I)=""
-        I $G(PSBORDNM)]"" S ZTSAVE("PSBORDNM")=""
-        D ^%ZTLOAD
-        I $D(ZTSK) S ^TMP("PSBO",$J,1)="0^Report queued. (Task #"_ZTSK_")"
-        E  S ^TMP("PSBO",$J,1)="-1^Task Rejected."
-        Q
-        ;
-LIST(XLIST)     ;  Place List Criteria into subfile #53.692 (multiple)
-        F XL1=$O(XLIST("")):1:$O(XLIST("B"),-1)  Q:+XL1=""  D
-        .I $P(XLIST(XL1),U)=PSBTYPE D
-        ..K PSBFDA,PSBRET,PSBIENX D CLEAN^DILF
-        ..S PSBIENX="+"_(XL1+1)_","_PSBIENS
-        ..D VAL^DIE(53.692,"+"_(XL1+1)_","_PSBIENS,.01,"F",$TR(XLIST(XL1),"^","~"),"PSBRET","PSBFDA")
-        ..D UPDATE^DIE("","PSBFDA","PSBIENX","PSBRET")
-        Q
-        ;
+PSBO1 ;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004
+ ;;3.0;BAR CODE MED ADMIN;**4,13,32**;Mar 2004;Build 32
+ ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+ ; Reference/IA
+ ; FILE^DICN/10009
+ ;
+NEW(RESULTS,PSBRTYP) ; Create a new report request
+ ; Called interactively and via RPCBroker
+ K RESULTS
+ ; Check Type
+ I '$F("DL^MD^MH^ML^MM^MV^MT^PE^PM^WA^BL^PI^AL^DO^VT^PF^XA^IV^CM^CP^CE^CI^",PSBRTYP) S RESULTS(0)="-1^Invalid Report Type" Q
+ I '+$G(DUZ) S RESULTS(0)="-1^Undefined User" Q
+ I '$G(DUZ(2)) S RESULTS(0)="-1^Undefined Division" Q
+ ; Lock Log
+ L +(^PSB(53.69,0)):0
+ E  S RESULTS(0)="-1^Request Log Locked" Q
+ ; Generate Unique Entry and Create
+ F  D NOW^%DTC S X=$E(%_"000000",1,14) S X=(1700+$E(X,1,3))_$E(X,4,14),X=PSBRTYP_"-"_$TR(X,".","-") Q:'$D(^PSB(53.69,"B",X))
+ S DIC="^PSB(53.69,",DIC(0)="L"
+ S DIC("DR")=".02///N;.03////^S X=DUZ;.04////^S X=DUZ(2);.05///^S X=PSBRTYP"
+ K DD,DO D FILE^DICN
+ L -(^PSB(53.69,0))
+ ; Okay, setup return and Boogie
+ I +Y<1 S RESULTS(0)="-1^Error Creating Request"
+ E  S RESULTS(0)=Y
+ Q
+ ;
+PRINT ;
+ N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,DA
+ S DA=+PSBRPT(0)
+ S IOP=$$GET1^DIQ(53.69,DA_",",.06,"I"),PSBSIO=0 I IOP]"" D
+ .S IOP="`"_IOP,%ZIS="N"
+ .D ^%ZIS
+ .I IO=IO(0) S PSBSIO=1
+ .D HOME^%ZIS K IOP
+ I $$GET1^DIQ(53.69,DA_",",.06)["BROWSER"!(PSBSIO=1) S IOP=$$GET1^DIQ(53.69,DA_",",.06)_";132" D ^%ZIS U IO D DQ^PSBO(DA) D ^%ZISC K IOP Q
+ W @IOF,"Submitting Your Report Request to Taskman..."
+ S ZTIO=$$GET1^DIQ(53.69,DA_",",.06)_";132"
+ S ZTDTH=$S($$GET1^DIQ(53.69,DA_",",.07,"I")]"":$$GET1^DIQ(53.69,DA_",",.07,"I"),1:$H)
+ S ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05)
+ S ZTRTN="DQ^PSBO("_DA_")"
+ F I="PSBDFN","PSBTYPE" S ZTSAVE(I)=""
+ I $G(PSBORDNM)]"" S ZTSAVE("PSBORDNM")=""
+ D ^%ZTLOAD
+ I $D(ZTSK) S ^TMP("PSBO",$J,1)="0^Report queued. (Task #"_ZTSK_")"
+ E  S ^TMP("PSBO",$J,1)="-1^Task Rejected."
+ Q
+ ;
+LIST(XLIST) ;  Place List Criteria into subfile #53.692 (multiple)
+ F XL1=$O(XLIST("")):1:$O(XLIST("B"),-1)  Q:+XL1=""  D
+ .I $P(XLIST(XL1),U)=PSBTYPE D
+ ..K PSBFDA,PSBRET,PSBIENX D CLEAN^DILF
+ ..S PSBIENX="+"_(XL1+1)_","_PSBIENS
+ ..D VAL^DIE(53.692,"+"_(XL1+1)_","_PSBIENS,.01,"F",$TR(XLIST(XL1),"^","~"),"PSBRET","PSBFDA")
+ ..D UPDATE^DIE("","PSBFDA","PSBIENX","PSBRET")
+ Q
+ ;