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
