SDEC40.m

SDEC40 ;ALB/SAT,WTC,LEG - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22

 ;;5.3;Scheduling;**627,665,694,785,813**;Aug 13, 1993;Build 6

 ;

 ;  ICR

 ;  ---

 ;   7024 - #40.8

 ;   7025 - #43

 ;   7030 - #2 (appointment record)

 ;   7034 - DGNFUNC

 ;  10035 - #2 (demographics)

 ;  10060 - #200

 ;  10061 - VAPDT

 ;

 Q

 ;

 ;  APL - Print Appointment Letter

 ;

APPTLETR(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

 ; Called by SDEC PRINT APPT LETTER remote procedure

 N SDECI,SDECNOD,SDECTMP,DFN,IN,RES,SCLT,SDC,SDLET,SDS,SDT,X1,X2,Y,TIMEZONE

 N SDIV,SDFORM,SDNAM,SDSSN,VAPA

 S SDECI=0

 K ^TMP("SDEC",$J)

 S SDECY="^TMP(""SDEC"","_$J_")"

 S ^TMP("SDEC",$J,0)="T00080ERRORID"_$C(30)

 I '+SDECAPID D ERR^SDECERR("Invalid Appointment ID.") Q

 I '$D(^SDEC(409.84,SDECAPID,0)) D ERR^SDECERR("Invalid Appointment ID.") Q

 I $G(LT)="" S LT="P"  ;D ERR^SDECERR("Invalid Letter Type.") Q

 S SDECNOD=^SDEC(409.84,SDECAPID,0)

 S SDT=$P(SDECNOD,U)  ;Get appt time

 S DFN=$P(SDECNOD,U,5)  ;Get patient pointer to VA PATIENT (^DPT) file 2

 S RES=$P(SDECNOD,U,7) S SDC=$P(^SDEC(409.831,RES,0),U,4)  ;get resource and clinic

 S SDS=^DPT(DFN,"S",SDT,0)

 S SCLT=$S(LT="N":1,LT="P":2,LT="C":3,LT="A":4,1:"2") ;get storage position of LETTER pointer

 S SDLET=$P($G(^SC(SDC,"LTR")),U,SCLT)

 I SDLET="" D ERR^SDECERR($S(SCLT=1:"No-Show",SCLT=2:"Pre-Appointment",SCLT=3:"Clinic Cancellation",1:"Patient Cancellation")_" Letter not defined for Clinic "_$P(^SC(SDC,0),U)_".") Q  ;LEG 5/17/2021 ; added missing space

 S SDIV=$P(^SC(SDC,0),"^",15),SDIV=$S(SDIV:SDIV,1:$O(^DG(40.8,0)))

 S SDFORM=$P($G(^DG(40.8,SDIV,"LTR")),U,1)

 ; data header

 S ^TMP("SDEC",$J,0)="T00080TEXT"_$C(30)

 D PRT(DFN,SDC,SDT,LT,SDLET,SDFORM)

 D WRAPP(DFN,SDC,SDT,LT,SDLET)

 D REST(DFN,SDC,SDT,LT,SDLET,SDFORM)

 S SDECI=SDECI+1 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(30,31)

 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

 ;WRITE GREETING AND OPENING TEXT OF LETTER

 N A,DPTNAME,IN,X,Y

 S A=DFN

 Q:DFN=""

 Q:LT=""

 S SDFORM=$G(SDFORM)

 S Y=DT D DTS^SDUTL

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(64," ")_Y_$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(64," ")_$$LAST4(A)_$C(13,10)

 I 'SDFORM D

 .F I=1:1:4 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 .D ADDR

 .F I=1:1:4 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 ;

 S DPTNAME("FILE")=2,DPTNAME("FIELD")=".01",DPTNAME("IENS")=(+A)_","

 S X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M")

 ;S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Dear "_$S($P(^DPT(+A,0),"^",2)="M":"Mr. ",1:"Ms. ")_X_","_$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Dear "_X_","_$C(13,10) ;VSE-693;LEG 5/12/21

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 ;loop and display initial section of Letter

 S IN=0 F  S IN=$O(^VA(407.5,SDLET,1,IN)) Q:IN'>0  D

 . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=^VA(407.5,SDLET,1,IN,0)_$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 Q

 ;

WRAPP(DFN,SDC,SD,LT,SDLET) ;WRITE APPOINTMENT INFORMATION

 N B,DOW,S,SDCL,SDDAT,SDHX,SDT0,SDTMP,SDX,SDX1,X

 S SDX=SD,S=$G(^DPT(DFN,"S",SD,0))  ;alb/sat 665 add S

 S SDCL=$P(^SC(+SDC,0),"^",1),SDCL="    Clinic:  "_SDCL D FORM ; SD*5.3*622 end changes

 ;

 S SDX1=SDX S:$D(SDS) S=SDS F B=3,4,5 I $P(S,"^",B)]"" S SDCL=$S(B=3:"LAB",B=4:"XRAY",1:"EKG"),SDX=$P(S,"^",B) D FORM   ;alb/sat 665

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)  ;alb/sat 665

 S (SDX,X)=SDX1 Q

 ; SD*5.3*622 - add more detail for appointment and format it

