- 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 Dec 13, 2024@02:53 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