SDEC52.m

SDEC52 ;ALB/SAT,CT,LAB,BWF - VISTA SCHEDULING RPCS ;OCT 19, 2022

 ;;5.3;Scheduling;**627,642,651,658,745,813,827**;Aug 13, 1993;Build 10

 ;

 Q

 ;

RECGET(SDECY,DFN,SDBEG,SDEND,MAXREC,LASTSUB,RECIEN,SDSTOP,SDFLAGS,SDCLL) ; GET entries from the RECALL REMINDERS file 403.5 for a given Patient and Recall Date range. ;alb/sat 658 add SDCLL

RECGETA ;

 N SDCL,SDDATA,SDECI,SDDEMO,SDMSG,SDTMP   ;alb/sat 658 added SDCL

 N ACCESION,APPTLEN,CLINIEN,CLINNAME,COMM,DAPTDT,DATE,DATE1,DATE2,DATE3,DOB,ELIGIEN,ELIGNAME,ERR,FASTING  ;alb/sat 658 added ERR

 N GAF,GENDER,HRN,IEN,INSTIEN,INSTNAME,NAME,PD,PM,PRIGRP,RRAPPTYP,RRPROVNAME,PTINFO,RRPROVIEN,SSN

 N SVCCONNP,SVVCCONN,SDDFN

 N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PTPHONE,PZIP4

 N SDCNT,SDI,SDJ,SDSENS,SDSUB,TYPEIEN,TYPENAME,USERIEN,USERNAME,X,Y,%DT

 N BADADD,OPHONE,NOK,KNAME,KREL,KPHONE,KSTREET,KSTREET2,KSTREET3,KCITY,KSTATE,KZIP

 N NOK2,K2NAME,K2REL,K2PHONE,K2STREET,S2STREE2,K2STREET3,K2CITY,K2STATE,K2ZIP,PCOUNTY

 N PMARITAL,PRELIGION,PTACTIVE,PTADDRESS1,PTADDRESS2,PTADDRESS3,PTCITY,PTSTATE,PTZIP,PTZIP4

 N PTCOUNTRY,PTCOUNTY,PTMPHONE,PTSTART,PTEND,PCELL,PPAGER,PEMAIL,PFFFF,PFVCD,PFNATIONAL,PFLOCAL

 ;

 S ERR=0  ;alb/sat 658

 S SDSUB=""

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

 K @SDECY

 S SDECI=0

 D HDR

 ;validate SDFLAGS (optional)  ;alb/sat 651

 S SDFLAGS=$G(SDFLAGS)

 ;validate RECIEN (optional)

 S RECIEN=$G(RECIEN)

 I RECIEN'="" I '$D(^SD(403.5,RECIEN,0)) D ERR1^SDECERR(-1,"Invalid Recall Reminders ID.",SDECI,SDECY) Q

 I RECIEN'="" D RECIEN1 G RECX

 S SDCNT=0

 ;validate SDBEG

 S SDBEG=$G(SDBEG)

 I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825)

 I $G(SDBEG)="" S SDBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1825)

 ;validate SDEND (optional)

 S SDEND=$G(SDEND)

 I SDEND'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90)

 I SDEND="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90)

 ;validate SDSTOP (optional)

 S SDSTOP=$G(SDSTOP)

 ;validate DFN (optional)

 S DFN=$G(DFN)

 I DFN'="" I '$D(^DPT(DFN,0)) S DFN=""

 ;get all records for a specific patient

 I +DFN D RECGET1(DFN,,SDBEG,SDEND,SDFLAGS) G RECX   ;alb/sat 651 - add SDFLAGS

 ;get records in specified date range

 ;validate MAXREC (optional)

 S MAXREC=$G(MAXREC) I 'MAXREC S MAXREC=9999999

 ;validate LASTSUB (optional)

 S LASTSUB=$G(LASTSUB)

 ;validate SDCLL (optional)  ;alb/sat 658

 S SDCLL=$G(SDCLL)

 I SDCLL'="" D

 .F SDJ=1:1:$L(SDCLL,U) S SDCL=+$P(SDCLL,U,SDJ) D  Q:ERR

 ..I '$D(^SD(403.5,SDCL,0)) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31),ERR=1 Q

 .D RECSDCL

 Q:ERR

 G:SDCLL'="" RECX

 ;get Recalls for date range

 D RECGETD

RECX S SDTMP=@SDECY@(SDECI) S SDTMP=$P(SDTMP,$C(30),1)

 S:$G(SDSUB)'="" $P(SDTMP,U,42)=SDSUB

 S @SDECY@(SDECI)=SDTMP_$C(30,31)

 Q

 ;

