SDESAPPTLETTERS ;ALB/BWF,TJB,JHC - VISTA SCHEDULING RPCS - LETTER PRINT ; March 14, 2025
;;5.3;Scheduling;**824,895,903**;Aug 13, 1993;Build 3
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to DIVISION in ICR #7024
; Reference to PATIENT in ICR #7025
;
Q
; print single letter
PRINTLETTER(SDRES,APPTIEN,LTYPE,SDEAS) ;
N APPTLIST,ERRORS,GBL,LETTERS,LINE,LCNT
S APPTIEN=$G(APPTIEN),LTYPE=$G(LTYPE),SDEAS=$G(SDEAS)
D VALAPPT(.ERRORS,APPTIEN)
D VALLETTYPE(.ERRORS,LTYPE)
D VALIDATEEAS(.ERRORS,SDEAS)
I $D(ERRORS) D Q
.D BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS)
D APPTLETTER(.GBL,APPTIEN,LTYPE)
S LCNT=0
I '$D(@GBL) D Q
.S LCNT=LCNT+1
.S LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
.S LETTERS("Letters",LCNT,"Error")="No letter returned."
S LCNT=LCNT+1
S LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
I $G(@GBL@(0))["ERROR" D Q
. S LETTERS("Letters",LCNT,"Error")=$G(@GBL@(1))
. D BUILDJSON^SDESBUILDJSON(.SDRES,.LETTERS)
S LINE=0 F S LINE=$O(@GBL@(LINE)) Q:'LINE D
.S LETTERS("Letters",LCNT,"Text",LINE)=$G(@GBL@(LINE))
I '$D(LETTERS) S LETTERS("Letters",1)=""
I $D(ERRORS) M LETTERS=ERRORS
D BUILDJSON^SDESBUILDJSON(.SDRES,.LETTERS)
Q
; print multiple letters
PRINTLETTERS(SDRES,APPTLIST,LTYPE,SDEAS) ;
N APPTIEN,ERRORS,LETIEN,LCNT,GBL,LETTERS,LINE
I '$D(APPTLIST) D
.D ERRLOG^SDESJSON(.ERRORS,254)
S LTYPE=$G(LTYPE),SDEAS=$G(SDEAS)
D VALAPPTS(.ERRORS,.APPTLIST)
S LETIEN=$$VALLETTYPE(.ERRORS,LTYPE)
D VALIDATEEAS(.ERRORS,SDEAS)
I 'LETIEN!($D(ERRORS)) D Q
.S ERRORS("Letters",1)=""
.D BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS)
S (APPTIEN,LCNT)=0
; build appointment letter for each appointment
F S APPTIEN=$O(APPTLIST(APPTIEN)) Q:'APPTIEN D
.D APPTLETTER(.GBL,APPTIEN,LTYPE)
.I '$D(@GBL) D Q
..S LCNT=LCNT+1
..S LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
..S LETTERS("Letters",LCNT,"Error")="No letter returned."
.S LCNT=LCNT+1
.S LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
.I $G(@GBL@(0))["ERROR" D Q
.. S LETTERS("Letters",LCNT,"Error")=$G(@GBL@(1)) Q
.S LINE=0 F S LINE=$O(@GBL@(LINE)) Q:'LINE D
..S LETTERS("Letters",LCNT,"Text",LINE)=$G(@GBL@(LINE))
I '$D(LETTERS) S LETTERS("Letters",1)=""
I $D(ERRORS) M LETTERS=ERRORS
D BUILDJSON^SDESBUILDJSON(.SDRES,.LETTERS)
Q
; validate appointment list
VALAPPTS(ERRORS,LIST) ;
N APPT
I '$O(LIST(0)) D ERRLOG^SDESJSON(.ERRORS,254)
S APPT=0 F S APPT=$O(LIST(APPT)) Q:'APPT D
.I '$D(^SDEC(409.84,APPT)) D ERRLOG^SDESJSON(.ERRORS,52,"Invalid appointment ID "_APPT)
Q
VALAPPT(ERRORS,APPTIEN) ;
I '$L(APPTIEN) D ERRLOG^SDESJSON(.ERRORS,14) Q
I '$D(^SDEC(409.84,APPTIEN)) D ERRLOG^SDESJSON(.ERRORS,15)
Q
; validate letter type
VALLETTYPE(ERRORS,LTYPE) ;
N LIEN,RESOURCE,CLIN
I '$L(LTYPE) D ERRLOG^SDESJSON(.ERRORS,228) Q "" ; missing letter type
I '$D(^VA(407.6,"B",LTYPE)) D ERRLOG^SDESJSON(.ERRORS,226) Q "" ;Invalid letter type.
;S LIEN=$$FIND1^DIC(407.6,,"B",LTYPE)
S LIEN="",LIEN=$O(^VA(407.6,"B",LTYPE,LIEN))
Q LIEN
VALIDATEEAS(ERRORS,SDEAS) ;
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL($G(SDEAS))
I $P($G(SDEAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142)
Q
; print single appointment letter
APPTLETTER(SDECY,SDECAPID,LT) ;Print Appointment Letter
;APPTLETR(SDECY,SDECAPID,LT) external parameter tag is in SDEC
; SDECAPPT = Pointer to appointment in SDEC APPOINTMENT file 409.84
; LT = Letter type - "N"=No Show; "P"=Pre-Appointment; "A"=Cancelled by Patient; "C"=Cancelled by Clinic
;
N SDECI,DFN,RES,CLINICIEN,SDLET,SDT,X1,X2,Y,TIMEZONE
N SDIV,SDFORM,SDNAM,SDECDATA,SCLETFLD,ERRTXT
S SDECI=0
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S ^TMP("SDEC",$J,0)="T00080ERRORID"_$C(30)
D GETS^DIQ(409.84,SDECAPID_",",".01;.05;.07","I","SDECDATA")
S SDT=$G(SDECDATA(409.84,SDECAPID_",",.01,"I"))
S DFN=$G(SDECDATA(409.84,SDECAPID_",",.05,"I"))
S RES=$G(SDECDATA(409.84,SDECAPID_",",.07,"I"))
; future consideration - it seems the letter should still print if there is no clinic.. may need to activate the following line
; I 'RES D ERRLOG^SDESJSON(.ERRORS,52,"No resource defined for this appointment.") Q
S CLINICIEN=$$GET1^DIQ(409.831,RES,.04,"I")
S SCLETFLD=$S(LT="N":2508,LT="P":2509,LT="C":2510,LT="A":2511,1:2509)
S SDLET=$$GET1^DIQ(44,CLINICIEN,SCLETFLD,"I")
I SDLET="" D Q
.S ERRTXT=$S(LT="N":"No-Show",LT="P":"Pre-Appointment",LT="C":"Clinic Cancellation",1:"Patient Cancellation")_" Letter not defined for Clinic "_$$GET1^DIQ(44,CLINICIEN,.01,"E")
.S SDECI=SDECI+1,^TMP("SDEC",$J,SDECI)=ERRTXT
S SDIV=$$GET1^DIQ(44,CLINICIEN,3.5,"I")
S SDIV=$S(SDIV:SDIV,1:$O(^DG(40.8,0)))
; address location on letters 1 - bottom, 0 - top
S SDFORM=$$GET1^DIQ(40.8,SDIV,30.01,"I")
; data header
S ^TMP("SDEC",$J,0)="T00080TEXT"_$C(30)
D PRT(DFN,CLINICIEN,SDT,LT,SDLET,SDFORM)
D WRAPP(DFN,CLINICIEN,SDT,LT,SDLET)
D REST(DFN,CLINICIEN,SDT,LT,SDLET,SDFORM)
S SDECI=SDECI+1 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
Q
;
;
PRT(DFN,SDC,SD,LT,SDLET,SDFORM) ;
; DFN - pointer to PATIENT file 2
; SDC - pointer to HOSPITAL LOCATION file 44
; SD - appointment time in FM format
; LT - Letter type - "N"=No Show; "P"=Pre-Appointment; "A"=Cancelled by Patient; "C"=Cancelled by Clinic
; SDLET - pointer to LETTER file 407.5
; SDFORM - address location on letters (1 - bottom, 0 - top)
;WRITE GREETING AND OPENING TEXT OF LETTER
N DPTNAME,INITSEC,X,Y
Q:DFN=""
Q:LT=""
S SDFORM=$G(SDFORM)
S Y=DT
S Y=$TR($$FMTE^XLFDT(Y,"5DF")," ","0")
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(64," ")_Y
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(64," ")_$$LAST4(DFN)
I 'SDFORM D
.F I=1:1:4 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
.D ADDR(DFN)
.F I=1:1:4 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
;
S DPTNAME("FILE")=2,DPTNAME("FIELD")=".01",DPTNAME("IENS")=(+DFN)_","
S X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M")
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Dear "_X_"," ;VSE-693;LEG 5/12/21
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
;loop and display initial section of Letter
S INITSEC=0 F S INITSEC=$O(^VA(407.5,SDLET,1,INITSEC)) Q:INITSEC'>0 D
.S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$GET1^DIQ(407.52,INITSEC_","_SDLET_",",.01,"E")
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
Q
;
WRAPP(DFN,SDC,SD,LT,SDLET) ;WRITE APPOINTMENT INFORMATION
N B,S,SDCL,SDDAT,SDHX,SDX,SDX1,X,PTAPPIENS
S SDX=SD
S SDCL=$$GET1^DIQ(44,+SDC,.01,"E")
S SDCL=" Clinic: "_SDCL D FORM(SDC,SDCL,SDX) ; SD*5.3*622 end changes
S SDX1=SDX
S PTAPPIENS=SD_","_DFN_","
I $$GET1^DIQ(2.98,PTAPPIENS,5,"I")]"" D
.S SDCL="LAB",SDX=$$GET1^DIQ(2.98,PTAPPIENS,5,"I") D FORM(SDC,SDCL,SDX,1)
I $$GET1^DIQ(2.98,PTAPPIENS,6,"I")]"" D
.S SDCL="XRAY",SDX=$$GET1^DIQ(2.98,PTAPPIENS,6,"I") D FORM(SDC,SDCL,SDX,1)
I $$GET1^DIQ(2.98,PTAPPIENS,7,"I")]"" D
.S SDCL="EKG",SDX=$$GET1^DIQ(2.98,PTAPPIENS,7,"I") D FORM(SDC,SDCL,SDX,1)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="" ;alb/sat 665
S (SDX,X)=SDX1
Q
; SD*5.3*622 - add more detail for appointment and format it
; SDC - clinic ien
; SDCL - clinic name or xray/lab/ekg
; SDX - date/time
; LEXPROC - is only passed in when this is a lab/xray/ekg date
;
; Change display time for noon and midnight from 12:00 PM to 12:00 Noon and 12:00 Midnight
FORM(SDC,SDCL,SDX,LEXPROC) ;
N TIMEZONE,X,J,SDLOC,SDPROV,SDPRNM,SDTEL,SDTELEXT,SDTMP,SDHX,SDT0,DOW
S TIMEZONE=$$TIMEZONEDATA^SDESUTIL($G(SDC)),TIMEZONE=$P($G(TIMEZONE),U)
S:$D(SDX) X=SDX S SDHX=X D DW^%DTC S DOW=X,X=SDHX ;
I $P(X,".",2)=12!($P(X,".",2)=24) S X="12:00 "_$S($P(X,".",2)=12:"N",1:"M") ;
E X ^DD("FUNC",2,1) ;
S SDT0=X,SDDAT=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(SDHX,4,5))_" "_+$E(SDHX,6,7)_", "_(1700+$E(SDHX,1,3))
I '$D(LEXPROC) D
.S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" Date/Time: "_DOW_" "_$J(SDDAT,12)_$S('$D(LEXPROC)&$D(SDC):$J(SDT0,9),1:"")_" "_TIMEZONE
I '$D(LEXPROC),$D(SDC) D
.S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_SDCL
; get default provider if defined for a given clinic, print it on the
; letter only if we have a YES on file, same for clinic location
; skip printing the provider label if the field is empty in file #44
S SDLOC=$$GET1^DIQ(44,+SDC,10,"I") ; physical location of the clinic
S SDTEL=$$GET1^DIQ(44,+SDC,99,"I") ; telephone number of clinic
S SDTELEXT="" I SDTEL]"",$$GET1^DIQ(44,+SDC,99.1,"I")]"" D
.S SDTELEXT=$$GET1^DIQ(44,+SDC,99.1,"I") ; telephone ext of clinic
; get default provider, if any
F J=0:0 S J=$O(^SC(+SDC,"PR",J)) Q:'J>0 D
.I $$GET1^DIQ(44.1,J_","_+SDC_",",.02,"I")'=1 Q
.S SDPROV=$$GET1^DIQ(44.1,J_","_+SDC_",",.01,"I")
I $D(SDC),'$D(LEXPROC),$$GET1^DIQ(407.5,SDLET,5,"I")="Y" D
.I SDLOC]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_"Location: "_SDLOC
I $D(SDC),'$D(LEXPROC),SDTEL]"" D
.S SDTMP=" Telephone: "_SDTEL
.I SDTELEXT]"" S SDTMP=SDTMP_" Telephone Ext.: "_SDTELEXT
.S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDTMP
I $D(SDPROV) D
.I $D(SDC),SDPROV>0 S SDPRNM=$P(^VA(200,SDPROV,0),U,1)
.I $D(SDC),'$D(LEXPROC),$P($G(^VA(407.5,SDLET,3)),U,1)="Y" I SDPRNM]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" Provider: "_$G(SDPRNM)
; call handler for LAB, XRAY, and EKG tests
I $D(LEXPROC) D TST(SDCL,DOW)
Q
REST(DFN,SDC,SD,LT,SDLET,SDFORM) ;WRITE THE REMAINDER OF LETTER
N FINSEC
;loop and display final section of Letter
S FINSEC=0 F S FINSEC=$O(^VA(407.5,SDLET,2,FINSEC)) Q:FINSEC'>0 D
.S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$GET1^DIQ(407.53,FINSEC_","_SDLET_",",.01,"E")
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
I SDFORM=1 D ADDR(DFN)
Q
ADDR(DFN) ;
K VAHOW
N SDIENS,X,SDCCACT1,SDCCACT2,LL,VAPA
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_$$FML^DGNFUNC(DFN)
I $D(^DG(43,1,"BT")),$$GET1^DIQ(43,1,722,"I") S VAPA("P")=""
D ADD^VADPT
;CHANGE STATE TO ABBR.
I $D(VAPA(5)) S SDIENS=+VAPA(5)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(VAPA(5),U,2)=X
I $D(VAPA(17)) S SDIENS=+VAPA(17)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(VAPA(17),U,2)=X
S SDCCACT1=VAPA(12),SDCCACT2=$P($G(VAPA(22,2)),"^",3)
;if confidential address is not active for scheduling/appointment letters, print to regular address
I ($G(SDCCACT1)=0)!($G(SDCCACT2)'="Y") D
.F LL=1:1:3 I VAPA(LL)]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_VAPA(LL)
.;if country is blank display as USA
.I (VAPA(25)="")!($P(VAPA(25),"^",2)="UNITED STATES") D ;display city,state,zip
..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_VAPA(4)_" "_$P(VAPA(5),U,2)_" "_$P(VAPA(11),U,2)
.E D ;display postal code,city,province
..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_VAPA(24)_" "_VAPA(4)_" "_VAPA(23)_$C(13,10)
.I ($P(VAPA(25),"^",2)'="UNITED STATES") S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_$P(VAPA(25),U,2) ;display country
;if confidential address is active for scheduling/appointment letters, print to confidential address
I $G(SDCCACT1)=1,$G(SDCCACT2)="Y" D
.F LL=13:1:15 I VAPA(LL)]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_VAPA(LL)
.I (VAPA(28)="")!($P(VAPA(28),"^",2)="UNITED STATES") D
..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_VAPA(16)_" "_$P(VAPA(17),U,2)_" "_$P(VAPA(18),U,2)
.E D
..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_VAPA(27)_" "_VAPA(16)_" "_VAPA(26)
.I ($P(VAPA(28),"^",2)'="UNITED STATES") S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(11," ")_$P(VAPA(28),U,2)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
D KVAR^VADPT
Q
;
DTS(Y) ;
Q:'Y ""
Q $TR($$FMTE^XLFDT(Y,"5DF")," ","0")
;
LAST4(DFN) ;Return patient "last four"
N RET
D DEM^VADPT
S RET=$E(VADM(1))_$E($P(VADM(2),U,1),6,9)
K VADM
Q RET
;
BADADD ;Print patients with a Bad Address Indicator
I '$D(^TMP($J,"BADADD")) Q
N SDHDR,SDHDR1,SDNAM,SDDFN
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(79,"*")
S SDHDR="BAD ADDRESS INDICATOR LIST" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL((80-$L(SDHDR)/2)," ")_SDHDR
S SDHDR1="** THE LETTER FOR THESE PATIENT(S) DID NOT PRINT DUE TO A BAD ADDRESS INDICATOR."
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Last 4"
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="of SSN "_"Patient Name"
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL(79,"*")
S SDNAM="" F S SDNAM=$O(^TMP($J,"BADADD",SDNAM)) Q:SDNAM="" D
.S SDDFN=0 F S SDDFN=$O(^TMP($J,"BADADD",SDNAM,SDDFN)) Q:'SDDFN D
..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$LAST4(SDDFN)_" "_SDNAM_$C(13,10)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=""
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDHDR1
Q
;
TST(SDCL,DOW) ; handle scheduled tests
I ($L(SDCL)=3&($E(SDCL,1,3)="LAB")) D
.S SDECI=SDECI+1
.S ^TMP("SDEC",$J,SDECI)=" "_SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5) ;alb/sat 665 add space
I ($L(SDCL)=4&($E(SDCL,1,4)="XRAY")) D
.S SDECI=SDECI+1
.S ^TMP("SDEC",$J,SDECI)=SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5)
I ($L(SDCL)=3&($E(SDCL,1,3)="EKG")) D
.S SDECI=SDECI+1
.S ^TMP("SDEC",$J,SDECI)=" "_SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5) ;alb/sat 665 add space
Q
FILL(PADS,CHAR) ;pad string
N I,RET
S CHAR=$G(CHAR)
S:CHAR="" CHAR=" "
S RET=""
F I=1:1:PADS S RET=RET_CHAR
Q RET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESAPPTLETTERS 13447 printed Sep 23, 2025@20:32:29 Page 2
SDESAPPTLETTERS ;ALB/BWF,TJB,JHC - VISTA SCHEDULING RPCS - LETTER PRINT ; March 14, 2025
+1 ;;5.3;Scheduling;**824,895,903**;Aug 13, 1993;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to DIVISION in ICR #7024
+5 ; Reference to PATIENT in ICR #7025
+6 ;
+7 QUIT
+8 ; print single letter
PRINTLETTER(SDRES,APPTIEN,LTYPE,SDEAS) ;
+1 NEW APPTLIST,ERRORS,GBL,LETTERS,LINE,LCNT
+2 SET APPTIEN=$GET(APPTIEN)
SET LTYPE=$GET(LTYPE)
SET SDEAS=$GET(SDEAS)
+3 DO VALAPPT(.ERRORS,APPTIEN)
+4 DO VALLETTYPE(.ERRORS,LTYPE)
+5 DO VALIDATEEAS(.ERRORS,SDEAS)
+6 IF $DATA(ERRORS)
Begin DoDot:1
+7 DO BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS)
End DoDot:1
QUIT
+8 DO APPTLETTER(.GBL,APPTIEN,LTYPE)
+9 SET LCNT=0
+10 IF '$DATA(@GBL)
Begin DoDot:1
+11 SET LCNT=LCNT+1
+12 SET LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
+13 SET LETTERS("Letters",LCNT,"Error")="No letter returned."
End DoDot:1
QUIT
+14 SET LCNT=LCNT+1
+15 SET LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
+16 IF $GET(@GBL@(0))["ERROR"
Begin DoDot:1
+17 SET LETTERS("Letters",LCNT,"Error")=$GET(@GBL@(1))
+18 DO BUILDJSON^SDESBUILDJSON(.SDRES,.LETTERS)
End DoDot:1
QUIT
+19 SET LINE=0
FOR
SET LINE=$ORDER(@GBL@(LINE))
if 'LINE
QUIT
Begin DoDot:1
+20 SET LETTERS("Letters",LCNT,"Text",LINE)=$GET(@GBL@(LINE))
End DoDot:1
+21 IF '$DATA(LETTERS)
SET LETTERS("Letters",1)=""
+22 IF $DATA(ERRORS)
MERGE LETTERS=ERRORS
+23 DO BUILDJSON^SDESBUILDJSON(.SDRES,.LETTERS)
+24 QUIT
+25 ; print multiple letters
PRINTLETTERS(SDRES,APPTLIST,LTYPE,SDEAS) ;
+1 NEW APPTIEN,ERRORS,LETIEN,LCNT,GBL,LETTERS,LINE
+2 IF '$DATA(APPTLIST)
Begin DoDot:1
+3 DO ERRLOG^SDESJSON(.ERRORS,254)
End DoDot:1
+4 SET LTYPE=$GET(LTYPE)
SET SDEAS=$GET(SDEAS)
+5 DO VALAPPTS(.ERRORS,.APPTLIST)
+6 SET LETIEN=$$VALLETTYPE(.ERRORS,LTYPE)
+7 DO VALIDATEEAS(.ERRORS,SDEAS)
+8 IF 'LETIEN!($DATA(ERRORS))
Begin DoDot:1
+9 SET ERRORS("Letters",1)=""
+10 DO BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS)
End DoDot:1
QUIT
+11 SET (APPTIEN,LCNT)=0
+12 ; build appointment letter for each appointment
+13 FOR
SET APPTIEN=$ORDER(APPTLIST(APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:1
+14 DO APPTLETTER(.GBL,APPTIEN,LTYPE)
+15 IF '$DATA(@GBL)
Begin DoDot:2
+16 SET LCNT=LCNT+1
+17 SET LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
+18 SET LETTERS("Letters",LCNT,"Error")="No letter returned."
End DoDot:2
QUIT
+19 SET LCNT=LCNT+1
+20 SET LETTERS("Letters",LCNT,"AppointmentID")=APPTIEN
+21 IF $GET(@GBL@(0))["ERROR"
Begin DoDot:2
+22 SET LETTERS("Letters",LCNT,"Error")=$GET(@GBL@(1))
QUIT
End DoDot:2
QUIT
+23 SET LINE=0
FOR
SET LINE=$ORDER(@GBL@(LINE))
if 'LINE
QUIT
Begin DoDot:2
+24 SET LETTERS("Letters",LCNT,"Text",LINE)=$GET(@GBL@(LINE))
End DoDot:2
End DoDot:1
+25 IF '$DATA(LETTERS)
SET LETTERS("Letters",1)=""
+26 IF $DATA(ERRORS)
MERGE LETTERS=ERRORS
+27 DO BUILDJSON^SDESBUILDJSON(.SDRES,.LETTERS)
+28 QUIT
+29 ; validate appointment list
VALAPPTS(ERRORS,LIST) ;
+1 NEW APPT
+2 IF '$ORDER(LIST(0))
DO ERRLOG^SDESJSON(.ERRORS,254)
+3 SET APPT=0
FOR
SET APPT=$ORDER(LIST(APPT))
if 'APPT
QUIT
Begin DoDot:1
+4 IF '$DATA(^SDEC(409.84,APPT))
DO ERRLOG^SDESJSON(.ERRORS,52,"Invalid appointment ID "_APPT)
End DoDot:1
+5 QUIT
VALAPPT(ERRORS,APPTIEN) ;
+1 IF '$LENGTH(APPTIEN)
DO ERRLOG^SDESJSON(.ERRORS,14)
QUIT
+2 IF '$DATA(^SDEC(409.84,APPTIEN))
DO ERRLOG^SDESJSON(.ERRORS,15)
+3 QUIT
+4 ; validate letter type
VALLETTYPE(ERRORS,LTYPE) ;
+1 NEW LIEN,RESOURCE,CLIN
+2 ; missing letter type
IF '$LENGTH(LTYPE)
DO ERRLOG^SDESJSON(.ERRORS,228)
QUIT ""
+3 ;Invalid letter type.
IF '$DATA(^VA(407.6,"B",LTYPE))
DO ERRLOG^SDESJSON(.ERRORS,226)
QUIT ""
+4 ;S LIEN=$$FIND1^DIC(407.6,,"B",LTYPE)
+5 SET LIEN=""
SET LIEN=$ORDER(^VA(407.6,"B",LTYPE,LIEN))
+6 QUIT LIEN
VALIDATEEAS(ERRORS,SDEAS) ;
+1 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL($GET(SDEAS))
+2 IF $PIECE($GET(SDEAS),U)=-1
DO ERRLOG^SDESJSON(.ERRORS,142)
+3 QUIT
+4 ; print single appointment letter
APPTLETTER(SDECY,SDECAPID,LT) ;Print Appointment Letter
+1 ;APPTLETR(SDECY,SDECAPID,LT) external parameter tag is in SDEC
+2 ; SDECAPPT = Pointer to appointment in SDEC APPOINTMENT file 409.84
+3 ; LT = Letter type - "N"=No Show; "P"=Pre-Appointment; "A"=Cancelled by Patient; "C"=Cancelled by Clinic
+4 ;
+5 NEW SDECI,DFN,RES,CLINICIEN,SDLET,SDT,X1,X2,Y,TIMEZONE
+6 NEW SDIV,SDFORM,SDNAM,SDECDATA,SCLETFLD,ERRTXT
+7 SET SDECI=0
+8 KILL ^TMP("SDEC",$JOB)
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+10 SET ^TMP("SDEC",$JOB,0)="T00080ERRORID"_$CHAR(30)
+11 DO GETS^DIQ(409.84,SDECAPID_",",".01;.05;.07","I","SDECDATA")
+12 SET SDT=$GET(SDECDATA(409.84,SDECAPID_",",.01,"I"))
+13 SET DFN=$GET(SDECDATA(409.84,SDECAPID_",",.05,"I"))
+14 SET RES=$GET(SDECDATA(409.84,SDECAPID_",",.07,"I"))
+15 ; future consideration - it seems the letter should still print if there is no clinic.. may need to activate the following line
+16 ; I 'RES D ERRLOG^SDESJSON(.ERRORS,52,"No resource defined for this appointment.") Q
+17 SET CLINICIEN=$$GET1^DIQ(409.831,RES,.04,"I")
+18 SET SCLETFLD=$SELECT(LT="N":2508,LT="P":2509,LT="C":2510,LT="A":2511,1:2509)
+19 SET SDLET=$$GET1^DIQ(44,CLINICIEN,SCLETFLD,"I")
+20 IF SDLET=""
Begin DoDot:1
+21 SET ERRTXT=$SELECT(LT="N":"No-Show",LT="P":"Pre-Appointment",LT="C":"Clinic Cancellation",1:"Patient Cancellation")_" Letter not defined for Clinic "_$$GET1^DIQ(44,CLINICIEN,.01,"E")
+22 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=ERRTXT
End DoDot:1
QUIT
+23 SET SDIV=$$GET1^DIQ(44,CLINICIEN,3.5,"I")
+24 SET SDIV=$SELECT(SDIV:SDIV,1:$ORDER(^DG(40.8,0)))
+25 ; address location on letters 1 - bottom, 0 - top
+26 SET SDFORM=$$GET1^DIQ(40.8,SDIV,30.01,"I")
+27 ; data header
+28 SET ^TMP("SDEC",$JOB,0)="T00080TEXT"_$CHAR(30)
+29 DO PRT(DFN,CLINICIEN,SDT,LT,SDLET,SDFORM)
+30 DO WRAPP(DFN,CLINICIEN,SDT,LT,SDLET)
+31 DO REST(DFN,CLINICIEN,SDT,LT,SDLET,SDFORM)
+32 SET SDECI=SDECI+1
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+33 QUIT
+34 ;
+35 ;
PRT(DFN,SDC,SD,LT,SDLET,SDFORM) ;
+1 ; DFN - pointer to PATIENT file 2
+2 ; SDC - pointer to HOSPITAL LOCATION file 44
+3 ; SD - appointment time in FM format
+4 ; LT - Letter type - "N"=No Show; "P"=Pre-Appointment; "A"=Cancelled by Patient; "C"=Cancelled by Clinic
+5 ; SDLET - pointer to LETTER file 407.5
+6 ; SDFORM - address location on letters (1 - bottom, 0 - top)
+7 ;WRITE GREETING AND OPENING TEXT OF LETTER
+8 NEW DPTNAME,INITSEC,X,Y
+9 if DFN=""
QUIT
+10 if LT=""
QUIT
+11 SET SDFORM=$GET(SDFORM)
+12 SET Y=DT
+13 SET Y=$TRANSLATE($$FMTE^XLFDT(Y,"5DF")," ","0")
+14 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(64," ")_Y
+15 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(64," ")_$$LAST4(DFN)
+16 IF 'SDFORM
Begin DoDot:1
+17 FOR I=1:1:4
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+18 DO ADDR(DFN)
+19 FOR I=1:1:4
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
End DoDot:1
+20 ;
+21 SET DPTNAME("FILE")=2
SET DPTNAME("FIELD")=".01"
SET DPTNAME("IENS")=(+DFN)_","
+22 SET X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M")
+23 ;VSE-693;LEG 5/12/21
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="Dear "_X_","
+24 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+25 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+26 ;loop and display initial section of Letter
+27 SET INITSEC=0
FOR
SET INITSEC=$ORDER(^VA(407.5,SDLET,1,INITSEC))
if INITSEC'>0
QUIT
Begin DoDot:1
+28 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$GET1^DIQ(407.52,INITSEC_","_SDLET_",",.01,"E")
End DoDot:1
+29 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+30 QUIT
+31 ;
WRAPP(DFN,SDC,SD,LT,SDLET) ;WRITE APPOINTMENT INFORMATION
+1 NEW B,S,SDCL,SDDAT,SDHX,SDX,SDX1,X,PTAPPIENS
+2 SET SDX=SD
+3 SET SDCL=$$GET1^DIQ(44,+SDC,.01,"E")
+4 ; SD*5.3*622 end changes
SET SDCL=" Clinic: "_SDCL
DO FORM(SDC,SDCL,SDX)
+5 SET SDX1=SDX
+6 SET PTAPPIENS=SD_","_DFN_","
+7 IF $$GET1^DIQ(2.98,PTAPPIENS,5,"I")]""
Begin DoDot:1
+8 SET SDCL="LAB"
SET SDX=$$GET1^DIQ(2.98,PTAPPIENS,5,"I")
DO FORM(SDC,SDCL,SDX,1)
End DoDot:1
+9 IF $$GET1^DIQ(2.98,PTAPPIENS,6,"I")]""
Begin DoDot:1
+10 SET SDCL="XRAY"
SET SDX=$$GET1^DIQ(2.98,PTAPPIENS,6,"I")
DO FORM(SDC,SDCL,SDX,1)
End DoDot:1
+11 IF $$GET1^DIQ(2.98,PTAPPIENS,7,"I")]""
Begin DoDot:1
+12 SET SDCL="EKG"
SET SDX=$$GET1^DIQ(2.98,PTAPPIENS,7,"I")
DO FORM(SDC,SDCL,SDX,1)
End DoDot:1
+13 ;alb/sat 665
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+14 SET (SDX,X)=SDX1
+15 QUIT
+16 ; SD*5.3*622 - add more detail for appointment and format it
+17 ; SDC - clinic ien
+18 ; SDCL - clinic name or xray/lab/ekg
+19 ; SDX - date/time
+20 ; LEXPROC - is only passed in when this is a lab/xray/ekg date
+21 ;
+22 ; Change display time for noon and midnight from 12:00 PM to 12:00 Noon and 12:00 Midnight
FORM(SDC,SDCL,SDX,LEXPROC) ;
+1 NEW TIMEZONE,X,J,SDLOC,SDPROV,SDPRNM,SDTEL,SDTELEXT,SDTMP,SDHX,SDT0,DOW
+2 SET TIMEZONE=$$TIMEZONEDATA^SDESUTIL($GET(SDC))
SET TIMEZONE=$PIECE($GET(TIMEZONE),U)
+3 ;
if $DATA(SDX)
SET X=SDX
SET SDHX=X
DO DW^%DTC
SET DOW=X
SET X=SDHX
+4 ;
IF $PIECE(X,".",2)=12!($PIECE(X,".",2)=24)
SET X="12:00 "_$SELECT($PIECE(X,".",2)=12:"N",1:"M")
+5 ;
IF '$TEST
XECUTE ^DD("FUNC",2,1)
+6 SET SDT0=X
SET SDDAT=$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$EXTRACT(SDHX,4,5))_" "_+$EXTRACT(SDHX,6,7)_", "_(1700+$EXTRACT(SDHX,1,3))
+7 IF '$DATA(LEXPROC)
Begin DoDot:1
+8 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=" Date/Time: "_DOW_" "_$JUSTIFY(SDDAT,12)_$SELECT('$DATA(LEXPROC)&$DATA(SDC):$JUSTIFY(SDT0,9),1:"")_" "_TIMEZONE
End DoDot:1
+9 IF '$DATA(LEXPROC)
IF $DATA(SDC)
Begin DoDot:1
+10 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=" "_SDCL
End DoDot:1
+11 ; get default provider if defined for a given clinic, print it on the
+12 ; letter only if we have a YES on file, same for clinic location
+13 ; skip printing the provider label if the field is empty in file #44
+14 ; physical location of the clinic
SET SDLOC=$$GET1^DIQ(44,+SDC,10,"I")
+15 ; telephone number of clinic
SET SDTEL=$$GET1^DIQ(44,+SDC,99,"I")
+16 SET SDTELEXT=""
IF SDTEL]""
IF $$GET1^DIQ(44,+SDC,99.1,"I")]""
Begin DoDot:1
+17 ; telephone ext of clinic
SET SDTELEXT=$$GET1^DIQ(44,+SDC,99.1,"I")
End DoDot:1
+18 ; get default provider, if any
+19 FOR J=0:0
SET J=$ORDER(^SC(+SDC,"PR",J))
if 'J>0
QUIT
Begin DoDot:1
+20 IF $$GET1^DIQ(44.1,J_","_+SDC_",",.02,"I")'=1
QUIT
+21 SET SDPROV=$$GET1^DIQ(44.1,J_","_+SDC_",",.01,"I")
End DoDot:1
+22 IF $DATA(SDC)
IF '$DATA(LEXPROC)
IF $$GET1^DIQ(407.5,SDLET,5,"I")="Y"
Begin DoDot:1
+23 IF SDLOC]""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=" "_"Location: "_SDLOC
End DoDot:1
+24 IF $DATA(SDC)
IF '$DATA(LEXPROC)
IF SDTEL]""
Begin DoDot:1
+25 SET SDTMP=" Telephone: "_SDTEL
+26 IF SDTELEXT]""
SET SDTMP=SDTMP_" Telephone Ext.: "_SDTELEXT
+27 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=SDTMP
End DoDot:1
+28 IF $DATA(SDPROV)
Begin DoDot:1
+29 IF $DATA(SDC)
IF SDPROV>0
SET SDPRNM=$PIECE(^VA(200,SDPROV,0),U,1)
+30 IF $DATA(SDC)
IF '$DATA(LEXPROC)
IF $PIECE($GET(^VA(407.5,SDLET,3)),U,1)="Y"
IF SDPRNM]""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=" Provider: "_$GET(SDPRNM)
End DoDot:1
+31 ; call handler for LAB, XRAY, and EKG tests
+32 IF $DATA(LEXPROC)
DO TST(SDCL,DOW)
+33 QUIT
REST(DFN,SDC,SD,LT,SDLET,SDFORM) ;WRITE THE REMAINDER OF LETTER
+1 NEW FINSEC
+2 ;loop and display final section of Letter
+3 SET FINSEC=0
FOR
SET FINSEC=$ORDER(^VA(407.5,SDLET,2,FINSEC))
if FINSEC'>0
QUIT
Begin DoDot:1
+4 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$GET1^DIQ(407.53,FINSEC_","_SDLET_",",.01,"E")
End DoDot:1
+5 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+6 IF SDFORM=1
DO ADDR(DFN)
+7 QUIT
ADDR(DFN) ;
+1 KILL VAHOW
+2 NEW SDIENS,X,SDCCACT1,SDCCACT2,LL,VAPA
+3 SET SDECI=SDECI+1
+4 SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_$$FML^DGNFUNC(DFN)
+5 IF $DATA(^DG(43,1,"BT"))
IF $$GET1^DIQ(43,1,722,"I")
SET VAPA("P")=""
+6 DO ADD^VADPT
+7 ;CHANGE STATE TO ABBR.
+8 IF $DATA(VAPA(5))
SET SDIENS=+VAPA(5)_","
SET X=$$GET1^DIQ(5,SDIENS,1)
SET $PIECE(VAPA(5),U,2)=X
+9 IF $DATA(VAPA(17))
SET SDIENS=+VAPA(17)_","
SET X=$$GET1^DIQ(5,SDIENS,1)
SET $PIECE(VAPA(17),U,2)=X
+10 SET SDCCACT1=VAPA(12)
SET SDCCACT2=$PIECE($GET(VAPA(22,2)),"^",3)
+11 ;if confidential address is not active for scheduling/appointment letters, print to regular address
+12 IF ($GET(SDCCACT1)=0)!($GET(SDCCACT2)'="Y")
Begin DoDot:1
+13 FOR LL=1:1:3
IF VAPA(LL)]""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_VAPA(LL)
+14 ;if country is blank display as USA
+15 ;display city,state,zip
IF (VAPA(25)="")!($PIECE(VAPA(25),"^",2)="UNITED STATES")
Begin DoDot:2
+16 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_VAPA(4)_" "_$PIECE(VAPA(5),U,2)_" "_$PIECE(VAPA(11),U,2)
End DoDot:2
+17 ;display postal code,city,province
IF '$TEST
Begin DoDot:2
+18 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_VAPA(24)_" "_VAPA(4)_" "_VAPA(23)_$CHAR(13,10)
End DoDot:2
+19 ;display country
IF ($PIECE(VAPA(25),"^",2)'="UNITED STATES")
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_$PIECE(VAPA(25),U,2)
End DoDot:1
+20 ;if confidential address is active for scheduling/appointment letters, print to confidential address
+21 IF $GET(SDCCACT1)=1
IF $GET(SDCCACT2)="Y"
Begin DoDot:1
+22 FOR LL=13:1:15
IF VAPA(LL)]""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_VAPA(LL)
+23 IF (VAPA(28)="")!($PIECE(VAPA(28),"^",2)="UNITED STATES")
Begin DoDot:2
+24 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_VAPA(16)_" "_$PIECE(VAPA(17),U,2)_" "_$PIECE(VAPA(18),U,2)
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_VAPA(27)_" "_VAPA(16)_" "_VAPA(26)
End DoDot:2
+27 IF ($PIECE(VAPA(28),"^",2)'="UNITED STATES")
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(11," ")_$PIECE(VAPA(28),U,2)
End DoDot:1
+28 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+29 DO KVAR^VADPT
+30 QUIT
+31 ;
DTS(Y) ;
+1 if 'Y
QUIT ""
+2 QUIT $TRANSLATE($$FMTE^XLFDT(Y,"5DF")," ","0")
+3 ;
LAST4(DFN) ;Return patient "last four"
+1 NEW RET
+2 DO DEM^VADPT
+3 SET RET=$EXTRACT(VADM(1))_$EXTRACT($PIECE(VADM(2),U,1),6,9)
+4 KILL VADM
+5 QUIT RET
+6 ;
BADADD ;Print patients with a Bad Address Indicator
+1 IF '$DATA(^TMP($JOB,"BADADD"))
QUIT
+2 NEW SDHDR,SDHDR1,SDNAM,SDDFN
+3 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(79,"*")
+4 SET SDHDR="BAD ADDRESS INDICATOR LIST"
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL((80-$LENGTH(SDHDR)/2)," ")_SDHDR
+5 SET SDHDR1="** THE LETTER FOR THESE PATIENT(S) DID NOT PRINT DUE TO A BAD ADDRESS INDICATOR."
+6 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="Last 4"
+7 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)="of SSN "_"Patient Name"
+8 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$FILL(79,"*")
+9 SET SDNAM=""
FOR
SET SDNAM=$ORDER(^TMP($JOB,"BADADD",SDNAM))
if SDNAM=""
QUIT
Begin DoDot:1
+10 SET SDDFN=0
FOR
SET SDDFN=$ORDER(^TMP($JOB,"BADADD",SDNAM,SDDFN))
if 'SDDFN
QUIT
Begin DoDot:2
+11 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$$LAST4(SDDFN)_" "_SDNAM_$CHAR(13,10)
End DoDot:2
End DoDot:1
+12 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+13 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=""
+14 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=SDHDR1
+15 QUIT
+16 ;
TST(SDCL,DOW) ; handle scheduled tests
+1 IF ($LENGTH(SDCL)=3&($EXTRACT(SDCL,1,3)="LAB"))
Begin DoDot:1
+2 SET SDECI=SDECI+1
+3 ;alb/sat 665 add space
SET ^TMP("SDEC",$JOB,SDECI)=" "_SDCL_" SCHEDULED: "_DOW_" "_$JUSTIFY(SDDAT,12)_" "_$JUSTIFY(SDT0,5)
End DoDot:1
+4 IF ($LENGTH(SDCL)=4&($EXTRACT(SDCL,1,4)="XRAY"))
Begin DoDot:1
+5 SET SDECI=SDECI+1
+6 SET ^TMP("SDEC",$JOB,SDECI)=SDCL_" SCHEDULED: "_DOW_" "_$JUSTIFY(SDDAT,12)_" "_$JUSTIFY(SDT0,5)
End DoDot:1
+7 IF ($LENGTH(SDCL)=3&($EXTRACT(SDCL,1,3)="EKG"))
Begin DoDot:1
+8 SET SDECI=SDECI+1
+9 ;alb/sat 665 add space
SET ^TMP("SDEC",$JOB,SDECI)=" "_SDCL_" SCHEDULED: "_DOW_" "_$JUSTIFY(SDDAT,12)_" "_$JUSTIFY(SDT0,5)
End DoDot:1
+10 QUIT
FILL(PADS,CHAR) ;pad string
+1 NEW I,RET
+2 SET CHAR=$GET(CHAR)
+3 if CHAR=""
SET CHAR=" "
+4 SET RET=""
+5 FOR I=1:1:PADS
SET RET=RET_CHAR
+6 QUIT RET
