SDECWL1 ;ALB/SAT,CT - VISTA SCHEDULING RPCS ;MAY 12, 2020@12:25
;;5.3;Scheduling;**627,642,658,745**;Aug 13, 1993;Build 40
;
Q
;
; Get SD WAIT LIST for all entries in the user's Institution
; where the Current Status is not C(losed).
WLGET(RET,WLIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRL,SVCR,SCVISIT,CLINIC,ORIGDT) ;Waitlist GET ;alb/sat 658 add SVCL-ORIGDT
WLGETA ;
;
N CLOSED,DES,FNUM,WLORIGDT,WLINST,WLINSTNM,WLTYPE,WLTEAM,WLPOS
N ELIGIEN,ELIGNAME,FRULES,GLOREF
N SDK,SDSUB,SDTMP,SVC,WLSSIEN,WLSSNAME,WLCLIEN,WLCLNAME
N WLUSER,WLPRIO,WLREQBY,WLPROV,WLPROVNM,WLDAPTDT,WLCOMM,WLEESTAT,WLUSRNM
N WLCLIENL,WLEDT,WLIEN,PTINFOLSTA,WLDISPD,WLDISPU,WLDISPUN,WLSVCCON
N WLSTAT,COUNT,STR,SDRTMP,SDWAIT
N PCITY,GAF,PPC,WLENPRI,WLASD,WLPC,WLDATA
N SDI,SDJ,SDMTRC,SDSENS,X,Y,%DT
S RET="^TMP(""SDEC"","_$J_")"
K @RET
S FNUM=$$FNUM^SDECWL,COUNT=0
S MAXREC=+$G(MAXREC,50)
D HDR
S GLOREF=$NA(^SDWL(409.3,"C",DUZ(2)))
S FRULES=1
S WLIEN=0
;F S WLIEN=$O(@GLOREF@(WLIEN)) Q:'WLIEN D ONEPAT I MAXREC,COUNT'<MAXREC Q
S SDBEG=$G(SDBEG)
I SDBEG'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=3100101
I SDBEG="" S SDBEG=3100101
S SDEND=$G(SDEND)
I SDEND'="" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y I Y=-1 S SDEND=$$FMADD^XLFDT($E($$NOW^XLFDT,1,12),-90)
I SDEND="" S SDEND=$$FMADD^XLFDT($E($$NOW^XLFDT,1,12),-90)
S DFN=$G(DFN)
I DFN'="",'$D(^DPT(DFN,0)) S DFN=""
S LASTSUB=$S(DFN="":$G(LASTSUB),1:"")
S SDTOP=+$G(SDTOP)
;single IEN
S WLIEN1=$G(WLIEN1)
I +WLIEN1 I '$D(^SDWL(409.3,+WLIEN1,0)) S COUNT=COUNT+1 S @RET@(COUNT)="-1^Invalid Wait List ID." Q ;S WLIEN1=""
I +WLIEN1 D
.S WLIEN=+WLIEN1
.S FRULES=0 ;no rules - just return the single record
.D ONEPAT
I +WLIEN1 S @RET@(COUNT)=@RET@(COUNT)_$C(31) Q
;by patient
I +DFN D
.I 'SDTOP S WLIEN=0 F S WLIEN=$O(^SDWL(409.3,"B",+DFN,WLIEN)) Q:WLIEN'>0 D ONEPAT ;I MAXREC,COUNT'<MAXREC Q
.I SDTOP S WLIEN=999999999 F S WLIEN=$O(^SDWL(409.3,"B",+DFN,WLIEN),-1) Q:WLIEN'>0 D ONEPAT ;I MAXREC,COUNT'<MAXREC Q
;alb/sat 658 start modifications
;validate ORIGDT
S ORIGDT=$G(ORIGDT)
;validate CLINIC
S CLINIC=$G(CLINIC)
;validate SVCL
S SVCL=$G(SVCL)
I SVCL'="" D
.F SDI=$L(SVCL,"|"):-1:1 S SVC=$P(SVCL,"|",SDI) D
..I (SVC="")!('$D(^DIC(40.7,+SVC,0))) S SVCL=$$PD^SDECUTL(SVCL,SDI,"|")
;validate DESDT
S DESDT=$G(DESDT)
;validate PRL
S PRL=$G(PRL)
I PRL'="" D
.N PR
.F SDI=$L(PRL,"|"):-1:1 S PR=$P(PRL,"|",SDI) D
..I "012345678"'[PR S PR=$E(PR,7)
..I "012345678"'[PR S PRL=$$PD^SDECUTL(PRL,SDI,"|")
;validate SVCR
S SVCR=$G(SVCR) S:SVCR'="" SVCR=$$UP^XLFSTR(SVCR)
I SVCR'="" S SVCR=$S(SVCR="Y":1,SVCR="N":0,SVCR="YES":1,SVCR="NO":0,1:"")
;validate SCVISIT
S SCVISIT=$G(SCVISIT) S:SCVISIT'="" SCVISIT=$$UP^XLFSTR(SCVISIT)
I SCVISIT'="" S SCVISIT=$S(SCVISIT="Y":"Y",SCVISIT="N":"N",SCVISIT="YES":"Y",SCVISIT="NO":"N",1:"")
;
;clinic
I CLINIC'="" D G WLX
.S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:1)
.F SDI=SDI:1:$L(CLINIC,"|") S SDCL=$P(CLINIC,"|",SDI) D I MAXREC,COUNT'<MAXREC Q
..Q:SDCL=""
..I DESDT'="" D Q ;GCC DESDT desired dates by pipe
...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:1)
...F SDT=SDT:1:$L(DESDT,"|") S DES=$P(DESDT,"|",SDT) D I MAXREC,COUNT'<MAXREC Q
....Q:DES=""
....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
....F S WLIEN=$O(^SDWL(409.3,"GCC",SDCL,DES,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDCL_"|"_SDT_"|"_WLIEN Q
.....D ONEPAT
..;
..S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,ORIGDT'="":ORIGDT-1,1:SDBEG-1) ;GC
..F S SDT=$O(^SDWL(409.3,"GC",SDCL,SDT)) Q:SDT="" Q:((ORIGDT'="")&(SDT>ORIGDT)) Q:(ORIGDT="")&(SDT>SDEND) D I MAXREC,COUNT'<MAXREC Q
...S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
...F S WLIEN=$O(^SDWL(409.3,"GC",SDCL,SDT,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDI_"|"_SDT_"|"_WLIEN Q
....D ONEPAT
;clinic stop/services
I SVCL'="" D G WLX
.N PR1,SDT
.S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:1)
.F SDI=SDI:1:$L(SVCL,"|") S SVC=$P(SVCL,"|",SDI) D I MAXREC,COUNT'<MAXREC Q
..Q:SVC=""
..;I DESDTR'="" D ;desired date range range <begin> ~ <end> not implemented
..I DESDT'="" D Q ;GSC DESDT desired dates by pipe
...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:1)
...F SDT=SDT:1:$L(DESDT,"|") S DES=$P(DESDT,"|",SDT) D I MAXREC,COUNT'<MAXREC Q
....Q:DES=""
....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
....F S WLIEN=$O(^SDWL(409.3,"GSC",SVC,DES,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDT_"|"_WLIEN Q
.....D ONEPAT
..I PRL'="" D Q ;GSP
...S SDK=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:1)
...F SDK=SDK:1:$L(PRL,"|") S PR1=$P(PRL,"|",SDK) D I MAXREC,COUNT'<MAXREC Q
....S SDT=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3)-1,1:SDBEG-1)
....F S SDT=$O(^SDWL(409.3,"GSP",SVC,PR1,SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
.....S WLIEN=$S($P(LASTSUB,"|",4)'="":$P(LASTSUB,"|",4),1:0)
.....F S WLIEN=$O(^SDWL(409.3,"GSP",SVC,PR1,SDT,WLIEN)) Q:WLIEN="" D ONEPAT I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDK_"|"_SDT_"|"_WLIEN Q
..I SVCR'="" D Q ;GSB - WL service connected
...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:SDBEG-1)
...F S SDT=$O(^SDWL(409.3,"GSB",SVC,$E(SVCR),SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
....F S WLIEN=$O(^SDWL(409.3,"GSB",SVC,$E(SVCR),SDT,WLIEN)) Q:WLIEN="" D ONEPAT I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDT_"|"_WLIEN Q
..I SCVISIT'="" D Q ;GSA - Patient Service Connected
...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:SDBEG-1)
...F S SDT=$O(^SDWL(409.3,"GSA",SVC,$E(SCVISIT),SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
....F S WLIEN=$O(^SDWL(409.3,"GSA",SVC,$E(SCVISIT),SDT,WLIEN)) Q:WLIEN="" D ONEPAT I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDT_"|"_WLIEN Q
..S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:SDBEG-1) ;GS
..F S SDT=$O(^SDWL(409.3,"GS",SVC,SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
...S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
...F S WLIEN=$O(^SDWL(409.3,"GS",SVC,SDT,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDI_"|"_SDT_"|"_WLIEN Q
....D ONEPAT
;all by date range
I 'DFN D
.I 'SDTOP D
..S SDJ=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)-1,1:SDBEG-1)
..F S SDJ=$O(^SDWL(409.3,"E","O",SDJ)) Q:SDJ'>0 Q:SDJ>SDEND D I MAXREC,COUNT'<MAXREC Q
...S WLIEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:0) S LASTSUB=""
...F S WLIEN=$O(^SDWL(409.3,"E","O",SDJ,WLIEN)) Q:WLIEN'>0 D I MAXREC,COUNT'<MAXREC S SDSUB=SDJ_"|"_WLIEN Q
....S SDSUB=""
....D ONEPAT
.I +SDTOP D
..S SDJ=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)+1,1:SDEND+1)
..F S SDJ=$O(^SDWL(409.3,"E","O",SDJ),-1) Q:SDJ'>0 Q:SDJ<SDBEG D I MAXREC,COUNT'<MAXREC Q
...S WLIEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:999999999) S LASTSUB=""
...F S WLIEN=$O(^SDWL(409.3,"E","O",SDJ,WLIEN),-1) Q:WLIEN'>0 D I MAXREC,COUNT'<MAXREC S SDSUB=SDJ_"|"_WLIEN Q
....S SDSUB=""
....D ONEPAT
WLX S SDTMP=@RET@(COUNT) S SDTMP=$P(SDTMP,$C(30),1)
S:$G(SDSUB)'="" $P(SDTMP,U,56)=SDSUB
S @RET@(COUNT)=SDTMP_$C(30,31)
Q
;
HDR ;Output header
; 1 2
S SDRTMP="T00030DFN^T00030NAME"
; 3 4 5 6 7 8
S SDRTMP=SDRTMP_"^T00030HRN2^T00030DOB^T00030SSN^T00030GENDER^I00010IEN^D00030ORIGDT"
; 9 10 11 12 13
S SDRTMP=SDRTMP_"^T00030INSTIEN^T00030INSTNAME^T00030TYPE^T00030TEAM^T00030POS"
; 14 15 16 17
S SDRTMP=SDRTMP_"^T00030SRVSPIEN^T00030SRVSPNAME^T00030CLINIEN^T00030CLINNAME"
; 18 19 20 21 22 23
S SDRTMP=SDRTMP_"^T00030USERIEN^T00030USERNAME^T00030PRIO^T00030REQBY^T00030PROVIEN^T00030PROVNAME"
; 24 25 26 27 28
S SDRTMP=SDRTMP_"^T00030DAPTDT^T00250COMM^T00030EESTAT^T00030PTELEPHONE^T00030ENROLLMENT_PRIORITY"
S SDRTMP=SDRTMP_"^T00250APPT_SCHED_DATE^T00010MULTIPLE APPOINTMENT RTC^T00010MULT APPT RTC INTERVAL"
S SDRTMP=SDRTMP_"^T00010MULT APPT NUMBER"
; 36
S SDRTMP=SDRTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"
S SDRTMP=SDRTMP_"^T00030TYPEIEN^T00030TYPENAME^T00100PCONTACT^T00030WLDISPD^T00030WLDISPU^T00030WLDISPUN"
; 44 45 46 47 48
S SDRTMP=SDRTMP_"^T00030WLSVCCON^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3^T00030PCITY"
; 49 50 51 52 53 54
S SDRTMP=SDRTMP_"^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00050GAF^T00030DATE^T00030MTRCDATES"
S SDRTMP=SDRTMP_"^T00100SENSITIVE^T00030LASTSUB^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN"
S SDRTMP=SDRTMP_"^T00030APPTYPE^T00030PRHBLOC" ;62
S SDRTMP=SDRTMP_"^T00030HRN^T00030BADADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE" ;69
S SDRTMP=SDRTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP" ;75
S SDRTMP=SDRTMP_"^T00030NOK2^T00030K2NAME^T00030K2REL^T00030K2PHONE" ;79
S SDRTMP=SDRTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP^T00030PCOUNTY" ;86
S SDRTMP=SDRTMP_"^T00030PETH^T00030PRACE^T00030PMARITAL^T00030PRELIGION^T00030PTACTIVE" ;91
S SDRTMP=SDRTMP_"^T00030PTADDRESS1^T00030PTADDRESS2^T00030PTADDRESS3^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4" ;98
S SDRTMP=SDRTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTMPPHONE^T00030PTSTART^T00030PTEND^T00030PCELL^T00030PPAGER^T00030PEMAIL" ;106
S SDRTMP=SDRTMP_"^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL^T00030SUBGRP^T00030CAT8G^T01000SIMILAR" ;113
S SDRTMP=SDRTMP_"^T00030CPHONE^T00030CLET" ;115 added call phone & letter *745 5/14/20
S @RET@(COUNT)=SDRTMP_$C(30)
Q
ONEPAT ; Process one patient
;D GETS^DIQ(FNUM,WLIEN,"23;.01;.05;1;2;4;5;6;7;8;8.5;9;10,10.5;11;12;12.5;22;25;27","IE","WLDATA","WLMSG")
N SDCL,SDI,WLSDOA,WLDAM,WLCLERK,WLCLERKN
N APPTYPE,PRACE,PRACEN,PETH,PETHN,PRHBLOC
K WLDATA
S FRULES=$G(FRULES)
D GETS^DIQ(FNUM,WLIEN,"**","IE","WLDATA","WLMSG")
S WLSTAT=WLDATA(FNUM,WLIEN_",",23,"I")
I FRULES I '+$G(CLOSED) Q:WLSTAT="C" ; Ignore CLOSED records; CLOSED setup and used from SDEC54 only
S WLORIGDT=WLDATA(FNUM,WLIEN_",",1,"I")
I FRULES I ($P(WLORIGDT,".",1)<SDBEG)!($P(WLORIGDT,".",1)>SDEND) Q
S DFN=WLDATA(FNUM,WLIEN_",",.01,"I")
Q:DFN=""
S WLCLIENL=WLDATA(FNUM,WLIEN_",",8,"I")
S SDCL=WLDATA(FNUM,WLIEN_",",8.5,"I")
I SDCL="" S SDCL=$$GET1^DIQ(409.32,WLCLIENL_",",.01,"I")
Q:(SDCL'="")&($$GET1^DIQ(44,SDCL_",",50.01,"I")=1) ;check OOS? in file 44
S PRHBLOC=$S($$GET1^DIQ(44,SDCL_",",2500,"I")="Y":1,1:0)
S GAF=$$GAF^SDECU2(DFN)
D RACELST^SDECU2(DFN,.PRACE,.PRACEN)
D ETH^SDECU2(DFN,.PETH,.PETHN) ;get ethnicity
S WLINST=WLDATA(FNUM,WLIEN_",",2,"I")
S WLINSTNM=WLDATA(FNUM,WLIEN_",",2,"E")
S WLTYPE=WLDATA(FNUM,WLIEN_",",4,"I")
Q:"34"'[WLTYPE ;only look for SERVICE/SPECIALITY or SPECIFIC CLINIC ;todo-need xref
S WLTEAM=WLDATA(FNUM,WLIEN_",",5,"I")
S WLPOS=WLDATA(FNUM,WLIEN_",",6,"I")
S WLSSIEN=WLDATA(FNUM,WLIEN_",",7,"I")
S WLSSNAME=WLDATA(FNUM,WLIEN_",",7,"E")
S WLCLIEN=$P($G(^SDWL(409.32,+WLCLIENL,0)),U,1)
S WLCLNAME=WLDATA(FNUM,WLIEN_",",8,"E")
S APPTYPE=WLDATA(FNUM,WLIEN_",",8.7,"I")
S WLUSER=WLDATA(FNUM,WLIEN_",",9,"I")
S WLUSRNM=WLDATA(FNUM,WLIEN_",",9,"E")
S WLEDT=$G(WLDATA(FNUM,WLIEN_",",9.5,"E")) ;53
S WLPRIO=WLDATA(FNUM,WLIEN_",",10,"I")
S WLENPRI=WLDATA(FNUM,WLIEN_",",10.5,"E") ;msc/sat
S WLREQBY=WLDATA(FNUM,WLIEN_",",11,"I")
S WLPROV=$S(WLREQBY=1:WLDATA(FNUM,WLIEN_",",12,"I"),1:"") ;alb/sat 658 - only when REQBY is provider
S WLPROVNM=$S(WLREQBY=1:WLDATA(FNUM,WLIEN_",",12,"E"),1:"") ;alb/sat 658 - only when REQBY is provider
S WLSDOA=WLDATA(FNUM,WLIEN_",",13,"E") ;scheduled date of appt
S WLDAM=WLDATA(FNUM,WLIEN_",",13.1,"E") ;date appt. made
S WLCLERK=WLDATA(FNUM,WLIEN_",",13.7,"I") ;appt clerk
S WLCLERKN=WLDATA(FNUM,WLIEN_",",13.7,"E") ;appt clerk name
S WLSVCCON=WLDATA(FNUM,WLIEN_",",15,"E")
S WLDAPTDT=WLDATA(FNUM,WLIEN_",",22,"I")
S WLCOMM=WLDATA(FNUM,WLIEN_",",25,"I")
S WLEESTAT=WLDATA(FNUM,WLIEN_",",27,"I")
S WLASD=""
S:WLSDOA'="" $P(WLASD,"~~",1)=WLSDOA
S:WLCLERK'="" $P(WLASD,"~~",12)=WLCLERK
S:WLCLERKN'="" $P(WLASD,"~~",13)=WLCLERKN
S:WLDAM'="" $P(WLASD,"~~",17)=WLDAM
S WLPC=$$WLPC(.WLDATA,WLIEN)
S WLDISPD=WLDATA(FNUM,WLIEN_",",19,"E")
S WLDISPU=WLDATA(FNUM,WLIEN_",",20,"I")
S WLDISPUN=WLDATA(FNUM,WLIEN_",",20,"E")
S SDSENS=$$PTSEC^SDECUTL(DFN)
S SDMTRC="" ;S (SDI,SDMTRC)="" F S SDI=$O(WLDATA(409.37,SDI)) Q:SDI="" S SDMTRC=$S(SDMTRC'="":SDMTRC_"|",1:"")_WLDATA(409.37,SDI,.01,"E")
S COUNT=COUNT+1
; 1 2 3 4 5 6 7 8 9 10 11 12 13
S STR=DFN_U_""_U_""_U_""_U_""_U_""_U_WLIEN_U_WLORIGDT_U_WLINST_U_WLINSTNM_U_WLTYPE_U_WLTEAM_U_WLPOS
; 14 15 16 17 18 19 20 21 22
S STR=STR_U_WLSSIEN_U_WLSSNAME_U_WLCLIEN_U_WLCLNAME_U_WLUSER_U_WLUSRNM_U_WLPRIO_U_WLREQBY_U_WLPROV
S STR=STR_U_WLPROVNM_U_WLDAPTDT_U_WLCOMM_U_WLEESTAT_U_""_U_WLENPRI_U_WLASD_U_""_U_""_U_"" ;32
S STR=STR_U_""_U_""_U_""_U_""_U_""_U_""_U_""_U_WLPC ;40
S STR=STR_U_WLDISPD_U_WLDISPU_U_WLDISPUN_U_WLSVCCON_U_""_U_""_U_""_U_""_U_"" ;49
; 50 51 52 53 54 55 56 57 58 59 60 61
S STR=STR_U_""_U_""_U_GAF_U_WLEDT_U_""_U_SDSENS_U_""_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_APPTYPE
S STR=STR_U_PRHBLOC ;62
D WLDEMO^SDECWL3(.STR,DFN)
;S STR=STR_U_0_U_"" ; SET DEFAULT SDCALL TO 0 AND SDECLET TO NULL UNTIL FURTHER TESTING
;COMMENT OUT NEXT LINE INTIL FURTHER TESTING ; PWC *745
S SDWAIT=$$CALLWL^SDECAR1A(DFN,WLIEN),STR=STR_U_$P(SDWAIT,U,1)_U_$P(SDWAIT,U,2) ;SDCALL_U_SDECLET 114^115 COMPUTE CLAL AND LETTER DATA CT - *745 5/12/20
S @RET@(COUNT)=STR_$C(30)
Q
;
WLPC(WLDATA,ASDIEN) ;
N PC,PC1,PCIEN
S PC=""
S PCIEN="" F S PCIEN=$O(WLDATA(409.344,PCIEN)) Q:PCIEN="" D
.Q:$P(PCIEN,",",2)'=ASDIEN
.S PC1=""
.S $P(PC1,"~~",1)=WLDATA(409.344,PCIEN,.01,"E") ;DATE ENTERED
.S $P(PC1,"~~",2)=WLDATA(409.344,PCIEN,2,"I") ;PC ENTERED BY USER IEN
.S $P(PC1,"~~",3)=WLDATA(409.344,PCIEN,2,"E") ;PC ENTERED BY USER NAME
.S $P(PC1,"~~",4)=WLDATA(409.344,PCIEN,3,"E") ;ACTION
.S $P(PC1,"~~",5)=WLDATA(409.344,PCIEN,4,"E") ;PATIENT PHONE
.S PC=$S(PC'="":PC_"::",1:"")_PC1
Q PC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECWL1 15163 printed Oct 16, 2024@18:53:34 Page 2
SDECWL1 ;ALB/SAT,CT - VISTA SCHEDULING RPCS ;MAY 12, 2020@12:25
+1 ;;5.3;Scheduling;**627,642,658,745**;Aug 13, 1993;Build 40
+2 ;
+3 QUIT
+4 ;
+5 ; Get SD WAIT LIST for all entries in the user's Institution
+6 ; where the Current Status is not C(losed).
WLGET(RET,WLIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRL,SVCR,SCVISIT,CLINIC,ORIGDT) ;Waitlist GET ;alb/sat 658 add SVCL-ORIGDT
WLGETA ;
+1 ;
+2 NEW CLOSED,DES,FNUM,WLORIGDT,WLINST,WLINSTNM,WLTYPE,WLTEAM,WLPOS
+3 NEW ELIGIEN,ELIGNAME,FRULES,GLOREF
+4 NEW SDK,SDSUB,SDTMP,SVC,WLSSIEN,WLSSNAME,WLCLIEN,WLCLNAME
+5 NEW WLUSER,WLPRIO,WLREQBY,WLPROV,WLPROVNM,WLDAPTDT,WLCOMM,WLEESTAT,WLUSRNM
+6 NEW WLCLIENL,WLEDT,WLIEN,PTINFOLSTA,WLDISPD,WLDISPU,WLDISPUN,WLSVCCON
+7 NEW WLSTAT,COUNT,STR,SDRTMP,SDWAIT
+8 NEW PCITY,GAF,PPC,WLENPRI,WLASD,WLPC,WLDATA
+9 NEW SDI,SDJ,SDMTRC,SDSENS,X,Y,%DT
+10 SET RET="^TMP(""SDEC"","_$JOB_")"
+11 KILL @RET
+12 SET FNUM=$$FNUM^SDECWL
SET COUNT=0
+13 SET MAXREC=+$GET(MAXREC,50)
+14 DO HDR
+15 SET GLOREF=$NAME(^SDWL(409.3,"C",DUZ(2)))
+16 SET FRULES=1
+17 SET WLIEN=0
+18 ;F S WLIEN=$O(@GLOREF@(WLIEN)) Q:'WLIEN D ONEPAT I MAXREC,COUNT'<MAXREC Q
+19 SET SDBEG=$GET(SDBEG)
+20 IF SDBEG'=""
SET %DT=""
SET X=$PIECE(SDBEG,"@",1)
DO ^%DT
SET SDBEG=Y
IF Y=-1
SET SDBEG=3100101
+21 IF SDBEG=""
SET SDBEG=3100101
+22 SET SDEND=$GET(SDEND)
+23 IF SDEND'=""
SET %DT=""
SET X=$PIECE(SDEND,"@",1)
DO ^%DT
SET SDEND=Y
IF Y=-1
SET SDEND=$$FMADD^XLFDT($EXTRACT($$NOW^XLFDT,1,12),-90)
+24 IF SDEND=""
SET SDEND=$$FMADD^XLFDT($EXTRACT($$NOW^XLFDT,1,12),-90)
+25 SET DFN=$GET(DFN)
+26 IF DFN'=""
IF '$DATA(^DPT(DFN,0))
SET DFN=""
+27 SET LASTSUB=$SELECT(DFN="":$GET(LASTSUB),1:"")
+28 SET SDTOP=+$GET(SDTOP)
+29 ;single IEN
+30 SET WLIEN1=$GET(WLIEN1)
+31 ;S WLIEN1=""
IF +WLIEN1
IF '$DATA(^SDWL(409.3,+WLIEN1,0))
SET COUNT=COUNT+1
SET @RET@(COUNT)="-1^Invalid Wait List ID."
QUIT
+32 IF +WLIEN1
Begin DoDot:1
+33 SET WLIEN=+WLIEN1
+34 ;no rules - just return the single record
SET FRULES=0
+35 DO ONEPAT
End DoDot:1
+36 IF +WLIEN1
SET @RET@(COUNT)=@RET@(COUNT)_$CHAR(31)
QUIT
+37 ;by patient
+38 IF +DFN
Begin DoDot:1
+39 ;I MAXREC,COUNT'<MAXREC Q
IF 'SDTOP
SET WLIEN=0
FOR
SET WLIEN=$ORDER(^SDWL(409.3,"B",+DFN,WLIEN))
if WLIEN'>0
QUIT
DO ONEPAT
+40 ;I MAXREC,COUNT'<MAXREC Q
IF SDTOP
SET WLIEN=999999999
FOR
SET WLIEN=$ORDER(^SDWL(409.3,"B",+DFN,WLIEN),-1)
if WLIEN'>0
QUIT
DO ONEPAT
End DoDot:1
+41 ;alb/sat 658 start modifications
+42 ;validate ORIGDT
+43 SET ORIGDT=$GET(ORIGDT)
+44 ;validate CLINIC
+45 SET CLINIC=$GET(CLINIC)
+46 ;validate SVCL
+47 SET SVCL=$GET(SVCL)
+48 IF SVCL'=""
Begin DoDot:1
+49 FOR SDI=$LENGTH(SVCL,"|"):-1:1
SET SVC=$PIECE(SVCL,"|",SDI)
Begin DoDot:2
+50 IF (SVC="")!('$DATA(^DIC(40.7,+SVC,0)))
SET SVCL=$$PD^SDECUTL(SVCL,SDI,"|")
End DoDot:2
End DoDot:1
+51 ;validate DESDT
+52 SET DESDT=$GET(DESDT)
+53 ;validate PRL
+54 SET PRL=$GET(PRL)
+55 IF PRL'=""
Begin DoDot:1
+56 NEW PR
+57 FOR SDI=$LENGTH(PRL,"|"):-1:1
SET PR=$PIECE(PRL,"|",SDI)
Begin DoDot:2
+58 IF "012345678"'[PR
SET PR=$EXTRACT(PR,7)
+59 IF "012345678"'[PR
SET PRL=$$PD^SDECUTL(PRL,SDI,"|")
End DoDot:2
End DoDot:1
+60 ;validate SVCR
+61 SET SVCR=$GET(SVCR)
if SVCR'=""
SET SVCR=$$UP^XLFSTR(SVCR)
+62 IF SVCR'=""
SET SVCR=$SELECT(SVCR="Y":1,SVCR="N":0,SVCR="YES":1,SVCR="NO":0,1:"")
+63 ;validate SCVISIT
+64 SET SCVISIT=$GET(SCVISIT)
if SCVISIT'=""
SET SCVISIT=$$UP^XLFSTR(SCVISIT)
+65 IF SCVISIT'=""
SET SCVISIT=$SELECT(SCVISIT="Y":"Y",SCVISIT="N":"N",SCVISIT="YES":"Y",SCVISIT="NO":"N",1:"")
+66 ;
+67 ;clinic
+68 IF CLINIC'=""
Begin DoDot:1
+69 SET SDI=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1),1:1)
+70 FOR SDI=SDI:1:$LENGTH(CLINIC,"|")
SET SDCL=$PIECE(CLINIC,"|",SDI)
Begin DoDot:2
+71 if SDCL=""
QUIT
+72 ;GCC DESDT desired dates by pipe
IF DESDT'=""
Begin DoDot:3
+73 SET SDT=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:1)
+74 FOR SDT=SDT:1:$LENGTH(DESDT,"|")
SET DES=$PIECE(DESDT,"|",SDT)
Begin DoDot:4
+75 if DES=""
QUIT
+76 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+77 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"GCC",SDCL,DES,WLIEN))
if WLIEN=""
QUIT
Begin DoDot:5
+78 DO ONEPAT
End DoDot:5
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SDCL_"|"_SDT_"|"_WLIEN
QUIT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:3
QUIT
+79 ;
+80 ;GC
SET SDT=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,ORIGDT'="":ORIGDT-1,1:SDBEG-1)
+81 FOR
SET SDT=$ORDER(^SDWL(409.3,"GC",SDCL,SDT))
if SDT=""
QUIT
if ((ORIGDT'="")&(SDT>ORIGDT))
QUIT
if (ORIGDT="")&(SDT>SDEND)
QUIT
Begin DoDot:3
+82 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+83 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"GC",SDCL,SDT,WLIEN))
if WLIEN=""
QUIT
Begin DoDot:4
+84 DO ONEPAT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SDI_"|"_SDT_"|"_WLIEN
QUIT
End DoDot:3
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:2
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:1
GOTO WLX
+85 ;clinic stop/services
+86 IF SVCL'=""
Begin DoDot:1
+87 NEW PR1,SDT
+88 SET SDI=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1),1:1)
+89 FOR SDI=SDI:1:$LENGTH(SVCL,"|")
SET SVC=$PIECE(SVCL,"|",SDI)
Begin DoDot:2
+90 if SVC=""
QUIT
+91 ;I DESDTR'="" D ;desired date range range <begin> ~ <end> not implemented
+92 ;GSC DESDT desired dates by pipe
IF DESDT'=""
Begin DoDot:3
+93 SET SDT=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:1)
+94 FOR SDT=SDT:1:$LENGTH(DESDT,"|")
SET DES=$PIECE(DESDT,"|",SDT)
Begin DoDot:4
+95 if DES=""
QUIT
+96 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+97 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"GSC",SVC,DES,WLIEN))
if WLIEN=""
QUIT
Begin DoDot:5
+98 DO ONEPAT
End DoDot:5
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SVC_"|"_SDT_"|"_WLIEN
QUIT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:3
QUIT
+99 ;GSP
IF PRL'=""
Begin DoDot:3
+100 SET SDK=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:1)
+101 FOR SDK=SDK:1:$LENGTH(PRL,"|")
SET PR1=$PIECE(PRL,"|",SDK)
Begin DoDot:4
+102 SET SDT=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3)-1,1:SDBEG-1)
+103 FOR
SET SDT=$ORDER(^SDWL(409.3,"GSP",SVC,PR1,SDT))
if SDT=""
QUIT
if SDT>SDEND
QUIT
Begin DoDot:5
+104 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",4)'="":$PIECE(LASTSUB,"|",4),1:0)
+105 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"GSP",SVC,PR1,SDT,WLIEN))
if WLIEN=""
QUIT
DO ONEPAT
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SVC_"|"_SDK_"|"_SDT_"|"_WLIEN
QUIT
End DoDot:5
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:3
QUIT
+106 ;GSB - WL service connected
IF SVCR'=""
Begin DoDot:3
+107 SET SDT=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:SDBEG-1)
+108 FOR
SET SDT=$ORDER(^SDWL(409.3,"GSB",SVC,$EXTRACT(SVCR),SDT))
if SDT=""
QUIT
if SDT>SDEND
QUIT
Begin DoDot:4
+109 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+110 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"GSB",SVC,$EXTRACT(SVCR),SDT,WLIEN))
if WLIEN=""
QUIT
DO ONEPAT
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SVC_"|"_SDT_"|"_WLIEN
QUIT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:3
QUIT
+111 ;GSA - Patient Service Connected
IF SCVISIT'=""
Begin DoDot:3
+112 SET SDT=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:SDBEG-1)
+113 FOR
SET SDT=$ORDER(^SDWL(409.3,"GSA",SVC,$EXTRACT(SCVISIT),SDT))
if SDT=""
QUIT
if SDT>SDEND
QUIT
Begin DoDot:4
+114 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+115 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"GSA",SVC,$EXTRACT(SCVISIT),SDT,WLIEN))
if WLIEN=""
QUIT
DO ONEPAT
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SVC_"|"_SDT_"|"_WLIEN
QUIT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:3
QUIT
+116 ;GS
SET SDT=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:SDBEG-1)
+117 FOR
SET SDT=$ORDER(^SDWL(409.3,"GS",SVC,SDT))
if SDT=""
QUIT
if SDT>SDEND
QUIT
Begin DoDot:3
+118 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+119 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"GS",SVC,SDT,WLIEN))
if WLIEN=""
QUIT
Begin DoDot:4
+120 DO ONEPAT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SDI_"|"_SDT_"|"_WLIEN
QUIT
End DoDot:3
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:2
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:1
GOTO WLX
+121 ;all by date range
+122 IF 'DFN
Begin DoDot:1
+123 IF 'SDTOP
Begin DoDot:2
+124 SET SDJ=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1)-1,1:SDBEG-1)
+125 FOR
SET SDJ=$ORDER(^SDWL(409.3,"E","O",SDJ))
if SDJ'>0
QUIT
if SDJ>SDEND
QUIT
Begin DoDot:3
+126 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2),1:0)
SET LASTSUB=""
+127 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"E","O",SDJ,WLIEN))
if WLIEN'>0
QUIT
Begin DoDot:4
+128 SET SDSUB=""
+129 DO ONEPAT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SDJ_"|"_WLIEN
QUIT
End DoDot:3
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:2
+130 IF +SDTOP
Begin DoDot:2
+131 SET SDJ=$SELECT($PIECE(LASTSUB,"|",1)'="":$PIECE(LASTSUB,"|",1)+1,1:SDEND+1)
+132 FOR
SET SDJ=$ORDER(^SDWL(409.3,"E","O",SDJ),-1)
if SDJ'>0
QUIT
if SDJ<SDBEG
QUIT
Begin DoDot:3
+133 SET WLIEN=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2),1:999999999)
SET LASTSUB=""
+134 FOR
SET WLIEN=$ORDER(^SDWL(409.3,"E","O",SDJ,WLIEN),-1)
if WLIEN'>0
QUIT
Begin DoDot:4
+135 SET SDSUB=""
+136 DO ONEPAT
End DoDot:4
IF MAXREC
IF COUNT'<MAXREC
SET SDSUB=SDJ_"|"_WLIEN
QUIT
End DoDot:3
IF MAXREC
IF COUNT'<MAXREC
QUIT
End DoDot:2
End DoDot:1
WLX SET SDTMP=@RET@(COUNT)
SET SDTMP=$PIECE(SDTMP,$CHAR(30),1)
+1 if $GET(SDSUB)'=""
SET $PIECE(SDTMP,U,56)=SDSUB
+2 SET @RET@(COUNT)=SDTMP_$CHAR(30,31)
+3 QUIT
+4 ;
HDR ;Output header
+1 ; 1 2
+2 SET SDRTMP="T00030DFN^T00030NAME"
+3 ; 3 4 5 6 7 8
+4 SET SDRTMP=SDRTMP_"^T00030HRN2^T00030DOB^T00030SSN^T00030GENDER^I00010IEN^D00030ORIGDT"
+5 ; 9 10 11 12 13
+6 SET SDRTMP=SDRTMP_"^T00030INSTIEN^T00030INSTNAME^T00030TYPE^T00030TEAM^T00030POS"
+7 ; 14 15 16 17
+8 SET SDRTMP=SDRTMP_"^T00030SRVSPIEN^T00030SRVSPNAME^T00030CLINIEN^T00030CLINNAME"
+9 ; 18 19 20 21 22 23
+10 SET SDRTMP=SDRTMP_"^T00030USERIEN^T00030USERNAME^T00030PRIO^T00030REQBY^T00030PROVIEN^T00030PROVNAME"
+11 ; 24 25 26 27 28
+12 SET SDRTMP=SDRTMP_"^T00030DAPTDT^T00250COMM^T00030EESTAT^T00030PTELEPHONE^T00030ENROLLMENT_PRIORITY"
+13 SET SDRTMP=SDRTMP_"^T00250APPT_SCHED_DATE^T00010MULTIPLE APPOINTMENT RTC^T00010MULT APPT RTC INTERVAL"
+14 SET SDRTMP=SDRTMP_"^T00010MULT APPT NUMBER"
+15 ; 36
+16 SET SDRTMP=SDRTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"
+17 SET SDRTMP=SDRTMP_"^T00030TYPEIEN^T00030TYPENAME^T00100PCONTACT^T00030WLDISPD^T00030WLDISPU^T00030WLDISPUN"
+18 ; 44 45 46 47 48
+19 SET SDRTMP=SDRTMP_"^T00030WLSVCCON^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3^T00030PCITY"
+20 ; 49 50 51 52 53 54
+21 SET SDRTMP=SDRTMP_"^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00050GAF^T00030DATE^T00030MTRCDATES"
+22 SET SDRTMP=SDRTMP_"^T00100SENSITIVE^T00030LASTSUB^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN"
+23 ;62
SET SDRTMP=SDRTMP_"^T00030APPTYPE^T00030PRHBLOC"
+24 ;69
SET SDRTMP=SDRTMP_"^T00030HRN^T00030BADADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE"
+25 ;75
SET SDRTMP=SDRTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP"
+26 ;79
SET SDRTMP=SDRTMP_"^T00030NOK2^T00030K2NAME^T00030K2REL^T00030K2PHONE"
+27 ;86
SET SDRTMP=SDRTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP^T00030PCOUNTY"
+28 ;91
SET SDRTMP=SDRTMP_"^T00030PETH^T00030PRACE^T00030PMARITAL^T00030PRELIGION^T00030PTACTIVE"
+29 ;98
SET SDRTMP=SDRTMP_"^T00030PTADDRESS1^T00030PTADDRESS2^T00030PTADDRESS3^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4"
+30 ;106
SET SDRTMP=SDRTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTMPPHONE^T00030PTSTART^T00030PTEND^T00030PCELL^T00030PPAGER^T00030PEMAIL"
+31 ;113
SET SDRTMP=SDRTMP_"^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL^T00030SUBGRP^T00030CAT8G^T01000SIMILAR"
+32 ;115 added call phone & letter *745 5/14/20
SET SDRTMP=SDRTMP_"^T00030CPHONE^T00030CLET"
+33 SET @RET@(COUNT)=SDRTMP_$CHAR(30)
+34 QUIT
ONEPAT ; Process one patient
+1 ;D GETS^DIQ(FNUM,WLIEN,"23;.01;.05;1;2;4;5;6;7;8;8.5;9;10,10.5;11;12;12.5;22;25;27","IE","WLDATA","WLMSG")
+2 NEW SDCL,SDI,WLSDOA,WLDAM,WLCLERK,WLCLERKN
+3 NEW APPTYPE,PRACE,PRACEN,PETH,PETHN,PRHBLOC
+4 KILL WLDATA
+5 SET FRULES=$GET(FRULES)
+6 DO GETS^DIQ(FNUM,WLIEN,"**","IE","WLDATA","WLMSG")
+7 SET WLSTAT=WLDATA(FNUM,WLIEN_",",23,"I")
+8 ; Ignore CLOSED records; CLOSED setup and used from SDEC54 only
IF FRULES
IF '+$GET(CLOSED)
if WLSTAT="C"
QUIT
+9 SET WLORIGDT=WLDATA(FNUM,WLIEN_",",1,"I")
+10 IF FRULES
IF ($PIECE(WLORIGDT,".",1)<SDBEG)!($PIECE(WLORIGDT,".",1)>SDEND)
QUIT
+11 SET DFN=WLDATA(FNUM,WLIEN_",",.01,"I")
+12 if DFN=""
QUIT
+13 SET WLCLIENL=WLDATA(FNUM,WLIEN_",",8,"I")
+14 SET SDCL=WLDATA(FNUM,WLIEN_",",8.5,"I")
+15 IF SDCL=""
SET SDCL=$$GET1^DIQ(409.32,WLCLIENL_",",.01,"I")
+16 ;check OOS? in file 44
if (SDCL'="")&($$GET1^DIQ(44,SDCL_",",50.01,"I")=1)
QUIT
+17 SET PRHBLOC=$SELECT($$GET1^DIQ(44,SDCL_",",2500,"I")="Y":1,1:0)
+18 SET GAF=$$GAF^SDECU2(DFN)
+19 DO RACELST^SDECU2(DFN,.PRACE,.PRACEN)
+20 ;get ethnicity
DO ETH^SDECU2(DFN,.PETH,.PETHN)
+21 SET WLINST=WLDATA(FNUM,WLIEN_",",2,"I")
+22 SET WLINSTNM=WLDATA(FNUM,WLIEN_",",2,"E")
+23 SET WLTYPE=WLDATA(FNUM,WLIEN_",",4,"I")
+24 ;only look for SERVICE/SPECIALITY or SPECIFIC CLINIC ;todo-need xref
if "34"'[WLTYPE
QUIT
+25 SET WLTEAM=WLDATA(FNUM,WLIEN_",",5,"I")
+26 SET WLPOS=WLDATA(FNUM,WLIEN_",",6,"I")
+27 SET WLSSIEN=WLDATA(FNUM,WLIEN_",",7,"I")
+28 SET WLSSNAME=WLDATA(FNUM,WLIEN_",",7,"E")
+29 SET WLCLIEN=$PIECE($GET(^SDWL(409.32,+WLCLIENL,0)),U,1)
+30 SET WLCLNAME=WLDATA(FNUM,WLIEN_",",8,"E")
+31 SET APPTYPE=WLDATA(FNUM,WLIEN_",",8.7,"I")
+32 SET WLUSER=WLDATA(FNUM,WLIEN_",",9,"I")
+33 SET WLUSRNM=WLDATA(FNUM,WLIEN_",",9,"E")
+34 ;53
SET WLEDT=$GET(WLDATA(FNUM,WLIEN_",",9.5,"E"))
+35 SET WLPRIO=WLDATA(FNUM,WLIEN_",",10,"I")
+36 ;msc/sat
SET WLENPRI=WLDATA(FNUM,WLIEN_",",10.5,"E")
+37 SET WLREQBY=WLDATA(FNUM,WLIEN_",",11,"I")
+38 ;alb/sat 658 - only when REQBY is provider
SET WLPROV=$SELECT(WLREQBY=1:WLDATA(FNUM,WLIEN_",",12,"I"),1:"")
+39 ;alb/sat 658 - only when REQBY is provider
SET WLPROVNM=$SELECT(WLREQBY=1:WLDATA(FNUM,WLIEN_",",12,"E"),1:"")
+40 ;scheduled date of appt
SET WLSDOA=WLDATA(FNUM,WLIEN_",",13,"E")
+41 ;date appt. made
SET WLDAM=WLDATA(FNUM,WLIEN_",",13.1,"E")
+42 ;appt clerk
SET WLCLERK=WLDATA(FNUM,WLIEN_",",13.7,"I")
+43 ;appt clerk name
SET WLCLERKN=WLDATA(FNUM,WLIEN_",",13.7,"E")
+44 SET WLSVCCON=WLDATA(FNUM,WLIEN_",",15,"E")
+45 SET WLDAPTDT=WLDATA(FNUM,WLIEN_",",22,"I")
+46 SET WLCOMM=WLDATA(FNUM,WLIEN_",",25,"I")
+47 SET WLEESTAT=WLDATA(FNUM,WLIEN_",",27,"I")
+48 SET WLASD=""
+49 if WLSDOA'=""
SET $PIECE(WLASD,"~~",1)=WLSDOA
+50 if WLCLERK'=""
SET $PIECE(WLASD,"~~",12)=WLCLERK
+51 if WLCLERKN'=""
SET $PIECE(WLASD,"~~",13)=WLCLERKN
+52 if WLDAM'=""
SET $PIECE(WLASD,"~~",17)=WLDAM
+53 SET WLPC=$$WLPC(.WLDATA,WLIEN)
+54 SET WLDISPD=WLDATA(FNUM,WLIEN_",",19,"E")
+55 SET WLDISPU=WLDATA(FNUM,WLIEN_",",20,"I")
+56 SET WLDISPUN=WLDATA(FNUM,WLIEN_",",20,"E")
+57 SET SDSENS=$$PTSEC^SDECUTL(DFN)
+58 ;S (SDI,SDMTRC)="" F S SDI=$O(WLDATA(409.37,SDI)) Q:SDI="" S SDMTRC=$S(SDMTRC'="":SDMTRC_"|",1:"")_WLDATA(409.37,SDI,.01,"E")
SET SDMTRC=""
+59 SET COUNT=COUNT+1
+60 ; 1 2 3 4 5 6 7 8 9 10 11 12 13
+61 SET STR=DFN_U_""_U_""_U_""_U_""_U_""_U_WLIEN_U_WLORIGDT_U_WLINST_U_WLINSTNM_U_WLTYPE_U_WLTEAM_U_WLPOS
+62 ; 14 15 16 17 18 19 20 21 22
+63 SET STR=STR_U_WLSSIEN_U_WLSSNAME_U_WLCLIEN_U_WLCLNAME_U_WLUSER_U_WLUSRNM_U_WLPRIO_U_WLREQBY_U_WLPROV
+64 ;32
SET STR=STR_U_WLPROVNM_U_WLDAPTDT_U_WLCOMM_U_WLEESTAT_U_""_U_WLENPRI_U_WLASD_U_""_U_""_U_""
+65 ;40
SET STR=STR_U_""_U_""_U_""_U_""_U_""_U_""_U_""_U_WLPC
+66 ;49
SET STR=STR_U_WLDISPD_U_WLDISPU_U_WLDISPUN_U_WLSVCCON_U_""_U_""_U_""_U_""_U_""
+67 ; 50 51 52 53 54 55 56 57 58 59 60 61
+68 SET STR=STR_U_""_U_""_U_GAF_U_WLEDT_U_""_U_SDSENS_U_""_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_APPTYPE
+69 ;62
SET STR=STR_U_PRHBLOC
+70 DO WLDEMO^SDECWL3(.STR,DFN)
+71 ;S STR=STR_U_0_U_"" ; SET DEFAULT SDCALL TO 0 AND SDECLET TO NULL UNTIL FURTHER TESTING
+72 ;COMMENT OUT NEXT LINE INTIL FURTHER TESTING ; PWC *745
+73 ;SDCALL_U_SDECLET 114^115 COMPUTE CLAL AND LETTER DATA CT - *745 5/12/20
SET SDWAIT=$$CALLWL^SDECAR1A(DFN,WLIEN)
SET STR=STR_U_$PIECE(SDWAIT,U,1)_U_$PIECE(SDWAIT,U,2)
+74 SET @RET@(COUNT)=STR_$CHAR(30)
+75 QUIT
+76 ;
WLPC(WLDATA,ASDIEN) ;
+1 NEW PC,PC1,PCIEN
+2 SET PC=""
+3 SET PCIEN=""
FOR
SET PCIEN=$ORDER(WLDATA(409.344,PCIEN))
if PCIEN=""
QUIT
Begin DoDot:1
+4 if $PIECE(PCIEN,",",2)'=ASDIEN
QUIT
+5 SET PC1=""
+6 ;DATE ENTERED
SET $PIECE(PC1,"~~",1)=WLDATA(409.344,PCIEN,.01,"E")
+7 ;PC ENTERED BY USER IEN
SET $PIECE(PC1,"~~",2)=WLDATA(409.344,PCIEN,2,"I")
+8 ;PC ENTERED BY USER NAME
SET $PIECE(PC1,"~~",3)=WLDATA(409.344,PCIEN,2,"E")
+9 ;ACTION
SET $PIECE(PC1,"~~",4)=WLDATA(409.344,PCIEN,3,"E")
+10 ;PATIENT PHONE
SET $PIECE(PC1,"~~",5)=WLDATA(409.344,PCIEN,4,"E")
+11 SET PC=$SELECT(PC'="":PC_"::",1:"")_PC1
End DoDot:1
+12 QUIT PC