FORM ;S:$D(SDX) X=SDX S SDHX=X D DW^%DTC S DOW=X,X=SDHX 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)) ; See below wtc 6/7/18 694

 ;

 ;  Change display time for noon and midnight from 12:00 PM to 12:00 Noon and 12:00 Midnight

 ;

 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(B) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="     Date/Time: "_DOW_"  "_$J(SDDAT,12)_$S('$D(B)&$D(SDC):$J(SDT0,9),1:"")_" "_TIMEZONE_$C(13,10)

 I '$D(B),$D(SDC) D

 .S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="    "_SDCL_$C(13,10)

 ; 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

 N J,SDLOC,SDPROV,SDPRNM,SDTEL,SDTELEXT

 S SDLOC=$P($G(^SC(+SDC,0)),"^",11) ; physical location of the clinic

 ;ajf ;050918 ;R16969456FY18

 S SDTEL=$P($G(^SC(+SDC,99)),"^",1)        ; telephone number of clinic

 S SDTELEXT="" I SDTEL]"",$G(^SC(+SDC,99.1))]"" D

 .S SDTELEXT=^SC(+SDC,99.1)  ; telephone ext of clinic

 ; get default provider, if any

 F J=0:0 S J=$O(^SC(+SDC,"PR",J)) Q:'J>0  I $P($G(^SC(+SDC,"PR",J,0)),U,2)=1 S SDPROV=+$P(^SC(+SDC,"PR",J,0),U,1)

 I $D(SDC),'$D(B),$P($G(^VA(407.5,SDLET,3)),U,2)="Y" D

 .I SDLOC]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="     "_"Location:  "_SDLOC_$C(13,10)

 I $D(SDC),'$D(B),SDTEL]"" D

 .S SDTMP="    Telephone:  "_SDTEL

 .I SDTELEXT]"" S SDTMP=SDTMP_"   Telephone Ext.:  "_SDTELEXT

 .S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(13,10)

 I $D(SDPROV) D

 .I $D(SDC),SDPROV>0 S SDPRNM=$P(^VA(200,SDPROV,0),U,1)

 .I $D(SDC),'$D(B),$P($G(^VA(407.5,SDLET,3)),U,1)="Y" I SDPRNM]"" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="     Provider:  "_$G(SDPRNM)_$C(13,10)

 ; call handler for LAB, XRAY, and EKG tests

 I $D(B) D TST

 Q

REST(DFN,SDC,SD,LT,SDLET,SDFORM) ;WRITE THE REMAINDER OF LETTER

 N A,Z5,I,IN,X

 S A=DFN

 S SDFORM=$G(SDFORM)

 ;loop and display final section of Letter

 S IN=0 F  S IN=$O(^VA(407.5,SDLET,2,IN)) Q:IN'>0  D

 . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=^VA(407.5,SDLET,2,IN,0)_$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 D:SDFORM=1 ADDR

 Q

