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

SDECU3.m

Go to the documentation of this file.
  1. SDECU3 ;ALB/SAT,LAB - VISTA SCHEDULING RPCS ;JUL 27,2022
  1. ;;5.3;Scheduling;**658,823**;Aug 13, 1993;Build 9
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. Q
  1. ;
  1. PDEMO(RET,DFN) ;GET specific patient demographics
  1. ;INPUT:
  1. ; DFN - Pointer to PATIENT file 2
  1. ;RETURN:
  1. ; .RET = Return Array
  1. ; RET("DOB") = Date of Birth
  1. ; RET("ELIGIEN") = Pointer to MAS ELIGIBILITY CODE file 8.1
  1. ; RET("ELIGNAME") = NAME from MAS ELIGIBILITY CODE file
  1. ; RET("GENDER")
  1. ; RET("HRN") = health record number
  1. ; RET("INSTIEN") = Institution IEN
  1. ; RET("INSTNAME") = Institution Name
  1. ; RET("NAME") = Patient name
  1. ; RET("PADDRES1")= STREET ADDRESS [LINE 1] (.111)
  1. ; RET("PADDRES2")= STREET ADDRESS [LINE 2] (.112)
  1. ; RET("PADDRES3")= STREET ADDRESS [LINE 3] (.113)
  1. ; RET("PZIP+4") = ZIP+4 (.1112)
  1. ; RET("PCITY") = CITY (.114)
  1. ; RET("PSTATE") = STATE name (from .115)
  1. ; RET("PCOUNTRY") = COUNTRY name (from .1173)
  1. ; RET("BADADD") = BAD ADDRESS INDICATOR (.121)
  1. ; 1=UNDELIVERABLE
  1. ; 2=HOMELESS
  1. ; 3=OTHER
  1. ; 4=ADDRESS NOT FOUND
  1. ; RET("HPHONE") = Home phone (.131)
  1. ; RET("OPHONE") = Office phone (.132)
  1. ; RET("PRIGRP") = ENROLLMENT PRIORITY text from PATIENT ENROLLMENT file
  1. ; Valid Values:
  1. ; GROUP 1
  1. ; GROUP 2
  1. ; GROUP 3
  1. ; GROUP 4
  1. ; GROUP 5
  1. ; GROUP 6
  1. ; GROUP 7
  1. ; GROUP 8
  1. ; RET("SIMILAR") = Similar Patients
  1. ; MESSSAGE | Patients
  1. ; Message
  1. ; Patients separated by ;;
  1. ; Each ;; piece contains the following ~ pieces
  1. ; DFN ~ NAME ~ DOB ~ SSN
  1. ; RET("SSN") = Social Security number
  1. ; RET("SUBGRP") = Enrollment Subgroup
  1. ; RET("SVCCONN") = SERVICE CONNECTED field from PATIENT ENROLLMENT file
  1. ; Valid values:
  1. ; YES
  1. ; NO
  1. ; RET("SVCCONNP") = SERVICE CONNECTED PERCENTAGE field from PATIENT ENROLLMENT file
  1. ; Numeric between 0-100
  1. ; RET("TYPEIEN") = Pointer to TYPE OF PATIENT file 391
  1. ; RET("TYPENAME")= NAME from TYPE OF PATIENT file 391
  1. ;
  1. ; RET("NOK") - Primary Next of Kin (.211)
  1. ; RET("KNAME") - Primary Next of Kin name
  1. ; RET("KREL") - Primary Next of Kin Relationship to Patient (.212)
  1. ; RET("KPHONE") - Primary Next of Kin Phone (.219)
  1. ; RET("KSTREET") - Primary Next of Kin Street Address [Line 1] (.213)
  1. ; RET("KSTREET2") - Primary Next of Kin Street Address [Line 2] (.214)
  1. ; RET("KSTREET3") - Primary Next of Kin Street Address [Line 3] (.215)
  1. ; RET("KCITY") - Primary Next of Kin City (.216)
  1. ; RET("KSTATE") - Primary Next of Kin State (.217)
  1. ; RET("KZIP") - Primary Next of Kin Zip (.218)
  1. ; RET("NOK2") - Secondary Next of Kin (.2191)
  1. ; RET("K2NAME") - Secondary Next of Kin name (.2191)
  1. ; RET("K2REL") - Secondary Next of Kin Relationship to Patient (.2192)
  1. ; RET("K2PHONE") - Secondary Next of Kin Phone (.2199)
  1. ; RET("K2STREET") - Secondary Next of Kin Street Address [Line 1] (.2193)
  1. ; RET("K2STREET2") - Secondary Next of Kin Street Address [Line 2] (.2194)
  1. ; RET("K2STREET3") - Secondary Next of Kin Street Address [Line 3] (.2195)
  1. ; RET("K2CITY") - Secondary Next of Kin City (.2196)
  1. ; RET("K2STATE") - Secondary Next of Kin State (.2197)
  1. ; RET("K2ZIP") - Secondary Next of Kin Zip (.2198)
  1. ; RET("PCOUNTY") - Patient County (.117)
  1. ; RET("PETH") - List of Patient Ethnicities/Names Eth|Name^... Use ETH^SDECU2
  1. ; RET("PRACE") - List of Patient Races/Names RACE|NAME^... Use RACELST^SDECU2
  1. ; RET("PMARITAL") - Patient Marital Status
  1. ; RET("PRELIGION") - Patient Religious Preference
  1. ; RET("PTACTIVE") - Patient Temporary Address Active? (.12105)
  1. ; RET("PTADDRESS1") - Patient Temporary Address Line 1 (.1211)
  1. ; RET("PTADDRESS2") - Patient Temporary Address Line 2 (.1212)
  1. ; RET("PTADDRESS3") - Patient Temporary Address Line 3 (.1213)
  1. ; RET("PTCITY") - Patient Temporary City (.1214)
  1. ; RET("PTSTATE") - Patient Temporary State (.1215)
  1. ; RET("PTZIP") - Patient Temporary Zip (.1216)
  1. ; RET("PTZIP+4") - Patient Temporary Zip+4 (.12112)
  1. ; RET("PTCOUNTRY") - Patient Temporary Country (.1223)
  1. ; RET("PTCOUNTY") - Patient Temporary County (.12111)
  1. ; RET("PTPHONE") - Patient Temporary Phone (.1219)
  1. ; RET("PTSTART") - Patient Temporary Address Start Date (.1217)
  1. ; RET("PTEND") - Patient Temporary Address End Date (.1218)
  1. ; RET("PCELL") - Patient Cell Phone (.134)
  1. ; RET("PPAGER") - Patient Pager Number (.135)
  1. ; RET("PEMAIL") - Patient Email Address (.133)
  1. ; RET("PF_FFF") - Patient FUGITIVE FELON FLAG 1=YES
  1. ; RET("PF_VCD") - Patient VETERAN CATASTROPHICALLY DISABLED? Y=YES N=NO
  1. ; RET("PFNATIONAL") - Patient national Flags (PRF ASSIGNMENT/PRF NATIONAL FLAG) separated by |
  1. ; Each | piece contains the following ;; pipe pieces:
  1. ; 1. PRFAID - PRF Assignment ID pointer to PRF ASSIGNMENT file (#26.13)
  1. ; 2. PRFSTAT - PRF Assignment Status 0=INACTIVE 1=ACTIVE
  1. ; 3. PRFNID - PRF National Flag ID pointer to PRF NATIONAL FLAG file (#26.15)
  1. ; 4. PRFNNAME - PRF National Flag name
  1. ; 5. PRFNSTAT - PRF National Flag status 0=INACTIVE 1=ACTIVE
  1. ; RET("PFLOCAL") - Patient Local Flags (PRF ASSIGNMENT/PRF Local FLAG) separated by |
  1. ; Each | piece contains the following ;; pipe pieces:
  1. ; 1. PRFAID - PRF Assignment ID pointer to PRF ASSIGNMENT file (#26.13)
  1. ; 2. PRFSTAT - PRF Assignment Status 0=INACTIVE 1=ACTIVE
  1. ; 3. PRFLID - PRF Local Flag ID pointer to PRF LOCAL FLAG file (#26.11)
  1. ; 4. PRFLNAME - PRF Local Flag name
  1. ; 5. PRFLSTAT - PRF Local Flag status 0=INACTIVE 1=ACTIVE
  1. ; RET("PF_8G") - Category 8G (not returned yet)
  1. ;
  1. N SDD,SDI,SDM
  1. N PCE,PCOUNTY,PD,PTCOUNTY,PETHL,PM,PTINFO
  1. Q:'+$G(DFN)
  1. Q:'$D(^DPT(DFN,0))
  1. ;collect demographics
  1. K RET
  1. S (PCOUNTY,PTCOUNTY,RET("PCOUNTY"),RET("PTCOUNTY"))=""
  1. ;get data from PTINFO and PATIENT/IHS
  1. D PTINFO^SDECPTCX(.PTINFO,DFN)
  1. D GETS^DIQ(9000001,DFN_",","**","IE","PD","PM")
  1. I '$D(PM) D
  1. .S RET("INSTIEN")=$G(PD(9000001.41,+DUZ(2)_","_DFN_",",.01,"I"))
  1. .S RET("INSTNAME")=$G(PD(9000001.41,+DUZ(2)_","_DFN_",",.01,"E"))
  1. E S (RET("INSTIEN"),RET("INSTNAME"))=""
  1. S RET("NAME")=$P($G(PTINFO),U)
  1. S RET("GENDER")=$P($G(PTINFO),U,2)
  1. S RET("DOB")=$$FMTE^XLFDT($P($G(PTINFO),U,3))
  1. S RET("SSN")=$P($G(PTINFO),U,4)
  1. ;
  1. S RET("HRN")=$$HRN^SDECPAT(DFN,DUZ(2))
  1. ;
  1. ;patient enrollment
  1. S PCE=$P($G(^DPT(DFN,"ENR")),U,1)
  1. D:+PCE GETS^DIQ(27.11,+PCE_",",".07;.12;50.01;50.02;50.03","IE","SDD","SDM")
  1. S RET("PRIGRP")=$S(+PCE:SDD(27.11,PCE_",",.07,"E"),1:"")
  1. S RET("SUBGRP")=$S(+PCE:SDD(27.11,PCE_",",.12,"E"),1:"")
  1. S RET("ELIGIEN")=$S(+PCE:SDD(27.11,PCE_",",50.01,"I"),1:"")
  1. S RET("ELIGNAME")=$S(+PCE:SDD(27.11,PCE_",",50.01,"E"),1:"")
  1. S RET("SVCCONN")=$$GET1^DIQ(2,DFN_",",.301,"E") ;$S(+PCE:SDD(27.11,PCE_",",50.02,"E"),1:"")
  1. S RET("SVCCONNP")=$$GET1^DIQ(2,DFN_",",.302,"E") ;$S(+PCE:SDD(27.11,PCE_",",50.03,"I"),1:"")
  1. S RET("TYPEIEN")=$$GET1^DIQ(2,DFN_",",391,"I")
  1. S RET("TYPENAME")=$$GET1^DIQ(2,DFN_",",391,"E")
  1. ;
  1. ;get addresses
  1. K SDD,SDM D GETS^DIQ(2,DFN_",",".05;.08;.111:.135;.211:.2207","IE","SDD","SDM")
  1. S RET("PADDRES1")=$G(SDD(2,DFN_",",.111,"E")) ; STREET ADDRESS [LINE 1]
  1. S RET("PADDRES2")=$G(SDD(2,DFN_",",.112,"E")) ; STREET ADDRESS [LINE 2]
  1. S RET("PADDRES3")=$G(SDD(2,DFN_",",.113,"E")) ; STREET ADDRESS [LINE 3]
  1. S RET("PZIP+4")=$G(SDD(2,DFN_",",.1112,"E")) ; ZIP+4
  1. S RET("PCITY")=$G(SDD(2,DFN_",",.114,"E")) ; CITY
  1. N PSTATE S PSTATE=$G(SDD(2,DFN_",",.115,"I"))
  1. S RET("PSTATE")=$G(SDD(2,DFN_",",.115,"E")) ; STATE name
  1. I PSTATE'="" D
  1. .S PCOUNTY=$G(SDD(2,DFN_",",.117,"I"))
  1. .S:PCOUNTY'="" RET("PCOUNTY")=$P($G(^DIC(5,PSTATE,1,PCOUNTY,0)),U,1) ; - Patient County (.117)
  1. S RET("PCOUNTRY")=$G(SDD(2,DFN_",",.1173,"I")) ; COUNTRY
  1. I RET("PCOUNTRY")'="",'+RET("PCOUNTRY") S RET("PCOUNTRY")=$O(^HL(779.004,"B",RET("PCOUNTRY"),0))
  1. S RET("BADADD")=$G(SDD(2,DFN_",",.121,"I")) ;bad address indicator
  1. S RET("PTACTIVE")=$G(SDD(2,DFN_",",.12105,"I"))
  1. S RET("PTADDRESS1")=$G(SDD(2,DFN_",",.1211,"E"))
  1. S RET("PTADDRESS2")=$G(SDD(2,DFN_",",.1212,"E"))
  1. S RET("PTADDRESS3")=$G(SDD(2,DFN_",",.1213,"E"))
  1. S RET("PTCITY")=$G(SDD(2,DFN_",",.1214,"E"))
  1. N PTSTATE S PTSTATE=$G(SDD(2,DFN_",",.1215,"I"))
  1. S RET("PTSTATE")=$G(SDD(2,DFN_",",.1215,"E")) ; Patient Temporary STATE name
  1. S RET("PTZIP")=$G(SDD(2,DFN_",",.1216,"E")) ; Patient Temporary Zip (.1216)
  1. S RET("PTZIP+4")=$G(SDD(2,DFN_",",.12112,"E")) ; Patient Temporary Zip+4 (.12112)
  1. S RET("PTCOUNTRY")=$G(SDD(2,DFN_",",.1223,"I")) ; Patient Temp COUNTRY
  1. I PTSTATE'="" D
  1. .S PTCOUNTY=$G(SDD(2,DFN_",",.12111,"I"))
  1. .S:PTCOUNTY'="" RET("PTCOUNTY")=$P($G(^DIC(5,PTSTATE,1,PTCOUNTY,0)),U,1) ; - Patient Temp County (.12111)
  1. S RET("PTSTART")=$G(SDD(2,DFN_",",.1217,"E")) ; Patient Temporary Address Start Date (.1217)
  1. S RET("PTEND")=$G(SDD(2,DFN_",",.1218,"E")) ; Patient Temporary Address End Date (.1218)
  1. ;
  1. ;get phones
  1. S RET("HPHONE")=$G(SDD(2,DFN_",",.131,"E")) ; phone number (residence) (home phone)
  1. S RET("OPHONE")=$G(SDD(2,DFN_",",.132,"E")) ; phone number (work) (office phone)
  1. S RET("PTPHONE")=$G(SDD(2,DFN_",",.1219,"E")) ; Patient Temporary Phone (.1219)
  1. S RET("PCELL")=$G(SDD(2,DFN_",",.134,"E")) ; Patient Cell Phone (.134)
  1. S RET("PPAGER")=$G(SDD(2,DFN_",",.135,"E")) ; Patient Pager Number (.135)
  1. S RET("PEMAIL")=$G(SDD(2,DFN_",",.133,"E")) ; Patient Email Address (.133)
  1. ;
  1. ; Return data to add:
  1. S RET("NOK")=$G(SDD(2,DFN_",",.211,"I")) ;Primary Next of Kin (.211)
  1. S RET("KNAME")=$G(SDD(2,DFN_",",.211,"E")) ;Primary Next of Kin name (.211)
  1. S RET("KREL")=$G(SDD(2,DFN_",",.212,"E")) ;Primary Next of Kin Relationship to Patient (.212)
  1. S RET("KPHONE")=$G(SDD(2,DFN_",",.219,"E")) ;Primary Next of Kin Phone (.219)
  1. S RET("KSTREET")=$G(SDD(2,DFN_",",.213,"E")) ;Primary Next of Kin Street Address [Line 1] (.213)
  1. S RET("KSTREET2")=$G(SDD(2,DFN_",",.214,"E")) ;Primary Next of Kin Street Address [Line 2] (.214)
  1. S RET("KSTREET3")=$G(SDD(2,DFN_",",.215,"E")) ;Primary Next of Kin Street Address [Line 3] (.215)
  1. S RET("KCITY")=$G(SDD(2,DFN_",",.216,"E")) ;Primary Next of Kin City (.216)
  1. S RET("KSTATE")=$G(SDD(2,DFN_",",.217,"E")) ;Primary Next of Kin State (.217)
  1. S RET("KZIP")=$G(SDD(2,DFN_",",.218,"E")) ;Primary Next of Kin Zip (.218)
  1. ;
  1. S RET("NOK2")=$G(SDD(2,DFN_",",.2191,"I")) ;Secondary Next of Kin (.2191)
  1. S RET("K2NAME")=$G(SDD(2,DFN_",",.2191,"E")) ;Secondary Next of Kin name (.2191)
  1. S RET("K2REL")=$G(SDD(2,DFN_",",.2192,"E")) ;Secondary Next of Kin Relationship to Patient (.2192)
  1. S RET("K2PHONE")=$G(SDD(2,DFN_",",.2199,"E")) ;Secondary Next of Kin Phone (.2199)
  1. S RET("K2STREET")=$G(SDD(2,DFN_",",.2193,"E")) ;Secondary Next of Kin Street Address [Line 1] (.2193)
  1. S RET("K2STREET2")=$G(SDD(2,DFN_",",.2194,"E")) ;Secondary Next of Kin Street Address [Line 2] (.2194)
  1. S RET("K2STREET3")=$G(SDD(2,DFN_",",.2195,"E")) ;Secondary Next of Kin Street Address [Line 3] (.2195)
  1. S RET("K2CITY")=$G(SDD(2,DFN_",",.2196,"E")) ;Secondary Next of Kin City (.2196)
  1. S RET("K2STATE")=$G(SDD(2,DFN_",",.2197,"E")) ;Secondary Next of Kin State (.2197)
  1. S RET("K2ZIP")=$G(SDD(2,DFN_",",.2198,"E")) ;Secondary Next of Kin Zip (.2198)
  1. ;
  1. S RET("PMARITAL")=$G(SDD(2,DFN_",",.05,"E")) ;Patient Marital Status (.05)
  1. S RET("PRELIGION")=$G(SDD(2,DFN_",",.08,"E")) ;Patient Religious Preference (.08)
  1. ;
  1. N PETH,PETHN D ETH^SDECU2(DFN,.PETH,.PETHN)
  1. S PETHL="" F SDI=1:1:$L(PETH,"|") S PETHL=PETHL_$S(PETHL'="":U,1:"")_$P(PETH,"|",SDI)_"|"_$P(PETHN,"|",SDI)
  1. S RET("PETH")=PETHL ;List of Patient Ethnicities/Names Eth|Name^... Use ETH^SDECU2
  1. N RACE,RACEL,RACEN D RACELST^SDECU2(DFN,.RACE,.RACEN)
  1. S RACEL="" F SDI=1:1:$L(RACE,"|") S RACEL=RACEL_$S(RACEL'="":U,1:"")_$P(RACE,"|",SDI)_"|"_$P(RACEN,"|",SDI)
  1. S RET("PRACE")=RACEL ;List of Patient Races/Names RACE|NAME^... Use RACELST^SDECU2
  1. S RET("PFNATIONAL")=$$FLAGS^SDECU2(DFN,26.15)
  1. S RET("PFLOCAL")=$$FLAGS^SDECU2(DFN,26.11)
  1. S RET("PF_FFF")=$$GET1^DIQ(2,DFN_",",1100.01,"I")
  1. S RET("PF_VCD")=$$GET1^DIQ(2,DFN_",",.39,"I")
  1. S RET("SIMILAR")=$$SIM(DFN)
  1. ;
  1. Q
  1. ;
  1. SIM(DFN) ;get similar patient data
  1. N MI,MSG,NOD,PATS,RET,SIM
  1. S (MSG,PATS,SIM)=""
  1. D GUIBS5A^DPTLK6(.RET,DFN)
  1. S MI=1 F S MI=$O(RET(MI)) Q:MI="" D
  1. .S NOD=RET(MI)
  1. .I $P(NOD,U,1)=0 S MSG=MSG_$S(MSG'="":" ",1:"")_$P(NOD,U,2)
  1. .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_"."
  1. S SIM=MSG_"|"_PATS
  1. Q SIM