HDR ;Print out the header

 S SDTMP="T00030IEN^T00030DFN^T00030NAME^T00030HRN^T00030DOB^T00030SSN^T00030GENDER^T00030INSTIEN^T00030INSTNAME"

 S SDTMP=SDTMP_"^T00030ACCESION^T00080COMM^T00030FASTING^T00030RRAPPTYP"

 S SDTMP=SDTMP_"^T00030RRPROVIEN^T00030PROVNAME^T00030CLINIEN^T00030CLINNAME^T00030APPTLEN"

 S SDTMP=SDTMP_"^T00030DATE^T00030DATE1^T00030DAPTDT^T00030USERIEN^T00030USERNAME^T00030DATE2"

 S SDTMP=SDTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"

 S SDTMP=SDTMP_"^T00030TYPEIEN^T00030TYPENAME^T00030DATE3^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3"

 S SDTMP=SDTMP_"^T00030PCITY^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00030GAF^T00100SENSITIVE^T00030LASTSUB^T00030PTPHONE"

 S SDTMP=SDTMP_"^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN^T00030PRHBLOC"

 S SDTMP=SDTMP_"^T00030BADDADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE"

 S SDTMP=SDTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP"

 S SDTMP=SDTMP_"^T00030NOK2^T00030K2NAME^T00030N2REL^T00030K2PHONE"

 S SDTMP=SDTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP"

 S SDTMP=SDTMP_"^T00030PCOUNTY^T00030PMARITAL^T00030PRELIGION^T00030PTACTIVE"

 S SDTMP=SDTMP_"^T00030PTADDRESS1^T00030PTADDRESS2^T00030PTADDRESS3^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4"

 S SDTMP=SDTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTMPHONE^T00030PTSTART^T00030PTEND"

 S SDTMP=SDTMP_"^T00030PCELL^T00030PPAGER^T00030PEMAIL^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL"

 S SDTMP=SDTMP_"^T00030SUBGRP^T00030CAT8G^T01000SIMILAR^T00030CPHONE^T00030CLET"    ;added call phone & letter *745 5/14/20

 S SDTMP=SDTMP_"^T00030CEMAIL^T00030CTEXT^T00030CSEC"    ;added call phone & letter *745 5/14/20

 S @SDECY@(SDECI)=SDTMP_$C(30)

 Q

 ;

RECGET1(DFN,IEN,SDBEG,SDEND,SDFLAGS) ;get all recall data for 1 patient  ;alb/sat 651 - add SDFLAGS

 ; DFN = (required) patient ID pointer to PATIENT file 2

 ; IEN - (optional) recall ID pointer to RECALL REMINDERS file

 ;                  all records in date range will be return if IEN=""

 N X,Y,%DT

 S SDFLAGS=$G(SDFLAGS)   ;alb/sat 651

 ;check for valid Patient (required)

 I '$D(^DPT(+$G(DFN),0)) D ERR1^SDECERR(-1,"Invalid Patient ID",SDECI,SDECY) Q

 ;check begin date (optional)

 I $G(SDBEG)'="" S %DT="" S X=$P($G(SDBEG),"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=1410102   ;alb/sat 658 use valid FM range instead of 1000101

 I $G(SDBEG)="" S SDBEG=1410102   ;alb/sat 658 use valid FM range instead of 1000101

 ;check end date (optional)

 I $G(SDEND)'="" S %DT="" S X=$P($G(SDEND),"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90)

 I $G(SDEND)="" S SDEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-90)

 ;get RECALL REMINDERS data

 S IEN=$G(IEN)

 I IEN'="" D GET1 Q

 I IEN="" F  S IEN=$O(^SD(403.5,"B",DFN,IEN)) Q:IEN=""  D GET1

 Q

 ;

RECGETD ;get recall data for date range

 S SDFLAGS=$G(SDFLAGS)  ;alb/sat 651

 I 'SDSTOP D

 .S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)-1,1:SDBEG-1) F  S SDI=$O(^SD(403.5,"D",SDI)) Q:SDI'>0  Q:SDI>$P(SDEND,".",1)  D  I SDECI>(MAXREC-1) S SDSUB=SDI_"|"_$S(SDDFN>0:SDDFN,1:"") Q

 ..S SDDFN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:"") S LASTSUB="" F  S SDDFN=$O(^SD(403.5,"D",SDI,SDDFN)) Q:SDDFN'>0  D  Q:SDECI>(MAXREC-1)

 ...S DFN=$$GET1^DIQ(403.5,SDDFN_",",.01,"I")  D RECGET1(DFN,SDDFN,SDBEG,SDEND,SDFLAGS)  ;alb/sat 651 - add SDFLAGS

 I +SDSTOP D

 .S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)+1,1:SDEND+1) F  S SDI=$O(^SD(403.5,"D",SDI),-1) Q:SDI'>0  Q:SDI<$P(SDBEG,".",1)  D  I SDECI>(MAXREC-1) S SDSUB=SDI_"|"_$S(SDDFN>0:SDDFN,1:"") Q

 ..S SDDFN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:999999999) S LASTSUB="" F  S SDDFN=$O(^SD(403.5,"D",SDI,SDDFN),-1) Q:SDDFN'>0  D  Q:SDECI>(MAXREC-1)

 ...S DFN=$$GET1^DIQ(403.5,SDDFN_",",.01,"I")  D RECGET1(DFN,SDDFN,SDBEG,SDEND,SDFLAGS)  ;alb/sat 651 - add SDFLAGS

 Q

