VistA-ccr/p/CCRDPT.m

CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
  ;;0.1;CCRCCD;;Jun 15, 2008;
 ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
 ;General Public License See attached copy of the License.
 ;
 ;This program is free software; you can redistribute it and/or modify
 ;it under the terms of the GNU General Public License as published by
 ;the Free Software Foundation; either version 2 of the License, or
 ;(at your option) any later version.
 ;
 ;This program is distributed in the hope that it will be useful,
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;GNU General Public License for more details.
 ;
 ;You should have received a copy of the GNU General Public License along
 ;with this program; if not, write to the Free Software Foundation, Inc.,
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    ; 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] ^DFN) ; Copy DFN global to a local variable; PUBLIC
    ; 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.
INIT(DFN) ;
          M PT=^DPT(DFN)
          Q
          ;
DESTROY ; Kill local variable; PUBLIC
          ; INPUT: None
          ; OUTPUT: Kill PT from the Symbol Table after you are done
          K PT
          Q
          ;
FAMILY() ; Family Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(0))="" ""
          N NAME S NAME=$P(PT(0),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("FAMILY")
          ;
GIVEN() ; Given Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(0))="" ""
          N NAME S NAME=$P(PT(0),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("GIVEN")
          ;
MIDDLE() ; Middle Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(0))="" ""
          N NAME S NAME=$P(PT(0),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("MIDDLE")
          ;
SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(0))="" ""
          N NAME S NAME=$P(PT(0),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("SUFFIX")
          ;
DISPNAME() ; Display Name; PUBLIC; Extrinsic
          ; 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
DOB() ; 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")
          ;
GENDER() ; Get Gender; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(0))="" ""
          Q $P(PT(0),"^",2)
          ;
SSN() ; Get SSN for ID; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(0))="" ""
          Q $P(PT(0),"^",9)
          ;
ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
          ; Vista only stores a home address for the patient.
          Q:$G(PT(0))="" ""
          Q "Home"
          ;
ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.11))="" ""
          Q $P(PT(.11),"^",1)
          ;
ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
          ; 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)
          ;
CITY() ; Get City for Home Address; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.11))="" ""
          Q $P(PT(.11),"^",4)
          ;
STATE() ; Get State for Home Address; PUBLIC; Extrinsic
          ; 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)
          ;
ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.11))="" ""
          Q $P(PT(.11),"^",6)
          ;
COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.11))="" ""
          Q $P(PT(.11),"^",7)
          ;
COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
          ; Unfortunately, I can't find where that is stored, so the inevitable...
          Q:$G(PT(.11))="" ""
          Q "USA"
          ;
RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.13))="" ""
          Q $P(PT(.13),"^",1)
          ;
WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.13))="" ""
          Q $P(PT(.13),"^",2)
          ;
EMAIL() ; Email Adddress; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.13))="" ""
          Q $P(PT(.13),"^",3)
          ;
CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.13))="" ""
          Q $P(PT(.13),"^",4)
          ;
NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          N NAME S NAME=$P(PT(.21),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("FAMILY")
          ;
NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          N NAME S NAME=$P(PT(.21),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("GIVEN")
          ;
NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          N NAME S NAME=$P(PT(.21),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("MIDDLE")
          ;
NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          N NAME S NAME=$P(PT(.21),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("SUFFIX")
          ;
NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
          ; 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
NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          Q $P(PT(.21),"^",2)
          ;
NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          Q $P(PT(.21),"^",3)
          ;
NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
          ; 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)
          ;
NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          Q $P(PT(.21),"^",6)
          ;
NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          N STATENUM S STATENUM=$P(PT(.21),"^",7)
          Q:STATENUM="" ""
          Q $P(^DIC(5,STATENUM,0),"^",1)
          ;
NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          Q $P(PT(.21),"^",8)
          ;
NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          Q $P(PT(.21),"^",9)
          ;
NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          Q $P(PT(.21),"^",11)
          ;
NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.21))="" ""
          Q $P(PT(.21),"^",10)
          ;
NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          N NAME S NAME=$P(PT(.211),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("FAMILY")
          ;
NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          N NAME S NAME=$P(PT(.211),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("GIVEN")
          ;
NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          N NAME S NAME=$P(PT(.211),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("MIDDLE")
          ;
NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          N NAME S NAME=$P(PT(.211),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("SUFFIX")
NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
          ; 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
NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          Q $P(PT(.211),"^",2)
          ;
NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          Q $P(PT(.211),"^",3)
          ;
NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
          ; 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)
          ;
NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          Q $P(PT(.211),"^",6)
          ;
NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
          ; 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
          ;
NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          Q $P(PT(.211),"^",8)
          ;
NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          Q $P(PT(.211),"^",9)
          ;
NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          Q $P(PT(.211),"^",11)
          ;
NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.211))="" ""
          Q $P(PT(.211),"^",10)
          ;
EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          N NAME S NAME=$P(PT(.33),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("FAMILY")
          ;
EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          N NAME S NAME=$P(PT(.33),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("GIVEN")
          ;
EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          N NAME S NAME=$P(PT(.33),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("MIDDLE")
          ;
EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          N NAME S NAME=$P(PT(.33),"^",1)
          D NAMECOMP^XLFNAME(.NAME)
          Q NAME("SUFFIX")
EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
          ; 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
EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          Q $P(PT(.33),"^",2)
          ;
EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          Q $P(PT(.33),"^",3)
          ;
EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
          ; 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)
          ;
EMERCITY() ; EMER City; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          Q $P(PT(.33),"^",6)
          ;
EMERSTAT() ; EMER State; PUBLIC; Extrinsic
          ; 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
          ;
EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          Q $P(PT(.33),"^",8)
          ;
EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          Q $P(PT(.33),"^",9)
          ;
EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          Q $P(PT(.33),"^",11)
          ;
EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
          ; PREREQ: PT Defined
          Q:$G(PT(.33))="" ""
          Q $P(PT(.33),"^",10)
          ;