SDECU3 ;ALB/SAT,LAB - VISTA SCHEDULING RPCS ;JUL 27,2022
;;5.3;Scheduling;**658,823**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
PDEMO(RET,DFN) ;GET specific patient demographics
;INPUT:
; DFN - Pointer to PATIENT file 2
;RETURN:
; .RET = Return Array
; RET("DOB") = Date of Birth
; RET("ELIGIEN") = Pointer to MAS ELIGIBILITY CODE file 8.1
; RET("ELIGNAME") = NAME from MAS ELIGIBILITY CODE file
; RET("GENDER")
; RET("HRN") = health record number
; RET("INSTIEN") = Institution IEN
; RET("INSTNAME") = Institution Name
; RET("NAME") = Patient name
; RET("PADDRES1")= STREET ADDRESS [LINE 1] (.111)
; RET("PADDRES2")= STREET ADDRESS [LINE 2] (.112)
; RET("PADDRES3")= STREET ADDRESS [LINE 3] (.113)
; RET("PZIP+4") = ZIP+4 (.1112)
; RET("PCITY") = CITY (.114)
; RET("PSTATE") = STATE name (from .115)
; RET("PCOUNTRY") = COUNTRY name (from .1173)
; RET("BADADD") = BAD ADDRESS INDICATOR (.121)
; 1=UNDELIVERABLE
; 2=HOMELESS
; 3=OTHER
; 4=ADDRESS NOT FOUND
; RET("HPHONE") = Home phone (.131)
; RET("OPHONE") = Office phone (.132)
; RET("PRIGRP") = ENROLLMENT PRIORITY text from PATIENT ENROLLMENT file
; Valid Values:
; GROUP 1
; GROUP 2
; GROUP 3
; GROUP 4
; GROUP 5
; GROUP 6
; GROUP 7
; GROUP 8
; RET("SIMILAR") = Similar Patients
; MESSSAGE | Patients
; Message
; Patients separated by ;;
; Each ;; piece contains the following ~ pieces
; DFN ~ NAME ~ DOB ~ SSN
; RET("SSN") = Social Security number
; RET("SUBGRP") = Enrollment Subgroup
; RET("SVCCONN") = SERVICE CONNECTED field from PATIENT ENROLLMENT file
; Valid values:
; YES
; NO
; RET("SVCCONNP") = SERVICE CONNECTED PERCENTAGE field from PATIENT ENROLLMENT file
; Numeric between 0-100
; RET("TYPEIEN") = Pointer to TYPE OF PATIENT file 391
; RET("TYPENAME")= NAME from TYPE OF PATIENT file 391
;
; RET("NOK") - Primary Next of Kin (.211)
; RET("KNAME") - Primary Next of Kin name
; RET("KREL") - Primary Next of Kin Relationship to Patient (.212)
; RET("KPHONE") - Primary Next of Kin Phone (.219)
; RET("KSTREET") - Primary Next of Kin Street Address [Line 1] (.213)
; RET("KSTREET2") - Primary Next of Kin Street Address [Line 2] (.214)
; RET("KSTREET3") - Primary Next of Kin Street Address [Line 3] (.215)
; RET("KCITY") - Primary Next of Kin City (.216)
; RET("KSTATE") - Primary Next of Kin State (.217)
; RET("KZIP") - Primary Next of Kin Zip (.218)
; RET("NOK2") - Secondary Next of Kin (.2191)
; RET("K2NAME") - Secondary Next of Kin name (.2191)
; RET("K2REL") - Secondary Next of Kin Relationship to Patient (.2192)
; RET("K2PHONE") - Secondary Next of Kin Phone (.2199)
; RET("K2STREET") - Secondary Next of Kin Street Address [Line 1] (.2193)
; RET("K2STREET2") - Secondary Next of Kin Street Address [Line 2] (.2194)
; RET("K2STREET3") - Secondary Next of Kin Street Address [Line 3] (.2195)
; RET("K2CITY") - Secondary Next of Kin City (.2196)
; RET("K2STATE") - Secondary Next of Kin State (.2197)
; RET("K2ZIP") - Secondary Next of Kin Zip (.2198)
; RET("PCOUNTY") - Patient County (.117)
; RET("PETH") - List of Patient Ethnicities/Names Eth|Name^... Use ETH^SDECU2
; RET("PRACE") - List of Patient Races/Names RACE|NAME^... Use RACELST^SDECU2
; RET("PMARITAL") - Patient Marital Status
; RET("PRELIGION") - Patient Religious Preference
; RET("PTACTIVE") - Patient Temporary Address Active? (.12105)
; RET("PTADDRESS1") - Patient Temporary Address Line 1 (.1211)
; RET("PTADDRESS2") - Patient Temporary Address Line 2 (.1212)
; RET("PTADDRESS3") - Patient Temporary Address Line 3 (.1213)
; RET("PTCITY") - Patient Temporary City (.1214)
; RET("PTSTATE") - Patient Temporary State (.1215)
; RET("PTZIP") - Patient Temporary Zip (.1216)
; RET("PTZIP+4") - Patient Temporary Zip+4 (.12112)
; RET("PTCOUNTRY") - Patient Temporary Country (.1223)
; RET("PTCOUNTY") - Patient Temporary County (.12111)
; RET("PTPHONE") - Patient Temporary Phone (.1219)
; RET("PTSTART") - Patient Temporary Address Start Date (.1217)
; RET("PTEND") - Patient Temporary Address End Date (.1218)
; RET("PCELL") - Patient Cell Phone (.134)
; RET("PPAGER") - Patient Pager Number (.135)
; RET("PEMAIL") - Patient Email Address (.133)
; RET("PF_FFF") - Patient FUGITIVE FELON FLAG 1=YES
; RET("PF_VCD") - Patient VETERAN CATASTROPHICALLY DISABLED? Y=YES N=NO
; RET("PFNATIONAL") - Patient national Flags (PRF ASSIGNMENT/PRF NATIONAL FLAG) separated by |
; Each | piece contains the following ;; pipe pieces:
; 1. PRFAID - PRF Assignment ID pointer to PRF ASSIGNMENT file (#26.13)
; 2. PRFSTAT - PRF Assignment Status 0=INACTIVE 1=ACTIVE
; 3. PRFNID - PRF National Flag ID pointer to PRF NATIONAL FLAG file (#26.15)
; 4. PRFNNAME - PRF National Flag name
; 5. PRFNSTAT - PRF National Flag status 0=INACTIVE 1=ACTIVE
; RET("PFLOCAL") - Patient Local Flags (PRF ASSIGNMENT/PRF Local FLAG) separated by |
; Each | piece contains the following ;; pipe pieces:
; 1. PRFAID - PRF Assignment ID pointer to PRF ASSIGNMENT file (#26.13)
; 2. PRFSTAT - PRF Assignment Status 0=INACTIVE 1=ACTIVE
; 3. PRFLID - PRF Local Flag ID pointer to PRF LOCAL FLAG file (#26.11)
; 4. PRFLNAME - PRF Local Flag name
; 5. PRFLSTAT - PRF Local Flag status 0=INACTIVE 1=ACTIVE
; RET("PF_8G") - Category 8G (not returned yet)
;
N SDD,SDI,SDM
N PCE,PCOUNTY,PD,PTCOUNTY,PETHL,PM,PTINFO
Q:'+$G(DFN)
Q:'$D(^DPT(DFN,0))
;collect demographics
K RET
S (PCOUNTY,PTCOUNTY,RET("PCOUNTY"),RET("PTCOUNTY"))=""
;get data from PTINFO and PATIENT/IHS
D PTINFO^SDECPTCX(.PTINFO,DFN)
D GETS^DIQ(9000001,DFN_",","**","IE","PD","PM")
I '$D(PM) D
.S RET("INSTIEN")=$G(PD(9000001.41,+DUZ(2)_","_DFN_",",.01,"I"))
.S RET("INSTNAME")=$G(PD(9000001.41,+DUZ(2)_","_DFN_",",.01,"E"))
E S (RET("INSTIEN"),RET("INSTNAME"))=""
S RET("NAME")=$P($G(PTINFO),U)
S RET("GENDER")=$P($G(PTINFO),U,2)
S RET("DOB")=$$FMTE^XLFDT($P($G(PTINFO),U,3))
S RET("SSN")=$P($G(PTINFO),U,4)
;
S RET("HRN")=$$HRN^SDECPAT(DFN,DUZ(2))
;
;patient enrollment
S PCE=$P($G(^DPT(DFN,"ENR")),U,1)
D:+PCE GETS^DIQ(27.11,+PCE_",",".07;.12;50.01;50.02;50.03","IE","SDD","SDM")
S RET("PRIGRP")=$S(+PCE:SDD(27.11,PCE_",",.07,"E"),1:"")
S RET("SUBGRP")=$S(+PCE:SDD(27.11,PCE_",",.12,"E"),1:"")
S RET("ELIGIEN")=$S(+PCE:SDD(27.11,PCE_",",50.01,"I"),1:"")
S RET("ELIGNAME")=$S(+PCE:SDD(27.11,PCE_",",50.01,"E"),1:"")
S RET("SVCCONN")=$$GET1^DIQ(2,DFN_",",.301,"E") ;$S(+PCE:SDD(27.11,PCE_",",50.02,"E"),1:"")
S RET("SVCCONNP")=$$GET1^DIQ(2,DFN_",",.302,"E") ;$S(+PCE:SDD(27.11,PCE_",",50.03,"I"),1:"")
S RET("TYPEIEN")=$$GET1^DIQ(2,DFN_",",391,"I")
S RET("TYPENAME")=$$GET1^DIQ(2,DFN_",",391,"E")
;
;get addresses
K SDD,SDM D GETS^DIQ(2,DFN_",",".05;.08;.111:.135;.211:.2207","IE","SDD","SDM")
S RET("PADDRES1")=$G(SDD(2,DFN_",",.111,"E")) ; STREET ADDRESS [LINE 1]
S RET("PADDRES2")=$G(SDD(2,DFN_",",.112,"E")) ; STREET ADDRESS [LINE 2]
S RET("PADDRES3")=$G(SDD(2,DFN_",",.113,"E")) ; STREET ADDRESS [LINE 3]
S RET("PZIP+4")=$G(SDD(2,DFN_",",.1112,"E")) ; ZIP+4
S RET("PCITY")=$G(SDD(2,DFN_",",.114,"E")) ; CITY
N PSTATE S PSTATE=$G(SDD(2,DFN_",",.115,"I"))
S RET("PSTATE")=$G(SDD(2,DFN_",",.115,"E")) ; STATE name
I PSTATE'="" D
.S PCOUNTY=$G(SDD(2,DFN_",",.117,"I"))
.S:PCOUNTY'="" RET("PCOUNTY")=$P($G(^DIC(5,PSTATE,1,PCOUNTY,0)),U,1) ; - Patient County (.117)
S RET("PCOUNTRY")=$G(SDD(2,DFN_",",.1173,"I")) ; COUNTRY
I RET("PCOUNTRY")'="",'+RET("PCOUNTRY") S RET("PCOUNTRY")=$O(^HL(779.004,"B",RET("PCOUNTRY"),0))
S RET("BADADD")=$G(SDD(2,DFN_",",.121,"I")) ;bad address indicator
S RET("PTACTIVE")=$G(SDD(2,DFN_",",.12105,"I"))
S RET("PTADDRESS1")=$G(SDD(2,DFN_",",.1211,"E"))
S RET("PTADDRESS2")=$G(SDD(2,DFN_",",.1212,"E"))
S RET("PTADDRESS3")=$G(SDD(2,DFN_",",.1213,"E"))
S RET("PTCITY")=$G(SDD(2,DFN_",",.1214,"E"))
N PTSTATE S PTSTATE=$G(SDD(2,DFN_",",.1215,"I"))
S RET("PTSTATE")=$G(SDD(2,DFN_",",.1215,"E")) ; Patient Temporary STATE name
S RET("PTZIP")=$G(SDD(2,DFN_",",.1216,"E")) ; Patient Temporary Zip (.1216)
S RET("PTZIP+4")=$G(SDD(2,DFN_",",.12112,"E")) ; Patient Temporary Zip+4 (.12112)
S RET("PTCOUNTRY")=$G(SDD(2,DFN_",",.1223,"I")) ; Patient Temp COUNTRY
I PTSTATE'="" D
.S PTCOUNTY=$G(SDD(2,DFN_",",.12111,"I"))
.S:PTCOUNTY'="" RET("PTCOUNTY")=$P($G(^DIC(5,PTSTATE,1,PTCOUNTY,0)),U,1) ; - Patient Temp County (.12111)
S RET("PTSTART")=$G(SDD(2,DFN_",",.1217,"E")) ; Patient Temporary Address Start Date (.1217)
S RET("PTEND")=$G(SDD(2,DFN_",",.1218,"E")) ; Patient Temporary Address End Date (.1218)
;
;get phones
S RET("HPHONE")=$G(SDD(2,DFN_",",.131,"E")) ; phone number (residence) (home phone)
S RET("OPHONE")=$G(SDD(2,DFN_",",.132,"E")) ; phone number (work) (office phone)
S RET("PTPHONE")=$G(SDD(2,DFN_",",.1219,"E")) ; Patient Temporary Phone (.1219)
S RET("PCELL")=$G(SDD(2,DFN_",",.134,"E")) ; Patient Cell Phone (.134)
S RET("PPAGER")=$G(SDD(2,DFN_",",.135,"E")) ; Patient Pager Number (.135)
S RET("PEMAIL")=$G(SDD(2,DFN_",",.133,"E")) ; Patient Email Address (.133)
;
; Return data to add:
S RET("NOK")=$G(SDD(2,DFN_",",.211,"I")) ;Primary Next of Kin (.211)
S RET("KNAME")=$G(SDD(2,DFN_",",.211,"E")) ;Primary Next of Kin name (.211)
S RET("KREL")=$G(SDD(2,DFN_",",.212,"E")) ;Primary Next of Kin Relationship to Patient (.212)
S RET("KPHONE")=$G(SDD(2,DFN_",",.219,"E")) ;Primary Next of Kin Phone (.219)
S RET("KSTREET")=$G(SDD(2,DFN_",",.213,"E")) ;Primary Next of Kin Street Address [Line 1] (.213)
S RET("KSTREET2")=$G(SDD(2,DFN_",",.214,"E")) ;Primary Next of Kin Street Address [Line 2] (.214)
S RET("KSTREET3")=$G(SDD(2,DFN_",",.215,"E")) ;Primary Next of Kin Street Address [Line 3] (.215)
S RET("KCITY")=$G(SDD(2,DFN_",",.216,"E")) ;Primary Next of Kin City (.216)
S RET("KSTATE")=$G(SDD(2,DFN_",",.217,"E")) ;Primary Next of Kin State (.217)
S RET("KZIP")=$G(SDD(2,DFN_",",.218,"E")) ;Primary Next of Kin Zip (.218)
;
S RET("NOK2")=$G(SDD(2,DFN_",",.2191,"I")) ;Secondary Next of Kin (.2191)
S RET("K2NAME")=$G(SDD(2,DFN_",",.2191,"E")) ;Secondary Next of Kin name (.2191)
S RET("K2REL")=$G(SDD(2,DFN_",",.2192,"E")) ;Secondary Next of Kin Relationship to Patient (.2192)
S RET("K2PHONE")=$G(SDD(2,DFN_",",.2199,"E")) ;Secondary Next of Kin Phone (.2199)
S RET("K2STREET")=$G(SDD(2,DFN_",",.2193,"E")) ;Secondary Next of Kin Street Address [Line 1] (.2193)
S RET("K2STREET2")=$G(SDD(2,DFN_",",.2194,"E")) ;Secondary Next of Kin Street Address [Line 2] (.2194)
S RET("K2STREET3")=$G(SDD(2,DFN_",",.2195,"E")) ;Secondary Next of Kin Street Address [Line 3] (.2195)
S RET("K2CITY")=$G(SDD(2,DFN_",",.2196,"E")) ;Secondary Next of Kin City (.2196)
S RET("K2STATE")=$G(SDD(2,DFN_",",.2197,"E")) ;Secondary Next of Kin State (.2197)
S RET("K2ZIP")=$G(SDD(2,DFN_",",.2198,"E")) ;Secondary Next of Kin Zip (.2198)
;
S RET("PMARITAL")=$G(SDD(2,DFN_",",.05,"E")) ;Patient Marital Status (.05)
S RET("PRELIGION")=$G(SDD(2,DFN_",",.08,"E")) ;Patient Religious Preference (.08)
;
N PETH,PETHN D ETH^SDECU2(DFN,.PETH,.PETHN)
S PETHL="" F SDI=1:1:$L(PETH,"|") S PETHL=PETHL_$S(PETHL'="":U,1:"")_$P(PETH,"|",SDI)_"|"_$P(PETHN,"|",SDI)
S RET("PETH")=PETHL ;List of Patient Ethnicities/Names Eth|Name^... Use ETH^SDECU2
N RACE,RACEL,RACEN D RACELST^SDECU2(DFN,.RACE,.RACEN)
S RACEL="" F SDI=1:1:$L(RACE,"|") S RACEL=RACEL_$S(RACEL'="":U,1:"")_$P(RACE,"|",SDI)_"|"_$P(RACEN,"|",SDI)
S RET("PRACE")=RACEL ;List of Patient Races/Names RACE|NAME^... Use RACELST^SDECU2
S RET("PFNATIONAL")=$$FLAGS^SDECU2(DFN,26.15)
S RET("PFLOCAL")=$$FLAGS^SDECU2(DFN,26.11)
S RET("PF_FFF")=$$GET1^DIQ(2,DFN_",",1100.01,"I")
S RET("PF_VCD")=$$GET1^DIQ(2,DFN_",",.39,"I")
S RET("SIMILAR")=$$SIM(DFN)
;
Q
;
SIM(DFN) ;get similar patient data
N MI,MSG,NOD,PATS,RET,SIM
S (MSG,PATS,SIM)=""
D GUIBS5A^DPTLK6(.RET,DFN)
S MI=1 F S MI=$O(RET(MI)) Q:MI="" D
.S NOD=RET(MI)
.I $P(NOD,U,1)=0 S MSG=MSG_$S(MSG'="":" ",1:"")_$P(NOD,U,2)
.I $P(NOD,U,1)=1 S PATS=PATS_$S(PATS'="":";;",1:"")_$TR($P(NOD,U,2,4),U,"~")_"~"_$E($P(NOD,U,5),6,$L($P(NOD,U,5))) S:(MSG'="")&($E(MSG,$L(MSG))'=".") MSG=MSG_"."
S SIM=MSG_"|"_PATS
Q SIM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECU3 13162 printed Apr 09, 2024@21:41:17 Page 2
SDECU3 ;ALB/SAT,LAB - VISTA SCHEDULING RPCS ;JUL 27,2022
+1 ;;5.3;Scheduling;**658,823**;Aug 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
PDEMO(RET,DFN) ;GET specific patient demographics
+1 ;INPUT:
+2 ; DFN - Pointer to PATIENT file 2
+3 ;RETURN:
+4 ; .RET = Return Array
+5 ; RET("DOB") = Date of Birth
+6 ; RET("ELIGIEN") = Pointer to MAS ELIGIBILITY CODE file 8.1
+7 ; RET("ELIGNAME") = NAME from MAS ELIGIBILITY CODE file
+8 ; RET("GENDER")
+9 ; RET("HRN") = health record number
+10 ; RET("INSTIEN") = Institution IEN
+11 ; RET("INSTNAME") = Institution Name
+12 ; RET("NAME") = Patient name
+13 ; RET("PADDRES1")= STREET ADDRESS [LINE 1] (.111)
+14 ; RET("PADDRES2")= STREET ADDRESS [LINE 2] (.112)
+15 ; RET("PADDRES3")= STREET ADDRESS [LINE 3] (.113)
+16 ; RET("PZIP+4") = ZIP+4 (.1112)
+17 ; RET("PCITY") = CITY (.114)
+18 ; RET("PSTATE") = STATE name (from .115)
+19 ; RET("PCOUNTRY") = COUNTRY name (from .1173)
+20 ; RET("BADADD") = BAD ADDRESS INDICATOR (.121)
+21 ; 1=UNDELIVERABLE
+22 ; 2=HOMELESS
+23 ; 3=OTHER
+24 ; 4=ADDRESS NOT FOUND
+25 ; RET("HPHONE") = Home phone (.131)
+26 ; RET("OPHONE") = Office phone (.132)
+27 ; RET("PRIGRP") = ENROLLMENT PRIORITY text from PATIENT ENROLLMENT file
+28 ; Valid Values:
+29 ; GROUP 1
+30 ; GROUP 2
+31 ; GROUP 3
+32 ; GROUP 4
+33 ; GROUP 5
+34 ; GROUP 6
+35 ; GROUP 7
+36 ; GROUP 8
+37 ; RET("SIMILAR") = Similar Patients
+38 ; MESSSAGE | Patients
+39 ; Message
+40 ; Patients separated by ;;
+41 ; Each ;; piece contains the following ~ pieces
+42 ; DFN ~ NAME ~ DOB ~ SSN
+43 ; RET("SSN") = Social Security number
+44 ; RET("SUBGRP") = Enrollment Subgroup
+45 ; RET("SVCCONN") = SERVICE CONNECTED field from PATIENT ENROLLMENT file
+46 ; Valid values:
+47 ; YES
+48 ; NO
+49 ; RET("SVCCONNP") = SERVICE CONNECTED PERCENTAGE field from PATIENT ENROLLMENT file
+50 ; Numeric between 0-100
+51 ; RET("TYPEIEN") = Pointer to TYPE OF PATIENT file 391
+52 ; RET("TYPENAME")= NAME from TYPE OF PATIENT file 391
+53 ;
+54 ; RET("NOK") - Primary Next of Kin (.211)
+55 ; RET("KNAME") - Primary Next of Kin name
+56 ; RET("KREL") - Primary Next of Kin Relationship to Patient (.212)
+57 ; RET("KPHONE") - Primary Next of Kin Phone (.219)
+58 ; RET("KSTREET") - Primary Next of Kin Street Address [Line 1] (.213)
+59 ; RET("KSTREET2") - Primary Next of Kin Street Address [Line 2] (.214)
+60 ; RET("KSTREET3") - Primary Next of Kin Street Address [Line 3] (.215)
+61 ; RET("KCITY") - Primary Next of Kin City (.216)
+62 ; RET("KSTATE") - Primary Next of Kin State (.217)
+63 ; RET("KZIP") - Primary Next of Kin Zip (.218)
+64 ; RET("NOK2") - Secondary Next of Kin (.2191)
+65 ; RET("K2NAME") - Secondary Next of Kin name (.2191)
+66 ; RET("K2REL") - Secondary Next of Kin Relationship to Patient (.2192)
+67 ; RET("K2PHONE") - Secondary Next of Kin Phone (.2199)
+68 ; RET("K2STREET") - Secondary Next of Kin Street Address [Line 1] (.2193)
+69 ; RET("K2STREET2") - Secondary Next of Kin Street Address [Line 2] (.2194)
+70 ; RET("K2STREET3") - Secondary Next of Kin Street Address [Line 3] (.2195)
+71 ; RET("K2CITY") - Secondary Next of Kin City (.2196)
+72 ; RET("K2STATE") - Secondary Next of Kin State (.2197)
+73 ; RET("K2ZIP") - Secondary Next of Kin Zip (.2198)
+74 ; RET("PCOUNTY") - Patient County (.117)
+75 ; RET("PETH") - List of Patient Ethnicities/Names Eth|Name^... Use ETH^SDECU2
+76 ; RET("PRACE") - List of Patient Races/Names RACE|NAME^... Use RACELST^SDECU2
+77 ; RET("PMARITAL") - Patient Marital Status
+78 ; RET("PRELIGION") - Patient Religious Preference
+79 ; RET("PTACTIVE") - Patient Temporary Address Active? (.12105)
+80 ; RET("PTADDRESS1") - Patient Temporary Address Line 1 (.1211)
+81 ; RET("PTADDRESS2") - Patient Temporary Address Line 2 (.1212)
+82 ; RET("PTADDRESS3") - Patient Temporary Address Line 3 (.1213)
+83 ; RET("PTCITY") - Patient Temporary City (.1214)
+84 ; RET("PTSTATE") - Patient Temporary State (.1215)
+85 ; RET("PTZIP") - Patient Temporary Zip (.1216)
+86 ; RET("PTZIP+4") - Patient Temporary Zip+4 (.12112)
+87 ; RET("PTCOUNTRY") - Patient Temporary Country (.1223)
+88 ; RET("PTCOUNTY") - Patient Temporary County (.12111)
+89 ; RET("PTPHONE") - Patient Temporary Phone (.1219)
+90 ; RET("PTSTART") - Patient Temporary Address Start Date (.1217)
+91 ; RET("PTEND") - Patient Temporary Address End Date (.1218)
+92 ; RET("PCELL") - Patient Cell Phone (.134)
+93 ; RET("PPAGER") - Patient Pager Number (.135)
+94 ; RET("PEMAIL") - Patient Email Address (.133)
+95 ; RET("PF_FFF") - Patient FUGITIVE FELON FLAG 1=YES
+96 ; RET("PF_VCD") - Patient VETERAN CATASTROPHICALLY DISABLED? Y=YES N=NO
+97 ; RET("PFNATIONAL") - Patient national Flags (PRF ASSIGNMENT/PRF NATIONAL FLAG) separated by |
+98 ; Each | piece contains the following ;; pipe pieces:
+99 ; 1. PRFAID - PRF Assignment ID pointer to PRF ASSIGNMENT file (#26.13)
+100 ; 2. PRFSTAT - PRF Assignment Status 0=INACTIVE 1=ACTIVE
+101 ; 3. PRFNID - PRF National Flag ID pointer to PRF NATIONAL FLAG file (#26.15)
+102 ; 4. PRFNNAME - PRF National Flag name
+103 ; 5. PRFNSTAT - PRF National Flag status 0=INACTIVE 1=ACTIVE
+104 ; RET("PFLOCAL") - Patient Local Flags (PRF ASSIGNMENT/PRF Local FLAG) separated by |
+105 ; Each | piece contains the following ;; pipe pieces:
+106 ; 1. PRFAID - PRF Assignment ID pointer to PRF ASSIGNMENT file (#26.13)
+107 ; 2. PRFSTAT - PRF Assignment Status 0=INACTIVE 1=ACTIVE
+108 ; 3. PRFLID - PRF Local Flag ID pointer to PRF LOCAL FLAG file (#26.11)
+109 ; 4. PRFLNAME - PRF Local Flag name
+110 ; 5. PRFLSTAT - PRF Local Flag status 0=INACTIVE 1=ACTIVE
+111 ; RET("PF_8G") - Category 8G (not returned yet)
+112 ;
+113 NEW SDD,SDI,SDM
+114 NEW PCE,PCOUNTY,PD,PTCOUNTY,PETHL,PM,PTINFO
+115 if '+$GET(DFN)
QUIT
+116 if '$DATA(^DPT(DFN,0))
QUIT
+117 ;collect demographics
+118 KILL RET
+119 SET (PCOUNTY,PTCOUNTY,RET("PCOUNTY"),RET("PTCOUNTY"))=""
+120 ;get data from PTINFO and PATIENT/IHS
+121 DO PTINFO^SDECPTCX(.PTINFO,DFN)
+122 DO GETS^DIQ(9000001,DFN_",","**","IE","PD","PM")
+123 IF '$DATA(PM)
Begin DoDot:1
+124 SET RET("INSTIEN")=$GET(PD(9000001.41,+DUZ(2)_","_DFN_",",.01,"I"))
+125 SET RET("INSTNAME")=$GET(PD(9000001.41,+DUZ(2)_","_DFN_",",.01,"E"))
End DoDot:1
+126 IF '$TEST
SET (RET("INSTIEN"),RET("INSTNAME"))=""
+127 SET RET("NAME")=$PIECE($GET(PTINFO),U)
+128 SET RET("GENDER")=$PIECE($GET(PTINFO),U,2)
+129 SET RET("DOB")=$$FMTE^XLFDT($PIECE($GET(PTINFO),U,3))
+130 SET RET("SSN")=$PIECE($GET(PTINFO),U,4)
+131 ;
+132 SET RET("HRN")=$$HRN^SDECPAT(DFN,DUZ(2))
+133 ;
+134 ;patient enrollment
+135 SET PCE=$PIECE($GET(^DPT(DFN,"ENR")),U,1)
+136 if +PCE
DO GETS^DIQ(27.11,+PCE_",",".07;.12;50.01;50.02;50.03","IE","SDD","SDM")
+137 SET RET("PRIGRP")=$SELECT(+PCE:SDD(27.11,PCE_",",.07,"E"),1:"")
+138 SET RET("SUBGRP")=$SELECT(+PCE:SDD(27.11,PCE_",",.12,"E"),1:"")
+139 SET RET("ELIGIEN")=$SELECT(+PCE:SDD(27.11,PCE_",",50.01,"I"),1:"")
+140 SET RET("ELIGNAME")=$SELECT(+PCE:SDD(27.11,PCE_",",50.01,"E"),1:"")
+141 ;$S(+PCE:SDD(27.11,PCE_",",50.02,"E"),1:"")
SET RET("SVCCONN")=$$GET1^DIQ(2,DFN_",",.301,"E")
+142 ;$S(+PCE:SDD(27.11,PCE_",",50.03,"I"),1:"")
SET RET("SVCCONNP")=$$GET1^DIQ(2,DFN_",",.302,"E")
+143 SET RET("TYPEIEN")=$$GET1^DIQ(2,DFN_",",391,"I")
+144 SET RET("TYPENAME")=$$GET1^DIQ(2,DFN_",",391,"E")
+145 ;
+146 ;get addresses
+147 KILL SDD,SDM
DO GETS^DIQ(2,DFN_",",".05;.08;.111:.135;.211:.2207","IE","SDD","SDM")
+148 ; STREET ADDRESS [LINE 1]
SET RET("PADDRES1")=$GET(SDD(2,DFN_",",.111,"E"))
+149 ; STREET ADDRESS [LINE 2]
SET RET("PADDRES2")=$GET(SDD(2,DFN_",",.112,"E"))
+150 ; STREET ADDRESS [LINE 3]
SET RET("PADDRES3")=$GET(SDD(2,DFN_",",.113,"E"))
+151 ; ZIP+4
SET RET("PZIP+4")=$GET(SDD(2,DFN_",",.1112,"E"))
+152 ; CITY
SET RET("PCITY")=$GET(SDD(2,DFN_",",.114,"E"))
+153 NEW PSTATE
SET PSTATE=$GET(SDD(2,DFN_",",.115,"I"))
+154 ; STATE name
SET RET("PSTATE")=$GET(SDD(2,DFN_",",.115,"E"))
+155 IF PSTATE'=""
Begin DoDot:1
+156 SET PCOUNTY=$GET(SDD(2,DFN_",",.117,"I"))
+157 ; - Patient County (.117)
if PCOUNTY'=""
SET RET("PCOUNTY")=$PIECE($GET(^DIC(5,PSTATE,1,PCOUNTY,0)),U,1)
End DoDot:1
+158 ; COUNTRY
SET RET("PCOUNTRY")=$GET(SDD(2,DFN_",",.1173,"I"))
+159 IF RET("PCOUNTRY")'=""
IF '+RET("PCOUNTRY")
SET RET("PCOUNTRY")=$ORDER(^HL(779.004,"B",RET("PCOUNTRY"),0))
+160 ;bad address indicator
SET RET("BADADD")=$GET(SDD(2,DFN_",",.121,"I"))
+161 SET RET("PTACTIVE")=$GET(SDD(2,DFN_",",.12105,"I"))
+162 SET RET("PTADDRESS1")=$GET(SDD(2,DFN_",",.1211,"E"))
+163 SET RET("PTADDRESS2")=$GET(SDD(2,DFN_",",.1212,"E"))
+164 SET RET("PTADDRESS3")=$GET(SDD(2,DFN_",",.1213,"E"))
+165 SET RET("PTCITY")=$GET(SDD(2,DFN_",",.1214,"E"))
+166 NEW PTSTATE
SET PTSTATE=$GET(SDD(2,DFN_",",.1215,"I"))
+167 ; Patient Temporary STATE name
SET RET("PTSTATE")=$GET(SDD(2,DFN_",",.1215,"E"))
+168 ; Patient Temporary Zip (.1216)
SET RET("PTZIP")=$GET(SDD(2,DFN_",",.1216,"E"))
+169 ; Patient Temporary Zip+4 (.12112)
SET RET("PTZIP+4")=$GET(SDD(2,DFN_",",.12112,"E"))
+170 ; Patient Temp COUNTRY
SET RET("PTCOUNTRY")=$GET(SDD(2,DFN_",",.1223,"I"))
+171 IF PTSTATE'=""
Begin DoDot:1
+172 SET PTCOUNTY=$GET(SDD(2,DFN_",",.12111,"I"))
+173 ; - Patient Temp County (.12111)
if PTCOUNTY'=""
SET RET("PTCOUNTY")=$PIECE($GET(^DIC(5,PTSTATE,1,PTCOUNTY,0)),U,1)
End DoDot:1
+174 ; Patient Temporary Address Start Date (.1217)
SET RET("PTSTART")=$GET(SDD(2,DFN_",",.1217,"E"))
+175 ; Patient Temporary Address End Date (.1218)
SET RET("PTEND")=$GET(SDD(2,DFN_",",.1218,"E"))
+176 ;
+177 ;get phones
+178 ; phone number (residence) (home phone)
SET RET("HPHONE")=$GET(SDD(2,DFN_",",.131,"E"))
+179 ; phone number (work) (office phone)
SET RET("OPHONE")=$GET(SDD(2,DFN_",",.132,"E"))
+180 ; Patient Temporary Phone (.1219)
SET RET("PTPHONE")=$GET(SDD(2,DFN_",",.1219,"E"))
+181 ; Patient Cell Phone (.134)
SET RET("PCELL")=$GET(SDD(2,DFN_",",.134,"E"))
+182 ; Patient Pager Number (.135)
SET RET("PPAGER")=$GET(SDD(2,DFN_",",.135,"E"))
+183 ; Patient Email Address (.133)
SET RET("PEMAIL")=$GET(SDD(2,DFN_",",.133,"E"))
+184 ;
+185 ; Return data to add:
+186 ;Primary Next of Kin (.211)
SET RET("NOK")=$GET(SDD(2,DFN_",",.211,"I"))
+187 ;Primary Next of Kin name (.211)
SET RET("KNAME")=$GET(SDD(2,DFN_",",.211,"E"))
+188 ;Primary Next of Kin Relationship to Patient (.212)
SET RET("KREL")=$GET(SDD(2,DFN_",",.212,"E"))
+189 ;Primary Next of Kin Phone (.219)
SET RET("KPHONE")=$GET(SDD(2,DFN_",",.219,"E"))
+190 ;Primary Next of Kin Street Address [Line 1] (.213)
SET RET("KSTREET")=$GET(SDD(2,DFN_",",.213,"E"))
+191 ;Primary Next of Kin Street Address [Line 2] (.214)
SET RET("KSTREET2")=$GET(SDD(2,DFN_",",.214,"E"))
+192 ;Primary Next of Kin Street Address [Line 3] (.215)
SET RET("KSTREET3")=$GET(SDD(2,DFN_",",.215,"E"))
+193 ;Primary Next of Kin City (.216)
SET RET("KCITY")=$GET(SDD(2,DFN_",",.216,"E"))
+194 ;Primary Next of Kin State (.217)
SET RET("KSTATE")=$GET(SDD(2,DFN_",",.217,"E"))
+195 ;Primary Next of Kin Zip (.218)
SET RET("KZIP")=$GET(SDD(2,DFN_",",.218,"E"))
+196 ;
+197 ;Secondary Next of Kin (.2191)
SET RET("NOK2")=$GET(SDD(2,DFN_",",.2191,"I"))
+198 ;Secondary Next of Kin name (.2191)
SET RET("K2NAME")=$GET(SDD(2,DFN_",",.2191,"E"))
+199 ;Secondary Next of Kin Relationship to Patient (.2192)
SET RET("K2REL")=$GET(SDD(2,DFN_",",.2192,"E"))
+200 ;Secondary Next of Kin Phone (.2199)
SET RET("K2PHONE")=$GET(SDD(2,DFN_",",.2199,"E"))
+201 ;Secondary Next of Kin Street Address [Line 1] (.2193)
SET RET("K2STREET")=$GET(SDD(2,DFN_",",.2193,"E"))
+202 ;Secondary Next of Kin Street Address [Line 2] (.2194)
SET RET("K2STREET2")=$GET(SDD(2,DFN_",",.2194,"E"))
+203 ;Secondary Next of Kin Street Address [Line 3] (.2195)
SET RET("K2STREET3")=$GET(SDD(2,DFN_",",.2195,"E"))
+204 ;Secondary Next of Kin City (.2196)
SET RET("K2CITY")=$GET(SDD(2,DFN_",",.2196,"E"))
+205 ;Secondary Next of Kin State (.2197)
SET RET("K2STATE")=$GET(SDD(2,DFN_",",.2197,"E"))
+206 ;Secondary Next of Kin Zip (.2198)
SET RET("K2ZIP")=$GET(SDD(2,DFN_",",.2198,"E"))
+207 ;
+208 ;Patient Marital Status (.05)
SET RET("PMARITAL")=$GET(SDD(2,DFN_",",.05,"E"))
+209 ;Patient Religious Preference (.08)
SET RET("PRELIGION")=$GET(SDD(2,DFN_",",.08,"E"))
+210 ;
+211 NEW PETH,PETHN
DO ETH^SDECU2(DFN,.PETH,.PETHN)
+212 SET PETHL=""
FOR SDI=1:1:$LENGTH(PETH,"|")
SET PETHL=PETHL_$SELECT(PETHL'="":U,1:"")_$PIECE(PETH,"|",SDI)_"|"_$PIECE(PETHN,"|",SDI)
+213 ;List of Patient Ethnicities/Names Eth|Name^... Use ETH^SDECU2
SET RET("PETH")=PETHL
+214 NEW RACE,RACEL,RACEN
DO RACELST^SDECU2(DFN,.RACE,.RACEN)
+215 SET RACEL=""
FOR SDI=1:1:$LENGTH(RACE,"|")
SET RACEL=RACEL_$SELECT(RACEL'="":U,1:"")_$PIECE(RACE,"|",SDI)_"|"_$PIECE(RACEN,"|",SDI)
+216 ;List of Patient Races/Names RACE|NAME^... Use RACELST^SDECU2
SET RET("PRACE")=RACEL
+217 SET RET("PFNATIONAL")=$$FLAGS^SDECU2(DFN,26.15)
+218 SET RET("PFLOCAL")=$$FLAGS^SDECU2(DFN,26.11)
+219 SET RET("PF_FFF")=$$GET1^DIQ(2,DFN_",",1100.01,"I")
+220 SET RET("PF_VCD")=$$GET1^DIQ(2,DFN_",",.39,"I")
+221 SET RET("SIMILAR")=$$SIM(DFN)
+222 ;
+223 QUIT
+224 ;
SIM(DFN) ;get similar patient data
+1 NEW MI,MSG,NOD,PATS,RET,SIM
+2 SET (MSG,PATS,SIM)=""
+3 DO GUIBS5A^DPTLK6(.RET,DFN)
+4 SET MI=1
FOR
SET MI=$ORDER(RET(MI))
if MI=""
QUIT
Begin DoDot:1
+5 SET NOD=RET(MI)
+6 IF $PIECE(NOD,U,1)=0
SET MSG=MSG_$SELECT(MSG'="":" ",1:"")_$PIECE(NOD,U,2)
+7 IF $PIECE(NOD,U,1)=1
SET PATS=PATS_$SELECT(PATS'="":";;",1:"")_$TRANSLATE($PIECE(NOD,U,2,4),U,"~")_"~"_$EXTRACT($PIECE(NOD,U,5),6,$LENGTH($PIECE(NOD,U,5)))
if (MSG'="")&($EXTRACT(MSG,$LENGTH(MSG))'=".")
SET MSG=MSG_"."
End DoDot:1
+8 SET SIM=MSG_"|"_PATS
+9 QUIT SIM