RECSDCL ;get recall data for clinics   ;alb/sat 658

 N SDCL,IEN,SDJ

 ;LASTSUB=clinic | ien

 I 'SDSTOP D

 .S SDCL=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:"")

 .S SDJ=$S(SDCL'="":$$PF(SDCLL,SDCL,U),1:1)

 .F SDJ=SDJ:1:$L(SDCLL,U) S SDCL=$P(SDCLL,U,SDJ) D  I SDECI>(MAXREC-1) S SDSUB=SDCL_"|"_IEN Q

 ..S IEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:"") S LASTSUB=""

 ..F  S IEN=$O(^SD(403.5,"E",SDCL,IEN)) Q:IEN'>0  D  I SDECI>(MAXREC-1) S SDSUB=SDCL_"|"_IEN Q

 ...S DFN="" D GET1

 I +SDSTOP D

 .S SDCL=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:"")

 .S SDJ=$S(SDCL'="":$$PF(SDCLL,SDCL,U),1:1)

 .F SDJ=SDJ:1:$L(SDCLL,U) S SDCL=$P(SDCLL,U,SDJ) D  I SDECI>(MAXREC-1) S SDSUB=SDCL_"|"_IEN Q

 ..S IEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:999999999) S LASTSUB=""

 ..F  S IEN=$O(^SD(403.5,"E",SDCL,IEN),-1) Q:IEN'>0  D  I SDECI>(MAXREC-1) S SDSUB=SDCL_"|"_IEN Q

 ...D GET1

 Q

 ;

RECIEN(SDECY,RECIEN) ;Get recall data for one entry

RECIEN1 ;

 ;Input is IEN to retieve data on

 N ACCESION,APPTLEN,CLINIEN,CLINNAME,COMM,DAPTDT,DATE,DATE1,DATE2,DATE3,DOB,ELIGIEN,ELIGNAME,FASTING

 N GAF,GENDER,HRN,IEN,INSTIEN,INSTNAME,NAME,PD,PM,PRIGRP,RRAPPTYP,RRPROVNAME,PTINFO,RRPROVIEN,SSN

 N CAT8G,SIMILAR,SUBGRP,SVCCONNP,SVVCCONN,SDBEG,SDEND,SDREC

 N PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PZIP4

 N SDCNT,SDI,SDSENS,SDSUB,TYPEIEN,TYPENAME,USERIEN,USERNAME,X,Y,%DT

 S SDSUB=""

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

 K @SDECY

 S SDECI=0

 D HDR

 S SDBEG=1410102   ;alb/sat 658 use valid FM range instead of 1000101

 S SDEND=4141015   ;alb/sat 658 use valid FM range instead of 9991231

 S DFN=$$GET1^DIQ(403.5,RECIEN_",",.01,"I")  I +DFN D

 .D RECGETP(DFN)

 .D RECGET1(DFN,RECIEN,SDBEG,SDEND)

 Q

 ;