ADDR K VAHOW S DFN=+A S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_$$FML^DGNFUNC(DFN)_$C(13,10)

 I $D(^DG(43,1,"BT")),'$P(^("BT"),"^",3) S VAPA("P")=""

 S X1=DT,X2=5 D C^%DTC ;I '$D(VAPA("P")) S (VATEST("ADD",9),VATEST("ADD",10))=X

 D ADD^VADPT D

 .;CHANGE STATE TO ABBR.

 .N SDIENS,X

 .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

 .K SDIENS Q

 N SDCCACT1,SDCCACT2,LL

 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^SDECU(11," ")_VAPA(LL)_$C(13,10)

 .;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^SDECU(11," ")_VAPA(4)_" "_$P(VAPA(5),U,2)_"  "_$P(VAPA(11),U,2)_$C(13,10)

 .E  D  ;display postal code,city,province

 ..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(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^SDECU(11," ")_$P(VAPA(25),U,2)_$C(13,10) ;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^SDECU(11," ")_VAPA(LL)_$C(13,10)

 .I (VAPA(28)="")!($P(VAPA(28),"^",2)="UNITED STATES") D

 ..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(16)_" "_$P(VAPA(17),U,2)_"  "_$P(VAPA(18),U,2)_$C(13,10)

 .E  D

 ..S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_VAPA(27)_" "_VAPA(16)_" "_VAPA(26)_$C(13,10)

 .I ($P(VAPA(28),"^",2)'="UNITED STATES") S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(11," ")_$P(VAPA(28),U,2)_$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 D KVAR^VADPT

 Q

 ;

 ;

LAST4(DFN) ;Return patient "last four"

 N SDX

 S SDX=$G(^DPT(+DFN,0))

 Q $E(SDX)_$E($P(SDX,U,9),6,9)

 ;

BADADD ;Print patients with a Bad Address Indicator

 I '$D(^TMP($J,"BADADD")) Q

 N SDHDR,SDHDR1

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(79,"*")_$C(13,10)

 S SDHDR="BAD ADDRESS INDICATOR LIST" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU((80-$L(SDHDR)/2)," ")_SDHDR_$C(13,10)

 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"_$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="of SSN   "_"Patient Name"_$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$$FILL^SDECU(79,"*")_$C(13,10)

 N SDNAM,SDDFN

 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)=$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)

 S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDHDR1_$C(13,10)

 Q

 ;

TST ; SD*5.3*622 - handle scheduled tests

 ;S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(13,10)  ;alb/sat 665 remove blank line

 I ($L(SDCL)=3&($E(SDCL,1,3)="LAB")) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_SDCL_" SCHEDULED:  "_DOW_"  "_$J(SDDAT,12)_"  "_$J(SDT0,5)_$C(13,10)  ;alb/sat 665 add space

 I ($L(SDCL)=4&($E(SDCL,1,4)="XRAY")) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDCL_" SCHEDULED:  "_DOW_"  "_$J(SDDAT,12)_"  "_$J(SDT0,5)_$C(13,10)

 I ($L(SDCL)=3&($E(SDCL,1,3)="EKG")) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=" "_SDCL_" SCHEDULED:  "_DOW_"  "_$J(SDDAT,12)_"  "_$J(SDT0,5)_$C(13,10)  ;alb/sat 665 add space

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDEC40   10576     printed  Feb 19, 2025@00:17                                                                                                                                                                                                        Page 2

SDEC40    ;ALB/SAT,WTC,LEG - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22

 +1       ;;5.3;Scheduling;**627,665,694,785,813**;Aug 13, 1993;Build 6

 +2       ;

 +3       ;  ICR

 +4       ;  ---

 +5       ;   7024 - #40.8

 +6       ;   7025 - #43

 +7       ;   7030 - #2 (appointment record)

 +8       ;   7034 - DGNFUNC

 +9       ;  10035 - #2 (demographics)

 +10      ;  10060 - #200

 +11      ;  10061 - VAPDT

 +12      ;

 +13       QUIT 

 +14      ;

 +15      ;  APL - Print Appointment Letter

 +16      ;

