Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESAPPTLETTERS

SDESAPPTLETTERS.m

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