SDECEPT.m

SDECEPT ;SPFO/RT,MGD,LAB,ANU - SCHEDULING ENHANCEMENTS VSE EP API ;JUN 08,2023

 ;;5.3;Scheduling;**669,671,694,794,809,813,823,846**;Aug 13 1993;Build 12

 ;;Per VHA Directive 6402, this routine should not be modified

 ;

 ;The API provides Extended Profile Appt info the VS GUI.

 ;INPUT - DFN required

 ;        APP appointment date/time required

 Q

 ;

INIT ;

 S (PAT0,PAM0,CLIEN,HLF0,HLAPIEN,HLAP0)=""

 ;

 ; PAT0=Global location 0 from Patient file

 ; PAM0=Global location 0 from Patient Appointment Multiple

 ; CLIEN=Clinic IEN

 ; HLF0=Global location 0 from Hospital Location File

 ; HLAPIEN=Hospital Location Appointment Multiple IEN

 ; HLAP0=Global location 0 from Hospital Appointment Multiple

 ;

 ; SET HELPERS

 ;

 S PAT0=$G(^DPT(DFN,0))

 S PAM0=$G(^DPT(DFN,"S",ADT,0)) I PAM0'="" D

 .S CLIEN=$P($G(PAM0),U,1) I CLIEN'="" D

 ..S HLF0=$G(^SC(CLIEN,0))

 ..S HLAPIEN=+$$FIND^SDAM2(DFN,ADT,CLIEN) I HLAPIEN'="" D

 ...S HLAP0=$G(^SC(CLIEN,"S",ADT,1,HLAPIEN,0))

 Q

 ;

GETDEM(RET,DFN,ADT,SDAPPTIEN) ;

 ; REQUIRE DFN AND APPOINTMENT DATE TIME

 Q:'$G(DFN)

 Q:'$G(ADT)

 S SDAPPTIEN=$G(SDAPPTIEN)

 S SDRET=$$SDEXPST(.SDRET,DFN,ADT,SDAPPTIEN)

 I +SDRET=-1 D  Q RET

 . S RET="-1^The detail for the selected record is no longer available in VistA. Select the more recent record for Expanded Entry."

 ;

 S ADT=+ADT   ;strip off extra zeros on time  pwc SD*5.3*694

 D INIT

 ;

 ; INITIALIZE VARIABLES

 S (PATN,SSN,LAB,XRAY,EKG,PCODE,POV,ATIEN)=""

 S (PAMAT,CCODE,COLL,CLN,LOA,OTH,ECODE,EGIL,PAMSC)=""

 S (ENROLC,STAT,OCODE)=""

 N TIMEZONE

 N APPTDATA,PATCMNTS,COUNT

 ;

 ;PATN=Patient Name - Patient File [0,1]

 ;SSN=Formatted Social Security Number

 ;STAT=Status Patient Appointment Multiple - CURRENT STATUS (2.98,100)

 ;LAB=Date/Time of Labs - PATIENT/APPOINTMENT MULTIPLE [0,3]

 ;XRAY=Date/Time of x-ray - PATIENT/APPOINTMENT MULTIPLE [0,4]

 ;EKG=Date/Time of EKG - PATIENT/APPOINTMENT MULTIPLE [0,5]

 ;PCODE=Purpose of Visit Code - PATIENT/APPOINTMENT MULTIPLE [0,7]

 ;POV=Purpose of Visit

 ;ATIEN=Appointment Type IEN - PATIENT/APPOINTMENT MULTIPLE [0,16]

 ;PAMAT=Patient Appointment Multiple Appointment Type

 ;CCODE=Collateral Code - PATIENT/APPOINTMENT MULTIPLE [0,11]

 ;COLL=Collateral Yes or No

 ;CLN=Clinic Name - Hospital Location File [0,1]

 ;LOA=Length of Appointment - Hospital Location Appointment Multiple [0,2]

 ;ECODE=Eligibility Code - Hospital Location Appointment Multiple [0,10]

 ;EGIL=Eligibility of Appointment

 ;OCODE=Overbook Code - Hospital Location Appointment Multiple [QB]

 ;OVB=Overbook

 ;PATEN0=Patient Enrollment Clinic - Patient File Enrollment Clinic Multiple [B]

 ;ENROLC=Enrolled in Clinic Yes/No

 ;ERCNUM=Enrolled Clinic Number

 ;LPNUM=Loop Number

 ;

 ; -PATIENT FILE GLOBAL LOCATION 0

 I PAT0'="" D

 .S PATN=$P($G(PAT0),U,1)

 .S SSN=$$LAST4SSN^SDESINPUTVALUTL(DFN)

 ;

 ; -PATIENT/APPOINTMENT MULTIPLE GLOBAL LOCATION 0

 I PAM0'="" D

 .S STAT=$$STATUS^SDAM1(DFN,ADT,CLIEN,PAM0) I STAT'="" D

 ..S STAT=$P(STAT,";",2)

 .S LAB=$P($G(PAM0),U,3)

 .S XRAY=$P($G(PAM0),U,4)

 .S EKG=$P($G(PAM0),U,5)

 .S PCODE=$P($G(PAM0),U,7) I PCODE'="" D

 ..S POV=$S(PCODE=1:"C&P",PCODE=2:"10-10",PCODE=3:"SCHEDULED",PCODE=4:"UNSCHEDULED",1:"UNKNOWN")

 .S ATIEN=$P($G(PAM0),U,16) I ATIEN'="" D

 ..S PAMAT=$$GET1^DIQ(409.1,ATIEN,.01)

 .S CCODE=$P($G(PAM0),U,11)

 .S COLL="No" I CCODE=1 S COLL="Yes"

 ;

 ; -HOSPITAL LOCATION FILE GLOBAL LOCATION 0

 I HLF0'="" D

 .S CLN=$P($G(HLF0),U,1)

 ;

 ; -HOSPITAL LOCATION/APPOINTMENT/PATIENT MULTIPLE GLOBAL LOCATION 0

 I HLAP0'="" D

 .S LOA=+$P($G(HLAP0),U,2)

 .S OTH=$P($G(HLAP0),U,4)

 .S ECODE=$P($G(HLAP0),U,10) I ECODE'="" D

 ..S EGIL=$$GET1^DIQ(8,ECODE,.01)

 .I ECODE="" S EGIL=$P($G(^DIC(8,+$G(^DPT(DFN,.36)),0)),U)

 ;

 ; -HOSPITAL LOCATION/APPOINTMENT/PATIENT MULTIPLE GLOBAL LOCATION OB

 I HLAPIEN'="" S OCODE=$G(^SC(CLIEN,"S",ADT,1,HLAPIEN,"OB"))   ; pwc added check for HLAPIEN SD*5.3*694

 S OVB="" I OCODE="O" S OVB="OVERBOOK"

 ;

 ; -PATIENT FILE ENROLLMENT CLINIC MULTIPLE

 S ENROLC="No"

 S LPNUM=0 F  S LPNUM=$O(^DPT(DFN,"DE",LPNUM)) Q:LPNUM=""  D

 .S ERCNUM=$P($G(^DPT(DFN,"DE",LPNUM,0)),"^",1)

 .Q:ERCNUM'=CLIEN

 .I $P($G(^DPT(DFN,"DE",LPNUM,0)),"^",2)="" D

 ..S ENROLC="Yes"

 ..Q

 ;

 ; -CONVERT DATES TO EXTERNAL

 ;

 ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/7/18

 ;

 ;S Y=ADT D D^DIQ S ADT=Y

 S ADT=$$FMTONET^SDECDATE(ADT) ;

 ;I LAB'="" S Y=LAB D D^DIQ S LAB=Y

 I LAB'="" S LAB=$$FMTONET^SDECDATE(LAB) ;

 ;I XRAY'="" S Y=XRAY D D^DIQ S XRAY=Y

 I XRAY'="" S XRAY=$$FMTONET^SDECDATE(XRAY) ;

 ;I EKG'="" S Y=EKG D D^DIQ S EKG=Y

 I EKG'="" S EKG=$$FMTONET^SDECDATE(EKG) ;

 ;

 S TIMEZONE=$$TIMEZONEDATA^SDESUTIL($G(CLIEN)),TIMEZONE=$P($G(TIMEZONE),U)

 ;

 ;ANU

 D GETPATCOMMENTS^SDESAPPTDATA(.APPTDATA,SDAPPTIEN)

 S COUNT=1

 S PATCMNTS=APPTDATA("PatientComments",1)

 F  S COUNT=$O(APPTDATA("PatientComments",COUNT)) Q:'COUNT  D

 .S PATCMNTS=PATCMNTS_U_APPTDATA("PatientComments",COUNT)

 ;

 S RET=PATN_U_CLN_U_SSN_U_ADT_U_STAT_U_POV_U_LOA_U_PAMAT_U_LAB_U_EGIL_U_XRAY_U_OVB_U_EKG_U_COLL_U_OTH_U_ENROLC_U_TIMEZONE_U_$G(PATCMNTS)_U

 ;

 D EXIT

 Q

 ;

