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 ---[H[J[2J[HSDEC52 16253 printed Dec 13, 2024@02:50:44 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
QUIT
if SDI<$PIECE(SDBEG,".",1)
QUIT
Begin DoDot:2
+8 SET SDDFN=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2),1:999999999)
SET LASTSUB=""
FOR
SET SDDFN=$ORDER(^SD(403.5,"D",SDI,SDDFN),-1)
if SDDFN'>0
QUIT
Begin DoDot:3
+9 ;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
+10 QUIT
RECSDCL ;get recall data for clinics ;alb/sat 658
+1 NEW SDCL,IEN,SDJ
+2 ;LASTSUB=clinic | ien
+3 IF 'SDSTOP
Begin DoDot:1
+4 SET SDCL=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1),1:"")
+5 SET SDJ=$SELECT(SDCL'="":$$PF(SDCLL,SDCL,U),1:1)
+6 FOR SDJ=SDJ:1:$LENGTH(SDCLL,U)
SET SDCL=$PIECE(SDCLL,U,SDJ)
Begin DoDot:2
+7 SET IEN=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:"")
SET LASTSUB=""
+8 FOR
SET IEN=$ORDER(^SD(403.5,"E",SDCL,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+9 SET DFN=""
DO GET1
End DoDot:3
IF SDECI>(MAXREC-1)
SET SDSUB=SDCL_"|"_IEN
QUIT
End DoDot:2
IF SDECI>(MAXREC-1)
SET SDSUB=SDCL_"|"_IEN
QUIT
End DoDot:1
+10 IF +SDSTOP
Begin DoDot:1
+11 SET SDCL=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1),1:"")
+12 SET SDJ=$SELECT(SDCL'="":$$PF(SDCLL,SDCL,U),1:1)
+13 FOR SDJ=SDJ:1:$LENGTH(SDCLL,U)
SET SDCL=$PIECE(SDCLL,U,SDJ)
Begin DoDot:2
+14 SET IEN=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:999999999)
SET LASTSUB=""
+15 FOR
SET IEN=$ORDER(^SD(403.5,"E",SDCL,IEN),-1)
if IEN'>0
QUIT
Begin DoDot:3
+16 DO GET1
End DoDot:3
IF SDECI>(MAXREC-1)
SET SDSUB=SDCL_"|"_IEN
QUIT
End DoDot:2
IF SDECI>(MAXREC-1)
SET SDSUB=SDCL_"|"_IEN
QUIT
End DoDot:1
+17 QUIT
+18 ;
RECIEN(SDECY,RECIEN) ;Get recall data for one entry
RECIEN1 ;
+1 ;Input is IEN to retieve data on
+2 NEW ACCESION,APPTLEN,CLINIEN,CLINNAME,COMM,DAPTDT,DATE,DATE1,DATE2,DATE3,DOB,ELIGIEN,ELIGNAME,FASTING
+3 NEW GAF,GENDER,HRN,IEN,INSTIEN,INSTNAME,NAME,PD,PM,PRIGRP,RRAPPTYP,RRPROVNAME,PTINFO,RRPROVIEN,SSN
+4 NEW CAT8G,SIMILAR,SUBGRP,SVCCONNP,SVVCCONN,SDBEG,SDEND,SDREC
+5 NEW PADDRES1,PADDRES2,PADDRES3,PCITY,PSTATE,PCOUNTRY,PZIP4
+6 NEW SDCNT,SDI,SDSENS,SDSUB,TYPEIEN,TYPENAME,USERIEN,USERNAME,X,Y,%DT
+7 SET SDSUB=""
+8 SET SDECY="^TMP(""SDEC52"","_$JOB_",""RECGET"")"
+9 KILL @SDECY
+10 SET SDECI=0
+11 DO HDR
+12 ;alb/sat 658 use valid FM range instead of 1000101
SET SDBEG=1410102
+13 ;alb/sat 658 use valid FM range instead of 9991231
SET SDEND=4141015
+14 SET DFN=$$GET1^DIQ(403.5,RECIEN_",",.01,"I")
IF +DFN
Begin DoDot:1
+15 DO RECGETP(DFN)
+16 DO RECGET1(DFN,RECIEN,SDBEG,SDEND)
End DoDot:1
+17 QUIT
+18 ;
RECGETP(DFN) ;get patient data
+1 ;collect demographics
+2 ;alb/sat 658 PDEMO moved ot SDECU3
DO PDEMO^SDECU3(.SDDEMO,DFN)
+3 SET NAME=SDDEMO("NAME")
+4 SET DOB=SDDEMO("DOB")
+5 SET GENDER=SDDEMO("GENDER")
+6 SET HRN=SDDEMO("HRN")
+7 SET SSN=SDDEMO("SSN")
+8 SET INSTIEN=SDDEMO("INSTIEN")
+9 SET INSTNAME=SDDEMO("INSTNAME")
+10 ;25
SET PRIGRP=SDDEMO("PRIGRP")
+11 ;26
SET ELIGIEN=SDDEMO("ELIGIEN")
+12 ;27
SET ELIGNAME=SDDEMO("ELIGNAME")
+13 ;28
SET SVVCCONN=SDDEMO("SVCCONN")
+14 ;29
SET SVCCONNP=SDDEMO("SVCCONNP")
+15 ;30
SET TYPEIEN=SDDEMO("TYPEIEN")
+16 ;31
SET TYPENAME=SDDEMO("TYPENAME")
+17 ;33 - Patient Address line 1
SET PADDRES1=SDDEMO("PADDRES1")
+18 ;34 - Patient Address line 2
SET PADDRES2=SDDEMO("PADDRES2")
+19 ;35 - Patient Address line 3
SET PADDRES3=SDDEMO("PADDRES3")
+20 ;36 - Patient City
SET PCITY=SDDEMO("PCITY")
+21 ;37 - Patient state name
SET PSTATE=SDDEMO("PSTATE")
+22 ;38 - Patient country name
SET PCOUNTRY=SDDEMO("PCOUNTRY")
+23 ;39 - Patient Zip+4
SET PZIP4=SDDEMO("PZIP+4")
+24 ;43 - Patient Phone
SET PTPHONE=SDDEMO("HPHONE")
+25 ;40
SET GAF=$$GAF^SDECU2(DFN)
+26 ;41
SET SDSENS=$$PTSEC^SDECUTL(DFN)
+27 ;
+28 SET BADADD=SDDEMO("BADADD")
+29 SET OPHONE=SDDEMO("OPHONE")
+30 SET NOK=SDDEMO("NOK")
+31 SET KNAME=SDDEMO("KNAME")
+32 SET KREL=SDDEMO("KREL")
+33 SET KPHONE=SDDEMO("KPHONE")
+34 SET KSTREET=SDDEMO("KSTREET")
+35 SET KSTREET2=SDDEMO("KSTREET2")
+36 SET KSTREET3=SDDEMO("KSTREET3")
+37 SET KCITY=SDDEMO("KCITY")
+38 SET KSTATE=SDDEMO("KSTATE")
+39 SET KZIP=SDDEMO("KZIP")
+40 SET NOK2=SDDEMO("NOK2")
+41 SET K2NAME=SDDEMO("K2NAME")
+42 SET K2REL=SDDEMO("K2REL")
+43 SET K2PHONE=SDDEMO("K2PHONE")
+44 SET K2STREET=SDDEMO("K2STREET")
+45 SET S2STREE2=SDDEMO("K2STREET2")
+46 SET K2STREET3=SDDEMO("K2STREET3")
+47 SET K2CITY=SDDEMO("K2CITY")
+48 SET K2STATE=SDDEMO("K2STATE")
+49 SET K2ZIP=SDDEMO("K2ZIP")
+50 SET PCOUNTY=SDDEMO("PCOUNTY")
+51 SET PMARITAL=SDDEMO("PMARITAL")
+52 SET PRELIGION=SDDEMO("PRELIGION")
+53 SET PTACTIVE=SDDEMO("PTACTIVE")
+54 SET PTADDRESS1=SDDEMO("PTADDRESS1")
+55 SET PTADDRESS2=SDDEMO("PTADDRESS2")
+56 SET PTADDRESS3=SDDEMO("PTADDRESS3")
+57 SET PTCITY=SDDEMO("PTCITY")
+58 SET PTSTATE=SDDEMO("PTSTATE")
+59 SET PTZIP=SDDEMO("PTZIP")
+60 SET PTZIP4=SDDEMO("PTZIP+4")
+61 SET PTCOUNTRY=SDDEMO("PTCOUNTRY")
+62 SET PTCOUNTY=SDDEMO("PTCOUNTY")
+63 SET PTMPHONE=SDDEMO("PTPHONE")
+64 SET PTSTART=SDDEMO("PTSTART")
+65 SET PTEND=SDDEMO("PTEND")
+66 SET PCELL=SDDEMO("PCELL")
+67 SET PPAGER=SDDEMO("PPAGER")
+68 SET PEMAIL=SDDEMO("PEMAIL")
+69 SET PFFFF=SDDEMO("PF_FFF")
+70 SET PFVCD=SDDEMO("PF_VCD")
+71 SET PFNATIONAL=SDDEMO("PFNATIONAL")
+72 SET PFLOCAL=SDDEMO("PFLOCAL")
+73 SET SUBGRP=$GET(SDDEMO("SUBGRP"))
+74 SET CAT8G=(PRIGRP="GROUP 8")&(SUBGRP="g")
+75 SET SIMILAR=SDDEMO("SIMILAR")
+76 QUIT
+77 ;
GET1 ;
+1 NEW PRACE,PRACEN,PETH,PETHN,PRHBLOC,PROVNAME
+2 KILL SDDATA,SDMSG
+3 ;alb/sat 651
SET SDFLAGS=$GET(SDFLAGS)
+4 SET PRHBLOC=0
+5 DO GETS^DIQ(403.5,IEN,"**","IE","SDDATA","SDMSG")
+6 ; if there is an error (SDMSG), clean up dangling cross references - SD*827
+7 IF $DATA(SDMSG)
IF '$DATA(^SD(403.5,IEN))
Begin DoDot:1
+8 NEW D0,I,STR,X,N3,N4
+9 SET D0=IEN
DO KXREF^SDRRTSK
End DoDot:1
+10 ; quit if there is an error
+11 if $DATA(SDMSG)
QUIT
+12 SET DATE=SDDATA(403.5,IEN_",",5,"I")
+13 if (DATE<SDBEG)!(DATE>SDEND)
QUIT
+14 ;alb/sat 658 get Patient
if $GET(DFN)=""
SET DFN=SDDATA(403.5,IEN_",",.01,"I")
+15 ;get PATIENT data
+16 DO RECGETP(DFN)
+17 ; 10. Accession # (free-text 1-25 characters)
SET ACCESION=SDDATA(403.5,IEN_",",2,"E")
+18 ; 11. COMMENT (free-text 1-80 characters)
SET COMM=SDDATA(403.5,IEN_",",2.5,"E")
+19 ; 12. FASTING/NON-FASTING
SET FASTING=SDDATA(403.5,IEN_",",2.6,"I")
+20 ; 13. Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51
SET RRAPPTYP=SDDATA(403.5,IEN_",",3,"I")
+21 ; 14. Pointer to RECALL REMINDERS PROVIDERS file 403.54
SET RRPROVIEN=SDDATA(403.5,IEN_",",4,"I")
+22 ; 15. Provider NAME of Provider in RECALL REMINDERS PROVIDERS file
SET PROVNAME=SDDATA(403.5,IEN_",",4,"E")
+23 ; 16. Clinic pointer to HOSPITAL LOCATION file
SET CLINIEN=SDDATA(403.5,IEN_",",4.5,"I")
+24 ; do not return if no clinic defined ;alb/sat 651
IF CLINIEN=""
IF +$EXTRACT(SDFLAGS)
QUIT
+25 ; 17. Clinic NAME from HOSPITAL LOCATION file
SET CLINNAME=SDDATA(403.5,IEN_",",4.5,"E")
+26 ;check OOS?
IF CLINIEN'=""
IF $$GET1^DIQ(44,CLINIEN_",",50.01,"I")=1
QUIT
+27 if CLINIEN'=""
SET PRHBLOC=$SELECT($$GET1^DIQ(44,+CLINIEN_",",2500,"I")="Y":1,1:0)
+28 ; 18. Length of Appointment numeric between 10 and 120
SET APPTLEN=SDDATA(403.5,IEN_",",4.7,"E")
+29 ;19. Recall Date in external format (no time)
SET DATE=SDDATA(403.5,IEN_",",5,"I")
SET DATE=$$FMTE^XLFDT(DATE)
+30 ;20. Recall Date (Per patient) in external format (no time)
SET DATE1=SDDATA(403.5,IEN_",",5.5,"I")
SET DATE1=$$FMTE^XLFDT(DATE1)
+31 ;21. Date Reminder Sent in external format (no time)
SET DAPTDT=SDDATA(403.5,IEN_",",6,"I")
SET DAPTDT=$$FMTE^XLFDT(DAPTDT)
+32 ; 22. User Who Entered Recall pointer to NEW PERSON file
SET USERIEN=SDDATA(403.5,IEN_",",7,"I")
+33 ; 23. User Who Entered Recall NAME from NEW PERSON file
SET USERNAME=SDDATA(403.5,IEN_",",7,"E")
+34 ; 32. DATE/TIME RECALL ADDED
SET DATE3=SDDATA(403.5,IEN_",",7.5,"E")
+35 if DATE3=""
SET DATE3=DATE
+36 ;24. Second Print Date in external format (no time)
SET DATE2=SDDATA(403.5,IEN_",",8,"I")
SET DATE2=$$FMTE^XLFDT(DATE2)
+37 DO RACELST^SDECU2(DFN,.PRACE,.PRACEN)
+38 ;get ethnicity
DO ETH^SDECU2(DFN,.PETH,.PETHN)
+39 ; 9
SET SDTMP=IEN_U_DFN_U_NAME_U_HRN_U_DOB_U_SSN_U_GENDER_U_INSTIEN_U_INSTNAME
+40 ;13
SET SDTMP=SDTMP_U_ACCESION_U_COMM_U_FASTING_U_RRAPPTYP
+41 ;18
SET SDTMP=SDTMP_U_RRPROVIEN_U_PROVNAME_U_CLINIEN_U_CLINNAME_U_APPTLEN
+42 ;24
SET SDTMP=SDTMP_U_DATE_U_DATE1_U_DAPTDT_U_USERIEN_U_USERNAME_U_DATE2
+43 ;29
SET SDTMP=SDTMP_U_PRIGRP_U_ELIGIEN_U_ELIGNAME_U_SVVCCONN_U_SVCCONNP
+44 ;35
SET SDTMP=SDTMP_U_TYPEIEN_U_TYPENAME_U_DATE3_U_PADDRES1_U_PADDRES2_U_PADDRES3
+45 ;41
SET SDTMP=SDTMP_U_PCITY_U_PSTATE_U_PCOUNTRY_U_PZIP4_U_GAF_U_SDSENS
+46 ;48
SET SDTMP=SDTMP_U_U_PTPHONE_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_PRHBLOC
+47 SET $PIECE(SDTMP,U,49)=BADADD
+48 SET $PIECE(SDTMP,U,50)=OPHONE
+49 SET $PIECE(SDTMP,U,51)=NOK
+50 SET $PIECE(SDTMP,U,52)=KNAME
+51 SET $PIECE(SDTMP,U,53)=KREL
+52 SET $PIECE(SDTMP,U,54)=KPHONE
+53 SET $PIECE(SDTMP,U,55)=KSTREET
+54 SET $PIECE(SDTMP,U,56)=KSTREET2
+55 SET $PIECE(SDTMP,U,57)=KSTREET3
+56 SET $PIECE(SDTMP,U,58)=KCITY
+57 SET $PIECE(SDTMP,U,59)=KSTATE
+58 SET $PIECE(SDTMP,U,60)=KZIP
+59 SET $PIECE(SDTMP,U,61)=NOK2
+60 SET $PIECE(SDTMP,U,62)=K2NAME
+61 SET $PIECE(SDTMP,U,63)=K2REL
+62 SET $PIECE(SDTMP,U,64)=K2PHONE
+63 SET $PIECE(SDTMP,U,65)=K2STREET
+64 SET $PIECE(SDTMP,U,66)=S2STREE2
+65 SET $PIECE(SDTMP,U,67)=K2STREET3
+66 SET $PIECE(SDTMP,U,68)=K2CITY
+67 SET $PIECE(SDTMP,U,69)=K2STATE
+68 SET $PIECE(SDTMP,U,70)=K2ZIP
+69 SET $PIECE(SDTMP,U,71)=PCOUNTY
+70 SET $PIECE(SDTMP,U,72)=PMARITAL
+71 SET $PIECE(SDTMP,U,73)=PRELIGION
+72 SET $PIECE(SDTMP,U,74)=PTACTIVE
+73 SET $PIECE(SDTMP,U,75)=PTADDRESS1
+74 SET $PIECE(SDTMP,U,76)=PTADDRESS2
+75 SET $PIECE(SDTMP,U,77)=PTADDRESS3
+76 SET $PIECE(SDTMP,U,78)=PTCITY
+77 SET $PIECE(SDTMP,U,79)=PTSTATE
+78 SET $PIECE(SDTMP,U,80)=PTZIP
+79 SET $PIECE(SDTMP,U,81)=PTZIP4
+80 SET $PIECE(SDTMP,U,82)=PTCOUNTRY
+81 SET $PIECE(SDTMP,U,83)=PTCOUNTY
+82 SET $PIECE(SDTMP,U,84)=PTMPHONE
+83 SET $PIECE(SDTMP,U,85)=PTSTART
+84 SET $PIECE(SDTMP,U,86)=PTEND
+85 SET $PIECE(SDTMP,U,87)=PCELL
+86 SET $PIECE(SDTMP,U,88)=PPAGER
+87 SET $PIECE(SDTMP,U,89)=PEMAIL
+88 SET $PIECE(SDTMP,U,90)=PFFFF
+89 SET $PIECE(SDTMP,U,91)=PFVCD
+90 SET $PIECE(SDTMP,U,92)=PFNATIONAL
+91 SET $PIECE(SDTMP,U,93)=PFLOCAL
+92 SET $PIECE(SDTMP,U,94)=SUBGRP
+93 SET $PIECE(SDTMP,U,95)=CAT8G
+94 SET $PIECE(SDTMP,U,96)=SIMILAR
+95 ; SDECALL_U_SDECLET 97^98 GET CALL AND LETTER DATA ;CT - *745 5/12/20
SET SDREC=$$RECALL^SDECAR1A(DFN,RECIEN)
SET $PIECE(SDTMP,U,97)=$PIECE(SDREC,U,1)
SET $PIECE(SDTMP,U,98)=$PIECE(SDREC,U,2)
+96 ;813 CEMAIL
SET $PIECE(SDTMP,U,99)=$PIECE(SDREC,U,3)
+97 ;813 CTEXT
SET $PIECE(SDTMP,U,100)=$PIECE(SDREC,U,4)
+98 ;813 CSEC
SET $PIECE(SDTMP,U,101)=$PIECE(SDREC,U,5)
+99 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
+100 QUIT
+101 ;
PF(STRING,SUB,DI) ;piece find
+1 NEW SDI
+2 SET STRING=$GET(STRING)
if STRING=""
QUIT ""
+3 SET SUB=$GET(SUB)
if SUB=""
QUIT ""
+4 SET DI=$GET(DI)
if DI=""
SET DI=U
+5 FOR SDI=1:1:$LENGTH(STRING,DI)
if $PIECE(STRING,DI,SDI)=SUB
QUIT
+6 QUIT SDI
