source: Scheduling/trunk/m/BSDX35.m@ 1173

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

Added LGPL license to routines

File size: 2.3 KB
Line 
1BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
2 ;;1.5;BSDX;;Apr 28, 2011
3 ; Licensed under LGPL
4 ;
5 ;
6 Q
7 ;
8RSRCLTRD(BSDXY,BSDXLIST) ;EP
9 ;Entry point for debugging
10 ;
11 ;D DEBUG^%Serenji("RSRCLTR^BSDX35(.BSDXY,BSDXLIST)")
12 Q
13 ;
14RSRCLTR(BSDXY,BSDXLIST) ;EP
15 ;
16 ;Return recordset of RESOURCES and associated LETTERS
17 ;Used in generating rebook letters for a clinic
18 ;BSDXLIST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
19 ;Called by BSDX RESOURCE LETTERS
20 ;
21 ;
22 S X="ERROR^BSDX35",@^%ZOSF("TRAP")
23 S BSDXY="^BSDXTMP("_$J_")"
24 N BSDXIEN,BSDX,BSDXLTR,BSDXNOS,BSDXCAN,BSDXIEN1
25 S BSDXI=0
26 S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00030LETTER_TEXT^T00030NO_SHOW_LETTER^T00030CLINIC_CANCELLATION_LETTER"_$C(30)
27 ;
28 ;
29 ;If BSDXLIST is a list of resource NAMES, look up each name and convert to IEN
30 F BSDXJ=1:1:$L(BSDXLIST,"|")-1 S BSDX=$P(BSDXLIST,"|",BSDXJ) D S $P(BSDXLIST,"|",BSDXJ)=BSDY
31 . S BSDY=""
32 . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q
33 . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q
34 . Q
35 ;
36 ;Get letter text from wp fields
37 S BSDXIEN=0
38 F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D
39 . Q:'$D(^BSDXRES(BSDXIEN))
40 . S BSDXNAM=$P(^BSDXRES(BSDXIEN,0),U)
41 . S BSDXLTR=""
42 . I $D(^BSDXRES(BSDXIEN,1)) D
43 . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,1,BSDXIEN1)) Q:'+BSDXIEN1 D
44 . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXIEN,1,BSDXIEN1,0))
45 . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
46 . S BSDXNOS=""
47 . I $D(^BSDXRES(BSDXIEN,12)) D
48 . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,12,BSDXIEN1)) Q:'+BSDXIEN1 D
49 . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXIEN,12,BSDXIEN1,0))
50 . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
51 . S BSDXCAN=""
52 . I $D(^BSDXRES(BSDXIEN,13)) D
53 . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,13,BSDXIEN1)) Q:'+BSDXIEN1 D
54 . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXIEN,13,BSDXIEN1,0))
55 . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
56 . S BSDXI=BSDXI+1
57 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_$C(30)
58 ;
59 S BSDXI=BSDXI+1
60 S ^BSDXTMP($J,BSDXI)=$C(31)
61 Q
62 ;
63ERROR ;
64 D ERR("RPMS Error")
65 Q
66 ;
67ERR(ERRNO) ;Error processing
68 S:'$D(BSDXI) BSDXI=999
69 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
70 E S BSDXERR=ERRNO
71 S BSDXI=BSDXI+1
72 S ^BSDXTMP($J,BSDXI)="^^^^"_$C(30)
73 S BSDXI=BSDXI+1
74 S ^BSDXTMP($J,BSDXI)=$C(31)
75 Q
Note: See TracBrowser for help on using the repository browser.