PSBO1 ;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**4,13,32,2,43,28**;Mar 2004;Build 9
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
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^ST^SF^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
K DO
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
+1 ;;3.0;BAR CODE MED ADMIN;**4,13,32,2,43,28**;Mar 2004;Build 9
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
NEW(RESULTS,PSBRTYP) ; Create a new report request
+1 ; Called interactively and via RPCBroker
+2 KILL RESULTS
+3 ; Check Type
+4 IF '$FIND("DL^MD^MH^ML^MM^MV^MT^PE^PM^WA^BL^PI^AL^DO^VT^PF^XA^ST^SF^IV^CM^CP^CE^CI^BZ^",PSBRTYP)
SET RESULTS(0)="-1^Invalid Report Type"
QUIT
+5 IF '+$GET(DUZ)
SET RESULTS(0)="-1^Undefined User"
QUIT
+6 IF '$GET(DUZ(2))
SET RESULTS(0)="-1^Undefined Division"
QUIT
+7 ; Lock Log
+8 LOCK +(^PSB(53.69,0)):$SELECT($GET(DILOCKTM)>30:DILOCKTM,1:30)
+9 IF '$TEST
SET RESULTS(0)="-1^Request Log Locked"
QUIT
+10 ; Generate Unique Entry and Create
+11 FOR
DO NOW^%DTC
SET X=$EXTRACT(%_"000000",1,14)
SET X=(1700+$EXTRACT(X,1,3))_$EXTRACT(X,4,14)
SET X=PSBRTYP_"-"_$TRANSLATE(X,".","-")
IF '$DATA(^PSB(53.69,"B",X))
QUIT
+12 SET DIC="^PSB(53.69,"
SET DIC(0)="L"
+13 SET DIC("DR")=".02///N;.03////^S X=DUZ;.04////^S X=DUZ(2);.05///^S X=PSBRTYP"
+14 KILL DD,DO
DO FILE^DICN
+15 LOCK -(^PSB(53.69,0))
+16 ; Okay, setup return and Boogie
+17 IF +Y<1
SET RESULTS(0)="-1^Error Creating Request"
+18 IF '$TEST
SET RESULTS(0)=Y
+19 KILL DO
+20 QUIT
+21 ;
PRINT ;
+1 NEW ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,DA
+2 SET DA=+PSBRPT(0)
+3 SET IOP=$$GET1^DIQ(53.69,DA_",",.06,"I")
SET PSBSIO=0
IF IOP]""
Begin DoDot:1
+4 SET IOP="`"_IOP
SET %ZIS="N"
+5 DO ^%ZIS
+6 IF IO=IO(0)
SET PSBSIO=1
+7 DO HOME^%ZIS
KILL IOP
End DoDot:1
+8 IF $$GET1^DIQ(53.69,DA_",",.06)["BROWSER"!(PSBSIO=1)
SET IOP=$$GET1^DIQ(53.69,DA_",",.06)_";132"
DO ^%ZIS
USE IO
DO DQ^PSBO(DA)
DO ^%ZISC
KILL IOP
QUIT
+9 WRITE @IOF,"Submitting Your Report Request to TaskMan..."
+10 SET ZTIO=$$GET1^DIQ(53.69,DA_",",.06)_";132"
+11 SET ZTDTH=$SELECT($$GET1^DIQ(53.69,DA_",",.07,"I")]"":$$GET1^DIQ(53.69,DA_",",.07,"I"),1:$HOROLOG)
+12 SET ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05)
+13 SET ZTRTN="DQ^PSBO("_DA_")"
+14 FOR I="PSBDFN","PSBTYPE"
SET ZTSAVE(I)=""
+15 IF $GET(PSBORDNM)]""
SET ZTSAVE("PSBORDNM")=""
+16 DO ^%ZTLOAD
+17 IF $DATA(ZTSK)
SET ^TMP("PSBO",$JOB,1)="0^Report queued. (Task #"_ZTSK_")"
+18 IF '$TEST
SET ^TMP("PSBO",$JOB,1)="-1^Task Rejected."
+19 QUIT
+20 ;
LIST(XLIST) ; Place List Criteria into subfile #53.692 (multiple)
+1 FOR XL1=$ORDER(XLIST("")):1:$ORDER(XLIST("B"),-1)
IF +XL1=""
QUIT
Begin DoDot:1
+2 IF $PIECE(XLIST(XL1),U)=PSBTYPE
Begin DoDot:2
+3 KILL PSBFDA,PSBRET,PSBIENX
DO CLEAN^DILF
+4 SET PSBIENX="+"_(XL1+1)_","_PSBIENS
+5 DO VAL^DIE(53.692,"+"_(XL1+1)_","_PSBIENS,.01,"F",$TRANSLATE(XLIST(XL1),"^","~"),"PSBRET","PSBFDA")
+6 DO UPDATE^DIE("","PSBFDA","PSBIENX","PSBRET")
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
