SDEC35 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
RESLETRS(SDECY,SDECLIST,SDLTR,SDNOS,SDCAN) ;Return recordset of RESOURCES and associated LETTERS
;RESLETRS(SDECY,SDECLIST,SDLTR,SDNOS,SDCAN) external parameter tag is in SDEC
; SDECLIST = (required) pipe | delimited list of SDEC RESOURCE iens
; resource ID pointer to SDEC RESOURCE file
; SDLTR = (optional) 1 will return the LETTER TEXT
; 0 will not return the LETTER TEXT (default)
; SDNOS = (optional) 1 will return the NO SHOW LETTER text
; 0 will not return the NO SHOW LETTER text (default)
; SDCAN = (optional) 1 will return the CLINIC CANCELLATION LETTER text
; 0 will not return the CLINIC CANCELLATION text (default)
;RETURN:
; Successful Return:
; 1. RESOURCEID
; 2. RESOURCE_NAME
; 3. LETTER_TEXT
; 4. NO_SHOW_LETTER
; 5. CLINIC_CANCELLATION_LETTER
;
N BSDY
N SDECI,SDECIEN,SDECJ,SDEC,SDECLTR,SDECNOS,SDECCAN,SDECIEN1,SDECNAM
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00030LETTER_TEXT^T00030NO_SHOW_LETTER^T00030CLINIC_CANCELLATION_LETTER"_$C(30)
;validate flags
S SDLTR=$G(SDLTR)
S SDNOS=$G(SDNOS)
S SDCAN=$G(SDCAN)
;
;If SDECLIST is a list of resource NAMES, look up each name and convert to IEN
F SDECJ=1:1:$L(SDECLIST,"|")-1 S SDEC=$P(SDECLIST,"|",SDECJ) D S $P(SDECLIST,"|",SDECJ)=BSDY
. S BSDY=""
. I SDEC]"",$D(^SDEC(409.831,SDEC,0)) S BSDY=SDEC Q
. I SDEC]"",$D(^SDEC(409.831,"B",SDEC)) S BSDY=$O(^SDEC(409.831,"B",SDEC,0)) Q
. Q
;
;Get letter text from wp fields
S SDECIEN=0
F SDEC=1:1:$L(SDECLIST,"|") S SDECIEN=$P(SDECLIST,"|",SDEC) D
. Q:'$D(^SDEC(409.831,+SDECIEN))
. S SDECNAM=$P(^SDEC(409.831,SDECIEN,0),U)
. S SDECLTR=""
. I +SDLTR,$D(^SDEC(409.831,SDECIEN,1)) D
. . S SDECIEN1=0 F S SDECIEN1=$O(^SDEC(409.831,SDECIEN,1,SDECIEN1)) Q:'+SDECIEN1 D
. . . S SDECLTR=SDECLTR_$G(^SDEC(409.831,SDECIEN,1,SDECIEN1,0))
. . . S SDECLTR=SDECLTR_$C(13)_$C(10)
. S SDECNOS=""
. I +SDNOS,$D(^SDEC(409.831,SDECIEN,12)) D
. . S SDECIEN1=0 F S SDECIEN1=$O(^SDEC(409.831,SDECIEN,12,SDECIEN1)) Q:'+SDECIEN1 D
. . . S SDECNOS=SDECNOS_$G(^SDEC(409.831,SDECIEN,12,SDECIEN1,0))
. . . S SDECNOS=SDECNOS_$C(13)_$C(10)
. S SDECCAN=""
. I SDCAN,$D(^SDEC(409.831,SDECIEN,13)) D
. . S SDECIEN1=0 F S SDECIEN1=$O(^SDEC(409.831,SDECIEN,13,SDECIEN1)) Q:'+SDECIEN1 D
. . . S SDECCAN=SDECCAN_$G(^SDEC(409.831,SDECIEN,13,SDECIEN1,0))
. . . S SDECCAN=SDECCAN_$C(13)_$C(10)
. S SDECI=SDECI+1
. S ^TMP("SDEC",$J,SDECI)=SDECIEN_U_SDECNAM_U_SDECLTR_U_SDECNOS_U_SDECCAN_$C(30)
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ERROR ;
D ERR("Error")
Q
;
ERR(ERRNO) ;Error processing
S:'$D(SDECI) SDECI=999
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="^^^^"_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC35 3059 printed Dec 13, 2024@02:50:30 Page 2
SDEC35 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
RESLETRS(SDECY,SDECLIST,SDLTR,SDNOS,SDCAN) ;Return recordset of RESOURCES and associated LETTERS
+1 ;RESLETRS(SDECY,SDECLIST,SDLTR,SDNOS,SDCAN) external parameter tag is in SDEC
+2 ; SDECLIST = (required) pipe | delimited list of SDEC RESOURCE iens
+3 ; resource ID pointer to SDEC RESOURCE file
+4 ; SDLTR = (optional) 1 will return the LETTER TEXT
+5 ; 0 will not return the LETTER TEXT (default)
+6 ; SDNOS = (optional) 1 will return the NO SHOW LETTER text
+7 ; 0 will not return the NO SHOW LETTER text (default)
+8 ; SDCAN = (optional) 1 will return the CLINIC CANCELLATION LETTER text
+9 ; 0 will not return the CLINIC CANCELLATION text (default)
+10 ;RETURN:
+11 ; Successful Return:
+12 ; 1. RESOURCEID
+13 ; 2. RESOURCE_NAME
+14 ; 3. LETTER_TEXT
+15 ; 4. NO_SHOW_LETTER
+16 ; 5. CLINIC_CANCELLATION_LETTER
+17 ;
+18 NEW BSDY
+19 NEW SDECI,SDECIEN,SDECJ,SDEC,SDECLTR,SDECNOS,SDECCAN,SDECIEN1,SDECNAM
+20 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+21 KILL @SDECY
+22 SET SDECI=0
+23 SET ^TMP("SDEC",$JOB,SDECI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00030LETTER_TEXT^T00030NO_SHOW_LETTER^T00030CLINIC_CANCELLATION_LETTER"_$CHAR(30)
+24 ;validate flags
+25 SET SDLTR=$GET(SDLTR)
+26 SET SDNOS=$GET(SDNOS)
+27 SET SDCAN=$GET(SDCAN)
+28 ;
+29 ;If SDECLIST is a list of resource NAMES, look up each name and convert to IEN
+30 FOR SDECJ=1:1:$LENGTH(SDECLIST,"|")-1
SET SDEC=$PIECE(SDECLIST,"|",SDECJ)
Begin DoDot:1
+31 SET BSDY=""
+32 IF SDEC]""
IF $DATA(^SDEC(409.831,SDEC,0))
SET BSDY=SDEC
QUIT
+33 IF SDEC]""
IF $DATA(^SDEC(409.831,"B",SDEC))
SET BSDY=$ORDER(^SDEC(409.831,"B",SDEC,0))
QUIT
+34 QUIT
End DoDot:1
SET $PIECE(SDECLIST,"|",SDECJ)=BSDY
+35 ;
+36 ;Get letter text from wp fields
+37 SET SDECIEN=0
+38 FOR SDEC=1:1:$LENGTH(SDECLIST,"|")
SET SDECIEN=$PIECE(SDECLIST,"|",SDEC)
Begin DoDot:1
+39 if '$DATA(^SDEC(409.831,+SDECIEN))
QUIT
+40 SET SDECNAM=$PIECE(^SDEC(409.831,SDECIEN,0),U)
+41 SET SDECLTR=""
+42 IF +SDLTR
IF $DATA(^SDEC(409.831,SDECIEN,1))
Begin DoDot:2
+43 SET SDECIEN1=0
FOR
SET SDECIEN1=$ORDER(^SDEC(409.831,SDECIEN,1,SDECIEN1))
if '+SDECIEN1
QUIT
Begin DoDot:3
+44 SET SDECLTR=SDECLTR_$GET(^SDEC(409.831,SDECIEN,1,SDECIEN1,0))
+45 SET SDECLTR=SDECLTR_$CHAR(13)_$CHAR(10)
End DoDot:3
End DoDot:2
+46 SET SDECNOS=""
+47 IF +SDNOS
IF $DATA(^SDEC(409.831,SDECIEN,12))
Begin DoDot:2
+48 SET SDECIEN1=0
FOR
SET SDECIEN1=$ORDER(^SDEC(409.831,SDECIEN,12,SDECIEN1))
if '+SDECIEN1
QUIT
Begin DoDot:3
+49 SET SDECNOS=SDECNOS_$GET(^SDEC(409.831,SDECIEN,12,SDECIEN1,0))
+50 SET SDECNOS=SDECNOS_$CHAR(13)_$CHAR(10)
End DoDot:3
End DoDot:2
+51 SET SDECCAN=""
+52 IF SDCAN
IF $DATA(^SDEC(409.831,SDECIEN,13))
Begin DoDot:2
+53 SET SDECIEN1=0
FOR
SET SDECIEN1=$ORDER(^SDEC(409.831,SDECIEN,13,SDECIEN1))
if '+SDECIEN1
QUIT
Begin DoDot:3
+54 SET SDECCAN=SDECCAN_$GET(^SDEC(409.831,SDECIEN,13,SDECIEN1,0))
+55 SET SDECCAN=SDECCAN_$CHAR(13)_$CHAR(10)
End DoDot:3
End DoDot:2
+56 SET SDECI=SDECI+1
+57 SET ^TMP("SDEC",$JOB,SDECI)=SDECIEN_U_SDECNAM_U_SDECLTR_U_SDECNOS_U_SDECCAN_$CHAR(30)
End DoDot:1
+58 ;
+59 SET SDECI=SDECI+1
+60 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+61 QUIT
+62 ;
ERROR ;
+1 DO ERR("Error")
+2 QUIT
+3 ;
ERR(ERRNO) ;Error processing
+1 if '$DATA(SDECI)
SET SDECI=999
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC",$JOB,SDECI)="^^^^"_$CHAR(30)
+4 SET SDECI=SDECI+1
+5 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+6 QUIT
