source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBO1.m@ 1450

Last change on this file since 1450 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.2 KB
Line 
1PSBO1 ;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 ;
7NEW(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 ;
28PRINT ;
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 ;
49LIST(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 ;
Note: See TracBrowser for help on using the repository browser.