- BSDX35 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- ;
- ;
- Q
- ;
- RSRCLTRD(BSDXY,BSDXLIST) ;EP
- ;Entry point for debugging
- ;
- ;D DEBUG^%Serenji("RSRCLTR^BSDX35(.BSDXY,BSDXLIST)")
- Q
- ;
- RSRCLTR(BSDXY,BSDXLIST) ;EP
- ;
- ;Return recordset of RESOURCES and associated LETTERS
- ;Used in generating rebook letters for a clinic
- ;BSDXLIST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
- ;Called by BSDX RESOURCE LETTERS
- ;
- ;
- S X="ERROR^BSDX35",@^%ZOSF("TRAP")
- S BSDXY="^BSDXTMP("_$J_")"
- N BSDXIEN,BSDX,BSDXLTR,BSDXNOS,BSDXCAN,BSDXIEN1
- S BSDXI=0
- S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00030LETTER_TEXT^T00030NO_SHOW_LETTER^T00030CLINIC_CANCELLATION_LETTER"_$C(30)
- ;
- ;
- ;If BSDXLIST is a list of resource NAMES, look up each name and convert to IEN
- F BSDXJ=1:1:$L(BSDXLIST,"|")-1 S BSDX=$P(BSDXLIST,"|",BSDXJ) D S $P(BSDXLIST,"|",BSDXJ)=BSDY
- . S BSDY=""
- . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q
- . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q
- . Q
- ;
- ;Get letter text from wp fields
- S BSDXIEN=0
- F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D
- . Q:'$D(^BSDXRES(BSDXIEN))
- . S BSDXNAM=$P(^BSDXRES(BSDXIEN,0),U)
- . S BSDXLTR=""
- . I $D(^BSDXRES(BSDXIEN,1)) D
- . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,1,BSDXIEN1)) Q:'+BSDXIEN1 D
- . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXIEN,1,BSDXIEN1,0))
- . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
- . S BSDXNOS=""
- . I $D(^BSDXRES(BSDXIEN,12)) D
- . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,12,BSDXIEN1)) Q:'+BSDXIEN1 D
- . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXIEN,12,BSDXIEN1,0))
- . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
- . S BSDXCAN=""
- . I $D(^BSDXRES(BSDXIEN,13)) D
- . . S BSDXIEN1=0 F S BSDXIEN1=$O(^BSDXRES(BSDXIEN,13,BSDXIEN1)) Q:'+BSDXIEN1 D
- . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXIEN,13,BSDXIEN1,0))
- . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
- . S BSDXI=BSDXI+1
- . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_$C(30)
- ;
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- ;
- ERROR ;
- D ERR("RPMS Error")
- Q
- ;
- ERR(ERRNO) ;Error processing
- S:'$D(BSDXI) BSDXI=999
- I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
- E S BSDXERR=ERRNO
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)="^^^^"_$C(30)
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- BSDX35 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- +1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- +2 ;
- +3 ;
- +4 QUIT
- +5 ;
- RSRCLTRD(BSDXY,BSDXLIST) ;EP
- +1 ;Entry point for debugging
- +2 ;
- +3 ;D DEBUG^%Serenji("RSRCLTR^BSDX35(.BSDXY,BSDXLIST)")
- +4 QUIT
- +5 ;
- RSRCLTR(BSDXY,BSDXLIST) ;EP
- +1 ;
- +2 ;Return recordset of RESOURCES and associated LETTERS
- +3 ;Used in generating rebook letters for a clinic
- +4 ;BSDXLIST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
- +5 ;Called by BSDX RESOURCE LETTERS
- +6 ;
- +7 ;
- +8 SET X="ERROR^BSDX35"
- SET @^%ZOSF("TRAP")
- +9 SET BSDXY="^BSDXTMP("_$JOB_")"
- +10 NEW BSDXIEN,BSDX,BSDXLTR,BSDXNOS,BSDXCAN,BSDXIEN1
- +11 SET BSDXI=0
- +12 SET ^BSDXTMP($JOB,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00030LETTER_TEXT^T00030NO_SHOW_LETTER^T00030CLINIC_CANCELLATION_LETTER"_$CHAR(30)
- +13 ;
- +14 ;
- +15 ;If BSDXLIST is a list of resource NAMES, look up each name and convert to IEN
- +16 FOR BSDXJ=1:1:$LENGTH(BSDXLIST,"|")-1
- SET BSDX=$PIECE(BSDXLIST,"|",BSDXJ)
- Begin DoDot:1
- +17 SET BSDY=""
- +18 IF BSDX]""
- IF $DATA(^BSDXRES(BSDX,0))
- SET BSDY=BSDX
- QUIT
- +19 IF BSDX]""
- IF $DATA(^BSDXRES("B",BSDX))
- SET BSDY=$ORDER(^BSDXRES("B",BSDX,0))
- QUIT
- +20 QUIT
- End DoDot:1
- SET $PIECE(BSDXLIST,"|",BSDXJ)=BSDY
- +21 ;
- +22 ;Get letter text from wp fields
- +23 SET BSDXIEN=0
- +24 FOR BSDX=1:1:$LENGTH(BSDXLIST,"|")-1
- SET BSDXIEN=$PIECE(BSDXLIST,"|",BSDX)
- Begin DoDot:1
- +25 IF '$DATA(^BSDXRES(BSDXIEN))
- QUIT
- +26 SET BSDXNAM=$PIECE(^BSDXRES(BSDXIEN,0),U)
- +27 SET BSDXLTR=""
- +28 IF $DATA(^BSDXRES(BSDXIEN,1))
- Begin DoDot:2
- +29 SET BSDXIEN1=0
- FOR
- SET BSDXIEN1=$ORDER(^BSDXRES(BSDXIEN,1,BSDXIEN1))
- IF '+BSDXIEN1
- QUIT
- Begin DoDot:3
- +30 SET BSDXLTR=BSDXLTR_$GET(^BSDXRES(BSDXIEN,1,BSDXIEN1,0))
- +31 SET BSDXLTR=BSDXLTR_$CHAR(13)_$CHAR(10)
- End DoDot:3
- End DoDot:2
- +32 SET BSDXNOS=""
- +33 IF $DATA(^BSDXRES(BSDXIEN,12))
- Begin DoDot:2
- +34 SET BSDXIEN1=0
- FOR
- SET BSDXIEN1=$ORDER(^BSDXRES(BSDXIEN,12,BSDXIEN1))
- IF '+BSDXIEN1
- QUIT
- Begin DoDot:3
- +35 SET BSDXNOS=BSDXNOS_$GET(^BSDXRES(BSDXIEN,12,BSDXIEN1,0))
- +36 SET BSDXNOS=BSDXNOS_$CHAR(13)_$CHAR(10)
- End DoDot:3
- End DoDot:2
- +37 SET BSDXCAN=""
- +38 IF $DATA(^BSDXRES(BSDXIEN,13))
- Begin DoDot:2
- +39 SET BSDXIEN1=0
- FOR
- SET BSDXIEN1=$ORDER(^BSDXRES(BSDXIEN,13,BSDXIEN1))
- IF '+BSDXIEN1
- QUIT
- Begin DoDot:3
- +40 SET BSDXCAN=BSDXCAN_$GET(^BSDXRES(BSDXIEN,13,BSDXIEN1,0))
- +41 SET BSDXCAN=BSDXCAN_$CHAR(13)_$CHAR(10)
- End DoDot:3
- End DoDot:2
- +42 SET BSDXI=BSDXI+1
- +43 SET ^BSDXTMP($JOB,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_$CHAR(30)
- End DoDot:1
- +44 ;
- +45 SET BSDXI=BSDXI+1
- +46 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +47 QUIT
- +48 ;
- ERROR ;
- +1 DO ERR("RPMS Error")
- +2 QUIT
- +3 ;
- ERR(ERRNO) ;Error processing
- +1 IF '$DATA(BSDXI)
- SET BSDXI=999
- +2 ;vbObjectError
- IF +ERRNO
- SET BSDXERR=ERRNO+134234112
- +3 IF '$TEST
- SET BSDXERR=ERRNO
- +4 SET BSDXI=BSDXI+1
- +5 SET ^BSDXTMP($JOB,BSDXI)="^^^^"_$CHAR(30)
- +6 SET BSDXI=BSDXI+1
- +7 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +8 QUIT
