- 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 ;
