source: Scheduling/trunk/m/BSDX16.m@ 760

Last change on this file since 760 was 614, checked in by Sam Habiel, 15 years ago

Initial committ of scheduling package
File size: 3.1 KB
Line 
1BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
2 ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
3 ;
4 ;
5RSRCD(BSDXY,BSDXVAL) ;EP
6 ;Entry point for debugging
7 ;
8 ;D DEBUG^%Serenji("RSRC^BSDX16(.BSDXY,BSDXVAL)")
9 Q
10 ;
11RSRC(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 ;
92ERROR ;
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 ;
99ERR(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
Note: See TracBrowser for help on using the repository browser.