SDEXPST(SDRET,DFN,ADT,SDAPPTIEN) ;

 N SDAPPT,SDRTN,SDNEXTIEN,SDCAN

 S SDRTN="" ; Appt can be expanded

 S SDAPPT="",ADT=+ADT

 F  S SDAPPT=$O(^SDEC(409.84,"APTDT",DFN,ADT,SDAPPT)) Q:'SDAPPT  D  Q:SDRTN'=""

 . Q:SDAPPT'=SDAPPTIEN

 . S SDCAN=($$GET1^DIQ(409.84,SDAPPT,.12,"I")'="")

 . S SDNEXTIEN=$O(^SDEC(409.84,"APTDT",DFN,ADT,SDAPPT))

 . ; Current Appt is cancelled and there is another APPT

 . I SDCAN,SDNEXTIEN S SDRTN=-1 Q

 . ; Current Appt is cancelled & no other Appt

 . I SDCAN,'SDNEXTIEN S SDRTN=0 Q

 . ; Current Appt is NOT cancelled so there can't be other Appt for same Date/Time

 . I 'SDCAN,'SDNEXTIEN S SDRTN=0 Q

 S SDRET=SDRTN

 Q SDRET

 ;

GETEVT(RET,DFN,ADT) ;

 ; REQUIRE DFN AND APPOINTMENT DATE TIME

 Q:'$G(DFN)

 Q:'$G(ADT)

 ;

 S ADT=+ADT  ;strip off extra zeros on time  pwc SD*5.3*694

 D INIT

 ;

 ; INITIALIZE VARIABLES

 S (AMUIEN,AMU,AMD,HLAPC,CID,CIUIEN,CIUN,COD,COUIEN,CREAC)=""

 S (COUN,COED,NCD,NCUIEN,NCUN,CANREA,RBD,CANREM,AMUN,HLPAC)=""

 ;

 ;AMUIEN=Appointment Made User IEN - Hospital Location Appointment Multiple [0,6]

 ;AMUN=Appointment Made User Name - New Person File Field .01

 ;AMD=Appointment Made Date - Hospital Location Appointment Multiple [0,7]

 ;HLAPC=Global location C from Hospital Location Appointment Multiple

 ;CID=Check-in Date - Hospital Location Appointment Multiple [C,1]

 ;CIUIEN=Check-in User IEN - Hospital Location Appointment Multiple [C,2]

 ;CIUN=Check-in User Name - New Person File Field .01

 ;COD=Check Out Date - Hospital Location Appointment Multiple [C,3]

 ;COUIEN=Check Out User IEN - Hospital Location Appointment Multiple [C,4]

 ;COUN=Check Out User Name - New Person File Field .01

 ;COED=Check Out Entered Date - Hospital Location Appointment Multiple [C,3]

 ;NCD=No-Show/Cancel Date - PATIENT/APPOINTMENT MULTIPLE [0,14]

 ;NCUIEN=No-Show/Cancel User IEN - PATIENT/APPOINTMENT MULTIPLE [0,12]

 ;NCUN=No-Show/Cancel User Name - New Person File Field .01

 ;CREAC=Cancel Reason Code - PATIENT/APPOINTMENT MULTIPLE [0,15]

 ;CANREA=Cancel Reason - CANCELLATION REASONS [0,1]

 ;RBD=Rebook Date - PATIENT/APPOINTMENT MULTIPLE [0,10]

 ;CANREM=Cancel Remarks - PATIENT/APPOINTMENT MULTIPLE [R,1]

 ;

 ; -HOSPITAL LOCATION/APPOINTMENT/PATIENT MULTIPLE GLOBAL LOCATION 0

 I HLAP0'="" D

 .S AMUIEN=$P($G(HLAP0),U,6) I AMUIEN'="" D

 ..S AMUN=$$GET1^DIQ(200,AMUIEN,.01,"E")

 .S AMD=$P($G(HLAP0),U,7)

 ;

 ; -HOSPITAL LOCATION/APPOINTMENT/PATIENT MULTIPLE GLOBAL LOCATION C

 I HLAPIEN'="" S HLAPC=$G(^SC(CLIEN,"S",ADT,1,HLAPIEN,"C")) I HLAPC'="" D

 .S CID=$P($G(HLAPC),U,1) I CID'="" D

 ..S CIUIEN=$P($G(HLAPC),U,2) I CIUIEN'="" D

 ...S CIUN=$$GET1^DIQ(200,CIUIEN,.01,"E")

 .S COD=$P($G(HLAPC),U,3) I COD'="" D

 ..S COUIEN=$P($G(HLAPC),U,4) I COUIEN'="" D

 ...S COUN=$$GET1^DIQ(200,COUIEN,.01,"E")

 ..S COED=$P($G(HLAPC),U,6)

 ;

 ; -PATIENT/APPOINTMENT MULTIPLE GLOBAL LOCATION 0

 I PAM0'="" D

 .S NCD=$P($G(PAM0),U,14) I NCD'="" D

 ..S NCUIEN=$P($G(PAM0),U,12) I NCUIEN'="" D

 ...S NCUN=$$GET1^DIQ(200,NCUIEN,.01,"E")

 .S CREAC=$P($G(PAM0),U,15) I NCUIEN'="" D

 ..S CANREA=$$GET1^DIQ(409.2,CREAC,.01)

 .S RBD=$P($G(PAM0),U,10)

 I AMUN="" D

 .S AMUIEN=$P($G(PAM0),U,18) I AMUIEN'="" D

 ..S AMUN=$$GET1^DIQ(200,AMUIEN,.01,"E")

 I AMD="" D

 .S AMD=$P($G(PAM0),U,19)

 ;

 ; -PATIENT/APPOINTMENT MULTIPLE GLOBAL LOCATION R

 S PAMR=$G(^DPT(DFN,"S",ADT,"R")) I PAMR'="" D

 .S CANREM=$P($G(PAMR),U,1)

 ;

 ; -CONVERT DATES TO EXTERNAL

 ;

 ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/7/18

 ;

 ;I AMD'="" S Y=AMD D D^DIQ S AMD=Y

 I AMD'="" S AMD=$$FMTONET^SDECDATE(AMD) ;

 ;I CID'="" S Y=CID D D^DIQ S CID=Y

 I CID'="" S CID=$$FMTONET^SDECDATE(CID) ;

 ;I COD'="" S Y=COD D D^DIQ S COD=Y

 I COD'="" S COD=$$FMTONET^SDECDATE(COD) ;

 ;I COED'="" S Y=COED D D^DIQ S COED=Y

 I COED'="" S COED=$$FMTONET^SDECDATE(COED) ;

 ;I NCD'="" S Y=NCD D D^DIQ S NCD=Y

 I NCD'="" S NCD=$$FMTONET^SDECDATE(NCD) ;

 ;

 S RET=AMD_U_AMUN_U_CID_U_CIUN_U_COD_U_COUN_U_COED_U_NCD_U_NCUN_U_CANREA_U_CANREM_U_RBD

 ;

 D EXIT

 Q

 ;

GETWT(RET,DFN,ADT) ;

 ; REQUIRE DFN AND APPOINTMENT DATE TIME

 Q:'$G(DFN)

 Q:'$G(ADT)

 ;

 S ADT=+ADT   ;strip off extra zeros on time  pwc SD*5.3*694

 D INIT

 ;

 S (REQTC,REQT,NATCODE,NAT,AMD,PAM1,CID,FUVCODE,FUV,CWT1,CWT2)=""

 ;

 ;REQTC=Request Type Code - Patient File Appointment Multiple [0,25]

 ;REQT=Request Type

 ;NATCODE=Next Available Type Code - Patient File Appointment Multiple [0,26]

 ;NAT=Next Available Type

 ;AMD=Appointment Made Date - Patient File Appointment Multiple [0,19]

 ;PAM1=Global Location 1 of the Patient File Appointment Multiple

 ;CID=Clinic Indicated Date/Preferred Date - Patient File Appointment Multiple [1,1]

 ;FUVCODE=Follow-Up Visit Code 1=Yes 0=No - Patient File Appointment Multiple [1,2]

 ;FUV=Follow-Up Visit

 ;CWT1=Clinic Wait Time 1

 ;CWT2=Clinic Wait Time 2

 ;

 ; -PATIENT/APPOINTMENT MULTIPLE GLOBAL LOCATION 0

 I PAM0'="" D

 .S REQTC=$P($G(PAM0),U,25) I REQTC'="" D

 ..I REQTC="N" S REQT="'NEXT AVAILABLE' APPT."

 ..I REQTC="C" S REQT="OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)"

 ..I REQTC="P" S REQT="OTHER THAN 'NEXT AVA.' (PATIENT REQ.)"

 ..I REQTC="W" S REQT="WALKIN APPT."

 ..I REQTC="M" S REQT="MULTIPLE APPT. BOOKING"

 ..I REQTC="A" S REQT="AUTO REBOOK"

 ..I REQTC="O" S REQT="OTHER THAN 'NEXT AVA.' APPT."

 .S NATCODE=$P($G(PAM0),U,26) I NATCODE'="" D

 ..I NATCODE=0 S NAT="NOT INDICATED TO BE A 'NEXT AVA.' APPT."

 ..I NATCODE=1 S NAT="'NEXT AVA.' APPT. INDICATED BY USER"

 ..I NATCODE=3 S NAT="'NEXT AVA.' APPT. INDICATED BY CALCULATION"

 ..I NATCODE=4 S NAT="'NEXT AVA.' APPT. INDICATED BY USER & CALCULATION"

 .S AMD=$P($G(PAM0),U,19)

 ;

 ; -PATIENT/APPOINTMENT MULTIPLE GLOBAL LOCATION 1

 S PAM1=$G(^DPT(DFN,"S",ADT,1)) I PAM1'="" D

 .S CID=$P($G(PAM1),U,1)

 .S FUVCODE=$P($G(PAM1),U,2)

 .S FUV="No" I FUVCODE=1 S FUV="Yes"

 ;

 ; CALULATE WAIT TIMES

 S (X,X1,X2)=""

 I AMD'="" D

 .S X1=ADT S X2=AMD D ^%DTC S CWT1=X

 I CID'="" D

 .S X1=ADT S X2=CID D ^%DTC S CWT2=X

 ;

 ; -CONVERT DATES TO EXTERNAL

 ;

 ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/7/18

 ;

 ;I CID'="" S Y=CID D D^DIQ S CID=Y

 I CID'="" S CID=$$FMTONET^SDECDATE(CID) ;

 ;

 S RET=REQT_U_NAT_U_CID_U_FUV_U_CWT1_U_CWT2

 ;

 D EXIT

 Q

 ;

 ;STATUS, LAST ADMIT/LODGER DATE, LAST DISCHARGE/LODGER DATE

INP ;

 Q:'$G(DFN)

 ;

 S (LADMT,LDIS,DNUM,STAT,SDST,SDSTA,REN,A)=""

 I '$D(^DGPM("C",DFN)) S LSTAT="NO INPT./LOD. ACT." Q

 ;

 S VAIP("D")="L",VAIP("L")="" D INP^DGPMV10

 S A=$S("^3^5^"[("^"_+DGPMVI(2)_"^"):0,1:+DGPMVI(2)),SDST=$S('A:"IN",1:"")_"ACTIVE ",SDSTA=$S("^4^5^"[("^"_+DGPMVI(2)_"^"):"LODGER",1:"INPATIENT")

 S STAT="" S STAT=SDST_SDSTA

 S LADMT="" S LADMT=$P($G(DGPMVI(13,1)),"^",2)

 S DNUM="" S DNUM=$G(DGPMV1(17)) I DNUM'="" D

 .S LDIS="" S LDIS=$$GET1^DIQ(405,DNUM,.01)

 Q

GETPTIN(RET,DFN,ADT) ;

 ;REQUIRE DFN AND APPOINTMENT DATE TIME

 Q:'$G(DFN)

 Q:'$G(ADT)

 ;

 S ADT=+ADT  ;strip off extra zeros on time  pwc SD*5.3*694

 D INIT

 ;

 S (DOB,SSN,SEX,MARSIEN,MARS,RELGP,PAT36,PELIG,POS,SADDR1,SWASIAC)=""

 S (SADDR2,SADDR3,CITY,STATEN,STATE,CNTY,ADDR,PHN,CPHN,PGER,EMAIL,RADEXC)=""

 S (RADEX,STAT,POW,LADMT,AOEXLC,AOEXL,LDIS,CMBTVC,CMBTV,CMBTVED,PROJ112)=""

 S (PROCODE,SWASIA,PAT36,PAT11,PAT13,PAT36,PAT52,PAT321,PAT322,POWCODE)=""

 S (RELGPN,PELIGN,POSN)=""

 ;

 ;DOB=Date Of Birth - Patient File [0,3]

 ;SSN=Formatted Social Security Number

 ;SEX=Male or Female - Patient File [0,2]

 ;MARSIEN=Marital Status IEN - Patient File [0,5]

 ;MARS=Marital Status - Marital Status File (11) Field .01

 ;RELGPN=Religious Preference IEN - Patient File [0,8]

 ;RELGP=Religious Preference - file 13 field .01 (Name)

 ;PELIGN=Primary Eligibility IEN - Patient File [.36,1]

 ;PELIG=Primary Eligibility - File 8 field .01 (name)

 ;POSN=Period of Service IEN

 ;POS=Period of Service - File 21 Field .01 (Name)

 ;SADDR1=Street Address 1 - Patient File [.11,1]

 ;SADDR2=Street Address 2 - Patient File [.11,2]

 ;SADDR3=Street Address 2 - Patient File [.11,3]

 ;CITY=City - Patient File [.11,4]

 ;STATEN=State IEN - Patient File [.11,5]

 ;STATE=State - State File (5) Field .01

 ;CNTYIEN=Country IEN - Patient File [.11,10]

 ;CNTY=Country - Country Code File (779.004) Field .01

 ;ADDR=Address

 ;PHN=Phone Number - Patient File [.13,1]

 ;CPHN=Cell Phone Number - Patient File [.13,4]

 ;PGER=Pager Number - Patient File [.13,5]

 ;EMAIL=Email Address - Patient File [.13,3]

 ;RADEXC=Radiation Exposure CODE Y=Yes N=No U=Unknown - Patient File [.321,3]

 ;RADEX=Radiation Exposure

 ;

 ;STAT=Status ???

 ;

 ;POWCODE=Prisoner Of War CODE Y=Yes N=No U=Unknown - Patient File [.52,5]

 ;POW=Prisoner Of War

 ;

 ;LADMT=Last Admit/Lodger Date ???

 ;

 ;AOEXLC=Agent Orange Exposure Location CODE K=Korean DMZ V=Vietnam O=Other - Patient File [.321,13]

 ;AOEXL=Agent Orange Exposure Location

 ;

 ;LDIS=Last Discharge/Lodger Date ???

 ;

 ;CMBTVC=Combat Veteran CODE Y=Yes N=No - Patient File [.52,11]

 ;CMBTV=Combat Veteran

 ;CMBTVED=Combat Veteran End Date - Patient File [.52,14]

 ;PROCODE=Project 112/SHAD CODE 0=No 1=Yes - Patient File [.321,15]

 ;PROJ112=Project 112/SHAD

 ;SWASIAC=SW Asia Conditions Code Y=Yes N=No U=Unknown - Patient File [.322,13]

 ;SWASIA=SW Asia Conditions

 ;

 ; -PATIENT FILE GLOBAL LOCATION 0

 I PAT0'="" D

 .S DOB=$P($G(PAT0),U,3)

 .S SSN=$$LAST4SSN^SDESINPUTVALUTL(DFN)

 .S SEXCODE=$P($G(PAT0),U,2) I SEXCODE'="" D

 ..I SEXCODE="M" S SEX="Male"

 ..I SEXCODE="F" S SEX="Female"

 .S MARSIEN=$P($G(PAT0),U,5) I MARSIEN'="" D

 ..S MARS=$$GET1^DIQ(11,MARSIEN,.01)

 .S RELGPN=$P($G(PAT0),U,8) I RELGPN'="" D

 ..S RELGP=$$GET1^DIQ(13,RELGPN,.01)

 ;

 ; -PATIENT FILE GLOBAL LOCATION .11

 S PAT11=$G(^DPT(DFN,.11)) I PAT11'="" D

 .S SADDR1=$P($G(PAT11),U,1)

 .S SADDR2=$P($G(PAT11),U,2)

 .S SADDR3=$P($G(PAT11),U,3)

 .S CITY=$P($G(PAT11),U,4)

 .S STATEN=$P($G(PAT11),U,5) I STATEN'="" D

 ..S STATE=$$GET1^DIQ(5,STATEN,.01)

 .S ZCODE=$P($G(PAT11),U,6)

 .S CNTYIEN=$P($G(PAT11),U,10) I CNTYIEN'="" D

 ..S CNTY=$$GET1^DIQ(779.004,CNTYIEN,.01)

 .S SADDR=SADDR1 I SADDR2'="" D

 ..S SADDR=SADDR1_" "_SADDR2 I SADDR3'="" D

 ...S SADDR=SADDR1_" "_SADDR2_" "_SADDR3

 .S ADDR=SADDR_" "_CITY_", "_STATE_" "_ZCODE_" "_CNTY

 ;

 ; -PATIENT FILE GLOBAL LOCATION .13

 S PAT13=$G(^DPT(DFN,.13)) I PAT13'="" D

 .S PHN=$P($G(PAT13),U,1)

 .S CPHN=$P($G(PAT13),U,4)

 .S PGER=$P($G(PAT13),U,5)

 .S EMAIL=$P($G(PAT13),U,3)

 ;

 ; -PATIENT FILE GLOBAL LOCATION .36

 S PAT36=$G(^DPT(DFN,.36)) I PAT36'="" D

 .S PELIGN=$P($G(PAT36),U,1) I PELIGN'="" D

 ..S PELIG=$$GET1^DIQ(8,PELIGN,.01)

 ;

 ; -PATIENT FILE GLOBAL LOCATION .52

 S PAT52=$G(^DPT(DFN,.52)) I PAT52'="" D

 .S POWCODE=$P($G(PAT52),U,5) I POWCODE'="" D

 ..I POWCODE="Y" S POW="Yes"

 ..I POWCODE="N" S POW="No"

 ..I POWCODE="U" S POW="Unknown"

 .S CMBTVC=$P($G(PAT52),U,11) I CMBTVC'="" D

 ..S CMBTV="No"

 ..I CMBTVC="Y" S CMBTV="Yes"

 .S CMBTVED=$P($G(PAT52),U,14) I CMBTV="No" D

 ..S CMBTVED="N/A"

 ;

 ; -PATIENT FILE GLOBAL LOCATION .321

 S PAT321=$G(^DPT(DFN,.52)) I PAT321'="" D

 .S RADEXC=$P($G(PAT321),U,3) I RADEXC'="" D

 ..I RADEXC="Y" S RADEX="Yes"

 ..I RADEXC="N" S RADEX="No"

 ..I RADEXC="U" S RADEX="Unknown"

 .S AOEXLC=$P($G(PAT321),U,13) I AOEXLC'="" D

 ..I AOEXLC="K" S AOEXL="Korean DMZ"

 ..I AOEXLC="V" S AOEXL="Vietnam"

 ..I AOEXLC="O" S AOEXL="Other (Not Korean DMZ or Vietnam)"

 .S PROCODE=$P($G(PAT321),U,15) I PROCODE'="" D

 ..I PROCODE=2 S PROJ112="No"

 ..I PROCODE=1 S PROJ112="Yes"

 ;

 ; -PATIENT FILE GLOBAL LOCATION .322

 S PAT322=$G(^DPT(DFN,.52)) I PAT322'="" D

 .S SWASIAC=$P($G(PAT322),U,13) I SWASIAC'="" D

 ..I SWASIAC="Y" S SWASIA="Yes"

 ..I SWASIAC="N" S SWASIA="No"

 ..I SWASIAC="U" S SWASIA="Unknown"

 ;

 ; -CONVERT DATES TO EXTERNAL

 I DOB'="" S Y=DOB D D^DIQ S DOB=Y

 ;

 ; -PERIOD OF SERVICE

 S (POSN,POS)="" S POSN=$$GET1^DIQ(2,DFN_",",.323,"I") I POSN'="" S POS=$$GET1^DIQ(21,POSN,.01,"E")

 ;

 ; -GET STAT, LADMT, LDIS

 D INP

 ; 

 S RET=DOB_U_SSN_U_SEX_U_MARS_U_RELGP_U_PELIG_U_POS_U_ADDR_U_PHN_U_CPHN_U_PGER_U_EMAIL_U_RADEX_U_STAT_U_POW_U_LADMT_U_AOEXL_U_LDIS_U_CMBTV_U_CMBTVED_U_PROJ112_U_SWASIA

 ;

 D EXIT

 Q

 ;

EXIT ;

 K PAT0,PAM0,CLIEN,HLF0,HLAPIEN,HLAP0,PAMS,PCODE,ATIEN,CCODE,ECODE,PAMSC

 K AMUIEN,AMU,HLAPC,CIUIEN,COUIEN,NCUIEN,PAT36,SADDR1,SWASIAC,SADDR2,SADDR3

 K CITY,STATEN,STATE,CNTY,RADEXC,AOEXLC,CMBTVC,PROCODE,PAT36,PAT11,PAT13,PAT52

 K PAT321,PAT322,ENROLC

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDECEPT   17682     printed  Feb 19, 2025@00:18:29                                                                                                                                                                                                    Page 2

SDECEPT   ;SPFO/RT,MGD,LAB,ANU - SCHEDULING ENHANCEMENTS VSE EP API ;JUN 08,2023

 +1       ;;5.3;Scheduling;**669,671,694,794,809,813,823,846**;Aug 13 1993;Build 12

 +2       ;;Per VHA Directive 6402, this routine should not be modified

 +3       ;

 +4       ;The API provides Extended Profile Appt info the VS GUI.

 +5       ;INPUT - DFN required

 +6       ;        APP appointment date/time required

 +7        QUIT 

 +8       ;

INIT      ;

 +1        SET (PAT0,PAM0,CLIEN,HLF0,HLAPIEN,HLAP0)=""

 +2       ;

 +3       ; PAT0=Global location 0 from Patient file

 +4       ; PAM0=Global location 0 from Patient Appointment Multiple

 +5       ; CLIEN=Clinic IEN

 +6       ; HLF0=Global location 0 from Hospital Location File

 +7       ; HLAPIEN=Hospital Location Appointment Multiple IEN

 +8       ; HLAP0=Global location 0 from Hospital Appointment Multiple

 +9       ;

 +10      ; SET HELPERS

 +11      ;

 +12       SET PAT0=$GET(^DPT(DFN,0))

 +13       SET PAM0=$GET(^DPT(DFN,"S",ADT,0))

           IF PAM0'=""

               Begin DoDot:1

 +14               SET CLIEN=$PIECE($GET(PAM0),U,1)

                   IF CLIEN'=""

                       Begin DoDot:2

 +15                       SET HLF0=$GET(^SC(CLIEN,0))

 +16                       SET HLAPIEN=+$$FIND^SDAM2(DFN,ADT,CLIEN)

                           IF HLAPIEN'=""

                               Begin DoDot:3

 +17                               SET HLAP0=$GET(^SC(CLIEN,"S",ADT,1,HLAPIEN,0))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18       QUIT 

 +19      ;

GETDEM(RET,DFN,ADT,SDAPPTIEN) ;

 +1       ; REQUIRE DFN AND APPOINTMENT DATE TIME

 +2        if '$GET(DFN)

               QUIT 

 +3        if '$GET(ADT)

               QUIT 

 +4        SET SDAPPTIEN=$GET(SDAPPTIEN)

 +5        SET SDRET=$$SDEXPST(.SDRET,DFN,ADT,SDAPPTIEN)

 +6        IF +SDRET=-1

               Begin DoDot:1

 +7                SET RET="-1^The detail for the selected record is no longer available in VistA. Select the more recent record for Expanded Entry."

               End DoDot:1

               QUIT RET

 +8       ;

 +9       ;strip off extra zeros on time  pwc SD*5.3*694

           SET ADT=+ADT

 +10       DO INIT

 +11      ;

 +12      ; INITIALIZE VARIABLES

 +13       SET (PATN,SSN,LAB,XRAY,EKG,PCODE,POV,ATIEN)=""

 +14       SET (PAMAT,CCODE,COLL,CLN,LOA,OTH,ECODE,EGIL,PAMSC)=""

 +15       SET (ENROLC,STAT,OCODE)=""

 +16       NEW TIMEZONE

 +17       NEW APPTDATA,PATCMNTS,COUNT

 +18      ;

 +19      ;PATN=Patient Name - Patient File [0,1]

 +20      ;SSN=Formatted Social Security Number

 +21      ;STAT=Status Patient Appointment Multiple - CURRENT STATUS (2.98,100)

 +22      ;LAB=Date/Time of Labs - PATIENT/APPOINTMENT MULTIPLE [0,3]

 +23      ;XRAY=Date/Time of x-ray - PATIENT/APPOINTMENT MULTIPLE [0,4]

 +24      ;EKG=Date/Time of EKG - PATIENT/APPOINTMENT MULTIPLE [0,5]

 +25      ;PCODE=Purpose of Visit Code - PATIENT/APPOINTMENT MULTIPLE [0,7]

 +26      ;POV=Purpose of Visit

 +27      ;ATIEN=Appointment Type IEN - PATIENT/APPOINTMENT MULTIPLE [0,16]

 +28      ;PAMAT=Patient Appointment Multiple Appointment Type

 +29      ;CCODE=Collateral Code - PATIENT/APPOINTMENT MULTIPLE [0,11]

 +30      ;COLL=Collateral Yes or No

 +31      ;CLN=Clinic Name - Hospital Location File [0,1]

 +32      ;LOA=Length of Appointment - Hospital Location Appointment Multiple [0,2]

 +33      ;ECODE=Eligibility Code - Hospital Location Appointment Multiple [0,10]

 +34      ;EGIL=Eligibility of Appointment

 +35      ;OCODE=Overbook Code - Hospital Location Appointment Multiple [QB]

 +36      ;OVB=Overbook

 +37      ;PATEN0=Patient Enrollment Clinic - Patient File Enrollment Clinic Multiple [B]

 +38      ;ENROLC=Enrolled in Clinic Yes/No

 +39      ;ERCNUM=Enrolled Clinic Number

 +40      ;LPNUM=Loop Number

 +41      ;

 +42      ; -PATIENT FILE GLOBAL LOCATION 0

 +43       IF PAT0'=""

               Begin DoDot:1

 +44               SET PATN=$PIECE($GET(PAT0),U,1)

 +45               SET SSN=$$LAST4SSN^SDESINPUTVALUTL(DFN)

               End DoDot:1

 +46      ;

 +47      ; -PATIENT/APPOINTMENT MULTIPLE GLOBAL LOCATION 0

 +48       IF PAM0'=""

               Begin DoDot:1

 +49               SET STAT=$$STATUS^SDAM1(DFN,ADT,CLIEN,PAM0)

                   IF STAT'=""

                       Begin DoDot:2

 +50                       SET STAT=$PIECE(STAT,";",2)

                       End DoDot:2

 +51               SET LAB=$PIECE($GET(PAM0),U,3)

 +52               SET XRAY=$PIECE($GET(PAM0),U,4)

 +53               SET EKG=$PIECE($GET(PAM0),U,5)

 +54               SET PCODE=$PIECE($GET(PAM0),U,7)

                   IF PCODE'=""

                       Begin DoDot:2

 +55                       SET POV=$SELECT(PCODE=1:"C&P",PCODE=2:"10-10",PCODE=3:"SCHEDULED",PCODE=4:"UNSCHEDULED",1:"UNKNOWN")

                       End DoDot:2

 +56               SET ATIEN=$PIECE($GET(PAM0),U,16)

                   IF ATIEN'=""

                       Begin DoDot:2

 +57                       SET PAMAT=$$GET1^DIQ(409.1,ATIEN,.01)

                       End DoDot:2

 +58               SET CCODE=$PIECE($GET(PAM0),U,11)

 +59               SET COLL="No"

                   IF CCODE=1

                       SET COLL="Yes"

               End DoDot:1

 +60      ;

 +61      ; -HOSPITAL LOCATION FILE GLOBAL LOCATION 0

 +62       IF HLF0'=""

               Begin DoDot:1

 +63               SET CLN=$PIECE($GET(HLF0),U,1)

               End DoDot:1

 +64      ;

 +65      ; -HOSPITAL LOCATION/APPOINTMENT/PATIENT MULTIPLE GLOBAL LOCATION 0

 +66       IF HLAP0'=""

               Begin DoDot:1

 +67               SET LOA=+$PIECE($GET(HLAP0),U,2)

 +68               SET OTH=$PIECE($GET(HLAP0),U,4)

 +69               SET ECODE=$PIECE($GET(HLAP0),U,10)

                   IF ECODE'=""

                       Begin DoDot:2

 +70                       SET EGIL=$$GET1^DIQ(8,ECODE,.01)

                       End DoDot:2

 +71               IF ECODE=""

                       SET EGIL=$PIECE($GET(^DIC(8,+$GET(^DPT(DFN,.36)),0)),U)

               End DoDot:1

 +72      ;

 +73      ; -HOSPITAL LOCATION/APPOINTMENT/PATIENT MULTIPLE GLOBAL LOCATION OB

 +74      ; pwc added check for HLAPIEN SD*5.3*694

           IF HLAPIEN'=""

               SET OCODE=$GET(^SC(CLIEN,"S",ADT,1,HLAPIEN,"OB"))

 +75       SET OVB=""

           IF OCODE="O"

               SET OVB="OVERBOOK"

 +76      ;

 +77      ; -PATIENT FILE ENROLLMENT CLINIC MULTIPLE

 +78       SET ENROLC="No"

 +79       SET LPNUM=0

           FOR 

               SET LPNUM=$ORDER(^DPT(DFN,"DE",LPNUM))

               if LPNUM=""

                   QUIT 

               Begin DoDot:1

 +80               SET ERCNUM=$PIECE($GET(^DPT(DFN,"DE",LPNUM,0)),"^",1)

 +81               if ERCNUM'=CLIEN

                       QUIT 

 +82               IF $PIECE($GET(^DPT(DFN,"DE",LPNUM,0)),"^",2)=""

                       Begin DoDot:2

 +83                       SET ENROLC="Yes"

 +84                       QUIT 

                       End DoDot:2

               End DoDot:1

 +85      ;

 +86      ; -CONVERT DATES TO EXTERNAL

 +87      ;

 +88      ;  Change date/time conversion so midnight is handled properly.  wtc 694 5/7/18

 +89      ;

 +90      ;S Y=ADT D D^DIQ S ADT=Y

 +91      ;

           SET ADT=$$FMTONET^SDECDATE(ADT)

 +92      ;I LAB'="" S Y=LAB D D^DIQ S LAB=Y

 +93      ;

           IF LAB'=""

               SET LAB=$$FMTONET^SDECDATE(LAB)

 +94      ;I XRAY'="" S Y=XRAY D D^DIQ S XRAY=Y

 +95      ;

           IF XRAY'=""

               SET XRAY=$$FMTONET^SDECDATE(XRAY)

 +96      ;I EKG'="" S Y=EKG D D^DIQ S EKG=Y

 +97      ;

           IF EKG'=""

               SET EKG=$$FMTONET^SDECDATE(EKG)

 +98      ;

 +99       SET TIMEZONE=$$TIMEZONEDATA^SDESUTIL($GET(CLIEN))

           SET TIMEZONE=$PIECE($GET(TIMEZONE),U)

 +100     ;

 +101     ;ANU

 +102      DO GETPATCOMMENTS^SDESAPPTDATA(.APPTDATA,SDAPPTIEN)

 +103      SET COUNT=1

 +104      SET PATCMNTS=APPTDATA("PatientComments",1)

 +105      FOR 

               SET COUNT=$ORDER(APPTDATA("PatientComments",COUNT))

               if 'COUNT

                   QUIT 

               Begin DoDot:1

 +106              SET PATCMNTS=PATCMNTS_U_APPTDATA("PatientComments",COUNT)

               End DoDot:1

 +107     ;

 +108      SET RET=PATN_U_CLN_U_SSN_U_ADT_U_STAT_U_POV_U_LOA_U_PAMAT_U_LAB_U_EGIL_U_XRAY_U_OVB_U_EKG_U_COLL_U_OTH_U_ENROLC_U_TIMEZONE_U_$GET(PATCMNTS)_U

 +109     ;

 +110      DO EXIT

 +111      QUIT 

 +112     ;

SDEXPST(SDRET,DFN,ADT,SDAPPTIEN) ;

 +1        NEW SDAPPT,SDRTN,SDNEXTIEN,SDCAN

 +2       ; Appt can be expanded

           SET SDRTN=""

 +3        SET SDAPPT=""

           SET ADT=+ADT

 +4        FOR 

               SET SDAPPT=$ORDER(^SDEC(409.84,"APTDT",DFN,ADT,SDAPPT))

               if 'SDAPPT

                   QUIT 

               Begin DoDot:1

 +5                if SDAPPT'=SDAPPTIEN

                       QUIT 

 +6                SET SDCAN=($$GET1^DIQ(409.84,SDAPPT,.12,"I")'="")

 +7                SET SDNEXTIEN=$ORDER(^SDEC(409.84,"APTDT",DFN,ADT,SDAPPT))

 +8       ; Current Appt is cancelled and there is another APPT

 +9                IF SDCAN

                       IF SDNEXTIEN

                           SET SDRTN=-1

                           QUIT 

 +10      ; Current Appt is cancelled & no other Appt

 +11               IF SDCAN

                       IF 'SDNEXTIEN

                           SET SDRTN=0

                           QUIT 

 +12      ; Current Appt is NOT cancelled so there can't be other Appt for same Date/Time