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

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 3.1 KB
Line 
1BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:20am
2 ;;1.6T2;BSDX;;May 16, 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.