RECGETP(DFN) ;get patient data

 ;collect demographics

 D PDEMO^SDECU3(.SDDEMO,DFN)  ;alb/sat 658 PDEMO moved ot SDECU3

 S NAME=SDDEMO("NAME")

 S DOB=SDDEMO("DOB")

 S GENDER=SDDEMO("GENDER")

 S HRN=SDDEMO("HRN")

 S SSN=SDDEMO("SSN")

 S INSTIEN=SDDEMO("INSTIEN")

 S INSTNAME=SDDEMO("INSTNAME")

 S PRIGRP=SDDEMO("PRIGRP")       ;25

 S ELIGIEN=SDDEMO("ELIGIEN")     ;26

 S ELIGNAME=SDDEMO("ELIGNAME")   ;27

 S SVVCCONN=SDDEMO("SVCCONN")    ;28

 S SVCCONNP=SDDEMO("SVCCONNP")   ;29

 S TYPEIEN=SDDEMO("TYPEIEN")     ;30

 S TYPENAME=SDDEMO("TYPENAME")   ;31

 S PADDRES1=SDDEMO("PADDRES1")   ;33   - Patient Address line 1

 S PADDRES2=SDDEMO("PADDRES2")   ;34   - Patient Address line 2

 S PADDRES3=SDDEMO("PADDRES3")   ;35  - Patient Address line 3

 S PCITY=SDDEMO("PCITY")         ;36   - Patient City

 S PSTATE=SDDEMO("PSTATE")       ;37   - Patient state name

 S PCOUNTRY=SDDEMO("PCOUNTRY")   ;38   - Patient country name

 S PZIP4=SDDEMO("PZIP+4")        ;39   - Patient Zip+4

 S PTPHONE=SDDEMO("HPHONE")      ;43   - Patient Phone

 S GAF=$$GAF^SDECU2(DFN)         ;40

 S SDSENS=$$PTSEC^SDECUTL(DFN)   ;41

 ;

 S BADADD=SDDEMO("BADADD")

 S OPHONE=SDDEMO("OPHONE")

 S NOK=SDDEMO("NOK")

 S KNAME=SDDEMO("KNAME")

 S KREL=SDDEMO("KREL")

 S KPHONE=SDDEMO("KPHONE")

 S KSTREET=SDDEMO("KSTREET")

 S KSTREET2=SDDEMO("KSTREET2")

 S KSTREET3=SDDEMO("KSTREET3")

 S KCITY=SDDEMO("KCITY")

 S KSTATE=SDDEMO("KSTATE")

 S KZIP=SDDEMO("KZIP")

 S NOK2=SDDEMO("NOK2")

 S K2NAME=SDDEMO("K2NAME")

 S K2REL=SDDEMO("K2REL")

 S K2PHONE=SDDEMO("K2PHONE")

 S K2STREET=SDDEMO("K2STREET")

 S S2STREE2=SDDEMO("K2STREET2")

 S K2STREET3=SDDEMO("K2STREET3")

 S K2CITY=SDDEMO("K2CITY")

 S K2STATE=SDDEMO("K2STATE")

 S K2ZIP=SDDEMO("K2ZIP")

 S PCOUNTY=SDDEMO("PCOUNTY")

 S PMARITAL=SDDEMO("PMARITAL")

 S PRELIGION=SDDEMO("PRELIGION")

 S PTACTIVE=SDDEMO("PTACTIVE")

 S PTADDRESS1=SDDEMO("PTADDRESS1")

 S PTADDRESS2=SDDEMO("PTADDRESS2")

 S PTADDRESS3=SDDEMO("PTADDRESS3")

 S PTCITY=SDDEMO("PTCITY")

 S PTSTATE=SDDEMO("PTSTATE")

 S PTZIP=SDDEMO("PTZIP")

 S PTZIP4=SDDEMO("PTZIP+4")

 S PTCOUNTRY=SDDEMO("PTCOUNTRY")

 S PTCOUNTY=SDDEMO("PTCOUNTY")

 S PTMPHONE=SDDEMO("PTPHONE")

 S PTSTART=SDDEMO("PTSTART")

 S PTEND=SDDEMO("PTEND")

 S PCELL=SDDEMO("PCELL")

 S PPAGER=SDDEMO("PPAGER")

 S PEMAIL=SDDEMO("PEMAIL")

 S PFFFF=SDDEMO("PF_FFF")

 S PFVCD=SDDEMO("PF_VCD")

 S PFNATIONAL=SDDEMO("PFNATIONAL")

 S PFLOCAL=SDDEMO("PFLOCAL")

 S SUBGRP=$G(SDDEMO("SUBGRP"))

 S CAT8G=(PRIGRP="GROUP 8")&(SUBGRP="g")

 S SIMILAR=SDDEMO("SIMILAR")

 Q

 ;

