- 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 Jan 18, 2025@03:53:56 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