Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECWL1

SDECWL1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. ;
  1. ; Get SD WAIT LIST for all entries in the user's Institution
  1. ; where the Current Status is not C(losed).
  1. WLGET(RET,WLIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRL,SVCR,SCVISIT,CLINIC,ORIGDT) ;Waitlist GET ;alb/sat 658 add SVCL-ORIGDT
  1. WLGETA ;
  1. ;
  1. N CLOSED,DES,FNUM,WLORIGDT,WLINST,WLINSTNM,WLTYPE,WLTEAM,WLPOS
  1. N ELIGIEN,ELIGNAME,FRULES,GLOREF
  1. N SDK,SDSUB,SDTMP,SVC,WLSSIEN,WLSSNAME,WLCLIEN,WLCLNAME
  1. N WLUSER,WLPRIO,WLREQBY,WLPROV,WLPROVNM,WLDAPTDT,WLCOMM,WLEESTAT,WLUSRNM
  1. N WLCLIENL,WLEDT,WLIEN,PTINFOLSTA,WLDISPD,WLDISPU,WLDISPUN,WLSVCCON
  1. N WLSTAT,COUNT,STR,SDRTMP,SDWAIT
  1. N PCITY,GAF,PPC,WLENPRI,WLASD,WLPC,WLDATA
  1. N SDI,SDJ,SDMTRC,SDSENS,X,Y,%DT
  1. S RET="^TMP(""SDEC"","_$J_")"
  1. K @RET
  1. S FNUM=$$FNUM^SDECWL,COUNT=0
  1. S MAXREC=+$G(MAXREC,50)
  1. D HDR
  1. S GLOREF=$NA(^SDWL(409.3,"C",DUZ(2)))
  1. S FRULES=1
  1. S WLIEN=0
  1. ;F S WLIEN=$O(@GLOREF@(WLIEN)) Q:'WLIEN D ONEPAT I MAXREC,COUNT'<MAXREC Q
  1. S SDBEG=$G(SDBEG)
  1. I SDBEG'="" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y I Y=-1 S SDBEG=3100101
  1. I SDBEG="" S SDBEG=3100101
  1. S SDEND=$G(SDEND)
  1. 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)
  1. I SDEND="" S SDEND=$$FMADD^XLFDT($E($$NOW^XLFDT,1,12),-90)
  1. S DFN=$G(DFN)
  1. I DFN'="",'$D(^DPT(DFN,0)) S DFN=""
  1. S LASTSUB=$S(DFN="":$G(LASTSUB),1:"")
  1. S SDTOP=+$G(SDTOP)
  1. ;single IEN
  1. S WLIEN1=$G(WLIEN1)
  1. I +WLIEN1 I '$D(^SDWL(409.3,+WLIEN1,0)) S COUNT=COUNT+1 S @RET@(COUNT)="-1^Invalid Wait List ID." Q ;S WLIEN1=""
  1. I +WLIEN1 D
  1. .S WLIEN=+WLIEN1
  1. .S FRULES=0 ;no rules - just return the single record
  1. .D ONEPAT
  1. I +WLIEN1 S @RET@(COUNT)=@RET@(COUNT)_$C(31) Q
  1. ;by patient
  1. I +DFN D
  1. .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
  1. .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
  1. ;alb/sat 658 start modifications
  1. ;validate ORIGDT
  1. S ORIGDT=$G(ORIGDT)
  1. ;validate CLINIC
  1. S CLINIC=$G(CLINIC)
  1. ;validate SVCL
  1. S SVCL=$G(SVCL)
  1. I SVCL'="" D
  1. .F SDI=$L(SVCL,"|"):-1:1 S SVC=$P(SVCL,"|",SDI) D
  1. ..I (SVC="")!('$D(^DIC(40.7,+SVC,0))) S SVCL=$$PD^SDECUTL(SVCL,SDI,"|")
  1. ;validate DESDT
  1. S DESDT=$G(DESDT)
  1. ;validate PRL
  1. S PRL=$G(PRL)
  1. I PRL'="" D
  1. .N PR
  1. .F SDI=$L(PRL,"|"):-1:1 S PR=$P(PRL,"|",SDI) D
  1. ..I "012345678"'[PR S PR=$E(PR,7)
  1. ..I "012345678"'[PR S PRL=$$PD^SDECUTL(PRL,SDI,"|")
  1. ;validate SVCR
  1. S SVCR=$G(SVCR) S:SVCR'="" SVCR=$$UP^XLFSTR(SVCR)
  1. I SVCR'="" S SVCR=$S(SVCR="Y":1,SVCR="N":0,SVCR="YES":1,SVCR="NO":0,1:"")
  1. ;validate SCVISIT
  1. S SCVISIT=$G(SCVISIT) S:SCVISIT'="" SCVISIT=$$UP^XLFSTR(SCVISIT)
  1. I SCVISIT'="" S SCVISIT=$S(SCVISIT="Y":"Y",SCVISIT="N":"N",SCVISIT="YES":"Y",SCVISIT="NO":"N",1:"")
  1. ;
  1. ;clinic
  1. I CLINIC'="" D G WLX
  1. .S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:1)
  1. .F SDI=SDI:1:$L(CLINIC,"|") S SDCL=$P(CLINIC,"|",SDI) D I MAXREC,COUNT'<MAXREC Q
  1. ..Q:SDCL=""
  1. ..I DESDT'="" D Q ;GCC DESDT desired dates by pipe
  1. ...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:1)
  1. ...F SDT=SDT:1:$L(DESDT,"|") S DES=$P(DESDT,"|",SDT) D I MAXREC,COUNT'<MAXREC Q
  1. ....Q:DES=""
  1. ....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....F S WLIEN=$O(^SDWL(409.3,"GCC",SDCL,DES,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDCL_"|"_SDT_"|"_WLIEN Q
  1. .....D ONEPAT
  1. ..;
  1. ..S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,ORIGDT'="":ORIGDT-1,1:SDBEG-1) ;GC
  1. ..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
  1. ...S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ...F S WLIEN=$O(^SDWL(409.3,"GC",SDCL,SDT,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDI_"|"_SDT_"|"_WLIEN Q
  1. ....D ONEPAT
  1. ;clinic stop/services
  1. I SVCL'="" D G WLX
  1. .N PR1,SDT
  1. .S SDI=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1),1:1)
  1. .F SDI=SDI:1:$L(SVCL,"|") S SVC=$P(SVCL,"|",SDI) D I MAXREC,COUNT'<MAXREC Q
  1. ..Q:SVC=""
  1. ..;I DESDTR'="" D ;desired date range range <begin> ~ <end> not implemented
  1. ..I DESDT'="" D Q ;GSC DESDT desired dates by pipe
  1. ...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:1)
  1. ...F SDT=SDT:1:$L(DESDT,"|") S DES=$P(DESDT,"|",SDT) D I MAXREC,COUNT'<MAXREC Q
  1. ....Q:DES=""
  1. ....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....F S WLIEN=$O(^SDWL(409.3,"GSC",SVC,DES,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDT_"|"_WLIEN Q
  1. .....D ONEPAT
  1. ..I PRL'="" D Q ;GSP
  1. ...S SDK=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:1)
  1. ...F SDK=SDK:1:$L(PRL,"|") S PR1=$P(PRL,"|",SDK) D I MAXREC,COUNT'<MAXREC Q
  1. ....S SDT=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3)-1,1:SDBEG-1)
  1. ....F S SDT=$O(^SDWL(409.3,"GSP",SVC,PR1,SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. .....S WLIEN=$S($P(LASTSUB,"|",4)'="":$P(LASTSUB,"|",4),1:0)
  1. .....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
  1. ..I SVCR'="" D Q ;GSB - WL service connected
  1. ...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:SDBEG-1)
  1. ...F S SDT=$O(^SDWL(409.3,"GSB",SVC,$E(SVCR),SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....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
  1. ..I SCVISIT'="" D Q ;GSA - Patient Service Connected
  1. ...S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:SDBEG-1)
  1. ...F S SDT=$O(^SDWL(409.3,"GSA",SVC,$E(SCVISIT),SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ....S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....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
  1. ..S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:SDBEG-1) ;GS
  1. ..F S SDT=$O(^SDWL(409.3,"GS",SVC,SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ...S WLIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ...F S WLIEN=$O(^SDWL(409.3,"GS",SVC,SDT,WLIEN)) Q:WLIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDI_"|"_SDT_"|"_WLIEN Q
  1. ....D ONEPAT
  1. ;all by date range
  1. I 'DFN D
  1. .I 'SDTOP D
  1. ..S SDJ=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)-1,1:SDBEG-1)
  1. ..F S SDJ=$O(^SDWL(409.3,"E","O",SDJ)) Q:SDJ'>0 Q:SDJ>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ...S WLIEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:0) S LASTSUB=""
  1. ...F S WLIEN=$O(^SDWL(409.3,"E","O",SDJ,WLIEN)) Q:WLIEN'>0 D I MAXREC,COUNT'<MAXREC S SDSUB=SDJ_"|"_WLIEN Q
  1. ....S SDSUB=""
  1. ....D ONEPAT
  1. .I +SDTOP D
  1. ..S SDJ=$S($P(LASTSUB,"|",1)'="":$P(LASTSUB,"|",1)+1,1:SDEND+1)
  1. ..F S SDJ=$O(^SDWL(409.3,"E","O",SDJ),-1) Q:SDJ'>0 Q:SDJ<SDBEG D I MAXREC,COUNT'<MAXREC Q
  1. ...S WLIEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:999999999) S LASTSUB=""
  1. ...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
  1. ....S SDSUB=""
  1. ....D ONEPAT
  1. WLX S SDTMP=@RET@(COUNT) S SDTMP=$P(SDTMP,$C(30),1)
  1. S:$G(SDSUB)'="" $P(SDTMP,U,56)=SDSUB
  1. S @RET@(COUNT)=SDTMP_$C(30,31)
  1. Q
  1. ;
  1. HDR ;Output header
  1. ; 1 2
  1. S SDRTMP="T00030DFN^T00030NAME"
  1. ; 3 4 5 6 7 8
  1. S SDRTMP=SDRTMP_"^T00030HRN2^T00030DOB^T00030SSN^T00030GENDER^I00010IEN^D00030ORIGDT"
  1. ; 9 10 11 12 13
  1. S SDRTMP=SDRTMP_"^T00030INSTIEN^T00030INSTNAME^T00030TYPE^T00030TEAM^T00030POS"
  1. ; 14 15 16 17
  1. S SDRTMP=SDRTMP_"^T00030SRVSPIEN^T00030SRVSPNAME^T00030CLINIEN^T00030CLINNAME"
  1. ; 18 19 20 21 22 23
  1. S SDRTMP=SDRTMP_"^T00030USERIEN^T00030USERNAME^T00030PRIO^T00030REQBY^T00030PROVIEN^T00030PROVNAME"
  1. ; 24 25 26 27 28
  1. S SDRTMP=SDRTMP_"^T00030DAPTDT^T00250COMM^T00030EESTAT^T00030PTELEPHONE^T00030ENROLLMENT_PRIORITY"
  1. S SDRTMP=SDRTMP_"^T00250APPT_SCHED_DATE^T00010MULTIPLE APPOINTMENT RTC^T00010MULT APPT RTC INTERVAL"
  1. S SDRTMP=SDRTMP_"^T00010MULT APPT NUMBER"
  1. ; 36
  1. S SDRTMP=SDRTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"
  1. S SDRTMP=SDRTMP_"^T00030TYPEIEN^T00030TYPENAME^T00100PCONTACT^T00030WLDISPD^T00030WLDISPU^T00030WLDISPUN"
  1. ; 44 45 46 47 48
  1. S SDRTMP=SDRTMP_"^T00030WLSVCCON^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3^T00030PCITY"
  1. ; 49 50 51 52 53 54
  1. S SDRTMP=SDRTMP_"^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00050GAF^T00030DATE^T00030MTRCDATES"
  1. S SDRTMP=SDRTMP_"^T00100SENSITIVE^T00030LASTSUB^T00030PRACE^T00030PRACEN^T00030PETH^T00030PETHN"
  1. S SDRTMP=SDRTMP_"^T00030APPTYPE^T00030PRHBLOC" ;62
  1. S SDRTMP=SDRTMP_"^T00030HRN^T00030BADADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE" ;69
  1. S SDRTMP=SDRTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP" ;75
  1. S SDRTMP=SDRTMP_"^T00030NOK2^T00030K2NAME^T00030K2REL^T00030K2PHONE" ;79
  1. S SDRTMP=SDRTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP^T00030PCOUNTY" ;86
  1. S SDRTMP=SDRTMP_"^T00030PETH^T00030PRACE^T00030PMARITAL^T00030PRELIGION^T00030PTACTIVE" ;91
  1. S SDRTMP=SDRTMP_"^T00030PTADDRESS1^T00030PTADDRESS2^T00030PTADDRESS3^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4" ;98
  1. S SDRTMP=SDRTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTMPPHONE^T00030PTSTART^T00030PTEND^T00030PCELL^T00030PPAGER^T00030PEMAIL" ;106
  1. S SDRTMP=SDRTMP_"^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL^T00030SUBGRP^T00030CAT8G^T01000SIMILAR" ;113
  1. S SDRTMP=SDRTMP_"^T00030CPHONE^T00030CLET" ;115 added call phone & letter *745 5/14/20
  1. S @RET@(COUNT)=SDRTMP_$C(30)
  1. Q
  1. 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")
  1. N SDCL,SDI,WLSDOA,WLDAM,WLCLERK,WLCLERKN
  1. N APPTYPE,PRACE,PRACEN,PETH,PETHN,PRHBLOC
  1. K WLDATA
  1. S FRULES=$G(FRULES)
  1. D GETS^DIQ(FNUM,WLIEN,"**","IE","WLDATA","WLMSG")
  1. S WLSTAT=WLDATA(FNUM,WLIEN_",",23,"I")
  1. I FRULES I '+$G(CLOSED) Q:WLSTAT="C" ; Ignore CLOSED records; CLOSED setup and used from SDEC54 only
  1. S WLORIGDT=WLDATA(FNUM,WLIEN_",",1,"I")
  1. I FRULES I ($P(WLORIGDT,".",1)<SDBEG)!($P(WLORIGDT,".",1)>SDEND) Q
  1. S DFN=WLDATA(FNUM,WLIEN_",",.01,"I")
  1. Q:DFN=""
  1. S WLCLIENL=WLDATA(FNUM,WLIEN_",",8,"I")
  1. S SDCL=WLDATA(FNUM,WLIEN_",",8.5,"I")
  1. I SDCL="" S SDCL=$$GET1^DIQ(409.32,WLCLIENL_",",.01,"I")
  1. Q:(SDCL'="")&($$GET1^DIQ(44,SDCL_",",50.01,"I")=1) ;check OOS? in file 44
  1. S PRHBLOC=$S($$GET1^DIQ(44,SDCL_",",2500,"I")="Y":1,1:0)
  1. S GAF=$$GAF^SDECU2(DFN)
  1. D RACELST^SDECU2(DFN,.PRACE,.PRACEN)
  1. D ETH^SDECU2(DFN,.PETH,.PETHN) ;get ethnicity
  1. S WLINST=WLDATA(FNUM,WLIEN_",",2,"I")
  1. S WLINSTNM=WLDATA(FNUM,WLIEN_",",2,"E")
  1. S WLTYPE=WLDATA(FNUM,WLIEN_",",4,"I")
  1. Q:"34"'[WLTYPE ;only look for SERVICE/SPECIALITY or SPECIFIC CLINIC ;todo-need xref
  1. S WLTEAM=WLDATA(FNUM,WLIEN_",",5,"I")
  1. S WLPOS=WLDATA(FNUM,WLIEN_",",6,"I")
  1. S WLSSIEN=WLDATA(FNUM,WLIEN_",",7,"I")
  1. S WLSSNAME=WLDATA(FNUM,WLIEN_",",7,"E")
  1. S WLCLIEN=$P($G(^SDWL(409.32,+WLCLIENL,0)),U,1)
  1. S WLCLNAME=WLDATA(FNUM,WLIEN_",",8,"E")
  1. S APPTYPE=WLDATA(FNUM,WLIEN_",",8.7,"I")
  1. S WLUSER=WLDATA(FNUM,WLIEN_",",9,"I")
  1. S WLUSRNM=WLDATA(FNUM,WLIEN_",",9,"E")
  1. S WLEDT=$G(WLDATA(FNUM,WLIEN_",",9.5,"E")) ;53
  1. S WLPRIO=WLDATA(FNUM,WLIEN_",",10,"I")
  1. S WLENPRI=WLDATA(FNUM,WLIEN_",",10.5,"E") ;msc/sat
  1. S WLREQBY=WLDATA(FNUM,WLIEN_",",11,"I")
  1. S WLPROV=$S(WLREQBY=1:WLDATA(FNUM,WLIEN_",",12,"I"),1:"") ;alb/sat 658 - only when REQBY is provider
  1. S WLPROVNM=$S(WLREQBY=1:WLDATA(FNUM,WLIEN_",",12,"E"),1:"") ;alb/sat 658 - only when REQBY is provider
  1. S WLSDOA=WLDATA(FNUM,WLIEN_",",13,"E") ;scheduled date of appt
  1. S WLDAM=WLDATA(FNUM,WLIEN_",",13.1,"E") ;date appt. made
  1. S WLCLERK=WLDATA(FNUM,WLIEN_",",13.7,"I") ;appt clerk
  1. S WLCLERKN=WLDATA(FNUM,WLIEN_",",13.7,"E") ;appt clerk name
  1. S WLSVCCON=WLDATA(FNUM,WLIEN_",",15,"E")
  1. S WLDAPTDT=WLDATA(FNUM,WLIEN_",",22,"I")
  1. S WLCOMM=WLDATA(FNUM,WLIEN_",",25,"I")
  1. S WLEESTAT=WLDATA(FNUM,WLIEN_",",27,"I")
  1. S WLASD=""
  1. S:WLSDOA'="" $P(WLASD,"~~",1)=WLSDOA
  1. S:WLCLERK'="" $P(WLASD,"~~",12)=WLCLERK
  1. S:WLCLERKN'="" $P(WLASD,"~~",13)=WLCLERKN
  1. S:WLDAM'="" $P(WLASD,"~~",17)=WLDAM
  1. S WLPC=$$WLPC(.WLDATA,WLIEN)
  1. S WLDISPD=WLDATA(FNUM,WLIEN_",",19,"E")
  1. S WLDISPU=WLDATA(FNUM,WLIEN_",",20,"I")
  1. S WLDISPUN=WLDATA(FNUM,WLIEN_",",20,"E")
  1. S SDSENS=$$PTSEC^SDECUTL(DFN)
  1. 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")
  1. S COUNT=COUNT+1
  1. ; 1 2 3 4 5 6 7 8 9 10 11 12 13
  1. S STR=DFN_U_""_U_""_U_""_U_""_U_""_U_WLIEN_U_WLORIGDT_U_WLINST_U_WLINSTNM_U_WLTYPE_U_WLTEAM_U_WLPOS
  1. ; 14 15 16 17 18 19 20 21 22
  1. S STR=STR_U_WLSSIEN_U_WLSSNAME_U_WLCLIEN_U_WLCLNAME_U_WLUSER_U_WLUSRNM_U_WLPRIO_U_WLREQBY_U_WLPROV
  1. S STR=STR_U_WLPROVNM_U_WLDAPTDT_U_WLCOMM_U_WLEESTAT_U_""_U_WLENPRI_U_WLASD_U_""_U_""_U_"" ;32
  1. S STR=STR_U_""_U_""_U_""_U_""_U_""_U_""_U_""_U_WLPC ;40
  1. S STR=STR_U_WLDISPD_U_WLDISPU_U_WLDISPUN_U_WLSVCCON_U_""_U_""_U_""_U_""_U_"" ;49
  1. ; 50 51 52 53 54 55 56 57 58 59 60 61
  1. S STR=STR_U_""_U_""_U_GAF_U_WLEDT_U_""_U_SDSENS_U_""_U_PRACE_U_PRACEN_U_PETH_U_PETHN_U_APPTYPE
  1. S STR=STR_U_PRHBLOC ;62
  1. D WLDEMO^SDECWL3(.STR,DFN)
  1. ;S STR=STR_U_0_U_"" ; SET DEFAULT SDCALL TO 0 AND SDECLET TO NULL UNTIL FURTHER TESTING
  1. ;COMMENT OUT NEXT LINE INTIL FURTHER TESTING ; PWC *745
  1. 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
  1. S @RET@(COUNT)=STR_$C(30)
  1. Q
  1. ;
  1. WLPC(WLDATA,ASDIEN) ;
  1. N PC,PC1,PCIEN
  1. S PC=""
  1. S PCIEN="" F S PCIEN=$O(WLDATA(409.344,PCIEN)) Q:PCIEN="" D
  1. .Q:$P(PCIEN,",",2)'=ASDIEN
  1. .S PC1=""
  1. .S $P(PC1,"~~",1)=WLDATA(409.344,PCIEN,.01,"E") ;DATE ENTERED
  1. .S $P(PC1,"~~",2)=WLDATA(409.344,PCIEN,2,"I") ;PC ENTERED BY USER IEN
  1. .S $P(PC1,"~~",3)=WLDATA(409.344,PCIEN,2,"E") ;PC ENTERED BY USER NAME
  1. .S $P(PC1,"~~",4)=WLDATA(409.344,PCIEN,3,"E") ;ACTION
  1. .S $P(PC1,"~~",5)=WLDATA(409.344,PCIEN,4,"E") ;PATIENT PHONE
  1. .S PC=$S(PC'="":PC_"::",1:"")_PC1
  1. Q PC