SDESAPPTLETTERSV ;ALB/BWF - VISTA SCHEDULING RPCS - VISTA LETTER PRINT ; September 07, 2022
;;5.3;Scheduling;**825**;Aug 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
Q
; Print single appointment
PRINTAPPT(SDRES,APPTIEN,TYPE,PDEV) ;
N ERRORS,PRINTRES
S APPTIEN=$G(APPTIEN),TYPE=$G(TYPE),PDEV=$G(PDEV)
D VALAPPTIEN(.ERRORS,.APPTIEN)
D VALTYPE(.ERRORS,TYPE)
D VALPDEV(.ERRORS,PDEV)
I $D(ERRORS) S ERRORS("PrintResult",1)="" D BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS) Q
D PRINT1(.PRINTRES,.ERRORS,APPTIEN,TYPE,PDEV)
I '$D(PRINTRES) S PRINTRES("PrintResult",1)=""
M PRINTRES=ERRORS
D BUILDJSON^SDESBUILDJSON(.SDRES,.PRINTRES)
Q
; Print list of appointments
PRINTAPPTS(SDRES,APPTIENS,TYPE,PDEV) ;
N ERRORS,PRINTRES,PAPPT
S TYPE=$G(TYPE),PDEV=$G(PDEV)
D VALAPPTLIST(.ERRORS,.APPTIENS)
D VALTYPE(.ERRORS,TYPE)
D VALPDEV(.ERRORS,PDEV)
I $D(ERRORS) S ERRORS("PrintResult",1)="" D BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS) Q
S PAPPT=0 F S PAPPT=$O(APPTIENS(PAPPT)) Q:'PAPPT D
.D PRINT1(.PRINTRES,.ERRORS,PAPPT,TYPE,PDEV)
.; log errors for each appointment and kill ERRORS so errors are not duplicated
.I $D(ERRORS) D
..D PRINTRESERR(.PRINTRES,PAPPT,.ERRORS)
..K ERRORS
I $D(ERRORS),'$D(PRINTRES("PrintResult")) S ERRORS("PrintResult",1)="" D BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS) Q
D BUILDJSON^SDESBUILDJSON(.SDRES,.PRINTRES)
Q
VALAPPTIEN(ERRORS,APPTIEN) ;
I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14) Q
I '$D(^SDEC(409.84,APPTIEN)) D ERRLOG^SDESJSON(.ERRORS,15)
Q
VALAPPTLIST(ERRORS,APPTLIST) ;
I '$O(APPTLIST(0)) D ERRLOG^SDESJSON(.ERRORS,254) Q
Q
VALTYPE(ERRORS,TYPE) ;
I TYPE="" D ERRLOG^SDESJSON(.ERRORS,228) Q
I "PCN"'[TYPE D ERRLOG^SDESJSON(.ERRORS,226)
Q
VALPDEV(ERRORS,PDEV) ;
I 'PDEV D ERRLOG^SDESJSON(.ERRORS,279) Q
I '$D(^%ZIS(1,PDEV)) D ERRLOG^SDESJSON(.ERRORS,280)
Q
PRINT1(PRINTRES,ERRORS,APPTIEN,TYPE,PDEV) ;
N APPTIENS,SDTTM,DFN,SDRES,SC,APPTDATA,SDT
S TYPE=$G(TYPE),PDEV=$G(PDEV)
I '$D(^SDEC(409.84,APPTIEN)) D ERRLOG^SDESJSON(.ERRORS,52,"Invalid appointment ID "_APPTIEN_".") Q
S APPTIENS=APPTIEN_","
D GETS^DIQ(409.84,APPTIENS,".01;.05;.07","I","APPTDATA")
S (SDT,SDTTM)=$G(APPTDATA(409.84,APPTIENS,.01,"I"))
S DFN=$G(APPTDATA(409.84,APPTIENS,.05,"I"))
S SDRES=$G(APPTDATA(409.84,APPTIENS,.07,"I"))
I $$BADADR^DGUTL3(+DFN) D Q
.D ERRLOG^SDESJSON(.ERRORS,281)
I 'SDRES D Q
.D ERRLOG^SDESJSON(.ERRORS,282)
S SC=$$GET1^DIQ(409.831,SDRES,.04,"I")
I 'SC D Q
.D ERRLOG^SDESJSON(.ERRORS,283)
I TYPE="P" D PREAPPT(.PRINTRES,.ERRORS,SC,APPTIEN,SDTTM,DFN,PDEV)
I TYPE="C" D CANCEL(.PRINTRES,.ERRORS,SC,APPTIEN,SDTTM,DFN,PDEV)
I TYPE="N" D NOSHOW(.PRINTRES,.ERRORS,SC,APPTIEN,SDTTM,DFN,PDEV)
Q
PREAPPT(RESULTS,ERRORS,SC,APPTIEN,SDTTM,DFN,SDID) ;print pre-appointment letter
N SDY,DFBD,SDED,SDLET,SDBD,SDED,L0,SD9,VAUTNALL,VAUTNI,S1,SDLT,SDV,SDWH,SDLET1
N SDFORM,L2,J,SDCL,L,S,SDAMTYP,SDC,SDFN,SDLET,SDX
S SDY=0 F S SDY=$O(^SC(SC,"S",SDTTM,1,SDY)) Q:SDY="" Q:$P($G(^SC(SC,"S",SDTTM,1,SDY,0)),U,1)=DFN
I SDY="" D ERRLOG^SDESJSON(.ERRORS,52,"Clinic appointment not found.") Q
;check for a PRE-APPT letter defined
S SDCL=$$GET1^DIQ(44,SC,.01,"I")
S SDLET=$$GET1^DIQ(44,SC,2509,"I")
I SDLET="" D ERRLOG^SDESJSON(.ERRORS,52,"A pre-appointment letter is not defined for "_SDCL_".") Q
;
; pre-define letter type (P), the division, date for appt, etc.
S SDWH=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
S (SDBD,SDED)=SDTTM,L0="P",SD9=0,VAUTNALL=1,VAUTNI=2,S1="P",SDLT=1,SDV1=1,SDFORM=""
S L2=$S(L0="P":"^SDL1",1:"^SDL1"),J=SDBD
S (A,SDFN,S)=DFN
S L="^SDL1"
S SDC=SC,SDX=SDTTM
S SDLET1=SDLET
S SDAMTYP="P" ;always by patient
;I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY
;I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY
; prepare to queue the letter if the user so desires
N %ZIS,IOP,POP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
S IOP="`"_SDID
S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS
I POP D ERRLOG^SDESJSON(.ERRORS,285) Q
S ZTIO=ION,ZTRTN="QUE^SDM1A",ZTDESC="PRINT PRE-APPT LETTER",ZTDTH=$$NOW^XLFDT ;,ZTSAVE("*")=""
F ZTS="A","AUTO(","DFN","DUZ","S","SC","SDCL","SDFORM","SDLET","SDWH","SDX" S ZTSAVE(ZTS)=""
D ^%ZTLOAD K IO("Q")
D PRINTRES(.RESULTS,APPTIEN)
Q
;
CANCEL(RESULTS,ERRORS,SC,APPTIEN,SDTTM,DFN,SDID) ;
N A,SDCL,SDL,APPTSTAT,SDWH
S SDL=""
S A=DFN
S APPTSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
S SDCL(1)=SC_U_SDTTM
I $D(^SC(SC,"LTR")) D
.I APPTSTAT["P" S SDL=$$GET1^DIQ(44,SC,2511,"I")
.I APPTSTAT'["P" S SDL=$$GET1^DIQ(44,SC,2510,"I")
I SDL="" D ERRLOG^SDESJSON(.ERRORS,52,$S(APPTSTAT["P":"An appointment",1:"A clinic")_" cancellation letter is not defined for "_$$GET1^DIQ(44,SC,.01,"E")_".") Q
S SDWH=APPTSTAT
;
N %ZIS,POP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
I APPTSTAT'="C",APPTSTAT'="PC" D ERRLOG^SDESJSON(.ERRORS,284) Q
S IOP="`"_SDID
S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS ;alb/sat 665 - change ^%ZIS params to match PRE
I POP D ERRLOG^SDESJSON(.ERRORS,285) Q
S ZTIO=ION,ZTRTN="SDLET^SDCNP1A",ZTDESC="PRINT CANCEL APPOINTMENT LETTER",ZTDTH=$$NOW^XLFDT F ZTS="SDCL(","DUZ","DFN","DT","A","SDWH","AUTO(" S ZTSAVE(ZTS)=""
K ZTS D ^%ZTLOAD K IO("Q")
D PRINTRES(.RESULTS,APPTIEN)
Q
NOSHOW(RESULTS,ERRORS,SC,APPTIEN,SDTTM,DFN,SDID) ;print no-show appointment letter
N ALS,ANS,C,DATEND,SDDT,SDLET,SDLT1,SDNSACT,SDTIME,SDV1,SDCLINNAME,APPTSTAT,SDT
I SDTTM="" D ERRLOG^SDESJSON(.ERRORS,285) Q
S APPTSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
I APPTSTAT'="N",(APPTSTAT'="NA") D ERRLOG^SDESJSON(.ERRORS,286) Q
S SDT=$P(SDTTM,".",1)
S ALS="Y",ANS="N",C=SC,SDDT=DT
S DATEND=SDT+.9
S (SDLT1,SDLET)=""
S SDNSACT=0
S SDV1=$$GET1^DIQ(44,SC,3.5,"I")
S SDTIME=$$GET1^DIQ(409.84,APPTIEN,.101,"I")
S SDCLINNAME=$$GET1^DIQ(44,SC,.01,"E")
S:SDTIME="" SDTIME="*"
S SDLET=$$GET1^DIQ(44,SC,2508,"I")
I 'SDLET D ERRLOG^SDESJSON(.ERRORS,52,"A No-show letter is not defined for "_SDCLINNAME_".") Q
S IOP="`"_SDID
S %ZIS("B")="",POP=0,%ZIS="MQ" D ^%ZIS ;alb/sat 665 - change ^%ZIS params to match PRE
I POP D ERRLOG^SDESJSON(.ERRORS,285) Q
S ZTIO=ION,ZTRTN="START^SDN0",ZTDESC="PRINT NO SHOW APPOINTMENT LETTER",ZTDTH=$$NOW^XLFDT F ZTS="SC","SDDT","ALS","ANS","SDLET","SDV1","SDT","C","DATEND","SDTIME","SDLT1","AUTO(","SDNSACT" S ZTSAVE(ZTS)=""
K ZTS D ^%ZTLOAD K IO("Q")
D PRINTRES(.RESULTS,APPTIEN)
Q
; set up print results for each item
PRINTRES(RESULTS,APPTIEN) ;
N CURCNT
S CURCNT=$O(RESULTS("PrintResults",99999999),-1)+1
S RESULTS("PrintResults",CURCNT,"AppointmentID")=APPTIEN
S RESULTS("PrintResults",CURCNT,"Status")="Print Queued."
Q
PRINTRESERR(RESULTS,APPTIEN,ERRORS) ;
N CURCNT,ERRCNT
S ERRCNT=0 F S ERRCNT=$O(ERRORS("Error",ERRCNT)) Q:'ERRCNT D
.S CURCNT=$O(RESULTS("PrintResults",99999999),-1)+1
.S RESULTS("PrintResults",CURCNT,"AppointmentID")=APPTIEN
.S RESULTS("PrintResults",CURCNT,"Status")=$G(ERRORS("Error",ERRCNT))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESAPPTLETTERSV 6922 printed Nov 22, 2024@18:05:34 Page 2
SDESAPPTLETTERSV ;ALB/BWF - VISTA SCHEDULING RPCS - VISTA LETTER PRINT ; September 07, 2022
+1 ;;5.3;Scheduling;**825**;Aug 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ; Print single appointment
PRINTAPPT(SDRES,APPTIEN,TYPE,PDEV) ;
+1 NEW ERRORS,PRINTRES
+2 SET APPTIEN=$GET(APPTIEN)
SET TYPE=$GET(TYPE)
SET PDEV=$GET(PDEV)
+3 DO VALAPPTIEN(.ERRORS,.APPTIEN)
+4 DO VALTYPE(.ERRORS,TYPE)
+5 DO VALPDEV(.ERRORS,PDEV)
+6 IF $DATA(ERRORS)
SET ERRORS("PrintResult",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS)
QUIT
+7 DO PRINT1(.PRINTRES,.ERRORS,APPTIEN,TYPE,PDEV)
+8 IF '$DATA(PRINTRES)
SET PRINTRES("PrintResult",1)=""
+9 MERGE PRINTRES=ERRORS
+10 DO BUILDJSON^SDESBUILDJSON(.SDRES,.PRINTRES)
+11 QUIT
+12 ; Print list of appointments
PRINTAPPTS(SDRES,APPTIENS,TYPE,PDEV) ;
+1 NEW ERRORS,PRINTRES,PAPPT
+2 SET TYPE=$GET(TYPE)
SET PDEV=$GET(PDEV)
+3 DO VALAPPTLIST(.ERRORS,.APPTIENS)
+4 DO VALTYPE(.ERRORS,TYPE)
+5 DO VALPDEV(.ERRORS,PDEV)
+6 IF $DATA(ERRORS)
SET ERRORS("PrintResult",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS)
QUIT
+7 SET PAPPT=0
FOR
SET PAPPT=$ORDER(APPTIENS(PAPPT))
if 'PAPPT
QUIT
Begin DoDot:1
+8 DO PRINT1(.PRINTRES,.ERRORS,PAPPT,TYPE,PDEV)
+9 ; log errors for each appointment and kill ERRORS so errors are not duplicated
+10 IF $DATA(ERRORS)
Begin DoDot:2
+11 DO PRINTRESERR(.PRINTRES,PAPPT,.ERRORS)
+12 KILL ERRORS
End DoDot:2
End DoDot:1
+13 IF $DATA(ERRORS)
IF '$DATA(PRINTRES("PrintResult"))
SET ERRORS("PrintResult",1)=""
DO BUILDJSON^SDESBUILDJSON(.SDRES,.ERRORS)
QUIT
+14 DO BUILDJSON^SDESBUILDJSON(.SDRES,.PRINTRES)
+15 QUIT
VALAPPTIEN(ERRORS,APPTIEN) ;
+1 IF APPTIEN=""
DO ERRLOG^SDESJSON(.ERRORS,14)
QUIT
+2 IF '$DATA(^SDEC(409.84,APPTIEN))
DO ERRLOG^SDESJSON(.ERRORS,15)
+3 QUIT
VALAPPTLIST(ERRORS,APPTLIST) ;
+1 IF '$ORDER(APPTLIST(0))
DO ERRLOG^SDESJSON(.ERRORS,254)
QUIT
+2 QUIT
VALTYPE(ERRORS,TYPE) ;
+1 IF TYPE=""
DO ERRLOG^SDESJSON(.ERRORS,228)
QUIT
+2 IF "PCN"'[TYPE
DO ERRLOG^SDESJSON(.ERRORS,226)
+3 QUIT
VALPDEV(ERRORS,PDEV) ;
+1 IF 'PDEV
DO ERRLOG^SDESJSON(.ERRORS,279)
QUIT
+2 IF '$DATA(^%ZIS(1,PDEV))
DO ERRLOG^SDESJSON(.ERRORS,280)
+3 QUIT
PRINT1(PRINTRES,ERRORS,APPTIEN,TYPE,PDEV) ;
+1 NEW APPTIENS,SDTTM,DFN,SDRES,SC,APPTDATA,SDT
+2 SET TYPE=$GET(TYPE)
SET PDEV=$GET(PDEV)
+3 IF '$DATA(^SDEC(409.84,APPTIEN))
DO ERRLOG^SDESJSON(.ERRORS,52,"Invalid appointment ID "_APPTIEN_".")
QUIT
+4 SET APPTIENS=APPTIEN_","
+5 DO GETS^DIQ(409.84,APPTIENS,".01;.05;.07","I","APPTDATA")
+6 SET (SDT,SDTTM)=$GET(APPTDATA(409.84,APPTIENS,.01,"I"))
+7 SET DFN=$GET(APPTDATA(409.84,APPTIENS,.05,"I"))
+8 SET SDRES=$GET(APPTDATA(409.84,APPTIENS,.07,"I"))
+9 IF $$BADADR^DGUTL3(+DFN)
Begin DoDot:1
+10 DO ERRLOG^SDESJSON(.ERRORS,281)
End DoDot:1
QUIT
+11 IF 'SDRES
Begin DoDot:1
+12 DO ERRLOG^SDESJSON(.ERRORS,282)
End DoDot:1
QUIT
+13 SET SC=$$GET1^DIQ(409.831,SDRES,.04,"I")
+14 IF 'SC
Begin DoDot:1
+15 DO ERRLOG^SDESJSON(.ERRORS,283)
End DoDot:1
QUIT
+16 IF TYPE="P"
DO PREAPPT(.PRINTRES,.ERRORS,SC,APPTIEN,SDTTM,DFN,PDEV)
+17 IF TYPE="C"
DO CANCEL(.PRINTRES,.ERRORS,SC,APPTIEN,SDTTM,DFN,PDEV)
+18 IF TYPE="N"
DO NOSHOW(.PRINTRES,.ERRORS,SC,APPTIEN,SDTTM,DFN,PDEV)
+19 QUIT
PREAPPT(RESULTS,ERRORS,SC,APPTIEN,SDTTM,DFN,SDID) ;print pre-appointment letter
+1 NEW SDY,DFBD,SDED,SDLET,SDBD,SDED,L0,SD9,VAUTNALL,VAUTNI,S1,SDLT,SDV,SDWH,SDLET1
+2 NEW SDFORM,L2,J,SDCL,L,S,SDAMTYP,SDC,SDFN,SDLET,SDX
+3 SET SDY=0
FOR
SET SDY=$ORDER(^SC(SC,"S",SDTTM,1,SDY))
if SDY=""
QUIT
if $PIECE($GET(^SC(SC,"S",SDTTM,1,SDY,0)),U,1)=DFN
QUIT
+4 IF SDY=""
DO ERRLOG^SDESJSON(.ERRORS,52,"Clinic appointment not found.")
QUIT
+5 ;check for a PRE-APPT letter defined
+6 SET SDCL=$$GET1^DIQ(44,SC,.01,"I")
+7 SET SDLET=$$GET1^DIQ(44,SC,2509,"I")
+8 IF SDLET=""
DO ERRLOG^SDESJSON(.ERRORS,52,"A pre-appointment letter is not defined for "_SDCL_".")
QUIT
+9 ;
+10 ; pre-define letter type (P), the division, date for appt, etc.
+11 SET SDWH=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
+12 SET (SDBD,SDED)=SDTTM
SET L0="P"
SET SD9=0
SET VAUTNALL=1
SET VAUTNI=2
SET S1="P"
SET SDLT=1
SET SDV1=1
SET SDFORM=""
+13 SET L2=$SELECT(L0="P":"^SDL1",1:"^SDL1")
SET J=SDBD
+14 SET (A,SDFN,S)=DFN
+15 SET L="^SDL1"
+16 SET SDC=SC
SET SDX=SDTTM
+17 SET SDLET1=SDLET
+18 ;always by patient
SET SDAMTYP="P"
+19 ;I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY
+20 ;I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY
+21 ; prepare to queue the letter if the user so desires
+22 NEW %ZIS,IOP,POP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+23 SET IOP="`"_SDID
+24 SET %ZIS("B")=""
SET POP=0
SET %ZIS="MQ"
DO ^%ZIS
+25 IF POP
DO ERRLOG^SDESJSON(.ERRORS,285)
QUIT
+26 ;,ZTSAVE("*")=""
SET ZTIO=ION
SET ZTRTN="QUE^SDM1A"
SET ZTDESC="PRINT PRE-APPT LETTER"
SET ZTDTH=$$NOW^XLFDT
+27 FOR ZTS="A","AUTO(","DFN","DUZ","S","SC","SDCL","SDFORM","SDLET","SDWH","SDX"
SET ZTSAVE(ZTS)=""
+28 DO ^%ZTLOAD
KILL IO("Q")
+29 DO PRINTRES(.RESULTS,APPTIEN)
+30 QUIT
+31 ;
CANCEL(RESULTS,ERRORS,SC,APPTIEN,SDTTM,DFN,SDID) ;
+1 NEW A,SDCL,SDL,APPTSTAT,SDWH
+2 SET SDL=""
+3 SET A=DFN
+4 SET APPTSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
+5 SET SDCL(1)=SC_U_SDTTM
+6 IF $DATA(^SC(SC,"LTR"))
Begin DoDot:1
+7 IF APPTSTAT["P"
SET SDL=$$GET1^DIQ(44,SC,2511,"I")
+8 IF APPTSTAT'["P"
SET SDL=$$GET1^DIQ(44,SC,2510,"I")
End DoDot:1
+9 IF SDL=""
DO ERRLOG^SDESJSON(.ERRORS,52,$SELECT(APPTSTAT["P":"An appointment",1:"A clinic")_" cancellation letter is not defined for "_$$GET1^DIQ(44,SC,.01,"E")_".")
QUIT
+10 SET SDWH=APPTSTAT
+11 ;
+12 NEW %ZIS,POP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+13 IF APPTSTAT'="C"
IF APPTSTAT'="PC"
DO ERRLOG^SDESJSON(.ERRORS,284)
QUIT
+14 SET IOP="`"_SDID
+15 ;alb/sat 665 - change ^%ZIS params to match PRE
SET %ZIS("B")=""
SET POP=0
SET %ZIS="MQ"
DO ^%ZIS
+16 IF POP
DO ERRLOG^SDESJSON(.ERRORS,285)
QUIT
+17 SET ZTIO=ION
SET ZTRTN="SDLET^SDCNP1A"
SET ZTDESC="PRINT CANCEL APPOINTMENT LETTER"
SET ZTDTH=$$NOW^XLFDT
FOR ZTS="SDCL(","DUZ","DFN","DT","A","SDWH","AUTO("
SET ZTSAVE(ZTS)=""
+18 KILL ZTS
DO ^%ZTLOAD
KILL IO("Q")
+19 DO PRINTRES(.RESULTS,APPTIEN)
+20 QUIT
NOSHOW(RESULTS,ERRORS,SC,APPTIEN,SDTTM,DFN,SDID) ;print no-show appointment letter
+1 NEW ALS,ANS,C,DATEND,SDDT,SDLET,SDLT1,SDNSACT,SDTIME,SDV1,SDCLINNAME,APPTSTAT,SDT
+2 IF SDTTM=""
DO ERRLOG^SDESJSON(.ERRORS,285)
QUIT
+3 SET APPTSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
+4 IF APPTSTAT'="N"
IF (APPTSTAT'="NA")
DO ERRLOG^SDESJSON(.ERRORS,286)
QUIT
+5 SET SDT=$PIECE(SDTTM,".",1)
+6 SET ALS="Y"
SET ANS="N"
SET C=SC
SET SDDT=DT
+7 SET DATEND=SDT+.9
+8 SET (SDLT1,SDLET)=""
+9 SET SDNSACT=0
+10 SET SDV1=$$GET1^DIQ(44,SC,3.5,"I")
+11 SET SDTIME=$$GET1^DIQ(409.84,APPTIEN,.101,"I")
+12 SET SDCLINNAME=$$GET1^DIQ(44,SC,.01,"E")
+13 if SDTIME=""
SET SDTIME="*"
+14 SET SDLET=$$GET1^DIQ(44,SC,2508,"I")
+15 IF 'SDLET
DO ERRLOG^SDESJSON(.ERRORS,52,"A No-show letter is not defined for "_SDCLINNAME_".")
QUIT
+16 SET IOP="`"_SDID
+17 ;alb/sat 665 - change ^%ZIS params to match PRE
SET %ZIS("B")=""
SET POP=0
SET %ZIS="MQ"
DO ^%ZIS
+18 IF POP
DO ERRLOG^SDESJSON(.ERRORS,285)
QUIT
+19 SET ZTIO=ION
SET ZTRTN="START^SDN0"
SET ZTDESC="PRINT NO SHOW APPOINTMENT LETTER"
SET ZTDTH=$$NOW^XLFDT
FOR ZTS="SC","SDDT","ALS","ANS","SDLET","SDV1","SDT","C","DATEND","SDTIME","SDLT1","AUTO(","SDNSACT"
SET ZTSAVE(ZTS)=""
+20 KILL ZTS
DO ^%ZTLOAD
KILL IO("Q")
+21 DO PRINTRES(.RESULTS,APPTIEN)
+22 QUIT
+23 ; set up print results for each item
PRINTRES(RESULTS,APPTIEN) ;
+1 NEW CURCNT
+2 SET CURCNT=$ORDER(RESULTS("PrintResults",99999999),-1)+1
+3 SET RESULTS("PrintResults",CURCNT,"AppointmentID")=APPTIEN
+4 SET RESULTS("PrintResults",CURCNT,"Status")="Print Queued."
+5 QUIT
PRINTRESERR(RESULTS,APPTIEN,ERRORS) ;
+1 NEW CURCNT,ERRCNT
+2 SET ERRCNT=0
FOR
SET ERRCNT=$ORDER(ERRORS("Error",ERRCNT))
if 'ERRCNT
QUIT
Begin DoDot:1
+3 SET CURCNT=$ORDER(RESULTS("PrintResults",99999999),-1)+1
+4 SET RESULTS("PrintResults",CURCNT,"AppointmentID")=APPTIEN
+5 SET RESULTS("PrintResults",CURCNT,"Status")=$GET(ERRORS("Error",ERRCNT))
End DoDot:1
+6 QUIT