GET1 ;

 N PRACE,PRACEN,PETH,PETHN,PRHBLOC,PROVNAME

 K SDDATA,SDMSG

 S SDFLAGS=$G(SDFLAGS)  ;alb/sat 651

 S PRHBLOC=0

 D GETS^DIQ(403.5,IEN,"**","IE","SDDATA","SDMSG")

 ; if there is an error (SDMSG), clean up dangling cross references - SD*827

 I $D(SDMSG),'$D(^SD(403.5,IEN)) D

 .N D0,I,STR,X,N3,N4

 .S D0=IEN D KXREF^SDRRTSK

 ; quit if there is an error

 Q:$D(SDMSG)

 S DATE=SDDATA(403.5,IEN_",",5,"I")

 Q:(DATE<SDBEG)!(DATE>SDEND)

 S:$G(DFN)="" DFN=SDDATA(403.5,IEN_",",.01,"I") ;alb/sat 658 get Patient

 ;get PATIENT data

 D RECGETP(DFN)

 S ACCESION=SDDATA(403.5,IEN_",",2,"E")   ;    10. Accession # (free-text 1-25 characters)

 S COMM=SDDATA(403.5,IEN_",",2.5,"E")     ;    11. COMMENT (free-text 1-80 characters)

 S FASTING=SDDATA(403.5,IEN_",",2.6,"I")  ;    12. FASTING/NON-FASTING

 S RRAPPTYP=SDDATA(403.5,IEN_",",3,"I")   ;    13. Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51

 S RRPROVIEN=SDDATA(403.5,IEN_",",4,"I")  ;    14. Pointer to RECALL REMINDERS PROVIDERS file 403.54

 S PROVNAME=SDDATA(403.5,IEN_",",4,"E")   ;    15. Provider NAME of Provider in RECALL REMINDERS PROVIDERS file

 S CLINIEN=SDDATA(403.5,IEN_",",4.5,"I")  ;    16. Clinic pointer to HOSPITAL LOCATION file

 I CLINIEN="",+$E(SDFLAGS) Q              ;        do not return if no clinic defined  ;alb/sat 651

 S CLINNAME=SDDATA(403.5,IEN_",",4.5,"E") ;    17. Clinic NAME from HOSPITAL LOCATION file

 I CLINIEN'="",$$GET1^DIQ(44,CLINIEN_",",50.01,"I")=1 Q   ;check OOS?

 S:CLINIEN'="" PRHBLOC=$S($$GET1^DIQ(44,+CLINIEN_",",2500,"I")="Y":1,1:0)

 S APPTLEN=SDDATA(403.5,IEN_",",4.7,"E")  ;    18. Length of Appointment  numeric between 10 and 120

 S DATE=SDDATA(403.5,IEN_",",5,"I") S DATE=$$FMTE^XLFDT(DATE)           ;19. Recall Date in external format (no time)

 S DATE1=SDDATA(403.5,IEN_",",5.5,"I") S DATE1=$$FMTE^XLFDT(DATE1)      ;20. Recall Date (Per patient) in external format (no time)

 S DAPTDT=SDDATA(403.5,IEN_",",6,"I") S DAPTDT=$$FMTE^XLFDT(DAPTDT)     ;21. Date Reminder Sent in external format (no time)

 S USERIEN=SDDATA(403.5,IEN_",",7,"I")    ;    22. User Who Entered Recall pointer to NEW PERSON file

 S USERNAME=SDDATA(403.5,IEN_",",7,"E")   ;    23. User Who Entered Recall NAME from NEW PERSON file

 S DATE3=SDDATA(403.5,IEN_",",7.5,"E")     ;    32. DATE/TIME RECALL ADDED

 S:DATE3="" DATE3=DATE

 S DATE2=SDDATA(403.5,IEN_",",8,"I") S DATE2=$$FMTE^XLFDT(DATE2)        ;24. Second Print Date in external format (no time)

 D RACELST^SDECU2(DFN,.PRACE,.PRACEN)

 D ETH^SDECU2(DFN,.PETH,.PETHN)   ;get ethnicity

 S SDTMP=IEN_U_DFN_U_NAME_U_HRN_U_DOB_U_SSN_U_GENDER_U_INSTIEN_U_INSTNAME      ; 9

 S SDTMP=SDTMP_U_ACCESION_U_COMM_U_FASTING_U_RRAPPTYP                          ;13

 S SDTMP=SDTMP_U_RRPROVIEN_U_PROVNAME_U_CLINIEN_U_CLINNAME_U_APPTLEN           ;18

 S SDTMP=SDTMP_U_DATE_U_DATE1_U_DAPTDT_U_USERIEN_U_USERNAME_U_DATE2            ;24

 S SDTMP=SDTMP_U_PRIGRP_U_ELIGIEN_U_ELIGNAME_U_SVVCCONN_U_SVCCONNP             ;29

 S SDTMP=SDTMP_U_TYPEIEN_U_TYPENAME_U_DATE3_U_PADDRES1_U_PADDRES2_U_PADDRES3   ;35

 S SDTMP=SDTMP_U_PCITY_U_PSTATE_U_PCOUNTRY_U_PZIP4_U_GAF_U_SDSENS              ;41

 S SDTMP=SDTMP_U_U_PTPHONE_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_PRHBLOC           ;48

 S $P(SDTMP,U,49)=BADADD

 S $P(SDTMP,U,50)=OPHONE

 S $P(SDTMP,U,51)=NOK

 S $P(SDTMP,U,52)=KNAME

 S $P(SDTMP,U,53)=KREL

 S $P(SDTMP,U,54)=KPHONE

 S $P(SDTMP,U,55)=KSTREET

 S $P(SDTMP,U,56)=KSTREET2

 S $P(SDTMP,U,57)=KSTREET3

 S $P(SDTMP,U,58)=KCITY

 S $P(SDTMP,U,59)=KSTATE

 S $P(SDTMP,U,60)=KZIP

 S $P(SDTMP,U,61)=NOK2

 S $P(SDTMP,U,62)=K2NAME

 S $P(SDTMP,U,63)=K2REL

 S $P(SDTMP,U,64)=K2PHONE

 S $P(SDTMP,U,65)=K2STREET

 S $P(SDTMP,U,66)=S2STREE2

 S $P(SDTMP,U,67)=K2STREET3

 S $P(SDTMP,U,68)=K2CITY

 S $P(SDTMP,U,69)=K2STATE

 S $P(SDTMP,U,70)=K2ZIP

 S $P(SDTMP,U,71)=PCOUNTY

 S $P(SDTMP,U,72)=PMARITAL

 S $P(SDTMP,U,73)=PRELIGION

 S $P(SDTMP,U,74)=PTACTIVE

 S $P(SDTMP,U,75)=PTADDRESS1

 S $P(SDTMP,U,76)=PTADDRESS2

 S $P(SDTMP,U,77)=PTADDRESS3

 S $P(SDTMP,U,78)=PTCITY

 S $P(SDTMP,U,79)=PTSTATE

 S $P(SDTMP,U,80)=PTZIP

 S $P(SDTMP,U,81)=PTZIP4

 S $P(SDTMP,U,82)=PTCOUNTRY

 S $P(SDTMP,U,83)=PTCOUNTY

 S $P(SDTMP,U,84)=PTMPHONE

 S $P(SDTMP,U,85)=PTSTART

 S $P(SDTMP,U,86)=PTEND

 S $P(SDTMP,U,87)=PCELL

 S $P(SDTMP,U,88)=PPAGER

 S $P(SDTMP,U,89)=PEMAIL

 S $P(SDTMP,U,90)=PFFFF

 S $P(SDTMP,U,91)=PFVCD

 S $P(SDTMP,U,92)=PFNATIONAL

 S $P(SDTMP,U,93)=PFLOCAL

 S $P(SDTMP,U,94)=SUBGRP

 S $P(SDTMP,U,95)=CAT8G

 S $P(SDTMP,U,96)=SIMILAR

 S SDREC=$$RECALL^SDECAR1A(DFN,RECIEN),$P(SDTMP,U,97)=$P(SDREC,U,1),$P(SDTMP,U,98)=$P(SDREC,U,2) ; SDECALL_U_SDECLET  97^98  GET CALL AND LETTER DATA ;CT - *745 5/12/20

 S $P(SDTMP,U,99)=$P(SDREC,U,3) ;813 CEMAIL

 S $P(SDTMP,U,100)=$P(SDREC,U,4) ;813 CTEXT

 S $P(SDTMP,U,101)=$P(SDREC,U,5) ;813 CSEC

 S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)

 Q

 ;

