| 1 | PSBO1 ;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**4,13,32,2**;Mar 2004;Build 22
|
|---|
| 3 | ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
|
|---|
| 4 | ; Reference/IA
|
|---|
| 5 | ; FILE^DICN/10009
|
|---|
| 6 | ;
|
|---|
| 7 | NEW(RESULTS,PSBRTYP) ; Create a new report request
|
|---|
| 8 | ; Called interactively and via RPCBroker
|
|---|
| 9 | K RESULTS
|
|---|
| 10 | ; Check Type
|
|---|
| 11 | 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
|
|---|
| 12 | I '+$G(DUZ) S RESULTS(0)="-1^Undefined User" Q
|
|---|
| 13 | I '$G(DUZ(2)) S RESULTS(0)="-1^Undefined Division" Q
|
|---|
| 14 | ; Lock Log
|
|---|
| 15 | L +(^PSB(53.69,0)):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
|
|---|
| 16 | E S RESULTS(0)="-1^Request Log Locked" Q
|
|---|
| 17 | ; Generate Unique Entry and Create
|
|---|
| 18 | 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))
|
|---|
| 19 | S DIC="^PSB(53.69,",DIC(0)="L"
|
|---|
| 20 | S DIC("DR")=".02///N;.03////^S X=DUZ;.04////^S X=DUZ(2);.05///^S X=PSBRTYP"
|
|---|
| 21 | K DD,DO D FILE^DICN
|
|---|
| 22 | L -(^PSB(53.69,0))
|
|---|
| 23 | ; Okay, setup return and Boogie
|
|---|
| 24 | I +Y<1 S RESULTS(0)="-1^Error Creating Request"
|
|---|
| 25 | E S RESULTS(0)=Y
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | PRINT ;
|
|---|
| 29 | N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,DA
|
|---|
| 30 | S DA=+PSBRPT(0)
|
|---|
| 31 | S IOP=$$GET1^DIQ(53.69,DA_",",.06,"I"),PSBSIO=0 I IOP]"" D
|
|---|
| 32 | .S IOP="`"_IOP,%ZIS="N"
|
|---|
| 33 | .D ^%ZIS
|
|---|
| 34 | .I IO=IO(0) S PSBSIO=1
|
|---|
| 35 | .D HOME^%ZIS K IOP
|
|---|
| 36 | 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
|
|---|
| 37 | W @IOF,"Submitting Your Report Request to Taskman..."
|
|---|
| 38 | S ZTIO=$$GET1^DIQ(53.69,DA_",",.06)_";132"
|
|---|
| 39 | S ZTDTH=$S($$GET1^DIQ(53.69,DA_",",.07,"I")]"":$$GET1^DIQ(53.69,DA_",",.07,"I"),1:$H)
|
|---|
| 40 | S ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05)
|
|---|
| 41 | S ZTRTN="DQ^PSBO("_DA_")"
|
|---|
| 42 | F I="PSBDFN","PSBTYPE" S ZTSAVE(I)=""
|
|---|
| 43 | I $G(PSBORDNM)]"" S ZTSAVE("PSBORDNM")=""
|
|---|
| 44 | D ^%ZTLOAD
|
|---|
| 45 | I $D(ZTSK) S ^TMP("PSBO",$J,1)="0^Report queued. (Task #"_ZTSK_")"
|
|---|
| 46 | E S ^TMP("PSBO",$J,1)="-1^Task Rejected."
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | LIST(XLIST) ; Place List Criteria into subfile #53.692 (multiple)
|
|---|
| 50 | F XL1=$O(XLIST("")):1:$O(XLIST("B"),-1) Q:+XL1="" D
|
|---|
| 51 | .I $P(XLIST(XL1),U)=PSBTYPE D
|
|---|
| 52 | ..K PSBFDA,PSBRET,PSBIENX D CLEAN^DILF
|
|---|
| 53 | ..S PSBIENX="+"_(XL1+1)_","_PSBIENS
|
|---|
| 54 | ..D VAL^DIE(53.692,"+"_(XL1+1)_","_PSBIENS,.01,"F",$TR(XLIST(XL1),"^","~"),"PSBRET","PSBFDA")
|
|---|
| 55 | ..D UPDATE^DIE("","PSBFDA","PSBIENX","PSBRET")
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
