1 | BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
|
---|
2 | ;;1.42;BSDX;;Dec 07, 2010
|
---|
3 | ;
|
---|
4 | ;
|
---|
5 | RSRCD(BSDXY,BSDXVAL) ;EP
|
---|
6 | ;Entry point for debugging
|
---|
7 | ;
|
---|
8 | ;D DEBUG^%Serenji("RSRC^BSDX16(.BSDXY,BSDXVAL)")
|
---|
9 | Q
|
---|
10 | ;
|
---|
11 | RSRC(BSDXY,BSDXVAL) ;EP
|
---|
12 | ;
|
---|
13 | ;Called by BSDX ADD/EDIT RESOURCE
|
---|
14 | ;Add/Edit BSDX RESOURCE entry
|
---|
15 | ;BSDXVAL is sResourceID|sResourceName|sInactive|sHospLocID|TIME_SCALE|LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER
|
---|
16 | ;If IEN=0 Then this is a new Resource
|
---|
17 | ;Test Line:
|
---|
18 | ;D RSRC^BSDX16(.RES,"sResourceID|sResourceName|sInactive|sHospLocID")
|
---|
19 | ;
|
---|
20 | S X="ERROR^BSDX16",@^%ZOSF("TRAP")
|
---|
21 | N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXINA,BSDXNOTE,BSDXNAM
|
---|
22 | S BSDXY="^BSDXTMP("_$J_")"
|
---|
23 | K ^BSDXTMP($J)
|
---|
24 | S ^BSDXTMP($J,0)="I00020RESOURCEID^T00030ERRORTEXT"_$C(30)
|
---|
25 | ; Changed following from a $G = "" to $D check: $G didn't work since BSDXVAL is an array. MJL 10/18/2006
|
---|
26 | I BSDXVAL="",$D(BSDXVAL)<2 D ERR(0,"BSDX16: Invalid null input Parameter") Q
|
---|
27 | ;Unpack array at @XWBARY
|
---|
28 | I BSDXVAL="" D
|
---|
29 | . N BSDXC S BSDXC=0 F S BSDXC=$O(BSDXVAL(BSDXC)) Q:'BSDXC D
|
---|
30 | . . S BSDXVAL=BSDXVAL_BSDXVAL(BSDXC)
|
---|
31 | S BSDXIEN=$P(BSDXVAL,"|")
|
---|
32 | I +BSDXIEN D
|
---|
33 | . S BSDX="EDIT"
|
---|
34 | . S BSDXIENS=BSDXIEN_","
|
---|
35 | E D
|
---|
36 | . S BSDX="ADD"
|
---|
37 | . S BSDXIENS="+1,"
|
---|
38 | ;
|
---|
39 | S BSDXNAM=$P(BSDXVAL,"|",2)
|
---|
40 | ;Prevent adding entry with duplicate name
|
---|
41 | I $D(^BSDXRES("B",BSDXNAM)),$O(^BSDXRES("B",BSDXNAM,0))'=BSDXIEN D Q
|
---|
42 | . D ERR(0,"BSDX16: Cannot have two Resources with the same name.")
|
---|
43 | . Q
|
---|
44 | ;
|
---|
45 | S BSDXINA=$P(BSDXVAL,"|",3)
|
---|
46 | S BSDXINA=$S(BSDXINA="YES":1,1:0)
|
---|
47 | ;
|
---|
48 | S BSDXFDA(9002018.1,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME
|
---|
49 | S BSDXFDA(9002018.1,BSDXIENS,.02)=BSDXINA ;INACTIVE
|
---|
50 | I +$P(BSDXVAL,"|",5) S BSDXFDA(9002018.1,BSDXIENS,.03)=+$P(BSDXVAL,"|",5) ;TIME SCALE
|
---|
51 | I +$P(BSDXVAL,"|",4) S BSDXFDA(9002018.1,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;HOSPITAL LOCATION
|
---|
52 | K BSDXMSG
|
---|
53 | I BSDX="ADD" D ;TODO: Check for error
|
---|
54 | . K BSDXIEN
|
---|
55 | . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
---|
56 | . S BSDXIEN=+$G(BSDXIEN(1))
|
---|
57 | E D
|
---|
58 | . D FILE^DIE("","BSDXFDA","BSDXMSG")
|
---|
59 | ;
|
---|
60 | ;LETTER TEXT wp field
|
---|
61 | S BSDXNOTE=$P(BSDXVAL,"|",6)
|
---|
62 | ;
|
---|
63 | I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
---|
64 | I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
---|
65 | ;
|
---|
66 | I $D(BSDXNOTE(.5)) D
|
---|
67 | . D WP^DIE(9002018.1,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
|
---|
68 | ;
|
---|
69 | ;NO SHOW LETTER wp fields
|
---|
70 | K BSDXNOTE
|
---|
71 | S BSDXNOTE=$P(BSDXVAL,"|",7)
|
---|
72 | ;
|
---|
73 | I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
---|
74 | I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
---|
75 | ;
|
---|
76 | I $D(BSDXNOTE(.5)) D
|
---|
77 | . D WP^DIE(9002018.1,BSDXIEN_",",1201,"","BSDXNOTE","BSDXMSG")
|
---|
78 | ;
|
---|
79 | ;CANCELLATION LETTER wp field
|
---|
80 | K BSDXNOTE
|
---|
81 | S BSDXNOTE=$P(BSDXVAL,"|",8)
|
---|
82 | ;
|
---|
83 | I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
---|
84 | I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
---|
85 | ;
|
---|
86 | I $D(BSDXNOTE(.5)) D
|
---|
87 | . D WP^DIE(9002018.1,BSDXIEN_",",1301,"","BSDXNOTE","BSDXMSG")
|
---|
88 | ;
|
---|
89 | S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
|
---|
90 | Q
|
---|
91 | ;
|
---|
92 | ERROR ;
|
---|
93 | D ^%ZTER
|
---|
94 | I '+$G(BSDXI) N BSDXI S BSDXI=999999
|
---|
95 | S BSDXI=BSDXI+1
|
---|
96 | D ERR(0,"BSDX16 M Error: <"_$G(%ZTERROR)_">")
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | ERR(BSDXERID,ERRTXT) ;Error processing
|
---|
100 | S:'+$G(BSDXI) BSDXI=999999
|
---|
101 | S BSDXI=BSDXI+1
|
---|
102 | S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
|
---|
103 | S BSDXI=BSDXI+1
|
---|
104 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
---|
105 | Q
|
---|