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

Last change on this file since 1475 was 1472, checked in by Sam Habiel, 12 years ago

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