PF(STRING,SUB,DI)  ;piece find

 N SDI

 S STRING=$G(STRING) Q:STRING="" ""

 S SUB=$G(SUB) Q:SUB="" ""

 S DI=$G(DI) S:DI="" DI=U

 F SDI=1:1:$L(STRING,DI) Q:$P(STRING,DI,SDI)=SUB

 Q SDI

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDEC52   16253     printed  Mar 13, 2025@21:55:46                                                                                                                                                                                                     Page 2

SDEC52    ;ALB/SAT,CT,LAB,BWF - VISTA SCHEDULING RPCS ;OCT 19, 2022

 +1       ;;5.3;Scheduling;**627,642,651,658,745,813,827**;Aug 13, 1993;Build 10

 +2       ;

 +3        QUIT 

 +4       ;

RECGET(SDECY,DFN,SDBEG,SDEND,MAXREC,LASTSUB,RECIEN,SDSTOP,SDFLAGS,SDCLL) ; GET entries from the RECALL REMINDERS file 403.5 for a given Patient and Recall Date range. ;alb/sat 658 add SDCLL

RECGETA   ;

 +1       ;alb/sat 658 added SDCL

           NEW SDCL,SDDATA,SDECI,SDDEMO,SDMSG,SDTMP

 +2       ;alb/sat 658 added ERR

           NEW ACCESION,APPTLEN,CLINIEN,CLINNAME,COMM,DAPTDT,DATE,DATE1,DATE2,DATE3,DOB,ELIGIEN,ELIGNAME,ERR,FASTING

 +3        NEW GAF,GENDER,HRN,IEN,INSTIEN,INSTNAME,NAME,PD,PM,PRIGRP,RRAPPTYP,RRPROVNAME,PTINFO,RRPROVIEN,SSN

 +4        NEW SVCCONNP,SVVCCONN,SDDFN

 +5        NEW PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PTPHONE,PZIP4

 +6        NEW SDCNT,SDI,SDJ,SDSENS,SDSUB,TYPEIEN,TYPENAME,USERIEN,USERNAME,X,Y,%DT

 +7        NEW BADADD,OPHONE,NOK,KNAME,KREL,KPHONE,KSTREET,KSTREET2,KSTREET3,KCITY,KSTATE,KZIP

 +8        NEW NOK2,K2NAME,K2REL,K2PHONE,K2STREET,S2STREE2,K2STREET3,K2CITY,K2STATE,K2ZIP,PCOUNTY

 +9        NEW PMARITAL,PRELIGION,PTACTIVE,PTADDRESS1,PTADDRESS2,PTADDRESS3,PTCITY,PTSTATE,PTZIP,PTZIP4

 +10       NEW PTCOUNTRY,PTCOUNTY,PTMPHONE,PTSTART,PTEND,PCELL,PPAGER,PEMAIL,PFFFF,PFVCD,PFNATIONAL,PFLOCAL

 +11      ;

 +12      ;alb/sat 658

           SET ERR=0

 +13       SET SDSUB=""

 +14       SET SDECY="^TMP(""SDEC52"","_$JOB_",""RECGET"")"

 +15       KILL @SDECY

 +16       SET SDECI=0

 +17       DO HDR

 +18      ;validate SDFLAGS (optional)  ;alb/sat 651

 +19       SET SDFLAGS=$GET(SDFLAGS)

 +20      ;validate RECIEN (optional)

 +21       SET RECIEN=$GET(RECIEN)

 +22       IF RECIEN'=""

               IF '$DATA(^SD(403.5,RECIEN,0))

                   DO ERR1^SDECERR(-1,"Invalid Recall Reminders ID.",SDECI,SDECY)

                   QUIT 

 +23       IF RECIEN'=""

               DO RECIEN1

               GOTO RECX

 +24       SET SDCNT=0

 +25      ;validate SDBEG

 +26       SET SDBEG=$GET(SDBEG)

 +27       IF $GET(SDBEG)'=""

               SET %DT=""

               SET X=$PIECE($GET(SDBEG),"@",1)

               DO ^%DT

               SET SDBEG=Y

               IF Y=-1

                   SET SDBEG=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-1825)

 +28       IF $GET(SDBEG)=""

               SET SDBEG=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-1825)

 +29      ;validate SDEND (optional)

 +30       SET SDEND=$GET(SDEND)

 +31       IF SDEND'=""

               SET %DT=""

               SET X=$PIECE($GET(SDEND),"@",1)

               DO ^%DT

               SET SDEND=Y

               IF Y=-1

                   SET SDEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-90)

 +32       IF SDEND=""

               SET SDEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-90)

 +33      ;validate SDSTOP (optional)

 +34       SET SDSTOP=$GET(SDSTOP)

 +35      ;validate DFN (optional)

 +36       SET DFN=$GET(DFN)

 +37       IF DFN'=""

               IF '$DATA(^DPT(DFN,0))

                   SET DFN=""

 +38      ;get all records for a specific patient

 +39      ;alb/sat 651 - add SDFLAGS

           IF +DFN

               DO RECGET1(DFN,,SDBEG,SDEND,SDFLAGS)

               GOTO RECX

 +40      ;get records in specified date range

 +41      ;validate MAXREC (optional)

 +42       SET MAXREC=$GET(MAXREC)

           IF 'MAXREC

               SET MAXREC=9999999

 +43      ;validate LASTSUB (optional)

 +44       SET LASTSUB=$GET(LASTSUB)

 +45      ;validate SDCLL (optional)  ;alb/sat 658

 +46       SET SDCLL=$GET(SDCLL)

 +47       IF SDCLL'=""

               Begin DoDot:1

 +48               FOR SDJ=1:1:$LENGTH(SDCLL,U)

                       SET SDCL=+$PIECE(SDCLL,U,SDJ)

                       Begin DoDot:2

 +49                       IF '$DATA(^SD(403.5,SDCL,0))

                               SET @SDECY@(1)="-1^Invalid clinic ID."_$CHAR(30,31)

                               SET ERR=1

                               QUIT 

                       End DoDot:2

                       if ERR

                           QUIT 

 +50               DO RECSDCL

               End DoDot:1

 +51       if ERR

               QUIT 

 +52       if SDCLL'=""

               GOTO RECX

 +53      ;get Recalls for date range

 +54       DO RECGETD