APPTLETR(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       ; Called by SDEC PRINT APPT LETTER remote procedure

 +5        NEW SDECI,SDECNOD,SDECTMP,DFN,IN,RES,SCLT,SDC,SDLET,SDS,SDT,X1,X2,Y,TIMEZONE

 +6        NEW SDIV,SDFORM,SDNAM,SDSSN,VAPA

 +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       IF '+SDECAPID

               DO ERR^SDECERR("Invalid Appointment ID.")

               QUIT 

 +12       IF '$DATA(^SDEC(409.84,SDECAPID,0))

               DO ERR^SDECERR("Invalid Appointment ID.")

               QUIT 

 +13      ;D ERR^SDECERR("Invalid Letter Type.") Q

           IF $GET(LT)=""

               SET LT="P"

 +14       SET SDECNOD=^SDEC(409.84,SDECAPID,0)

 +15      ;Get appt time

           SET SDT=$PIECE(SDECNOD,U)

 +16      ;Get patient pointer to VA PATIENT (^DPT) file 2

           SET DFN=$PIECE(SDECNOD,U,5)

 +17      ;get resource and clinic

           SET RES=$PIECE(SDECNOD,U,7)

           SET SDC=$PIECE(^SDEC(409.831,RES,0),U,4)

 +18       SET SDS=^DPT(DFN,"S",SDT,0)

 +19      ;get storage position of LETTER pointer

           SET SCLT=$SELECT(LT="N":1,LT="P":2,LT="C":3,LT="A":4,1:"2")

 +20       SET SDLET=$PIECE($GET(^SC(SDC,"LTR")),U,SCLT)

 +21      ;LEG 5/17/2021 ; added missing space

           IF SDLET=""

               DO ERR^SDECERR($SELECT(SCLT=1:"No-Show",SCLT=2:"Pre-Appointment",SCLT=3:"Clinic Cancellation",1:"Patient Cancellation")_" Letter not defined for Clinic "_$PIECE(^SC(SDC,0),U)_".")

               QUIT 

 +22       SET SDIV=$PIECE(^SC(SDC,0),"^",15)

           SET SDIV=$SELECT(SDIV:SDIV,1:$ORDER(^DG(40.8,0)))

 +23       SET SDFORM=$PIECE($GET(^DG(40.8,SDIV,"LTR")),U,1)

 +24      ; data header

 +25       SET ^TMP("SDEC",$JOB,0)="T00080TEXT"_$CHAR(30)

 +26       DO PRT(DFN,SDC,SDT,LT,SDLET,SDFORM)

 +27       DO WRAPP(DFN,SDC,SDT,LT,SDLET)

 +28       DO REST(DFN,SDC,SDT,LT,SDLET,SDFORM)

 +29       SET SDECI=SDECI+1

           SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(30,31)

 +30       QUIT 

 +31      ;

 +32      ;

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       ;WRITE GREETING AND OPENING TEXT OF LETTER

 +7        NEW A,DPTNAME,IN,X,Y

 +8        SET A=DFN

 +9        if DFN=""

               QUIT 

 +10       if LT=""

               QUIT 

 +11       SET SDFORM=$GET(SDFORM)

 +12       SET Y=DT

           DO DTS^SDUTL

 +13       SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$$FILL^SDECU(64," ")_Y_$CHAR(13,10)

 +14       SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$$FILL^SDECU(64," ")_$$LAST4(A)_$CHAR(13,10)

 +15       IF 'SDFORM

               Begin DoDot:1

 +16               FOR I=1:1:4

                       SET SDECI=SDECI+1

                       SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(13,10)

 +17               DO ADDR

 +18               FOR I=1:1:4

                       SET SDECI=SDECI+1

                       SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(13,10)

               End DoDot:1

 +19      ;

 +20       SET DPTNAME("FILE")=2

           SET DPTNAME("FIELD")=".01"

           SET DPTNAME("IENS")=(+A)_","

 +21       SET X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M")

 +22      ;S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)="Dear "_$S($P(^DPT(+A,0),"^",2)="M":"Mr. ",1:"Ms. ")_X_","_$C(13,10)

 +23      ;VSE-693;LEG 5/12/21

           SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)="Dear "_X_","_$CHAR(13,10)

 +24       SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(13,10)

 +25       SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(13,10)

 +26      ;loop and display initial section of Letter

 +27       SET IN=0

           FOR 

               SET IN=$ORDER(^VA(407.5,SDLET,1,IN))

               if IN'>0

                   QUIT 

               Begin DoDot:1

 +28               SET SDECI=SDECI+1

                   SET ^TMP("SDEC",$JOB,SDECI)=^VA(407.5,SDLET,1,IN,0)_$CHAR(13,10)

               End DoDot:1

 +29       SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(13,10)

 +30       QUIT 

 +31      ;

