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

SDECAR1.m

Go to the documentation of this file.
  1. SDECAR1 ;ALB/SAT,WTC,CT,LAB - VISTA SCHEDULING RPCS ;MAR 23, 2022@10:55
  1. ;;5.3;Scheduling;**627,642,658,686,694,745,813**;Aug 13, 1993;Build 6
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. ;
  1. Q
  1. ;
  1. ; Get SDEC APPOINTMENT REQUEST for all entries in the user's Institution
  1. ; where the Current Status is not C(losed).
  1. ARGET(RET,ARIEN1,MAXREC,SDBEG,SDEND,DFN,LASTSUB,SDTOP,SVCL,DESDT,PRL,SVCR,SCVISIT,CLINIC,ORIGDT) ;Appt Req GET ;alb/sat 658 add SVCL-SCVISIT
  1. ARGET1 ;
  1. ;29 SVCCONN - SERVICE CONNECTED? field .301 of the PATIENT file
  1. ;37 ARSVCCON - SERVICE CONNECTED PRIORITY field 15 of the SDEC APPT REQUEST file
  1. ;
  1. N CLOSED,FNUM,NAME,DOB,SSN4,GENDER,ARORIGDT,ARINST,ARINSTNM,ARTYPE,ARTEAM,ARPOS
  1. N ELIGIEN,ELIGNAME,FRULES,GLOREF,HRN,INSTIEN,INSTNAME,PRIGRP,SVCCONN,SVCCONNP,TYPEIEN,TYPENAME
  1. N PCOUNTRY,SDSUB,SDTMP,SSN,ARSSIEN,ARSSNAME,ARCLIEN,ARCLNAME
  1. N ARUSER,ARPRIO,ARREQBY,ARPROV,ARPROVNM,ARDAPTDT,ARCOMM,AREESTAT,ARUSRNM
  1. N ARCLIENL,AREDT,ARIEN,PTINFOLSTA,ARDISPD,ARDISPU,ARDISPUN,ARSVCCON
  1. N ARMAI,ARMAN,ARMAR,ARSTAT,ARSTOP,ARSTOPN,COUNT,DES,SDK,STR,SDRTMP
  1. N PCITY,GAF,PSTATE,PZIP4,PADDRES1,PADDRES2,PADDRES3,PPC,PTPHONE,ARENPRI,ARASD,ARPC,ARDATA
  1. N SDCL,SDI,SDJ,SDMTRC,SDPARENT,SDPS,SDSENS,SDDEMO,X,Y,%DT,APPTPTRS
  1. N VAOSGUID ; wtc patch 686 3/23/18 added for VAOS requests
  1. ;
  1. ; wtc/mbs patch 694 7/24/18 added to check if user has access to VAOS requests
  1. ;
  1. N VAOSUSR ;
  1. D OWNSKEY^XUSRB(.VAOSUSR,"SDECZ REQUEST") ;
  1. ;
  1. S RET="^TMP(""SDEC"","_$J_")"
  1. K @RET
  1. S FNUM=$$FNUM^SDECAR,COUNT=0
  1. S MAXREC=+$G(MAXREC,50)
  1. D HDR
  1. S GLOREF=$NA(^SDEC(409.85,"C",DUZ(2)))
  1. S FRULES=1
  1. S ARIEN=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. ;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. ;validate CLINIC
  1. S CLINIC=$G(CLINIC)
  1. ;validate ORIGDT
  1. S ORIGDT=$G(ORIGDT)
  1. ;single IEN
  1. S ARIEN1=$G(ARIEN1)
  1. I +ARIEN1 I '$D(^SDEC(409.85,+ARIEN1,0)) S ARIEN1=""
  1. I +ARIEN1 D
  1. .S ARIEN=+ARIEN1
  1. .S FRULES=0 ;no rules - just return the single record
  1. .D ONEPAT
  1. I +ARIEN1 S @RET@(COUNT)=@RET@(COUNT)_$C(31) Q
  1. ;by patient
  1. I +DFN D
  1. .I 'SDTOP S ARIEN=0 F S ARIEN=$O(^SDEC(409.85,"B",+DFN,ARIEN)) Q:ARIEN'>0 D ONEPAT ;I MAXREC,COUNT'<MAXREC Q
  1. .I +SDTOP S ARIEN=999999999 F S ARIEN=$O(^SDEC(409.85,"B",+DFN,ARIEN),-1) Q:ARIEN'>0 D ONEPAT
  1. ;clinic
  1. I CLINIC'="" D G ARX
  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 ARIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....F S ARIEN=$O(^SDEC(409.85,"GCC",SDCL,DES,ARIEN)) Q:ARIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDCL_"|"_SDT_"|"_ARIEN 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(^SDEC(409.85,"GC",SDCL,SDT)) Q:SDT="" Q:((ORIGDT'="")&(SDT>ORIGDT)) Q:(ORIGDT="")&(SDT>SDEND) D I MAXREC,COUNT'<MAXREC Q
  1. ...S ARIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ...F S ARIEN=$O(^SDEC(409.85,"GC",SDCL,SDT,ARIEN)) Q:ARIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDI_"|"_SDT_"|"_ARIEN Q
  1. ....D ONEPAT
  1. ;by service
  1. I SVCL'="" D G ARX
  1. .N PR1,SDT,SVC
  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 ARIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....F S ARIEN=$O(^SDEC(409.85,"GSC",SVC,DES,ARIEN)) Q:ARIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDT_"|"_ARIEN 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(^SDEC(409.85,"GSP",SVC,PR1,SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. .....S ARIEN=$S($P(LASTSUB,"|",4)'="":$P(LASTSUB,"|",4),1:0)
  1. .....F S ARIEN=$O(^SDEC(409.85,"GSP",SVC,PR1,SDT,ARIEN)) Q:ARIEN="" D ONEPAT I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDK_"|"_SDT_"|"_ARIEN 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(^SDEC(409.85,"GSB",SVC,$E(SVCR),SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ....S ARIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....F S ARIEN=$O(^SDEC(409.85,"GSB",SVC,$E(SVCR),SDT,ARIEN)) Q:ARIEN="" D ONEPAT I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDT_"|"_ARIEN 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(^SDEC(409.85,"GSA",SVC,$E(SCVISIT),SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ....S ARIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ....F S ARIEN=$O(^SDEC(409.85,"GSA",SVC,$E(SCVISIT),SDT,ARIEN)) Q:ARIEN="" D ONEPAT I MAXREC,COUNT'<MAXREC S SDSUB=SVC_"|"_SDT_"|"_ARIEN Q
  1. ..S SDT=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:SDBEG-1) ;GS
  1. ..F S SDT=$O(^SDEC(409.85,"GS",SVC,SDT)) Q:SDT="" Q:SDT>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ...S ARIEN=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ...F S ARIEN=$O(^SDEC(409.85,"GS",SVC,SDT,ARIEN)) Q:ARIEN="" D I MAXREC,COUNT'<MAXREC S SDSUB=SDI_"|"_SDT_"|"_ARIEN Q
  1. ....D ONEPAT
  1. ;
  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(^SDEC(409.85,"E","O",SDJ)) Q:SDJ'>0 Q:SDJ>SDEND D I MAXREC,COUNT'<MAXREC Q
  1. ...S ARIEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:0)
  1. ...F S ARIEN=$O(^SDEC(409.85,"E","O",SDJ,ARIEN)) Q:ARIEN'>0 D I MAXREC,COUNT'<MAXREC S SDSUB=SDJ_"|"_ARIEN 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(^SDEC(409.85,"E","O",SDJ),-1) Q:SDJ'>0 Q:SDJ<SDBEG D I MAXREC,COUNT'<MAXREC Q
  1. ...S ARIEN=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2),1:999999999)
  1. ...F S ARIEN=$O(^SDEC(409.85,"E","O",SDJ,ARIEN),-1) Q:ARIEN'>0 D I MAXREC,COUNT'<MAXREC S SDSUB=SDJ_"|"_ARIEN Q
  1. ....S SDSUB=""
  1. ....D ONEPAT
  1. ARX 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. HDR ;Send back the header
  1. ; 1 2
  1. S SDRTMP="T00030DFN^T00030NAME"
  1. ; 3 4 5 6 7 8
  1. S SDRTMP=SDRTMP_"^T00030HRN^T00030DOB^T00030SSN^T00030GENDER^I00010IEN^D00030ORIGDT"
  1. ; 9 10 11 12 13
  1. S SDRTMP=SDRTMP_"^T00030INSTIEN^T00030INSTNAME^T00030TYPE^T00030CLINIEN^T00030CLINNAME"
  1. ; 14 15 16 17 18 19
  1. S SDRTMP=SDRTMP_"^T00030USERIEN^T00030USERNAME^T00030PRIO^T00030REQBY^T00030PROVIEN^T00030PROVNAME"
  1. ; 20 21 22
  1. S SDRTMP=SDRTMP_"^T00030DAPTDT^T00250COMM^T00030ENROLLMENT_PRIORITY"
  1. ; 23 24 25
  1. S SDRTMP=SDRTMP_"^T00010MULTIPLE APPOINTMENT RTC^T00010MULT APPT RTC INTERVAL^T00010MULT APPT NUMBER"
  1. ; 26 27 28 29 30
  1. S SDRTMP=SDRTMP_"^T00030PRIGRP^T00030ELIGIEN^T00030ELIGNAME^T00030SVCCONN^T00030SVCCONNP"
  1. ; 31 32 33 34 35 36
  1. S SDRTMP=SDRTMP_"^T00030TYPEIEN^T00030TYPENAME^T00100PCONTACT^T00030ARDISPD^T00030ARDISPU^T00030ARDISPUN"
  1. ; 37 38 39 40 41
  1. S SDRTMP=SDRTMP_"^T00030WLSVCCON^T00030PADDRES1^T00030PADDRES2^T00030PADDRES3^T00030PCITY"
  1. ; 42 43 44 45 46 47
  1. S SDRTMP=SDRTMP_"^T00030PSTATE^T00030PCOUNTRY^T00030PZIP4^T00050GAF^T00030DATE^T00030MTRCDATES"
  1. ; 48 49 50 51 52 53
  1. S SDRTMP=SDRTMP_"^T00100SENSITIVE^T00030NU49^T00030NU50^T00030NU51^T00030NU52^T00030NU53"
  1. ; 54 55 56 57 58 59
  1. S SDRTMP=SDRTMP_"^T00030NU54^T00030NU55^T00030LASTSUB^T00030STOPIEN^T00030STOPNAME^T00250APPT_SCHED_DATE"
  1. S SDRTMP=SDRTMP_"^T00030MRTCCOUNT^T00030PTPHONE^T00030APPTYPE^T00030EESTAT^T00030PRHBLOC^T00030APPTPTRS"
  1. S SDRTMP=SDRTMP_"^T00250CHILDREN^T00030SDPARENT"
  1. ;
  1. ; Removed unnamed column header. 694 wtc 7/16/2019
  1. ;
  1. ;S SDRTMP=SDRTMP_"^T00030HRN^T00030BADADD^T00030OPHONE^T00030NOK^T00030^T00030KNAME^T00030KREL^T00030KPHONE"
  1. S SDRTMP=SDRTMP_"^T00030HRN^T00030BADADD^T00030OPHONE^T00030NOK^T00030KNAME^T00030KREL^T00030KPHONE"
  1. ;
  1. ; Removed unnamed column header. 694 wtc 7/16/2019
  1. ;
  1. ;S SDRTMP=SDRTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP^T00030"
  1. S SDRTMP=SDRTMP_"^T00030KSTREET^T00030KSTREET2^T00030KSTREET3^T00030KCITY^T00030KSTATE^T00030KZIP"
  1. S SDRTMP=SDRTMP_"^T00030NOK2^T00030K2NAME^T00030K2REL^T00030K2PHONE"
  1. S SDRTMP=SDRTMP_"^T00030K2STREET^T00030K2STREET2^T00030K2STREET3^T00030K2CITY^T00030K2STATE^T00030K2ZIP"
  1. S SDRTMP=SDRTMP_"^T00030PCOUNTY^T00030PETH^T00030PRACE^T00030PMARITAL^T00030PRELIGION^T00030PTACTIVE"
  1. S SDRTMP=SDRTMP_"^T00030PTADDRESS1^T00030PTADDRESS2^T00030PTADDRESS3^T00030PTCITY^T00030PTSTATE^T00030PTZIP^T00030PTZIP+4"
  1. S SDRTMP=SDRTMP_"^T00030PTCOUNTRY^T00030PTCOUNTY^T00030PTMPPHONE^T00030PTSTART^T00030PTEND^T00030PCELL^T00030PPAGER^T00030PEMAIL"
  1. S SDRTMP=SDRTMP_"^T00030PF_FFF^T00030PF_VCD^T00030PFNATIONAL^T00030PFLOCAL^T00030SUBGRP^T00030CAT8G^T01000SIMILAR"
  1. S SDRTMP=SDRTMP_"^T00032VAOS_GUID^T00030CPHONE^T00030CLET" ; wtc patch 686 3/23/18 added for VAOS requests ;CT added call phone & letter
  1. S SDRTMP=SDRTMP_"^T00030CEMAIL^T00030CTEXT^T00030CSEC" ; 813 contact email,text,sec msg
  1. S @RET@(COUNT)=SDRTMP_$C(30)
  1. Q
  1. ;
  1. ONEPAT ; Process one patient
  1. N APPTYPE,ARMRTC,CHILDREN,SDI,PRHBLOC
  1. K ARASD,ARDATA,ARSDOA,ARDAM,ARCLERK,ARCLERKN,SDAPPT
  1. S FRULES=$G(FRULES)
  1. D GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG")
  1. Q:'$D(ARDATA)
  1. S ARSTAT=ARDATA(FNUM,ARIEN_",",23,"I")
  1. I FRULES I '+$G(CLOSED) Q:ARSTAT="C" ; Ignore CLOSED records; CLOSED setup and used from SDEC54 only
  1. S ARORIGDT=ARDATA(FNUM,ARIEN_",",1,"I")
  1. I FRULES I ($P(ARORIGDT,".",1)<SDBEG)!($P(ARORIGDT,".",1)>SDEND) Q
  1. S DFN=ARDATA(FNUM,ARIEN_",",.01,"I")
  1. Q:DFN=""
  1. S SDPS=ARDATA(FNUM,ARIEN_",",.02,"E")
  1. S SDCL=ARDATA(FNUM,ARIEN_",",8,"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. ;collect demographics
  1. D PDEMO^SDECU3(.SDDEMO,DFN) ;alb/sat 658 PDEMO moved to SDECU3
  1. S NAME=SDDEMO("NAME")
  1. S DOB=SDDEMO("DOB")
  1. S GENDER=SDDEMO("GENDER")
  1. S HRN=SDDEMO("HRN")
  1. S SSN=SDDEMO("SSN")
  1. S INSTIEN=SDDEMO("INSTIEN")
  1. S INSTNAME=SDDEMO("INSTNAME")
  1. S PRIGRP=SDDEMO("PRIGRP")
  1. S ELIGIEN=SDDEMO("ELIGIEN")
  1. S ELIGNAME=SDDEMO("ELIGNAME")
  1. S SVCCONN=SDDEMO("SVCCONN")
  1. S SVCCONNP=SDDEMO("SVCCONNP")
  1. S TYPEIEN=SDDEMO("TYPEIEN")
  1. S TYPENAME=SDDEMO("TYPENAME")
  1. S PADDRES1=SDDEMO("PADDRES1")
  1. S PADDRES2=SDDEMO("PADDRES2")
  1. S PADDRES3=SDDEMO("PADDRES3")
  1. S PCITY=SDDEMO("PCITY")
  1. S PSTATE=SDDEMO("PSTATE")
  1. S PCOUNTRY=SDDEMO("PCOUNTRY")
  1. S PZIP4=SDDEMO("PZIP+4")
  1. ;
  1. S GAF=$$GAF^SDECU2(DFN)
  1. ;
  1. S PTPHONE=SDDEMO("HPHONE") ;ARDATA(FNUM,ARIEN_",",.05,"I") ;msc/sat
  1. S ARINST=ARDATA(FNUM,ARIEN_",",2,"I")
  1. S ARINSTNM=ARDATA(FNUM,ARIEN_",",2,"E")
  1. S ARTYPE=ARDATA(FNUM,ARIEN_",",4,"I")
  1. ;
  1. ; wtc/mbs patch 694 7/24/18 added to check if user has access to VAOS requests
  1. ;
  1. I ARTYPE="VETERAN",'$G(VAOSUSR(0)) Q ;
  1. ;
  1. S VAOSGUID=ARDATA(FNUM,ARIEN_",",5,"I") ; wtc patch 686 3/23/18 added for VAOS requests
  1. S ARCLIENL=ARDATA(FNUM,ARIEN_",",8,"I")
  1. S ARSTOP=ARDATA(FNUM,ARIEN_",",8.5,"I")
  1. S ARSTOPN=ARDATA(FNUM,ARIEN_",",8.5,"E")
  1. ;S ARCLIEN=$P($G(^SDWL(409.32,+ARCLIENL,0)),U,1)
  1. S ARCLIEN=ARCLIENL
  1. S ARCLNAME=ARDATA(FNUM,ARIEN_",",8,"E")
  1. S APPTYPE=ARDATA(FNUM,ARIEN_",",8.7,"I")
  1. S ARUSER=ARDATA(FNUM,ARIEN_",",9,"I")
  1. S ARUSRNM=ARDATA(FNUM,ARIEN_",",9,"E")
  1. S AREDT=$G(ARDATA(FNUM,ARIEN_",",9.5,"E")) ;53
  1. S ARPRIO=ARDATA(FNUM,ARIEN_",",10,"I")
  1. S ARENPRI=ARDATA(FNUM,ARIEN_",",10.5,"E") ;msc/sat
  1. S ARREQBY=ARDATA(FNUM,ARIEN_",",11,"I")
  1. S ARPROV=ARDATA(FNUM,ARIEN_",",12,"I")
  1. S ARPROVNM=ARDATA(FNUM,ARIEN_",",12,"E")
  1. ;S ARSDOA=ARDATA(FNUM,ARIEN_",",13,"E") ;scheduled date of appt
  1. S ARSDOA=ARDATA(FNUM,ARIEN_",",13,"I") ;scheduled date of appt
  1. ; Change date/time conversion so midnight is handled properly. wtc/pwc 694 1/7/2020
  1. ;
  1. S ARSDOA=$$FMTONET^SDECDATE(ARSDOA,"N") ;
  1. S ARDAM=ARDATA(FNUM,ARIEN_",",13.1,"E") ;date appt. made
  1. S ARCLERK=ARDATA(FNUM,ARIEN_",",13.7,"I") ;appt clerk ien
  1. S ARCLERKN=ARDATA(FNUM,ARIEN_",",13.7,"E") ;appt clerk name
  1. S ARASD=""
  1. S:ARSDOA'="" $P(ARASD,"~~",1)=ARSDOA
  1. S:ARCLERK'="" $P(ARASD,"~~",12)=ARCLERK
  1. S:ARCLERKN'="" $P(ARASD,"~~",13)=ARCLERKN
  1. S:ARDAM'="" $P(ARASD,"~~",17)=ARDAM
  1. S ARSVCCON=ARDATA(FNUM,ARIEN_",",15,"E")
  1. S ARDAPTDT=ARDATA(FNUM,ARIEN_",",22,"I")
  1. S ARCOMM=ARDATA(FNUM,ARIEN_",",25,"I")
  1. ;S AREESTAT=ARDATA(FNUM,ARIEN_",",27,"I")
  1. S ARMAR=$$GET1^DIQ(409.85,ARIEN_",",41)
  1. S ARMAI=$$GET1^DIQ(409.85,ARIEN_",",42)
  1. S ARMAN=$$GET1^DIQ(409.85,ARIEN_",",43)
  1. S ARPC=$$WLPC^SDECAR1A(.ARDATA,ARIEN)
  1. S ARDISPD=ARDATA(FNUM,ARIEN_",",19,"E")
  1. S ARDISPU=ARDATA(FNUM,ARIEN_",",20,"I")
  1. S ARDISPUN=ARDATA(FNUM,ARIEN_",",20,"E")
  1. S APPTPTRS=$$GETAPPTS^SDECAR1A(ARIEN)
  1. S CHILDREN=$$CHILDREN^SDECAR1A(ARIEN)
  1. S ARMRTC=$$MRTC^SDECAR(ARIEN)
  1. S SDPARENT=ARDATA(FNUM,ARIEN_",",43.8,"I")
  1. S SDSENS=$$PTSEC^SDECUTL(DFN)
  1. S (SDI,SDMTRC)="" F S SDI=$O(ARDATA(409.857,SDI)) Q:SDI="" S SDMTRC=$S(SDMTRC'="":SDMTRC_"|",1:"")_ARDATA(409.857,SDI,.01,"E")
  1. S COUNT=COUNT+1
  1. ; 1 2 3 4 5 6 7 8 9 10 11
  1. S STR=DFN_U_""_U_""_U_""_U_""_U_""_U_ARIEN_U_ARORIGDT_U_ARINST_U_ARINSTNM_U_ARTYPE
  1. ; 12 13 14 15 16 17 18
  1. S STR=STR_U_ARCLIEN_U_ARCLNAME_U_ARUSER_U_ARUSRNM_U_ARPRIO_U_ARREQBY_U_ARPROV
  1. ; 19 20 21 22 23 24 25
  1. S STR=STR_U_ARPROVNM_U_ARDAPTDT_U_ARCOMM_U_ARENPRI_U_ARMAR_U_ARMAI_U_ARMAN
  1. ; 26 27 28;29 30 31 32 33
  1. S STR=STR_U_PRIGRP_U_ELIGIEN_U_ELIGNAME_U_SVCCONN_U_SVCCONNP_U_TYPEIEN_U_TYPENAME_U_ARPC
  1. ; 34 35 36 37 38 39 40 41 42
  1. S STR=STR_U_ARDISPD_U_ARDISPU_U_ARDISPUN_U_ARSVCCON_U_""_U_""_U_""_U_""_U_""
  1. ; 43 44 45 46 47 48 57 (save 56 for SDSUB)
  1. S STR=STR_U_""_U_""_U_GAF_U_AREDT_U_SDMTRC_U_SDSENS_U_U_U_U_U_U_U_U_U_ARSTOP_U_ARSTOPN_U_ARASD
  1. S STR=STR_U_ARMRTC_U_PTPHONE_U_APPTYPE_U_SDPS_U_PRHBLOC_U_APPTPTRS_U_CHILDREN_U_SDPARENT
  1. D ARDEMO^SDECAR1A(.STR,DFN) ;alb/sat 658 - get demographics
  1. S $P(STR,"^",119)=VAOSGUID ; wtc patch 686 3/23/18 added for VAOS requests. Revised to store in piece 119.
  1. S SDAPPT=$$CALLET^SDECAR1A(DFN,ARIEN) ;CT *745 # OF CALLS MADE AND DATE LAST LETTER SENT
  1. S $P(STR,"^",120)=$P(SDAPPT,"^",1),$P(STR,"^",121)=$P(SDAPPT,"^",2) ;SDCALL ^ SDCLET *745
  1. S $P(STR,"^",122)=$P(SDAPPT,"^",3) ;813
  1. S $P(STR,"^",123)=$P(SDAPPT,"^",4) ;813
  1. S $P(STR,"^",124)=$P(SDAPPT,"^",5) ;813
  1. S @RET@(COUNT)=STR_$C(30)
  1. Q
  1. ;
  1. ARGUID(RET,GUID) ;
  1. ;
  1. ; Return SDEC Appointment Request data for a VAOS Request GUID.
  1. ;
  1. ; wtc SD*5.3*686 4/19/2018
  1. ;
  1. N FNUM,ARIEN,SDTMP,COUNT ;
  1. S RET="^TMP(""SDEC"","_$J_")" ;
  1. K @RET ;
  1. S FNUM=$$FNUM^SDECAR,COUNT=0 ;
  1. S ARIEN=$O(^SDEC(409.85,"GUID",GUID,0)) ;
  1. D HDR ;
  1. I ARIEN>0 D ;
  1. . ;
  1. . ; wtc/mbs patch 694 7/24/18 added to check if user has access to VAOS requests
  1. . ;
  1. . N VAOSUSR ;
  1. . D OWNSKEY^XUSRB(.VAOSUSR,"SDECZ REQUEST") ;
  1. . ;
  1. . D ONEPAT ;
  1. G ARX ;
  1. ;