RECX       SET SDTMP=@SDECY@(SDECI)

           SET SDTMP=$PIECE(SDTMP,$CHAR(30),1)

 +1        if $GET(SDSUB)'=""

               SET $PIECE(SDTMP,U,42)=SDSUB

 +2        SET @SDECY@(SDECI)=SDTMP_$CHAR(30,31)

 +3        QUIT 

 +4       ;

HDR       ;Print out the header

 +1        SET SDTMP="T00030IEN^T00030DFN^T00030NAME^T00030HRN^T00030DOB^T00030SSN^T00030GENDER^T00030INSTIEN^T00030INSTNAME"

 +2        SET SDTMP=SDTMP_"^T00030ACCESION^T00080COMM^T00030FASTING^T00030RRAPPTYP"

 +3        SET SDTMP=SDTMP_"^T00030RRPROVIEN^T00030PROVNAME^T00030CLINIEN^T00030CLINNAME^T00030APPTLEN"

 +4        SET SDTMP=SDTMP_"^T00030DATE^T00030DATE1^T00030DAPTDT^T00030USERIEN^T00030USERNAME^T00030DATE2"

 +5        SET SDTMP=SDTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"

 +6        SET SDTMP=SDTMP_"^T00030TYPEIEN^T00030TYPENAME^T00030DATE3^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3"

 +7        SET SDTMP=SDTMP_"^T00030PCITY^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00030GAF^T00100SENSITIVE^T00030LASTSUB^T00030PTPHONE"

 +8        SET SDTMP=SDTMP_"^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN^T00030PRHBLOC"

 +9        SET SDTMP=SDTMP_"^T00030BADDADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE"

 +10       SET SDTMP=SDTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP"

 +11       SET SDTMP=SDTMP_"^T00030NOK2^T00030K2NAME^T00030N2REL^T00030K2PHONE"

 +12       SET SDTMP=SDTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP"

 +13       SET SDTMP=SDTMP_"^T00030PCOUNTY^T00030PMARITAL^T00030PRELIGION^T00030PTACTIVE"

 +14       SET SDTMP=SDTMP_"^T00030PTADDRESS1^T00030PTADDRESS2^T00030PTADDRESS3^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4"

 +15       SET SDTMP=SDTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTMPHONE^T00030PTSTART^T00030PTEND"

 +16       SET SDTMP=SDTMP_"^T00030PCELL^T00030PPAGER^T00030PEMAIL^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL"

 +17      ;added call phone & letter *745 5/14/20

           SET SDTMP=SDTMP_"^T00030SUBGRP^T00030CAT8G^T01000SIMILAR^T00030CPHONE^T00030CLET"

 +18      ;added call phone & letter *745 5/14/20

           SET SDTMP=SDTMP_"^T00030CEMAIL^T00030CTEXT^T00030CSEC"

 +19       SET @SDECY@(SDECI)=SDTMP_$CHAR(30)

 +20       QUIT 

 +21      ;

