SDES2APTLETTERSV ;ALB/TAW - VISTA SCHEDULING RPCS - VISTA LETTER PRINT ; AUG 14, 2025
;;5.3;Scheduling;**918**;Aug 13, 1993;Build 4
;;Per VHA Directive 6402, this routine should not be modified
Q
; Print single appointment
PRINTAPPT(SDRES,SDCONTEXT,SDINPUT) ;
N ERRORS,PRINTRES
N %L,ZTS,ZTSK
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("PrintResults",1)="" D BUILDJSON^SDES2JSON(.SDRES,.ERRORS) Q
D VALINPUT(.ERRORS,.SDINPUT,1)
I $D(ERRORS) S ERRORS("PrintResults",1)="" D BUILDJSON^SDES2JSON(.SDRES,.ERRORS) Q
D PRINT1(.PRINTRES,.ERRORS,SDINPUT("APPT IEN"),SDINPUT("LETTER TYPE"),SDINPUT("DEVICE"))
I '$D(PRINTRES) S PRINTRES("PrintResults",1)=""
M PRINTRES=ERRORS
D BUILDJSON^SDES2JSON(.SDRES,.PRINTRES)
Q
; Print list of appointments
PRINTAPPTS(SDRES,SDCONTEXT,SDINPUT) ;
N ERRORS,PRINTRES,PAPPT
N %L,ZTS,ZTSK
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("PrintResults",1)="" D BUILDJSON^SDES2JSON(.SDRES,.ERRORS) Q
D VALINPUT(.ERRORS,.SDINPUT,0)
I $D(ERRORS) S ERRORS("PrintResults",1)="" D BUILDJSON^SDES2JSON(.SDRES,.ERRORS) Q
S PAPPT=0 F S PAPPT=$O(SDINPUT("APPT IEN ARRAY",PAPPT)) Q:'PAPPT D
.D PRINT1(.PRINTRES,.ERRORS,PAPPT,SDINPUT("LETTER TYPE"),SDINPUT("DEVICE"))
.; 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("PrintResults")) S ERRORS("PrintResults",1)="" D BUILDJSON^SDES2JSON(.SDRES,.ERRORS) Q
D BUILDJSON^SDES2JSON(.SDRES,.PRINTRES)
Q
VALINPUT(ERRORS,INPUT,ONEIEN) ;
I $G(INPUT("LETTER TYPE"))="" D ERRLOG^SDES2JSON(.ERRORS,228) Q
I "PCN"'[INPUT("LETTER TYPE") D ERRLOG^SDES2JSON(.ERRORS,226) Q
I $G(INPUT("DEVICE"))="" D ERRLOG^SDES2JSON(.ERRORS,279) Q
I '$D(^%ZIS(1,INPUT("DEVICE"))) D ERRLOG^SDES2JSON(.ERRORS,280) Q
I ONEIEN D
.I $G(INPUT("APPT IEN"))="" D ERRLOG^SDES2JSON(.ERRORS,14) Q
.I '$D(^SDEC(409.84,INPUT("APPT IEN"))) D ERRLOG^SDES2JSON(.ERRORS,15)
E D
.I '$O(INPUT("APPT IEN ARRAY",0)) D ERRLOG^SDES2JSON(.ERRORS,254) Q
Q
PRINT1(PRINTRES,ERRORS,APPTIEN,TYPE,PDEV) ;
N APPTIENS,SDTTM,DFN,SDRES,HOSPITAL,APPTDATA,SDT,TIMEZONE
S TYPE=$G(TYPE),PDEV=$G(PDEV)
I '$D(^SDEC(409.84,APPTIEN)) D ERRLOG^SDES2JSON(.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^SDES2JSON(.ERRORS,281)
I 'SDRES D Q
.D ERRLOG^SDES2JSON(.ERRORS,282)
S HOSPITAL=$$GET1^DIQ(409.831,SDRES,.04,"I")
I 'HOSPITAL D Q
.D ERRLOG^SDES2JSON(.ERRORS,283)
S TIMEZONE=$$TIMEZONEDATA^SDES2UTIL($G(HOSPITAL)),TIMEZONE=$P($G(TIMEZONE),U)
I TYPE="P" D PREAPPT(.PRINTRES,.ERRORS,HOSPITAL,APPTIEN,SDTTM,DFN,PDEV,TIMEZONE)
I TYPE="C" D CANCEL(.PRINTRES,.ERRORS,HOSPITAL,APPTIEN,SDTTM,DFN,PDEV)
I TYPE="N" D NOSHOW(.PRINTRES,.ERRORS,HOSPITAL,APPTIEN,SDTTM,DFN,PDEV)
Q
PREAPPT(RESULTS,ERRORS,SCIEN,APPTIEN,SDTTM,DFN,SDID,TIMEZONE) ;print pre-appointment letter
N CLNAPPT,DFBD,SDED,SDLET,SDBD,SDED,L0,SD9,VAUTNALL,VAUTNI,S1,SDLT,SDV1,SDWH,SDLET1
N SDFORM,L2,J,SDCL,L,S,SDAMTYP,SDC,SDFN,SDLET,SDX,A,SC
S CLNAPPT=0 F S CLNAPPT=$O(^SC(SCIEN,"S",SDTTM,1,CLNAPPT)) Q:CLNAPPT="" Q:$P($G(^SC(SCIEN,"S",SDTTM,1,CLNAPPT,0)),U,1)=DFN
I CLNAPPT="" D ERRLOG^SDES2JSON(.ERRORS,52,"Clinic appointment not found.") Q
;check for a PRE-APPT letter defined
S SDCL=$$GET1^DIQ(44,SCIEN,.01,"I")
S SDLET=$$GET1^DIQ(44,SCIEN,2509,"I")
I SDLET="" D ERRLOG^SDES2JSON(.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=SCIEN,SDX=SDTTM,SC=SCIEN
S SDLET1=SDLET
S SDAMTYP="P" ;always by patient
; 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^SDES2JSON(.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","TIMEZONE" S ZTSAVE(ZTS)=""
D ^%ZTLOAD K IO("Q")
D PRINTRES(.RESULTS,APPTIEN)
Q
;
CANCEL(RESULTS,ERRORS,SCIEN,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)=SCIEN_U_SDTTM
I $D(^SC(SCIEN,"LTR")) D
.I APPTSTAT["P" S SDL=$$GET1^DIQ(44,SCIEN,2511,"I")
.I APPTSTAT'["P" S SDL=$$GET1^DIQ(44,SCIEN,2510,"I")
I SDL="" D ERRLOG^SDES2JSON(.ERRORS,52,$S(APPTSTAT["P":"An appointment",1:"A clinic")_" cancellation letter is not defined for "_$$GET1^DIQ(44,SCIEN,.01,"E")_".") Q
S SDWH=APPTSTAT
;
N %ZIS,POP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
I APPTSTAT'="C",APPTSTAT'="PC" D ERRLOG^SDES2JSON(.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^SDES2JSON(.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,SCIEN,APPTIEN,SDTTM,DFN,SDID) ;print no-show appointment letter
N ALS,ANS,C,DATEND,SDDT,SDLET,SDLT1,SDNSACT,SDTIME,SDV1,SDCLINNAME,APPTSTAT,SDT,SC
I SDTTM="" D ERRLOG^SDES2JSON(.ERRORS,285) Q
S APPTSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
I APPTSTAT'="N",(APPTSTAT'="NA") D ERRLOG^SDES2JSON(.ERRORS,286) Q
S SDT=$P(SDTTM,".",1)
S ALS="Y",ANS="N",C=SCIEN,SDDT=DT
S DATEND=SDT+.9
S (SDLT1,SDLET)=""
S SDNSACT=0
S SC=SCIEN
S SDV1=$$GET1^DIQ(44,SCIEN,3.5,"I")
S SDTIME=$$GET1^DIQ(409.84,APPTIEN,.101,"I")
S SDCLINNAME=$$GET1^DIQ(44,SCIEN,.01,"E")
S:SDTIME="" SDTIME="*"
S SDLET=$$GET1^DIQ(44,SCIEN,2508,"I")
I 'SDLET D ERRLOG^SDES2JSON(.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^SDES2JSON(.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[HSDES2APTLETTERSV 7349 printed Jan 29, 2026@15:52:17 Page 2
SDES2APTLETTERSV ;ALB/TAW - VISTA SCHEDULING RPCS - VISTA LETTER PRINT ; AUG 14, 2025
+1 ;;5.3;Scheduling;**918**;Aug 13, 1993;Build 4
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ; Print single appointment
PRINTAPPT(SDRES,SDCONTEXT,SDINPUT) ;
+1 NEW ERRORS,PRINTRES
+2 NEW %L,ZTS,ZTSK
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("PrintResults",1)=""
DO BUILDJSON^SDES2JSON(.SDRES,.ERRORS)
QUIT
+5 DO VALINPUT(.ERRORS,.SDINPUT,1)
+6 IF $DATA(ERRORS)
SET ERRORS("PrintResults",1)=""
DO BUILDJSON^SDES2JSON(.SDRES,.ERRORS)
QUIT
+7 DO PRINT1(.PRINTRES,.ERRORS,SDINPUT("APPT IEN"),SDINPUT("LETTER TYPE"),SDINPUT("DEVICE"))
+8 IF '$DATA(PRINTRES)
SET PRINTRES("PrintResults",1)=""
+9 MERGE PRINTRES=ERRORS
+10 DO BUILDJSON^SDES2JSON(.SDRES,.PRINTRES)
+11 QUIT
+12 ; Print list of appointments
PRINTAPPTS(SDRES,SDCONTEXT,SDINPUT) ;
+1 NEW ERRORS,PRINTRES,PAPPT
+2 NEW %L,ZTS,ZTSK
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("PrintResults",1)=""
DO BUILDJSON^SDES2JSON(.SDRES,.ERRORS)
QUIT
+5 DO VALINPUT(.ERRORS,.SDINPUT,0)
+6 IF $DATA(ERRORS)
SET ERRORS("PrintResults",1)=""
DO BUILDJSON^SDES2JSON(.SDRES,.ERRORS)
QUIT
+7 SET PAPPT=0
FOR
SET PAPPT=$ORDER(SDINPUT("APPT IEN ARRAY",PAPPT))
if 'PAPPT
QUIT
Begin DoDot:1
+8 DO PRINT1(.PRINTRES,.ERRORS,PAPPT,SDINPUT("LETTER TYPE"),SDINPUT("DEVICE"))
+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("PrintResults"))
SET ERRORS("PrintResults",1)=""
DO BUILDJSON^SDES2JSON(.SDRES,.ERRORS)
QUIT
+14 DO BUILDJSON^SDES2JSON(.SDRES,.PRINTRES)
+15 QUIT
VALINPUT(ERRORS,INPUT,ONEIEN) ;
+1 IF $GET(INPUT("LETTER TYPE"))=""
DO ERRLOG^SDES2JSON(.ERRORS,228)
QUIT
+2 IF "PCN"'[INPUT("LETTER TYPE")
DO ERRLOG^SDES2JSON(.ERRORS,226)
QUIT
+3 IF $GET(INPUT("DEVICE"))=""
DO ERRLOG^SDES2JSON(.ERRORS,279)
QUIT
+4 IF '$DATA(^%ZIS(1,INPUT("DEVICE")))
DO ERRLOG^SDES2JSON(.ERRORS,280)
QUIT
+5 IF ONEIEN
Begin DoDot:1
+6 IF $GET(INPUT("APPT IEN"))=""
DO ERRLOG^SDES2JSON(.ERRORS,14)
QUIT
+7 IF '$DATA(^SDEC(409.84,INPUT("APPT IEN")))
DO ERRLOG^SDES2JSON(.ERRORS,15)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 IF '$ORDER(INPUT("APPT IEN ARRAY",0))
DO ERRLOG^SDES2JSON(.ERRORS,254)
QUIT
End DoDot:1
+10 QUIT
PRINT1(PRINTRES,ERRORS,APPTIEN,TYPE,PDEV) ;
+1 NEW APPTIENS,SDTTM,DFN,SDRES,HOSPITAL,APPTDATA,SDT,TIMEZONE
+2 SET TYPE=$GET(TYPE)
SET PDEV=$GET(PDEV)
+3 IF '$DATA(^SDEC(409.84,APPTIEN))
DO ERRLOG^SDES2JSON(.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^SDES2JSON(.ERRORS,281)
End DoDot:1
QUIT
+11 IF 'SDRES
Begin DoDot:1
+12 DO ERRLOG^SDES2JSON(.ERRORS,282)
End DoDot:1
QUIT
+13 SET HOSPITAL=$$GET1^DIQ(409.831,SDRES,.04,"I")
+14 IF 'HOSPITAL
Begin DoDot:1
+15 DO ERRLOG^SDES2JSON(.ERRORS,283)
End DoDot:1
QUIT
+16 SET TIMEZONE=$$TIMEZONEDATA^SDES2UTIL($GET(HOSPITAL))
SET TIMEZONE=$PIECE($GET(TIMEZONE),U)
+17 IF TYPE="P"
DO PREAPPT(.PRINTRES,.ERRORS,HOSPITAL,APPTIEN,SDTTM,DFN,PDEV,TIMEZONE)
+18 IF TYPE="C"
DO CANCEL(.PRINTRES,.ERRORS,HOSPITAL,APPTIEN,SDTTM,DFN,PDEV)
+19 IF TYPE="N"
DO NOSHOW(.PRINTRES,.ERRORS,HOSPITAL,APPTIEN,SDTTM,DFN,PDEV)
+20 QUIT
PREAPPT(RESULTS,ERRORS,SCIEN,APPTIEN,SDTTM,DFN,SDID,TIMEZONE) ;print pre-appointment letter
+1 NEW CLNAPPT,DFBD,SDED,SDLET,SDBD,SDED,L0,SD9,VAUTNALL,VAUTNI,S1,SDLT,SDV1,SDWH,SDLET1
+2 NEW SDFORM,L2,J,SDCL,L,S,SDAMTYP,SDC,SDFN,SDLET,SDX,A,SC
+3 SET CLNAPPT=0
FOR
SET CLNAPPT=$ORDER(^SC(SCIEN,"S",SDTTM,1,CLNAPPT))
if CLNAPPT=""
QUIT
if $PIECE($GET(^SC(SCIEN,"S",SDTTM,1,CLNAPPT,0)),U,1)=DFN
QUIT
+4 IF CLNAPPT=""
DO ERRLOG^SDES2JSON(.ERRORS,52,"Clinic appointment not found.")
QUIT
+5 ;check for a PRE-APPT letter defined
+6 SET SDCL=$$GET1^DIQ(44,SCIEN,.01,"I")
+7 SET SDLET=$$GET1^DIQ(44,SCIEN,2509,"I")
+8 IF SDLET=""
DO ERRLOG^SDES2JSON(.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=SCIEN
SET SDX=SDTTM
SET SC=SCIEN
+17 SET SDLET1=SDLET
+18 ;always by patient
SET SDAMTYP="P"
+19 ; prepare to queue the letter if the user so desires
+20 NEW %ZIS,IOP,POP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+21 SET IOP="`"_SDID
+22 SET %ZIS("B")=""
SET POP=0
SET %ZIS="MQ"
DO ^%ZIS
+23 IF POP
DO ERRLOG^SDES2JSON(.ERRORS,285)
QUIT
+24 ;,ZTSAVE("*")=""
SET ZTIO=ION
SET ZTRTN="QUE^SDM1A"
SET ZTDESC="PRINT PRE-APPT LETTER"
SET ZTDTH=$$NOW^XLFDT
+25 FOR ZTS="A","AUTO(","DFN","DUZ","S","SC","SDCL","SDFORM","SDLET","SDWH","SDX","TIMEZONE"
SET ZTSAVE(ZTS)=""
+26 DO ^%ZTLOAD
KILL IO("Q")
+27 DO PRINTRES(.RESULTS,APPTIEN)
+28 QUIT
+29 ;
CANCEL(RESULTS,ERRORS,SCIEN,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)=SCIEN_U_SDTTM
+6 IF $DATA(^SC(SCIEN,"LTR"))
Begin DoDot:1
+7 IF APPTSTAT["P"
SET SDL=$$GET1^DIQ(44,SCIEN,2511,"I")
+8 IF APPTSTAT'["P"
SET SDL=$$GET1^DIQ(44,SCIEN,2510,"I")
End DoDot:1
+9 IF SDL=""
DO ERRLOG^SDES2JSON(.ERRORS,52,$SELECT(APPTSTAT["P":"An appointment",1:"A clinic")_" cancellation letter is not defined for "_$$GET1^DIQ(44,SCIEN,.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^SDES2JSON(.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^SDES2JSON(.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,SCIEN,APPTIEN,SDTTM,DFN,SDID) ;print no-show appointment letter
+1 NEW ALS,ANS,C,DATEND,SDDT,SDLET,SDLT1,SDNSACT,SDTIME,SDV1,SDCLINNAME,APPTSTAT,SDT,SC
+2 IF SDTTM=""
DO ERRLOG^SDES2JSON(.ERRORS,285)
QUIT
+3 SET APPTSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
+4 IF APPTSTAT'="N"
IF (APPTSTAT'="NA")
DO ERRLOG^SDES2JSON(.ERRORS,286)
QUIT
+5 SET SDT=$PIECE(SDTTM,".",1)
+6 SET ALS="Y"
SET ANS="N"
SET C=SCIEN
SET SDDT=DT
+7 SET DATEND=SDT+.9
+8 SET (SDLT1,SDLET)=""
+9 SET SDNSACT=0
+10 SET SC=SCIEN
+11 SET SDV1=$$GET1^DIQ(44,SCIEN,3.5,"I")
+12 SET SDTIME=$$GET1^DIQ(409.84,APPTIEN,.101,"I")
+13 SET SDCLINNAME=$$GET1^DIQ(44,SCIEN,.01,"E")
+14 if SDTIME=""
SET SDTIME="*"
+15 SET SDLET=$$GET1^DIQ(44,SCIEN,2508,"I")
+16 IF 'SDLET
DO ERRLOG^SDES2JSON(.ERRORS,52,"A No-show letter is not defined for "_SDCLINNAME_".")
QUIT
+17 SET IOP="`"_SDID
+18 ;alb/sat 665 - change ^%ZIS params to match PRE
SET %ZIS("B")=""
SET POP=0
SET %ZIS="MQ"
DO ^%ZIS
+19 IF POP
DO ERRLOG^SDES2JSON(.ERRORS,285)
QUIT
+20 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)=""
+21 KILL ZTS
DO ^%ZTLOAD
KILL IO("Q")
+22 DO PRINTRES(.RESULTS,APPTIEN)
+23 QUIT
+24 ; 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
