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

SDECWL2.m

Go to the documentation of this file. 
  1. SDECWL2 ;ALB/SAT,WTC,LAB - VISTA SCHEDULING RPCS ;Apr 10, 2020@15:22
  1.  ;;5.3;Scheduling;**627,642,658,665,694,745**;Aug 13, 1993;Build 40
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1.  ;
  1.  Q
  1.  ;
  1. WLSET(RET,INP) ;Waitlist Set
  1.  ;SD*5.3*745 replace external 'INP...' due to XINDEX issue.  Parameters are then rolled into the INP array
  1.  ;WLSET(RET,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15,S16,S17,S18,S19,S20,S21,S22,S23,S24,S25,S26,SD27) external parameter tag in SDEC
  1.  ; INP - Input parameters array
  1.  ;  INP(1)  = (integer)  Wait List IEN point to
  1.  ;                       SD WAIT LIST file 409.3.
  1.  ;                       If null, a new entry will be added
  1.  ;  INP(2)  = (text)     DFN Pointer to the PATIENT file 2
  1.  ;  INP(3)  = (date)     Originating Date/time in external date form
  1.  ;  INP(4)  = (text)     Institution name NAME field from the INSTITUTION file
  1.  ;  INP(5)  = (text)     Wait List Type
  1.  ;                        PCMM TEAM ASSIGNMENT
  1.  ;                        PCMM POSITION ASSIGNMENT
  1.  ;                        SERVICE/SPECIALITY
  1.  ;                        SPECIFIC CLINIC
  1.  ;  INP(6)  = (text)     WL Specific Team name - NAME field in the TEAM file 404.51
  1.  ;  INP(7)  = (text)     WL Specific Position name - NAME field in the
  1.  ;                       TEAM POSITION file 404.57.
  1.  ;  INP(8)  = (text)     WL Service/Specialty name - NAME field in
  1.  ;                       SD WL SERVICE/SPECIALTY file 409.31 OR ien from 409.31
  1.  ;  INP(9)  = (text)     WL Specific Clinic name - NAME field in
  1.  ;                       SD WL CLINIC LOCATION file 409.32.
  1.  ;  INP(10) = (text)     Originating User name  - NAME field in NEW PERSON file 200
  1.  ;  INP(11) = (text)     Priority - 'ASAP' or 'FUTURE'
  1.  ;  INP(12) = (text)     Request By - 'PROVIDER' or 'PATIENT'
  1.  ;  INP(13) = (text)     Provider name  - NAME field in NEW PERSON file 200
  1.  ;  INP(14) = (date)     Desired Date of appointment in external format.
  1.  ;  INP(15) = (text)     comment must be 1-60 characters
  1.  ;  INP(16) = (text)     EWL Enrollee Status
  1.  ;                        NEW
  1.  ;                        ESTABLISHED
  1.  ;                        PRIOR
  1.  ;                        UNDETERMINED
  1.  ;  INP(17) = (text)     NOT USED - PATIENT TELEPHONE  4-20 characters
  1.  ;  INP(18) = (text)     ENROLLMENT PRIORITY - Valid Values are:
  1.  ;                                             GROUP 1
  1.  ;                                             GROUP 2
  1.  ;                                             GROUP 3
  1.  ;                                             GROUP 4
  1.  ;                                             GROUP 5
  1.  ;                                             GROUP 6
  1.  ;                                             GROUP 7
  1.  ;                                             GROUP 8
  1.  ;  INP(19) = (text)    NOT USED - APPT SCHEDULED DATE
  1.  ;  INP(20) = (text)     <NOT USED>  MULTIPLE APPOINTMENT RTC      NO; YES
  1.  ;  INP(21) = (integer)  <NOT USED>  MULT APPT RTC INTERVAL integer between 1-365
  1.  ;  INP(22) = (integer)  <NOT USED>  MULT APPT NUMBER integer between 1-100
  1.  ;  INP(23) = Patient Contacts separated by ::
  1.  ;            Each :: piece has the following ~~ pieces:
  1.  ;            1) = (date)    DATE ENTERED external date/time
  1.  ;            2) = (text)    PC ENTERED BY USER ID or NAME - Pointer to NEW PERSON file or NAME
  1.  ;            4) = (text)    ACTION - 'CALLED', 'MESSAGE LEFT', or 'LETTER'
  1.  ;            5) = (optional) PATIENT PHONE Free-Text 4-20 characters
  1.  ;            6) = NOT USED (optional) Comment 1-160 characters
  1.  ;  INP(24) = (optional) SERVICE CONNECTED PRIORITY valid values are NO  YES
  1.  ;  INP(25) = (optional) SERVICE CONNECTED PERCENTAGE = numeric 0-100
  1.  ;  INP(27) = (optional) Appointment Type ID pointer to APPOINTMENT TYPE file 409.1
  1.  ;
  1.  N X,Y,%DT
  1.  N DFN,MI,WLIEN,WLORIGDT,WLINST,WLINSTI,WLTYPE,WLTEAM,WLPOS,WLSRVSP,WLCLIN
  1.  N WLUSER,WLPRIO,WLREQBY,WLPROV,WLDAPTDT,WLCOMM,WLEESTAT,WLEDT,WLQUIT
  1.  N AUDF,FNUM,FDA,WLNEW,WLRET,WLMSG,WLDATA,WLERR,WLHOS
  1.  N WLAPTYP,WLPATTEL,WLENPRI,WLSVCCON,WLSVCCOP
  1.  S (AUDF,WLQUIT)=0
  1.  S FNUM=$$FNUM^SDECWL
  1.  S RET="I00020ERRORID^T00030ERRORTEXT"_$C(30)
  1.  ; Use MERGE instead of SET so we can know if values were actually specified or not.
  1.  ; This way, if a value is null, we will delete any previous value,
  1.  ; but if it is missing, then we will just ignore it.
  1.  M WLIEN=INP(1)
  1.  S WLHOS=""
  1.  S DFN=$G(INP(2))
  1.  I '+DFN S RET=RET_"-1^Invalid Patient ID."_$C(30,31) Q
  1.  I '$D(^DPT(DFN,0)) S RET=RET_"-1^Invalid Patient ID"_$C(30,31) Q
  1.  S WLEDT=$P($G(INP(3)),":",1,2)
  1.  ;
  1.  ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/17/18
  1.  ;
  1.  S WLEDT=$$NETTOFM^SDECDATE(WLEDT,"Y","N") I WLEDT=-1 S RET=RET_"-1^Invalid Origination date."_$C(30,31) Q  ;
  1.  ;S %DT="TX" S X=WLEDT D ^%DT S WLEDT=Y
  1.  ;I Y=-1 S RET=RET_"-1^Invalid Origination date."_$C(30,31) Q
  1.  S WLORIGDT=$P(WLEDT,".",1)
  1.  S WLINST=$G(INP(4)) I WLINST'="" D
  1.  .I '+WLINST S WLINST=$O(^DIC(4,"B",WLINST,0))
  1.  S WLTYPE=$G(INP(5)) I WLTYPE'="" S WLTYPE=$S(WLTYPE="PCMM TEAM ASSIGNMENT":1,WLTYPE="PCMM POSSITION ASSIGNMENT":2,WLTYPE="SERVICE/SPECIALITY":3,WLTYPE="SPECIFIC CLINIC":4,+WLTYPE:+WLTYPE,1:"")
  1.  I WLTYPE="" S RET=RET_"-1^Invalid Wait List Type."_$c(30,31) Q
  1.  S WLTEAM=$G(INP(6)) I WLTEAM'="" D
  1.  .I '+WLTEAM S WLTEAM=$O(^SCTM(404.51,"B",WLTEAM,0))
  1.  .I +WLTEAM I '$D(^SCTM(404.51,+WLTEAM,0)) S WLTEAM=""
  1.  S WLPOS=$G(INP(7)) I WLPOS'="" D
  1.  .I '+WLPOS S WLPOS=$O(^DIC(404.57,"B",WLPOS,0))
  1.  .I +WLPOS I '$D(^SCTM(404.57,WLPOS,0)) S WLPOS=""
  1.  S WLCLIN=$G(INP(9))
  1.  I WLCLIN'="" D   ;WLCLIN pointer to SD WL CLINIC LOCATION; WLHOS pointer to HOSPITAL LOCATION
  1.  .I +WLCLIN D
  1.  ..I '$D(^SDWL(409.32,+WLCLIN,0)) S RET=RET_"-1^"_WLCLIN_" is an invalid WL Waitlist Specific Clinic ID."_$C(30,31) S WLQUIT=1 Q
  1.  ..S WLHOS=+$P($G(^SDWL(409.32,+WLCLIN,0)),U,1)
  1.  .I '+WLCLIN D
  1.  ..S WLHOS=$O(^SC("B",WLCLIN,0))  ;$S(+WLCLIN:$P($G(^SC($P($G(^SDWL(409.32,WLCLIN,0)),U,1),0)),U,1),1:WLCLIN)
  1.  ..S WLCLIN=$O(^SDWL(409.32,"B",+WLHOS,0)) I 'WLCLIN S RET=RET_"-1^"_WLCLIN_" is an invalid WL Waitlist Specific Clinic Name."_$C(30,31) S WLQUIT=1 Q
  1.  Q:+WLQUIT  ;alb/sat 665
  1.  S INP(8)=$G(INP(8))
  1.  I INP(8)'="",WLCLIN'="" S RET=RET_"-1^Cannot include both Clinic and Service."_$C(30,31) Q   ;alb/sat 642
  1.  I +INP(8),'$D(^SDWL(409.31,+INP(8),0)) S RET=RET_"-1^Invalid service/specialty "_+INP(8)_"."_$C(30,31) Q   ;alb/sat 642
  1.  S WLUSER=$G(INP(10))
  1.  I WLUSER'="" I '+WLUSER S WLUSER=$O(^VA(200,"B",WLUSER,0))
  1.  I WLUSER="" S WLUSER=DUZ
  1.  S WLREQBY=$G(INP(12)) I WLREQBY'="" S WLREQBY=$S(WLREQBY="PATIENT":2,WLREQBY="PROVIDER":1,1:"")
  1.  S WLPROV=$G(INP(13)) I WLPROV'="" I '+WLPROV S WLPROV=$O(^VA(200,"B",WLPROV,0))
  1.  S WLDAPTDT=$G(INP(14))
  1.  S %DT="" S X=$P($G(WLDAPTDT),"@",1) D ^%DT S WLPRIO=$S(Y=$P($$NOW^XLFDT,".",1):"A",1:"F")
  1.  S WLDAPTDT=Y
  1.  I Y=-1 S WLDAPTDT=""   ;S RET=RET_"-1^Invalid Desired Date."_$C(30,31) Q
  1.  S (INP(15),WLCOMM)=$TR($G(INP(15)),"^"," ")  ;alb/sat 658
  1.  S WLEESTAT=$G(INP(16)) I WLEESTAT'="" S WLEESTAT=$S(WLEESTAT="NEW":"N",WLEESTAT="ESTABLISHED":"E",WLEESTAT="PRIOR":"P",WLEESTAT="UNDETERMINED":"U",1:WLEESTAT)
  1.  M WLPATTEL=INP(17)
  1.  S WLENPRI=$G(INP(18)) D
  1.  .S:WLENPRI'="" WLENPRI=$S(WLENPRI="GROUP 1":1,WLENPRI="GROUP 2":2,WLENPRI="GROUP 3":3,WLENPRI="GROUP 4":4,WLENPRI="GROUP 5":5,WLENPRI="GROUP 6":6,WLENPRI="GROUP 7":7,WLENPRI="GROUP 8":8,1:WLENPRI)
  1.  S WLSVCCON=$G(INP(24)) S:WLSVCCON'="" WLSVCCON=$S(WLSVCCON="YES":1,1:0)
  1.  S WLSVCCOP=$G(INP(25)) I WLSVCCOP'="" S WLSVCCOP=+$G(WLSVCCOP) S:(+WLSVCCOP<0)!(+WLSVCCOP>100) WLSVCCOP=""
  1.  S WLAPTYP=+$G(INP(27)) I +WLAPTYP,'$D(^SD(409.1,WLAPTYP,0)) S WLAPTYP=""
  1.  S WLIEN=$G(WLIEN)
  1.  S WLNEW=WLIEN=""
  1.  I WLNEW D
  1.  . S FDA=$NA(FDA(FNUM,"+1,"))
  1.  . S @FDA@(.01)=+DFN
  1.  . ;This handles the date/time coming in as "8/27/2014 12:00:00 AM"
  1.  . S:$G(WLORIGDT)'="" @FDA@(1)=WLORIGDT
  1.  . S:$G(WLINST)'="" @FDA@(2)=+WLINST
  1.  . S:$G(WLTYPE)'="" @FDA@(4)=WLTYPE
  1.  . ;S:$G(WLTEAM)'="" @FDA@(5)=+WLTEAM
  1.  . S:$G(WLPOS)'="" @FDA@(6)=+WLPOS
  1.  . ;S:$G(WLSRVSP)'="" @FDA@(7)=$S(+WLSRVSP:$P($G(^SDWL(409.31,WLSRVSP,0)),U),1:WLSRVSP)
  1.  . S:$G(WLCLIN)'="" @FDA@(8)=+WLCLIN
  1.  . S:$G(WLHOS)'="" @FDA@(8.5)=WLHOS
  1.  . S:+WLAPTYP @FDA@(8.7)=+WLAPTYP
  1.  . S:$G(WLUSER)'="" @FDA@(9)=+WLUSER
  1.  . S:$G(WLEDT)'="" @FDA@(9.5)=WLEDT
  1.  . S:$G(WLPRIO)'="" @FDA@(10)=WLPRIO
  1.  . S:$G(WLENPRI)'="" @FDA@(10.5)=WLENPRI
  1.  . S:$G(WLREQBY)'="" @FDA@(11)=WLREQBY
  1.  . S:$G(WLPROV)'="" @FDA@(12)=+WLPROV
  1.  . S:$G(WLSVCCOP)'="" @FDA@(14)=WLSVCCOP
  1.  . S:$G(WLSVCCON)'="" @FDA@(15)=WLSVCCON
  1.  . S:$G(WLDAPTDT)'="" @FDA@(22)=WLDAPTDT
  1.  . S @FDA@(23)="O"
  1.  . S:$G(WLCOMM)'="" @FDA@(25)=WLCOMM
  1.  . S:$G(WLEESTAT)'="" @FDA@(27)=WLEESTAT
  1.  . S:+WLAPTYP @FDA@(8.7)=+WLAPTYP
  1.  E  D
  1.  . S WLIEN=WLIEN_"," ; Append the comma for both
  1.  . K WLDATA,WLERR
  1.  . D GETS^DIQ(FNUM,WLIEN,"*","IE","WLDATA","WLERR")
  1.  . I $D(WLERR) M WLMSG=WLERR K FDA Q
  1.  . S FDA=$NA(FDA(FNUM,WLIEN))
  1.  . I $D(WLORIGDT) D
  1.  . . I WLORIGDT'=WLDATA(FNUM,WLIEN,1,"I") S @FDA@(1)=WLORIGDT
  1.  . I $D(WLINST),WLINST'=WLDATA(FNUM,WLIEN,2,"I") S @FDA@(2)=$S(WLINST="":"@",1:+WLINST)
  1.  . I $D(WLTYPE),WLTYPE'=WLDATA(FNUM,WLIEN,4,"E") S @FDA@(4)=WLTYPE
  1.  . ;I $D(WLTEAM),WLTEAM'=WLDATA(FNUM,WLIEN,5,"I") S @FDA@(5)=$S(WLTEAM="":"@",1:+WLTEAM)
  1.  . I $D(WLPOS),WLPOS'=WLDATA(FNUM,WLIEN,6,"I") S @FDA@(6)=$S(WLPOS="":"@",1:+WLPOS)
  1.  . ;I $D(WLSRVSP),WLSRVSP'=WLDATA(FNUM,WLIEN,7,"I") S @FDA@(7)=$S(WLSRVSP="":"@",+WLSRVSP:$P($G(^DIC(40.7,$P($G(^SDWL(409.31,WLSRVSP,0)),U),0)),U),1:WLSRVSP)
  1.  . I $D(WLCLIN),WLCLIN'=WLDATA(FNUM,WLIEN,8,"I") S @FDA@(8)=$S(WLCLIN="":"@",1:+WLCLIN),AUDF=1 S:WLDATA(FNUM,WLIEN,7,"I")'="" @FDA@(7)="@"
  1.  . I $D(WLHOS),WLHOS'=WLDATA(FNUM,WLIEN,8.5,"I") S @FDA@(8.5)=WLHOS,AUDF=1 S:WLDATA(FNUM,WLIEN,7,"I")'="" @FDA@(7)="@"
  1.  . S:+WLAPTYP @FDA@(8.7)=+WLAPTYP
  1.  . I $D(WLUSER),WLUSER'=WLDATA(FNUM,WLIEN,9,"I") S @FDA@(9)=$S(WLUSER="":"@",1:+WLUSER)
  1.  . I $D(WLEDT),WLEDT'=$G(WLDATA(FNUM,WLIEN,9.5,"I")) S @FDA@(9.5)=WLEDT
  1.  . I $D(WLPRIO),WLPRIO'=WLDATA(FNUM,WLIEN,10,"I") S @FDA@(10)=$S(WLPRIO="":"@",1:WLPRIO)
  1.  . I $D(WLENPRI),WLENPRI'=WLDATA(FNUM,WLIEN,10.5,"E") S @FDA@(10.5)=WLENPRI
  1.  . I $D(WLREQBY),WLREQBY'=WLDATA(FNUM,WLIEN,11,"I") S @FDA@(11)=$S(WLREQBY="":"@",1:WLREQBY)
  1.  . I $D(WLPROV),WLPROV'=WLDATA(FNUM,WLIEN,12,"I") S @FDA@(12)=$S(WLPROV="":"@",1:+WLPROV)
  1.  . I $D(WLSVCCOP),WLSVCCOP'=$G(WLDATA(FNUM,WLIEN,14,"I")) S @FDA@(14)=WLSVCCOP
  1.  . I $D(WLSVCCON),WLSVCCON'=WLDATA(FNUM,WLIEN,15,"E") S @FDA@(15)=WLSVCCON
  1.  . I $D(WLDAPTDT),WLDAPTDT'=WLDATA(FNUM,WLIEN,22,"I") S @FDA@(22)=$S(WLDAPTDT="":"@",1:WLDAPTDT)
  1.  . I $D(WLCOMM),WLCOMM'=WLDATA(FNUM,WLIEN,25,"I") S @FDA@(25)=$S(WLCOMM="":"@",1:WLCOMM)
  1.  . I $D(WLEESTAT),WLEESTAT'=WLDATA(FNUM,WLIEN,27,"I") S @FDA@(27)=$S(WLEESTAT="":"@",1:WLEESTAT)
  1.  ; Only call UPDATE^DIE if there are any array entries in FDA
  1.  D:$D(@FDA) UPDATE^DIE("","FDA","WLRET","WLMSG")
  1.  I $D(WLMSG) D
  1.  . F MI=1:1:$G(WLMSG("DIERR")) S RET=RET_"-1^"_$G(WLMSG("DIERR",MI,"TEXT",1))_$C(30)
  1.  . S RET=RET_$C(31)
  1.  Q:$D(WLMSG)
  1.  S WLINSTI=$P($G(^SDWL(409.3,$S(+WLIEN:WLIEN,1:WLRET(1)),0)),U,3)
  1.  I $G(INP(6))'="" D WL6   ;wl specific team
  1.  I $G(INP(8))'="" D WL8   ;wl service specialty
  1.  I $D(INP(23)) D WL23(INP(23),$S(+WLIEN:WLIEN,1:WLRET(1)))   ;patient contacts
  1.  I +AUDF D WLAUD($S(+WLIEN:+WLIEN,1:WLRET(1)),WLCLIN,WLHOS,INP(8))   ;VS AUDIT
  1.  I +$G(WLRET(1)) S RET=RET_WLRET(1)_U_$C(30,31)
  1.  E  S RET=RET_+WLIEN_U_$C(30,31)
  1.  Q
  1.  ;
  1. WL6 ;WL SPECIFIC TEAM does not store with bulk UPDATE^DIE with external data; don't know why
  1.  N FDA,H
  1.  S H=$O(^SCTM(404.51,"B",+$G(INP(6)),0))
  1.  I +H K FDA S FDA=$NA(FDA(409.3,$S(+WLIEN:WLIEN,1:WLRET(1))_",")) S @FDA@(5)=H D UPDATE^DIE("","FDA")
  1.  Q
  1.  ;
  1. WL8 ;WL SERVICE/SPECIALTY does not store with bulk UPDATE^DIE if duplicates; need to look for 1st active one
  1.  ; WL Service/Specialty name - NAME field in
  1.  ; SD WL SERVICE/SPECIALTY file 409.31.
  1.  N ADUF,SDWLNOD,WLSRVSP
  1.  S WLSRVSP=""
  1.  I +INP(8) S WLSRVSP=INP(8)
  1.  I WLSRVSP="" S H="" F  S H=$O(^DIC(40.7,"B",$G(INP(8)),H)) Q:H=""  D  Q:WLSRVSP'=""
  1.  .I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q
  1.  .S WLSRVSP=$O(^SDWL(409.31,"B",H,0))
  1.  I WLSRVSP'="" D
  1.  .K FDA
  1.  .S FDA=$NA(FDA(409.3,$S(+WLIEN:WLIEN,1:WLRET(1))_","))
  1.  .S @FDA@(7)=WLSRVSP,ADUF=1
  1.  .I +WLIEN,$D(WLDATA) D
  1.  ..S:WLDATA(FNUM,WLIEN,8,"I")'="" @FDA@(8)="@"  ;errors
  1.  ..S:WLDATA(FNUM,WLIEN,8.5,"I")'="" @FDA@(8.5)="@" ;errors
  1.  .D:$D(FDA) UPDATE^DIE("","FDA")
  1.  Q
  1.  ;
  1. WLACT(NAME) ;
  1.  N ACTIVE,H
  1.  S ACTIVE=""
  1.  S H="" F  S H=$O(^DIC(40.7,"B",NAME,H)) Q:H=""  D  Q:ACTIVE'=""
  1.  .I $P(^DIC(40.7,H,0),U,3)'="",$P(^DIC(40.7,H,0),U,3)<$$NOW^XLFDT() Q
  1.  .S ACTIVE=H
  1.  Q ACTIVE
  1.  ;
  1. WL23(INP23,WLI) ;Patient Contacts
  1.  N STR23,WLASD,WLASDH,WLDATA1,WLERR1,WLI1,WLIENS,WLIENS1,WLRET1,FDA
  1.  N WLUSR,X,Y,%DT
  1.  S WLIENS=WLI_","
  1.  F WLI1=1:1:$L(INP23,"::") D
  1.  .S STR23=$P(INP23,"::",WLI1)
  1.  .K FDA
  1.  . ;
  1.  . ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/17/18
  1.  . ;
  1.  . S WLASD=$$NETTOFM^SDECDATE($P($P(STR23,"~~",1),":",1,2),"Y","N") ;
  1.  . ;S %DT="T" S X=$P($P(STR23,"~~",1),":",1,2) D ^%DT S WLASD=Y
  1.  .I (WLASD=-1)!(WLASD="") Q
  1.  .S WLASDH=""   ;$O(^SDWL(409.3,WLI,4,"B",WLASD,0))
  1.  .S WLIENS1=$S(WLASDH'="":WLASDH,1:"+1")_","_WLIENS
  1.  .S FDA=$NA(FDA(409.344,WLIENS1))
  1.  .I WLASDH'="" D
  1.  ..D GETS^DIQ(409.344,WLIENS1,"*","IE","WLDATA1","WLERR1")
  1.  ..I $P(STR23,"~~",1)'="" S @FDA@(.01)=$P($P(STR23,"~~",1),":",1,2) ;DATE ENTERED external date/time
  1.  ..I $P(STR23,"~~",2)'="" S WLUSR=$P(STR23,"~~",2) S @FDA@(2)=$S(WLUSR="":"@",+WLUSR:$P($G(^VA(200,WLUSR,0)),U,1),1:WLUSR)  ;PC ENTERED BY USER
  1.  ..I $P(STR23,"~~",4)'="" S @FDA@(3)=$P(STR23,"~~",4)     ;ACTION  C=Called; M=Message Left; L=LETTER
  1.  ..I $P(STR23,"~~",5)'="" S @FDA@(4)=$P(STR23,"~~",5)     ;PATIENT PHONE
  1.  ..;I $P(STR23,"~~",6)'="" S @FDA@(5)=$E($P(STR23,"~~",6),1,160)     ;COMMENT
  1.  .I WLASDH="" D
  1.  ..I $P(STR23,"~~",1)'="" S @FDA@(.01)=$P($P(STR23,"~~",1),":",1,2) ;DATE ENTERED external date/time
  1.  ..I $P(STR23,"~~",2)'=""  S WLUSR=$P(STR23,"~~",2) S @FDA@(2)=$S(WLUSR="":"@",+WLUSR:$P($G(^VA(200,WLUSR,0)),U,1),1:WLUSR)     ;PC ENTERED BY USER
  1.  ..I $P(STR23,"~~",4)'="" S @FDA@(3)=$P(STR23,"~~",4)     ;ACTION  C=Called; M=Message Left; L=LETTER
  1.  ..I $P(STR23,"~~",5)'="" S @FDA@(4)=$P(STR23,"~~",5)     ;PATIENT PHONE
  1.  ..;I $P(STR23,"~~",6)'="" S @FDA@(5)=$E($P(STR23,"~~",6),1,160)     ;COMMENT
  1.  .D:$D(@FDA) UPDATE^DIE("E","FDA","WLRET1","WLMSG1")
  1.  .;D:$D(@FDA) UPDATE^DIE("E","FDA","WLRET1")
  1.  Q
  1.  ;
  1. WLAUD(WLIEN,WLCLIN,SDCL,WLSTOP,DATE,USER)  ;populate VS AUDIT multiple field 45
  1.  ; WLIEN   - (required) pointer to SDEC APPT REQUEST file 409.85
  1.  ; WLCLIN  - (optional) pointer to SD WL SPECIFIC CLINIC
  1.  ; SDCL    - (optional) pointer to HOSPITAL LOCATION file 44
  1.  ; WLSTOP  - (optional) pointer to CLINIC STOP file
  1.  ; DATE    - (optional) date/time in fileman format
  1.  N SDFDA,SDP,SDPN
  1.  S WLIEN=$G(WLIEN) Q:WLIEN=""
  1.  S WLCLIN=$G(WLCLIN)
  1.  S SDCL=$G(SDCL)
  1.  S WLSTOP=$G(WLSTOP)
  1.  S SDP=$O(^SDWL(409.3,WLIEN,6,9999999),-1)
  1.  I +SDP S SDPN=^SDWL(409.3,WLIEN,6,SDP,0) I $P(SDPN,U,3)=WLCLIN,$P(SDPN,U,4)=SDCL,$P(SDPN,U,5)=WLSTOP Q
  1.  S DATE=$G(DATE) S:DATE="" DATE=$E($$NOW^XLFDT,1,12)
  1.  S USER=$G(USER) S:USER="" USER=DUZ
  1.  S SDFDA(409.345,"+1,"_WLIEN_",",.01)=DATE
  1.  S SDFDA(409.345,"+1,"_WLIEN_",",1)=USER
  1.  S:WLCLIN'="" SDFDA(409.345,"+1,"_WLIEN_",",2)=WLCLIN
  1.  S:SDCL'="" SDFDA(409.345,"+1,"_WLIEN_",",3)=SDCL
  1.  S:WLSTOP'="" SDFDA(409.345,"+1,"_WLIEN_",",4)=WLSTOP
  1.  D UPDATE^DIE("","SDFDA")
  1.  Q