| 1 | PSBO1 ;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004
 | 
|---|
| 2 |  ;;3.0;BAR CODE MED ADMIN;**4,13,32**;Mar 2004;Build 32
 | 
|---|
| 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^",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)):0
 | 
|---|
| 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 |  ;
 | 
|---|