2008-06-22 00:29:13 -04:00
|
|
|
CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
2008-07-03 21:02:47 -04:00
|
|
|
;;0.1;CCRCCD;;Jun 15, 2008;
|
|
|
|
|
|
|
|
|
|
; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
|
|
|
|
|
; DESTROY to clean-up.
|
|
|
|
|
|
|
|
|
|
; The first line of every routine tests if the global exists.
|
|
|
|
|
|
|
|
|
|
; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for
|
|
|
|
|
; INIT 9 lines Copy DFN global to a local variable
|
|
|
|
|
; DESTROY 6 lines Kill local variable
|
|
|
|
|
; FAMILY 6 lines Family Name
|
|
|
|
|
; GIVEN 6 lines Given Name
|
|
|
|
|
; MIDDLE 6 lines Middle Name
|
|
|
|
|
; SUFFIX 6 lines Suffix Name
|
|
|
|
|
; DISPNAME 5 lines Display Name
|
|
|
|
|
; DOB 6 lines Date of Birth
|
|
|
|
|
; GENDER 4 lines Get Gender
|
|
|
|
|
; SSN 4 lines Get SSN for ID
|
|
|
|
|
; ADDRTYPE 4 lines Get Home Address
|
|
|
|
|
; ADDR1 4 lines Get Home Address line 1
|
|
|
|
|
; ADDR2 5 lines Get Home Address line 2
|
|
|
|
|
; CITY 4 lines Get City for Home Address
|
|
|
|
|
; STATE 11 lines Get State for Home Address
|
|
|
|
|
; ZIP 4 lines Get Zip code for Home Address
|
|
|
|
|
; COUNTY 4 lines Get County for our Address
|
|
|
|
|
; COUNTRY 4 lines Get Country for our Address
|
|
|
|
|
; RESTEL 4 lines Residential Telephone
|
|
|
|
|
; WORKTEL 4 lines Work Telephone
|
|
|
|
|
; EMAIL 4 lines Email Adddress
|
|
|
|
|
; CELLTEL 4 lines Cell Phone
|
|
|
|
|
; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name
|
|
|
|
|
; NOK1GIV 6 lines NOK1 Given Name
|
|
|
|
|
; NOK1MID 6 lines NOK1 Middle Name
|
|
|
|
|
; NOK1SUF 6 lines NOK1 Suffi Name
|
|
|
|
|
; NOK1DISP 5 lines NOK1 Display Name
|
|
|
|
|
; NOK1REL 4 lines NOK1 Relationship to the patient
|
|
|
|
|
; NOK1ADD1 4 lines NOK1 Address 1
|
|
|
|
|
; NOK1ADD2 5 lines NOK1 Address 2
|
|
|
|
|
; NOK1CITY 4 lines NOK1 City
|
|
|
|
|
; NOK1STAT 5 lines NOK1 State
|
|
|
|
|
; NOK1ZIP 4 lines NOK1 Zip Code
|
|
|
|
|
; NOK1HTEL; 4 lines NOK1 Home Telephone
|
|
|
|
|
; NOK1WTEL; 4 lines NOK1 Work Telephone
|
|
|
|
|
; NOK1SAME; 4 lines Is NOK1's Address the same the patient?
|
|
|
|
|
; NOK2FAM 6 lines NOK2 Family Name
|
|
|
|
|
; NOK2GIV 6 lines NOK2 Given Name
|
|
|
|
|
; NOK2MID 6 lines NOK2 Middle Name
|
|
|
|
|
; NOK2SUF 5 lines NOK2 Suffi Name
|
|
|
|
|
; NOK2DISP 5 lines NOK2 Display Name
|
|
|
|
|
; NOK2REL 4 lines NOK2 Relationship to the patient
|
|
|
|
|
; NOK2ADD1 4 lines NOK2 Address 1
|
|
|
|
|
; NOK2ADD2 5 lines NOK2 Address 2
|
|
|
|
|
; NOK2CITY 4 lines NOK2 City
|
|
|
|
|
; NOK2STAT 5 lines NOK2 State
|
|
|
|
|
; NOK2ZIP 4 lines NOK2 Zip Code
|
|
|
|
|
; NOK2HTEL; 4 lines NOK2 Home Telephone
|
|
|
|
|
; NOK2WTEL; 4 lines NOK2 Work Telephone
|
|
|
|
|
; NOK2SAME; 4 lines Is NOK2's Address the same the patient?
|
|
|
|
|
; EMERFAM 6 lines Emergency Contact (EMER) Family Name
|
|
|
|
|
; EMERGIV 6 lines EMER Given Name
|
|
|
|
|
; EMERMID 6 lines EMER Middle Name
|
|
|
|
|
; EMERSUF 5 lines EMER Suffi Name
|
|
|
|
|
; EMERDISP 5 lines EMER Display Name
|
|
|
|
|
; EMERREL 4 lines EMER Relationship to the patient
|
|
|
|
|
; EMERADD1 4 lines EMER Address 1
|
|
|
|
|
; EMERADD2 5 lines EMER Address 2
|
|
|
|
|
; EMERCITY 4 lines EMER City
|
|
|
|
|
; EMERSTAT 5 lines EMER State
|
|
|
|
|
; EMERZIP 4 lines EMER Zip Code
|
|
|
|
|
; EMERHTEL; 4 lines EMER Home Telephone
|
|
|
|
|
; EMERWTEL; 4 lines EMER Work Telephone
|
|
|
|
|
; EMERSAME; 4 lines Is EMER's Address the same the NOK?
|
|
|
|
|
|
|
|
|
|
W "No Entry at top!" Q
|
|
|
|
|
|
|
|
|
|
; The following is a map of the relevant data in the patient global.
|
|
|
|
|
;
|
|
|
|
|
; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
|
|
|
|
|
; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
|
|
|
|
|
; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
|
|
|
|
|
; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
|
|
|
|
|
; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
|
|
|
|
|
; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
|
|
|
|
|
; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
|
|
|
|
|
; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
|
|
|
|
|
; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
|
|
|
|
|
; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
|
|
|
|
|
; ==>[21S] ^
|
|
|
|
|
; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS
|
|
|
|
|
; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
|
|
|
|
|
; ==>COMPONENTS [3P:20] ^
|
|
|
|
|
; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
|
|
|
|
|
; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
|
|
|
|
|
; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
|
|
|
|
|
; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^
|
|
|
|
|
; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
|
|
|
|
|
; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
|
|
|
|
|
; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
|
|
|
|
|
; ==>^
|
|
|
|
|
; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
|
|
|
|
|
; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
|
|
|
|
|
; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
|
|
|
|
|
; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
|
|
|
|
|
; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
|
|
|
|
|
; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
|
|
|
|
|
; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
|
|
|
|
|
; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
|
|
|
|
|
; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
|
|
|
|
|
; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
|
|
|
|
|
; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
|
|
|
|
|
; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
|
|
|
|
|
; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
|
|
|
|
|
; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
|
|
|
|
|
; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
|
|
|
|
|
; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
|
|
|
|
|
; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
|
|
|
|
|
; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
|
|
|
|
|
; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
|
|
|
|
|
; ==>SITE [14P:4] ^
|
|
|
|
|
; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
|
|
|
|
|
; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
|
|
|
|
|
; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
|
|
|
|
|
; ==>3] [5F] ^
|
|
|
|
|
; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
|
|
|
|
|
; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
|
|
|
|
|
; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
|
|
|
|
|
; ==>^
|
|
|
|
|
; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
|
|
|
|
|
; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
|
|
|
|
|
; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
|
|
|
|
|
; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
|
|
|
|
|
; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
|
|
|
|
|
; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
|
|
|
|
|
; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
|
|
|
|
|
; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
|
|
|
|
|
; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
|
|
|
|
|
; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
|
|
|
|
|
; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
|
|
|
|
|
; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
|
|
|
|
|
; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514)
|
|
|
|
|
; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
|
|
|
|
|
; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
|
|
|
|
|
; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
|
|
|
|
|
; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
|
|
|
|
|
; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
|
|
|
|
|
; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
|
|
|
|
|
; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
|
|
|
|
|
; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
|
|
|
|
|
; ==>[11F] ^
|
|
|
|
|
|
2008-06-22 00:29:13 -04:00
|
|
|
INIT(DFN) ; Copy DFN global to a local variable; PUBLIC
|
2008-07-03 21:02:47 -04:00
|
|
|
; INPUT: Patient IEN (DFN)
|
|
|
|
|
; OUTPUT: PT in the Symbol Table, representing the patient global
|
|
|
|
|
|
|
|
|
|
; Instead of accessing a global each single read (SLOOOOW)
|
|
|
|
|
; read it off a local variable stored in Memory.
|
|
|
|
|
M PT=^DPT(DFN)
|
|
|
|
|
Q
|
|
|
|
|
;
|
2008-06-22 00:29:13 -04:00
|
|
|
DESTROY ; Kill local variable; PUBLIC
|
2008-07-03 21:02:47 -04:00
|
|
|
; INPUT: None
|
|
|
|
|
; OUTPUT: Kill PT from the Symbol Table after you are done
|
|
|
|
|
K PT
|
|
|
|
|
Q
|
|
|
|
|
;
|
2008-06-22 00:29:13 -04:00
|
|
|
FAMILY() ; Family Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(0),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("FAMILY")
|
|
|
|
|
;
|
2008-06-22 00:29:13 -04:00
|
|
|
GIVEN() ; Given Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(0),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("GIVEN")
|
|
|
|
|
;
|
2008-06-22 00:29:13 -04:00
|
|
|
MIDDLE() ; Middle Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(0),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("MIDDLE")
|
|
|
|
|
;
|
2008-06-22 00:29:13 -04:00
|
|
|
SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(0),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("SUFFIX")
|
|
|
|
|
;
|
2008-06-22 00:29:13 -04:00
|
|
|
DISPNAME() ; Display Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(0),"^",1)
|
|
|
|
|
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|
|
|
|
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
|
|
|
|
OB() ; Date of Birth; PUBLIC; Extrinsic
|
|
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
N DOB S DOB=$P(PT(0),"^",3)
|
|
|
|
|
; Date in FM Date Format. Convert to UTC/ISO 8601.
|
|
|
|
|
Q $$FMDTOUTC^CCRUTIL(DOB,"D")
|
|
|
|
|
;
|
2008-06-22 20:04:01 -04:00
|
|
|
GENDER() ; Get Gender; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
Q $P(PT(0),"^",2)
|
|
|
|
|
;
|
2008-06-22 20:04:01 -04:00
|
|
|
SSN() ; Get SSN for ID; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
Q $P(PT(0),"^",9)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; Vista only stores a home address for the patient.
|
|
|
|
|
Q:$G(PT(0))="" ""
|
|
|
|
|
Q "Home"
|
|
|
|
|
;
|
2008-06-22 20:04:01 -04:00
|
|
|
ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.11))="" ""
|
|
|
|
|
Q $P(PT(.11),"^",1)
|
|
|
|
|
;
|
2008-06-22 20:04:01 -04:00
|
|
|
ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
; Vista has Lines 2,3; CCR has only line 1,2; so compromise
|
|
|
|
|
Q:$G(PT(.11))="" ""
|
|
|
|
|
; If the thrid address is empty, just return the 2nd.
|
|
|
|
|
; If the 2nd is empty, we don't lose, b/c it will return ""
|
|
|
|
|
; This is so that we won't produce a comma if there is no 3rd addr.
|
|
|
|
|
Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
|
|
|
|
|
Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
|
|
|
|
|
;
|
2008-06-22 20:04:01 -04:00
|
|
|
CITY() ; Get City for Home Address; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.11))="" ""
|
|
|
|
|
Q $P(PT(.11),"^",4)
|
|
|
|
|
;
|
2008-06-22 20:04:01 -04:00
|
|
|
STATE() ; Get State for Home Address; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.11))="" ""
|
|
|
|
|
; State is stored as a pointer
|
|
|
|
|
N STATENUM S STATENUM=$P(PT(.11),"^",5)
|
|
|
|
|
;
|
|
|
|
|
; State File Global is below
|
|
|
|
|
; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
|
|
|
|
|
; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
|
|
|
|
|
; ==>US STATE OR POSSESSION [6S] ^
|
|
|
|
|
Q:STATENUM="" "" ; To prevent global undefined below if no state
|
|
|
|
|
Q $P(^DIC(5,STATENUM,0),"^",1)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.11))="" ""
|
|
|
|
|
Q $P(PT(.11),"^",6)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.11))="" ""
|
|
|
|
|
Q $P(PT(.11),"^",7)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; Unfortunately, I can't find where that is stored, so the inevitable...
|
|
|
|
|
Q:$G(PT(.11))="" ""
|
|
|
|
|
Q "USA"
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.13))="" ""
|
|
|
|
|
Q $P(PT(.13),"^",1)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.13))="" ""
|
|
|
|
|
Q $P(PT(.13),"^",2)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
EMAIL() ; Email Adddress; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.13))="" ""
|
|
|
|
|
Q $P(PT(.13),"^",3)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.13))="" ""
|
|
|
|
|
Q $P(PT(.13),"^",4)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.21),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("FAMILY")
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.21),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("GIVEN")
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.21),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("MIDDLE")
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.21),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("SUFFIX")
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.21),"^",1)
|
|
|
|
|
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|
|
|
|
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
Q $P(PT(.21),"^",2)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
Q $P(PT(.21),"^",3)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
; As before, CCR only allows two fileds for the address, so we have to compromise
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
; If the thrid address is empty, just return the 2nd.
|
|
|
|
|
; If the 2nd is empty, we don't lose, b/c it will return ""
|
|
|
|
|
; This is so that we won't produce a comma if there is no 3rd addr.
|
|
|
|
|
Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
|
|
|
|
|
Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
Q $P(PT(.21),"^",6)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
N STATENUM S STATENUM=$P(PT(.21),"^",7)
|
|
|
|
|
Q:STATENUM="" ""
|
|
|
|
|
Q $P(^DIC(5,STATENUM,0),"^",1)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
Q $P(PT(.21),"^",8)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
Q $P(PT(.21),"^",9)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
Q $P(PT(.21),"^",11)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.21))="" ""
|
|
|
|
|
Q $P(PT(.21),"^",10)
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.211),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("FAMILY")
|
|
|
|
|
;
|
2008-06-30 00:50:31 -04:00
|
|
|
NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
|
2008-07-03 21:02:47 -04:00
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.211),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("GIVEN")
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.211),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("MIDDLE")
|
|
|
|
|
;
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.211),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("SUFFIX")
|
2008-06-25 00:15:14 -04:00
|
|
|
NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.211),"^",1)
|
|
|
|
|
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|
|
|
|
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
Q $P(PT(.211),"^",2)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
Q $P(PT(.211),"^",3)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
; As before, CCR only allows two fileds for the address, so we have to compromise
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
; If the thrid address is empty, just return the 2nd.
|
|
|
|
|
; If the 2nd is empty, we don't lose, b/c it will return ""
|
|
|
|
|
; This is so that we won't produce a comma if there is no 3rd addr.
|
|
|
|
|
Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
|
|
|
|
|
Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
Q $P(PT(.211),"^",6)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
N STATENUM S STATENUM=$P(PT(.211),"^",7)
|
|
|
|
|
Q:STATENUM="" "" ; To prevent global undefined below if no state
|
|
|
|
|
Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
Q $P(PT(.211),"^",8)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
Q $P(PT(.211),"^",9)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
Q $P(PT(.211),"^",11)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.211))="" ""
|
|
|
|
|
Q $P(PT(.211),"^",10)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.33),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("FAMILY")
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.33),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("GIVEN")
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.33),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("MIDDLE")
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.33),"^",1)
|
|
|
|
|
D NAMECOMP^XLFNAME(.NAME)
|
|
|
|
|
Q NAME("SUFFIX")
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
N NAME S NAME=$P(PT(.33),"^",1)
|
|
|
|
|
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
|
|
|
|
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
Q $P(PT(.33),"^",2)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
Q $P(PT(.33),"^",3)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
; As before, CCR only allows two fileds for the address, so we have to compromise
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
; If the thrid address is empty, just return the 2nd.
|
|
|
|
|
; If the 2nd is empty, we don't lose, b/c it will return ""
|
|
|
|
|
; This is so that we won't produce a comma if there is no 3rd addr.
|
|
|
|
|
Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
|
|
|
|
|
Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERCITY() ; EMER City; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
Q $P(PT(.33),"^",6)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERSTAT() ; EMER State; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
N STATENUM S STATENUM=$P(PT(.33),"^",7)
|
|
|
|
|
Q:STATENUM="" "" ; To prevent global undefined below if no state
|
|
|
|
|
Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
Q $P(PT(.33),"^",8)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
Q $P(PT(.33),"^",9)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
Q $P(PT(.33),"^",11)
|
|
|
|
|
;
|
2008-06-26 23:23:21 -04:00
|
|
|
EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
|
2008-07-03 21:02:47 -04:00
|
|
|
; PREREQ: PT Defined
|
|
|
|
|
Q:$G(PT(.33))="" ""
|
|
|
|
|
Q $P(PT(.33),"^",10)
|
|
|
|
|
;
|
