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

Last change on this file since 1186 was 1177, checked in by Sam Habiel, 14 years ago

M routines to support Radiology Scheduling Integration; version bumped to 1.6t1
File size: 3.1 KB
Line 
1BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:20am
2 ;;1.6T1;BSDX;;May 11, 2011
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.