WRAPP(DFN,SDC,SD,LT,SDLET) ;WRITE APPOINTMENT INFORMATION

 +1        NEW B,DOW,S,SDCL,SDDAT,SDHX,SDT0,SDTMP,SDX,SDX1,X

 +2       ;alb/sat 665 add S

           SET SDX=SD

           SET S=$GET(^DPT(DFN,"S",SD,0))

 +3       ; SD*5.3*622 end changes

           SET SDCL=$PIECE(^SC(+SDC,0),"^",1)

           SET SDCL="    Clinic:  "_SDCL

           DO FORM

 +4       ;

 +5       ;alb/sat 665

           SET SDX1=SDX

           if $DATA(SDS)

               SET S=SDS

           FOR B=3,4,5

               IF $PIECE(S,"^",B)]""

                   SET SDCL=$SELECT(B=3:"LAB",B=4:"XRAY",1:"EKG")

                   SET SDX=$PIECE(S,"^",B)

                   DO FORM

 +6       ;alb/sat 665

           SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(13,10)

 +7        SET (SDX,X)=SDX1

           QUIT 

 +8       ; SD*5.3*622 - add more detail for appointment and format it

FORM      ;S:$D(SDX) X=SDX S SDHX=X D DW^%DTC S DOW=X,X=SDHX 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)) ; See below wtc 6/7/18 694

 +1       ;

 +2       ;  Change display time for noon and midnight from 12:00 PM to 12:00 Noon and 12:00 Midnight

 +3       ;

 +4        SET TIMEZONE=$$TIMEZONEDATA^SDESUTIL($GET(SDC))

           SET TIMEZONE=$PIECE($GET(TIMEZONE),U)

 +5       ;

           if $DATA(SDX)

               SET X=SDX

           SET SDHX=X

           DO DW^%DTC

           SET DOW=X

           SET X=SDHX

 +6       ;

           IF $PIECE(X,".",2)=12!($PIECE(X,".",2)=24)

               SET X="12:00 "_$SELECT($PIECE(X,".",2)=12:"N",1:"M")

 +7       ;

          IF '$TEST

               XECUTE ^DD("FUNC",2,1)

 +8        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))

 +9        IF '$DATA(B)

               SET SDECI=SDECI+1

               SET ^TMP("SDEC",$JOB,SDECI)="     Date/Time: "_DOW_"  "_$JUSTIFY(SDDAT,12)_$SELECT('$DATA(B)&$DATA(SDC):$JUSTIFY(SDT0,9),1:"")_" "_TIMEZONE_$CHAR(13,10)

 +10       IF '$DATA(B)

               IF $DATA(SDC)

                   Begin DoDot:1

 +11                   SET SDECI=SDECI+1

                       SET ^TMP("SDEC",$JOB,SDECI)="    "_SDCL_$CHAR(13,10)

                   End DoDot:1

 +12      ; get default provider if defined for a given clinic, print it on the

 +13      ; letter only if we have a YES on file, same for clinic location

 +14      ; skip printing the provider label if the field is empty in file #44

 +15       NEW J,SDLOC,SDPROV,SDPRNM,SDTEL,SDTELEXT

 +16      ; physical location of the clinic

           SET SDLOC=$PIECE($GET(^SC(+SDC,0)),"^",11)

 +17      ;ajf ;050918 ;R16969456FY18

 +18      ; telephone number of clinic

           SET SDTEL=$PIECE($GET(^SC(+SDC,99)),"^",1)

 +19       SET SDTELEXT=""

           IF SDTEL]""

               IF $GET(^SC(+SDC,99.1))]""

                   Begin DoDot:1

 +20      ; telephone ext of clinic

                       SET SDTELEXT=^SC(+SDC,99.1)

                   End DoDot:1

 +21      ; get default provider, if any

 +22       FOR J=0:0

               SET J=$ORDER(^SC(+SDC,"PR",J))

               if 'J>0

                   QUIT 

               IF $PIECE($GET(^SC(+SDC,"PR",J,0)),U,2)=1

                   SET SDPROV=+$PIECE(^SC(+SDC,"PR",J,0),U,1)

 +23       IF $DATA(SDC)

               IF '$DATA(B)

                   IF $PIECE($GET(^VA(407.5,SDLET,3)),U,2)="Y"

                       Begin DoDot:1

 +24                       IF SDLOC]""

                               SET SDECI=SDECI+1

                               SET ^TMP("SDEC",$JOB,SDECI)="     "_"Location:  "_SDLOC_$CHAR(13,10)

                       End DoDot:1

 +25       IF $DATA(SDC)

               IF '$DATA(B)

                   IF SDTEL]""

                       Begin DoDot:1

 +26                       SET SDTMP="    Telephone:  "_SDTEL

 +27                       IF SDTELEXT]""

                               SET SDTMP=SDTMP_"   Telephone Ext.:  "_SDTELEXT

 +28                       SET SDECI=SDECI+1

                           SET ^TMP("SDEC",$JOB,SDECI)=SDTMP_$CHAR(13,10)

                       End DoDot:1

 +29       IF $DATA(SDPROV)

               Begin DoDot:1

 +30               IF $DATA(SDC)

                       IF SDPROV>0

                           SET SDPRNM=$PIECE(^VA(200,SDPROV,0),U,1)

 +31               IF $DATA(SDC)

                       IF '$DATA(B)

                           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)_$CHAR(13,10)

               End DoDot:1

 +32      ; call handler for LAB, XRAY, and EKG tests

 +33       IF $DATA(B)

               DO TST

 +34       QUIT 

