SDEC47 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
;
; ICR
; ---
; 10060 - #200 New Person
Q
;
CLINDIS(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;Return formatted text output of the Clinic Schedules Report
;CLINDIS(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) external parameter tag is in SDEC
;Return formatted text output of the Clinic Schedules Report
;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
;SDECBEG and SDECEND are in external date form.
;SDECWI = return only appointments where the WALKIN field is yes
;
N SDECI,SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCID,SDECCNOD,SDECDT
N SDECJ,SDECAID,SDECPAT,SDECPNOD,SDECCLN,SDECCLRK,SDECMADE,SDECNOT,SDECLIN
N SDECSTRT,SDECAPT,SDECQ,SDECTMP,SDECTYPE
N SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON,%DT,X,Y
S SDECY="^TMP(""SDEC"","_$J_")"
K ^TMP("SDEC",$J)
S SDECI=0
S ^TMP("SDEC",$J,SDECI)="T00080TEXT"_$C(30)
;
;Convert beginning and ending dates
;
;
; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
;
;S SDECBEG=$P(SDECBEG,"@",1)
;S X=SDECBEG,%DT="X" D ^%DT S SDECBEG=$P(Y,"."),SDECBEG=SDECBEG-1,SDECBEG=SDECBEG_".9999"
;I Y=-1 D ERR("0^Routine: SDEC47, Error: Invalid Date") Q
S SDECBEG=$$NETTOFM^SDECDATE(SDECBEG) I SDECBEG=-1 D ERR("0^Routine: SDEC47, Error: Invalid Date") Q ;
S SDECBEG=$P(SDECBEG,".",1),SDECBEG=SDECBEG-1,SDECBEG=SDECBEG_".9999" ;
;S SDECEND=$P(SDECEND,"@",1)
;S X=SDECEND,%DT="X" D ^%DT S SDECEND=$P(Y,"."),SDECEND=SDECEND_".9999"
;I Y=-1 D ERR("0^Routine: SDEC47, Error: Invalid Date") Q
S SDECEND=$$NETTOFM^SDECDATE(SDECEND) I SDECEND=-1 D ERR("0^Routine: SDEC47, Error: Invalid Date") Q ;
S SDECEND=$P(SDECEND,".",1),SDECEND=SDECEND_".9999" ;
I SDECCLST="" D ERR("0^Routine: SDEC47, Error: Null clinic list") Q
;
;header
; 1 18 30 38 50 66 79
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Name DOB Sex HRN Clinic"_$C(30)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="==== === === === ======"_$C(30)
;For each clinic in SDECCLST $O through ^SDEC(409.84,"ARSRC",ResourceIEN,FMDate,ApptIEN)
F SDECJ=1:1:$L(SDECCLST,"|")-1 S SDECCID=$P(SDECCLST,"|",SDECJ) D
. S SDECCLN=$G(^SDEC(409.831,SDECCID,0)) S SDECCLN=$P(SDECCLN,U) Q:SDECCLN=""
. S SDECSTRT=SDECBEG F S SDECSTRT=$O(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT)) Q:'+SDECSTRT Q:SDECSTRT>SDECEND D
. . S SDECAID=0 F S SDECAID=$O(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT,SDECAID)) Q:'+SDECAID D
. . . S SDECNOD=$G(^SDEC(409.84,SDECAID,0))
. . . Q:SDECNOD=""
. . . Q:$P(SDECNOD,U,12)]"" ;CANCELLED
. . . I '$G(SDECWI),$P(SDECNOD,U,13)="y" Q ;DO NOT ALLOW WALKIN
. . . I $G(SDECWI),$P(SDECNOD,U,13)'="y" Q ;ONLY ALLOW WALKIN
. . . ;
. . . ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
. . . ;
. . . S Y=$P(SDECNOD,U)
. . . Q:'+Y
. . . ;X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . S Y=$$FMTONET^SDECDATE(Y,"Y") ;
. . . S SDECAPT=Y ;Appointment date time
. . . ;
. . . ;NOTE
. . . S SDECNOT=""
. . . I $D(^SDEC(409.84,SDECAID,1,0)) S SDECQ=0 F S SDECQ=$O(^SDEC(409.84,SDECAID,1,SDECQ)) Q:'+SDECQ D
. . . . S SDECLIN=$G(^SDEC(409.84,SDECAID,1,SDECQ,0))
. . . . S:(SDECLIN'="")&($E(SDECLIN,$L(SDECLIN)-1,$L(SDECLIN))'=" ") SDECLIN=SDECLIN_" "
. . . . S SDECNOT=SDECNOT_SDECLIN
. . . ;
. . . S SDECPAT=$P(SDECNOD,U,5)
. . . S SDECPNOD=$$PATINFO^SDEC27(SDECPAT)
. . . S SDECNAM=$P(SDECPNOD,U) ;NAME
. . . S SDECSEX=$P(SDECPNOD,U,2) ;SEX
. . . S SDECDOB=$P(SDECPNOD,U,3) ;DOB
. . . S SDECHRN=$P(SDECPNOD,U,4) ;Health Record Number for location DUZ(2)
. . . S SDECSTRE=$P(SDECPNOD,U,5) ;Street
. . . S SDECCITY=$P(SDECPNOD,U,6) ;City
. . . S SDECST=$P(SDECPNOD,U,7) ;State
. . . S SDECZIP=$P(SDECPNOD,U,8) ;zip
. . . S SDECPHON=$P(SDECPNOD,U,9) ;homephone
. . . S SDECTYPE="" ;Type/status doesn't exist for SDEC APPT clinics and it's not needed for clinic letters
. . . S SDECCLRK=$P(SDECNOD,U,8)
. . . S:+SDECCLRK SDECCLRK=$G(^VA(200,SDECCLRK,0)),SDECCLRK=$P(SDECCLRK,U)
. . . ;
. . . ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
. . . ;
. . . S Y=$P(SDECNOD,U,9)
. . . ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
. . . I +Y S Y=$$FMTONET^SDECDATE(Y,"Y") ;
. . . S SDECMADE=Y
. . . S SDECTMP=$E(SDECNAM,1,15)
. . . S SDECTMP=SDECTMP_$$FILL^SDECU(17-$L(SDECTMP))_SDECDOB
. . . S SDECTMP=SDECTMP_$$FILL^SDECU(29-$L(SDECTMP))_SDECSEX
. . . S SDECTMP=SDECTMP_$$FILL^SDECU(37-$L(SDECTMP))_SDECHRN
. . . S SDECTMP=SDECTMP_$$FILL^SDECU(49-$L(SDECTMP))_$E(SDECCLN,1,15)
. . . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDECTMP_$C(30)
. . . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="APPOINTMENT DATE: "_SDECAPT_$C(30)
. . . S SDECTMP="APPT MADE BY: "_$E(SDECCLRK,1,20)
. . . S SDECTMP=SDECTMP_$$FILL^SDECU(39-$L(SDECTMP))_"DATE APPT MADE: "_SDECMADE
. . . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDECTMP_$C(30)
. . . I SDECSTRE'="" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Address: "_SDECSTRE_$C(30)
. . . I SDECCITY'="" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_SDECCITY_", "_SDECST_" "_SDECZIP_$C(30)
. . . I SDECPHON'="" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Phone: "_SDECPHON_$C(30)
. . . I SDECNOT'="" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="NOTE: "_$E(SDECNOT,1,73)_$C(30)
. . . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""_$C(30)
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
CLINDISW(SDECY,SDECCLST,SDECBEG,SDECEND) ;Return formatted text output of the Clinic Schedules Report for Walkins
;CLINDISW(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
;Return formatted text output of the Clinic Schedules Report for Walkins
;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
;SDECBEG and SDECEND are in external date form.
S:$G(U)="" U="^"
D CLINDIS(.SDECY,SDECCLST,SDECBEG,SDECEND,1)
Q
;
RESLETRF(SDECY,SDECRES,SDECLT) ;Return formatted text output of the Resource's Letter - either "LETTER TEXT" (also used as Reminder Letter), NO SHOW LETTER, or CLINIC CANCELLATION LETTER.
;RESLETRF(SDECY,SDECRES,SDECLT) external parameter tag is in SDEC
;Called by SDEC RESOURCE LETTER FORMATTED
;Return formatted text output of the Resource's Letter - either "LETTER TEXT" (also used as Reminder Letter), NO SHOW LETTER, or CLINIC CANCELLATION LETTER.
;SDECRES = Resource IEN from the SDEC RESOURCE file
;SDECLT = Letter type: "R"=Reminder Letter; "C" or "A"=Clinic Cancellation letter; "N"=No Show Letter
;
N SDECH,SDECI,SDECJ,SDECL
N SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCID,SDECCNOD,SDECDT
N SDECJ,SDECAID,SDECPAT,SDECPNOD,SDECCLN,SDECCLRK,SDECMADE,SDECNOT,SDECLIN
N SDECSTRT
N SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
S SDECY="^TMP(""SDEC"","_$J_")"
K ^TMP("SDEC",$J)
S SDECI=0
;check resource
I $G(SDECRES)="" D ERR("0^SDEC47: Resource not specified.")
I '$D(^SDEC(409.831,SDECRES)) D ERR("0^SDEC47: Invalid Resource specified.")
;check letter type
I $G(SDECLT)="" D ERR("0^SDEC47: Letter type not specified.")
I "ACNR"'[SDECLT D ERR("0^SDEC47: Invalid letter type specified.")
;return header
S ^TMP("SDEC",$J,0)="T00080TEXT"_$c(30)
;
;format body of letter
S SDECH=0
F S SDECH=$O(^SDEC(409.831,SDECRES,$S(SDECLT="A":13,SDECLT="C":13,SDECLT="N":12,1:1),SDECH)) Q:SDECH="" D
. S SDECL=$G(^SDEC(409.831,SDECRES,$S(SDECLT="A":13,SDECLT="C":13,SDECLT="N":12,1:1),SDECH,0))
. I SDECL'="",$L(SDECL)>79 S SDECL=$$FL^SDECUTL(SDECL,80)
. F SDECJ=1:1:$L(SDECL,"||") S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$P(SDECL,"||",SDECJ)_$C(30)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
ERROR ;
D ERR("VISTA Error")
Q
;
ERR(ERRTXT) ;Error processing
S:'$D(SDECI) SDECI=999
S ERRTXT=$G(ERRTXT)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=ERRTXT_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC47 8310 printed Sep 23, 2025@20:27:03 Page 2
SDEC47 ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,694**;Aug 13, 1993;Build 61
+2 ;
+3 ; ICR
+4 ; ---
+5 ; 10060 - #200 New Person
+6 QUIT
+7 ;
CLINDIS(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) ;Return formatted text output of the Clinic Schedules Report
+1 ;CLINDIS(SDECY,SDECCLST,SDECBEG,SDECEND,SDECWI) external parameter tag is in SDEC
+2 ;Return formatted text output of the Clinic Schedules Report
+3 ;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
+4 ;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
+5 ;SDECBEG and SDECEND are in external date form.
+6 ;SDECWI = return only appointments where the WALKIN field is yes
+7 ;
+8 NEW SDECI,SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCID,SDECCNOD,SDECDT
+9 NEW SDECJ,SDECAID,SDECPAT,SDECPNOD,SDECCLN,SDECCLRK,SDECMADE,SDECNOT,SDECLIN
+10 NEW SDECSTRT,SDECAPT,SDECQ,SDECTMP,SDECTYPE
+11 NEW SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON,%DT,X,Y
+12 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+13 KILL ^TMP("SDEC",$JOB)
+14 SET SDECI=0
+15 SET ^TMP("SDEC",$JOB,SDECI)="T00080TEXT"_$CHAR(30)
+16 ;
+17 ;Convert beginning and ending dates
+18 ;
+19 ;
+20 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+21 ;
+22 ;S SDECBEG=$P(SDECBEG,"@",1)
+23 ;S X=SDECBEG,%DT="X" D ^%DT S SDECBEG=$P(Y,"."),SDECBEG=SDECBEG-1,SDECBEG=SDECBEG_".9999"
+24 ;I Y=-1 D ERR("0^Routine: SDEC47, Error: Invalid Date") Q
+25 ;
SET SDECBEG=$$NETTOFM^SDECDATE(SDECBEG)
IF SDECBEG=-1
DO ERR("0^Routine: SDEC47, Error: Invalid Date")
QUIT
+26 ;
SET SDECBEG=$PIECE(SDECBEG,".",1)
SET SDECBEG=SDECBEG-1
SET SDECBEG=SDECBEG_".9999"
+27 ;S SDECEND=$P(SDECEND,"@",1)
+28 ;S X=SDECEND,%DT="X" D ^%DT S SDECEND=$P(Y,"."),SDECEND=SDECEND_".9999"
+29 ;I Y=-1 D ERR("0^Routine: SDEC47, Error: Invalid Date") Q
+30 ;
SET SDECEND=$$NETTOFM^SDECDATE(SDECEND)
IF SDECEND=-1
DO ERR("0^Routine: SDEC47, Error: Invalid Date")
QUIT
+31 ;
SET SDECEND=$PIECE(SDECEND,".",1)
SET SDECEND=SDECEND_".9999"
+32 IF SDECCLST=""
DO ERR("0^Routine: SDEC47, Error: Null clinic list")
QUIT
+33 ;
+34 ;header
+35 ; 1 18 30 38 50 66 79
+36 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="Name DOB Sex HRN Clinic"_$CHAR(30)
+37 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="==== === === === ======"_$CHAR(30)
+38 ;For each clinic in SDECCLST $O through ^SDEC(409.84,"ARSRC",ResourceIEN,FMDate,ApptIEN)
+39 FOR SDECJ=1:1:$LENGTH(SDECCLST,"|")-1
SET SDECCID=$PIECE(SDECCLST,"|",SDECJ)
Begin DoDot:1
+40 SET SDECCLN=$GET(^SDEC(409.831,SDECCID,0))
SET SDECCLN=$PIECE(SDECCLN,U)
if SDECCLN=""
QUIT
+41 SET SDECSTRT=SDECBEG
FOR
SET SDECSTRT=$ORDER(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT))
if '+SDECSTRT
QUIT
if SDECSTRT>SDECEND
QUIT
Begin DoDot:2
+42 SET SDECAID=0
FOR
SET SDECAID=$ORDER(^SDEC(409.84,"ARSRC",SDECCID,SDECSTRT,SDECAID))
if '+SDECAID
QUIT
Begin DoDot:3
+43 SET SDECNOD=$GET(^SDEC(409.84,SDECAID,0))
+44 if SDECNOD=""
QUIT
+45 ;CANCELLED
if $PIECE(SDECNOD,U,12)]""
QUIT
+46 ;DO NOT ALLOW WALKIN
IF '$GET(SDECWI)
IF $PIECE(SDECNOD,U,13)="y"
QUIT
+47 ;ONLY ALLOW WALKIN
IF $GET(SDECWI)
IF $PIECE(SDECNOD,U,13)'="y"
QUIT
+48 ;
+49 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+50 ;
+51 SET Y=$PIECE(SDECNOD,U)
+52 if '+Y
QUIT
+53 ;X ^DD("DD") S Y=$TR(Y,"@"," ")
+54 ;
SET Y=$$FMTONET^SDECDATE(Y,"Y")
+55 ;Appointment date time
SET SDECAPT=Y
+56 ;
+57 ;NOTE
+58 SET SDECNOT=""
+59 IF $DATA(^SDEC(409.84,SDECAID,1,0))
SET SDECQ=0
FOR
SET SDECQ=$ORDER(^SDEC(409.84,SDECAID,1,SDECQ))
if '+SDECQ
QUIT
Begin DoDot:4
+60 SET SDECLIN=$GET(^SDEC(409.84,SDECAID,1,SDECQ,0))
+61 if (SDECLIN'="")&($EXTRACT(SDECLIN,$LENGTH(SDECLIN)-1,$LENGTH(SDECLIN))'=" ")
SET SDECLIN=SDECLIN_" "
+62 SET SDECNOT=SDECNOT_SDECLIN
End DoDot:4
+63 ;
+64 SET SDECPAT=$PIECE(SDECNOD,U,5)
+65 SET SDECPNOD=$$PATINFO^SDEC27(SDECPAT)
+66 ;NAME
SET SDECNAM=$PIECE(SDECPNOD,U)
+67 ;SEX
SET SDECSEX=$PIECE(SDECPNOD,U,2)
+68 ;DOB
SET SDECDOB=$PIECE(SDECPNOD,U,3)
+69 ;Health Record Number for location DUZ(2)
SET SDECHRN=$PIECE(SDECPNOD,U,4)
+70 ;Street
SET SDECSTRE=$PIECE(SDECPNOD,U,5)
+71 ;City
SET SDECCITY=$PIECE(SDECPNOD,U,6)
+72 ;State
SET SDECST=$PIECE(SDECPNOD,U,7)
+73 ;zip
SET SDECZIP=$PIECE(SDECPNOD,U,8)
+74 ;homephone
SET SDECPHON=$PIECE(SDECPNOD,U,9)
+75 ;Type/status doesn't exist for SDEC APPT clinics and it's not needed for clinic letters
SET SDECTYPE=""
+76 SET SDECCLRK=$PIECE(SDECNOD,U,8)
+77 if +SDECCLRK
SET SDECCLRK=$GET(^VA(200,SDECCLRK,0))
SET SDECCLRK=$PIECE(SDECCLRK,U)
+78 ;
+79 ; Change date/time conversion so midnight is handled properly. wtc 694 4/24/18
+80 ;
+81 SET Y=$PIECE(SDECNOD,U,9)
+82 ;I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
+83 ;
IF +Y
SET Y=$$FMTONET^SDECDATE(Y,"Y")
+84 SET SDECMADE=Y
+85 SET SDECTMP=$EXTRACT(SDECNAM,1,15)
+86 SET SDECTMP=SDECTMP_$$FILL^SDECU(17-$LENGTH(SDECTMP))_SDECDOB
+87 SET SDECTMP=SDECTMP_$$FILL^SDECU(29-$LENGTH(SDECTMP))_SDECSEX
+88 SET SDECTMP=SDECTMP_$$FILL^SDECU(37-$LENGTH(SDECTMP))_SDECHRN
+89 SET SDECTMP=SDECTMP_$$FILL^SDECU(49-$LENGTH(SDECTMP))_$EXTRACT(SDECCLN,1,15)
+90 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=SDECTMP_$CHAR(30)
+91 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="APPOINTMENT DATE: "_SDECAPT_$CHAR(30)
+92 SET SDECTMP="APPT MADE BY: "_$EXTRACT(SDECCLRK,1,20)
+93 SET SDECTMP=SDECTMP_$$FILL^SDECU(39-$LENGTH(SDECTMP))_"DATE APPT MADE: "_SDECMADE
+94 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=SDECTMP_$CHAR(30)
+95 IF SDECSTRE'=""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="Address: "_SDECSTRE_$CHAR(30)
+96 IF SDECCITY'=""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=" "_SDECCITY_", "_SDECST_" "_SDECZIP_$CHAR(30)
+97 IF SDECPHON'=""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="Phone: "_SDECPHON_$CHAR(30)
+98 IF SDECNOT'=""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="NOTE: "_$EXTRACT(SDECNOT,1,73)_$CHAR(30)
+99 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+100 ;
+101 SET SDECI=SDECI+1
+102 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+103 QUIT
+104 ;
CLINDISW(SDECY,SDECCLST,SDECBEG,SDECEND) ;Return formatted text output of the Clinic Schedules Report for Walkins
+1 ;CLINDISW(SDECY,SDECCLST,SDECBEG,SDECEND) external parameter tag is in SDEC
+2 ;Return formatted text output of the Clinic Schedules Report for Walkins
+3 ;between dates SDECBEG and SDECEND for each clinic in SDECCLST.
+4 ;SDECCLST is a |-delimited list of SDEC RESOURCE iens. (The last |-piece is null, so discard it.)
+5 ;SDECBEG and SDECEND are in external date form.
+6 if $GET(U)=""
SET U="^"
+7 DO CLINDIS(.SDECY,SDECCLST,SDECBEG,SDECEND,1)
+8 QUIT
+9 ;
RESLETRF(SDECY,SDECRES,SDECLT) ;Return formatted text output of the Resource's Letter - either "LETTER TEXT" (also used as Reminder Letter), NO SHOW LETTER, or CLINIC CANCELLATION LETTER.
+1 ;RESLETRF(SDECY,SDECRES,SDECLT) external parameter tag is in SDEC
+2 ;Called by SDEC RESOURCE LETTER FORMATTED
+3 ;Return formatted text output of the Resource's Letter - either "LETTER TEXT" (also used as Reminder Letter), NO SHOW LETTER, or CLINIC CANCELLATION LETTER.
+4 ;SDECRES = Resource IEN from the SDEC RESOURCE file
+5 ;SDECLT = Letter type: "R"=Reminder Letter; "C" or "A"=Clinic Cancellation letter; "N"=No Show Letter
+6 ;
+7 NEW SDECH,SDECI,SDECJ,SDECL
+8 NEW SDECNOD,SDECNAM,SDECDOB,SDECHRN,SDECSEX,SDECCID,SDECCNOD,SDECDT
+9 NEW SDECJ,SDECAID,SDECPAT,SDECPNOD,SDECCLN,SDECCLRK,SDECMADE,SDECNOT,SDECLIN
+10 NEW SDECSTRT
+11 NEW SDECSTRE,SDECCITY,SDECST,SDECZIP,SDECPHON
+12 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+13 KILL ^TMP("SDEC",$JOB)
+14 SET SDECI=0
+15 ;check resource
+16 IF $GET(SDECRES)=""
DO ERR("0^SDEC47: Resource not specified.")
+17 IF '$DATA(^SDEC(409.831,SDECRES))
DO ERR("0^SDEC47: Invalid Resource specified.")
+18 ;check letter type
+19 IF $GET(SDECLT)=""
DO ERR("0^SDEC47: Letter type not specified.")
+20 IF "ACNR"'[SDECLT
DO ERR("0^SDEC47: Invalid letter type specified.")
+21 ;return header
+22
*** ERROR ***
SET ^TMP("SDEC",$JOB,0)="T00080TEXT"_$c(30)
+23 ;
+24 ;format body of letter
+25 SET SDECH=0
+26 FOR
SET SDECH=$ORDER(^SDEC(409.831,SDECRES,$SELECT(SDECLT="A":13,SDECLT="C":13,SDECLT="N":12,1:1),SDECH))
if SDECH=""
QUIT
Begin DoDot:1
+27 SET SDECL=$GET(^SDEC(409.831,SDECRES,$SELECT(SDECLT="A":13,SDECLT="C":13,SDECLT="N":12,1:1),SDECH,0))
+28 IF SDECL'=""
IF $LENGTH(SDECL)>79
SET SDECL=$$FL^SDECUTL(SDECL,80)
+29 FOR SDECJ=1:1:$LENGTH(SDECL,"||")
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$PIECE(SDECL,"||",SDECJ)_$CHAR(30)
End DoDot:1
+30 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+31 QUIT
+32 ;
ERROR ;
+1 DO ERR("VISTA Error")
+2 QUIT
+3 ;
ERR(ERRTXT) ;Error processing
+1 if '$DATA(SDECI)
SET SDECI=999
+2 SET ERRTXT=$GET(ERRTXT)
+3 SET SDECI=SDECI+1
+4 SET ^TMP("SDEC",$JOB,SDECI)=ERRTXT_$CHAR(30)
+5 SET SDECI=SDECI+1
+6 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+7 QUIT