RECGET1(DFN,IEN,SDBEG,SDEND,SDFLAGS) ;get all recall data for 1 patient  ;alb/sat 651 - add SDFLAGS

 +1       ; DFN = (required) patient ID pointer to PATIENT file 2

 +2       ; IEN - (optional) recall ID pointer to RECALL REMINDERS file

 +3       ;                  all records in date range will be return if IEN=""

 +4        NEW X,Y,%DT

 +5       ;alb/sat 651

           SET SDFLAGS=$GET(SDFLAGS)

 +6       ;check for valid Patient (required)

 +7        IF '$DATA(^DPT(+$GET(DFN),0))

               DO ERR1^SDECERR(-1,"Invalid Patient ID",SDECI,SDECY)

               QUIT 

 +8       ;check begin date (optional)

 +9       ;alb/sat 658 use valid FM range instead of 1000101

           IF $GET(SDBEG)'=""

               SET %DT=""

               SET X=$PIECE($GET(SDBEG),"@",1)

               DO ^%DT

               SET SDBEG=Y

               IF Y=-1

                   SET SDBEG=1410102

 +10      ;alb/sat 658 use valid FM range instead of 1000101

           IF $GET(SDBEG)=""

               SET SDBEG=1410102

 +11      ;check end date (optional)

 +12       IF $GET(SDEND)'=""

               SET %DT=""

               SET X=$PIECE($GET(SDEND),"@",1)

               DO ^%DT

               SET SDEND=Y

               IF Y=-1

                   SET SDEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-90)

 +13       IF $GET(SDEND)=""

               SET SDEND=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,".",1),-90)

 +14      ;get RECALL REMINDERS data

 +15       SET IEN=$GET(IEN)

 +16       IF IEN'=""

               DO GET1

               QUIT 

 +17       IF IEN=""

               FOR 

                   SET IEN=$ORDER(^SD(403.5,"B",DFN,IEN))

                   if IEN=""

                       QUIT 

                   DO GET1

 +18       QUIT 

 +19      ;

RECGETD   ;get recall data for date range

 +1       ;alb/sat 651

           SET SDFLAGS=$GET(SDFLAGS)

 +2        IF 'SDSTOP

               Begin DoDot:1

 +3                SET SDI=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1)-1,1:SDBEG-1)

                   FOR 

                       SET SDI=$ORDER(^SD(403.5,"D",SDI))

                       if SDI'>0

                           QUIT 

                       if SDI>$PIECE(SDEND,".",1)

                           QUIT 

                       Begin DoDot:2

 +4                        SET SDDFN=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2),1:"")

                           SET LASTSUB=""

                           FOR 

                               SET SDDFN=$ORDER(^SD(403.5,"D",SDI,SDDFN))

                               if SDDFN'>0

                                   QUIT 

                               Begin DoDot:3

 +5       ;alb/sat 651 - add SDFLAGS

                                   SET DFN=$$GET1^DIQ(403.5,SDDFN_",",.01,"I")

                                   DO RECGET1(DFN,SDDFN,SDBEG,SDEND,SDFLAGS)

                               End DoDot:3

                               if SDECI>(MAXREC-1)

                                   QUIT 

                       End DoDot:2

                       IF SDECI>(MAXREC-1)

                           SET SDSUB=SDI_"|"_$SELECT(SDDFN>0:SDDFN,1:"")

                           QUIT 

               End DoDot:1

 +6        IF +SDSTOP

               Begin DoDot:1

 +7                SET SDI=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1)+1,1:SDEND+1)

                   FOR 

                       SET SDI=$ORDER(^SD(403.5,"D",SDI),-1)

                       if SDI'>0