REST(DFN,SDC,SD,LT,SDLET,SDFORM) ;WRITE THE REMAINDER OF LETTER

 +1        NEW A,Z5,I,IN,X

 +2        SET A=DFN

 +3        SET SDFORM=$GET(SDFORM)

 +4       ;loop and display final section of Letter

 +5        SET IN=0

           FOR 

               SET IN=$ORDER(^VA(407.5,SDLET,2,IN))

               if IN'>0

                   QUIT 

               Begin DoDot:1

 +6                SET SDECI=SDECI+1

                   SET ^TMP("SDEC",$JOB,SDECI)=^VA(407.5,SDLET,2,IN,0)_$CHAR(13,10)

               End DoDot:1

 +7        SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(13,10)

 +8        if SDFORM=1

               DO ADDR

 +9        QUIT 

ADDR       KILL VAHOW

           SET DFN=+A

           SET SDECI=SDECI+1

           SET ^TMP("SDEC",$JOB,SDECI)=$$FILL^SDECU(11," ")_$$FML^DGNFUNC(DFN)_$CHAR(13,10)

 +1        IF $DATA(^DG(43,1,"BT"))

               IF '$PIECE(^("BT"),"^",3)

                   SET VAPA("P")=""

 +2       ;I '$D(VAPA("P")) S (VATEST("ADD",9),VATEST("ADD",10))=X

           SET X1=DT

           SET X2=5

           DO C^%DTC

 +3        DO ADD^VADPT

           Begin DoDot:1

 +4       ;CHANGE STATE TO ABBR.

 +5            NEW SDIENS,X

 +6            IF $DATA(VAPA(5))

                   SET SDIENS=+VAPA(5)_","

                   SET X=$$GET1^DIQ(5,SDIENS,1)

                   SET $PIECE(VAPA(5),U,2)=X

 +7            IF $DATA(VAPA(17))

                   SET SDIENS=+VAPA(17)_","

                   SET X=$$GET1^DIQ(5,SDIENS,1)

                   SET $PIECE(VAPA(17),U,2)=X

 +8            KILL SDIENS

               QUIT 

           End DoDot:1

 +9        NEW SDCCACT1,SDCCACT2,LL

 +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^SDECU(11," ")_VAPA(LL)_$CHAR(13,10)

 +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^SDECU(11," ")_VAPA(4)_" "_$PIECE(VAPA(5),U,2)_"  "_$PIECE(VAPA(11),U,2)_$CHAR(13,10)

                       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^SDECU(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^SDECU(11," ")_$PIECE(VAPA(25),U,2)_$CHAR(13,10)

               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^SDECU(11," ")_VAPA(LL)_$CHAR(13,10)

 +23                   IF (VAPA(28)="")!($PIECE(VAPA(28),"^",2)="UNITED STATES")

                           Begin DoDot:2

 +24                           SET SDECI=SDECI+1

                               SET ^TMP("SDEC",$JOB,SDECI)=$$FILL^SDECU(11," ")_VAPA(16)_" "_$PIECE(VAPA(17),U,2)_"  "_$PIECE(VAPA(18),U,2)_$CHAR(13,10)

                           End DoDot:2

 +25                  IF '$TEST

                           Begin DoDot:2

 +26                           SET SDECI=SDECI+1

                               SET ^TMP("SDEC",$JOB,SDECI)=$$FILL^SDECU(11," ")_VAPA(27)_" "_VAPA(16)_" "_VAPA(26)_$CHAR(13,10)

                           End DoDot:2

 +27                   IF ($PIECE(VAPA(28),"^",2)'="UNITED STATES")