Refactored CCRDPT and updated GPLACTOR accordingly
This commit is contained in:
sam
parent
a9a0f2efd5
commit
36f1d9fb13
820
p/CCRDPT.m
820
p/CCRDPT.m
|
|
@ -1,556 +1,270 @@
|
|||
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.
|
||||
CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
||||
;;0.2;CCRCCD;;Jun 15, 2008;
|
||||
;
|
||||
;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.
|
||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||||
; General Public License.
|
||||
;
|
||||
; 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.
|
||||
;
|
||||
;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.
|
||||
; CCRDPT CCRCCD/SMH - Routines to Extract Patient Data for
|
||||
; FAMILY Family Name
|
||||
; GIVEN Given Name
|
||||
; MIDDLE Middle Name
|
||||
; SUFFIX Suffix Name
|
||||
; DISPNAME Display Name
|
||||
; DOB Date of Birth
|
||||
; GENDER Get Gender
|
||||
; SSN Get SSN for ID
|
||||
; ADDRTYPE Get Home Address
|
||||
; ADDR1 Get Home Address line 1
|
||||
; ADDR2 Get Home Address line 2
|
||||
; CITY Get City for Home Address
|
||||
; STATE Get State for Home Address
|
||||
; ZIP Get Zip code for Home Address
|
||||
; COUNTY Get County for our Address
|
||||
; COUNTRY Get Country for our Address
|
||||
; RESTEL Residential Telephone
|
||||
; WORKTEL Work Telephone
|
||||
; EMAIL Email Adddress
|
||||
; CELLTEL Cell Phone
|
||||
; NOK1FAM Next of Kin 1 (NOK1) Family Name
|
||||
; NOK1GIV NOK1 Given Name
|
||||
; NOK1MID NOK1 Middle Name
|
||||
; NOK1SUF NOK1 Suffi Name
|
||||
; NOK1DISP NOK1 Display Name
|
||||
; NOK1REL NOK1 Relationship to the patient
|
||||
; NOK1ADD1 NOK1 Address 1
|
||||
; NOK1ADD2 NOK1 Address 2
|
||||
; NOK1CITY NOK1 City
|
||||
; NOK1STAT NOK1 State
|
||||
; NOK1ZIP NOK1 Zip Code
|
||||
; NOK1HTEL NOK1 Home Telephone
|
||||
; NOK1WTEL NOK1 Work Telephone
|
||||
; NOK1SAME Is NOK1's Address the same the patient?
|
||||
; NOK2FAM NOK2 Family Name
|
||||
; NOK2GIV NOK2 Given Name
|
||||
; NOK2MID NOK2 Middle Name
|
||||
; NOK2SUF NOK2 Suffi Name
|
||||
; NOK2DISP NOK2 Display Name
|
||||
; NOK2REL NOK2 Relationship to the patient
|
||||
; NOK2ADD1 NOK2 Address 1
|
||||
; NOK2ADD2 NOK2 Address 2
|
||||
; NOK2CITY NOK2 City
|
||||
; NOK2STAT NOK2 State
|
||||
; NOK2ZIP NOK2 Zip Code
|
||||
; NOK2HTEL NOK2 Home Telephone
|
||||
; NOK2WTEL NOK2 Work Telephone
|
||||
; NOK2SAME Is NOK2's Address the same the patient?
|
||||
; EMERFAM Emergency Contact (EMER) Family Name
|
||||
; EMERGIV EMER Given Name
|
||||
; EMERMID EMER Middle Name
|
||||
; EMERSUF EMER Suffi Name
|
||||
; EMERDISP EMER Display Name
|
||||
; EMERREL EMER Relationship to the patient
|
||||
; EMERADD1 EMER Address 1
|
||||
; EMERADD2 EMER Address 2
|
||||
; EMERCITY EMER City
|
||||
; EMERSTAT EMER State
|
||||
; EMERZIP EMER Zip Code
|
||||
; EMERHTEL EMER Home Telephone
|
||||
; EMERWTEL EMER Work Telephone
|
||||
; EMERSAME Is EMER's Address the same the NOK?
|
||||
;
|
||||
;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)
|
||||
;
|
||||
W "No Entry at top!" Q
|
||||
;
|
||||
;**Revision History**
|
||||
; - June 15, 08: v0.1 using merged global
|
||||
; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
|
||||
;
|
||||
; All methods are Public and Extrinsic
|
||||
; All calls use Fileman file 2 (Patient).
|
||||
; You can obtain field numbers using the data dictionary
|
||||
;
|
||||
FAMILY(DFN) ; Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
GIVEN(DFN) ; Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
MIDDLE(DFN) ; Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
SUFFIX(DFN) ; Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
DISPNAME(DFN) ; Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
DOB(DFN) ; Date of Birth
|
||||
N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
|
||||
; Date in FM Date Format. Convert to UTC/ISO 8601.
|
||||
Q $$FMDTOUTC^CCRUTIL(DOB,"D")
|
||||
GENDER(DFN) ; Gender/Sex
|
||||
Q $$GET1^DIQ(2,DFN,.02) ;
|
||||
SSN(DFN) ; SSN
|
||||
Q $$GET1^DIQ(2,DFN,.09)
|
||||
ADDRTYPE(DFN) ; Address Type
|
||||
; Vista only stores a home address for the patient.
|
||||
Q "Home"
|
||||
ADDR1(DFN) ; Get Home Address line 1
|
||||
Q $$GET1^DIQ(2,DFN,.111)
|
||||
ADDR2(DFN) ; Get Home Address line 2
|
||||
; Vista has Lines 2,3; CCR has only line 1,2; so compromise
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
CITY(DFN) ; Get City for Home Address
|
||||
Q $$GET1^DIQ(2,DFN,.114)
|
||||
STATE(DFN) ; Get State for Home Address
|
||||
Q $$GET1^DIQ(2,DFN,.115)
|
||||
ZIP(DFN) ; Get Zip code for Home Address
|
||||
Q $$GET1^DIQ(2,DFN,.116)
|
||||
COUNTY(DFN) ; Get County for our Address
|
||||
Q $$GET1^DIQ(2,DFN,.117)
|
||||
COUNTRY(DFN) ; Get Country for our Address
|
||||
; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
|
||||
Q "USA"
|
||||
RESTEL(DFN) ; Residential Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.131)
|
||||
WORKTEL(DFN) ; Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.132)
|
||||
EMAIL(DFN) ; Email Adddress
|
||||
Q $$GET1^DIQ(2,DFN,.133)
|
||||
CELLTEL(DFN) ; Cell Phone
|
||||
Q $$GET1^DIQ(2,DFN,.134)
|
||||
NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
NOK1GIV(DFN) ; NOK1 Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
NOK1MID(DFN) ; NOK1 Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
NOK1SUF(DFN) ; NOK1 Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
NOK1DISP(DFN) ; NOK1 Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
NOK1REL(DFN) ; NOK1 Relationship to the patient
|
||||
Q $$GET1^DIQ(2,DFN,.212)
|
||||
NOK1ADD1(DFN) ; NOK1 Address 1
|
||||
Q $$GET1^DIQ(2,DFN,.213)
|
||||
NOK1ADD2(DFN) ; NOK1 Address 2
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
NOK1CITY(DFN) ; NOK1 City
|
||||
Q $$GET1^DIQ(2,DFN,.216)
|
||||
NOK1STAT(DFN) ; NOK1 State
|
||||
Q $$GET1^DIQ(2,DFN,.217)
|
||||
NOK1ZIP(DFN) ; NOK1 Zip Code
|
||||
Q $$GET1^DIQ(2,DFN,.218)
|
||||
NOK1HTEL(DFN) ; NOK1 Home Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.219)
|
||||
NOK1WTEL(DFN) ; NOK1 Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.21011)
|
||||
NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
|
||||
Q $$GET1^DIQ(2,DFN,.2125)
|
||||
NOK2FAM(DFN) ; NOK2 Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
NOK2GIV(DFN) ; NOK2 Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
NOK2MID(DFN) ; NOK2 Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
NOK2SUF(DFN) ; NOK2 Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
NOK2DISP(DFN) ; NOK2 Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
NOK2REL(DFN) ; NOK2 Relationship to the patient
|
||||
Q $$GET1^DIQ(2,DFN,.2192)
|
||||
NOK2ADD1(DFN) ; NOK2 Address 1
|
||||
Q $$GET1^DIQ(2,DFN,.2193)
|
||||
NOK2ADD2(DFN) ; NOK2 Address 2
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
NOK2CITY(DFN) ; NOK2 City
|
||||
Q $$GET1^DIQ(2,DFN,.2196)
|
||||
NOK2STAT(DFN) ; NOK2 State
|
||||
Q $$GET1^DIQ(2,DFN,.2197)
|
||||
NOK2ZIP(DFN) ; NOK2 Zip Code
|
||||
Q $$GET1^DIQ(2,DFN,.2198)
|
||||
NOK2HTEL(DFN) ; NOK2 Home Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.2199)
|
||||
NOK2WTEL(DFN) ; NOK2 Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.211011)
|
||||
NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
|
||||
Q $$GET1^DIQ(2,DFN,.21925)
|
||||
EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
EMERGIV(DFN) ; EMER Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
EMERMID(DFN) ; EMER Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
EMERSUF(DFN) ; EMER Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
EMERDISP(DFN) ; EMER Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
EMERREL(DFN) ; EMER Relationship to the patient
|
||||
Q $$GET1^DIQ(2,DFN,.331)
|
||||
EMERADD1(DFN) ; EMER Address 1
|
||||
Q $$GET1^DIQ(2,DFN,.333)
|
||||
EMERADD2(DFN) ; EMER Address 2
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
EMERCITY(DFN) ; EMER City
|
||||
Q $$GET1^DIQ(2,DFN,.336)
|
||||
EMERSTAT(DFN) ; EMER State
|
||||
Q $$GET1^DIQ(2,DFN,.337)
|
||||
EMERZIP(DFN) ; EMER Zip Code
|
||||
Q $$GET1^DIQ(2,DFN,.338)
|
||||
EMERHTEL(DFN) ; EMER Home Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.339)
|
||||
EMERWTEL(DFN) ; EMER Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.33011)
|
||||
EMERSAME(DFN) ; Is EMER's Address the same the NOK?
|
||||
Q $$GET1^DIQ(2,DFN,.3305)
|
||||
|
|
|
|||
|
|
@ -35,11 +35,9 @@ CCRDPTT ; Unit Tester...
|
|||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||
;
|
||||
W "You have selected patient "_Y,!!
|
||||
D INIT^CCRDPT($P(Y,"^"))
|
||||
; ZWR PT
|
||||
N I S I=165 F S I=$O(OUT(I)) Q:I="" D
|
||||
N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D
|
||||
. W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
|
||||
. W "valued at "
|
||||
. W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
|
||||
. W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
|
||||
. W !
|
||||
Q
|
||||
Q
|
||||
|
|
|
|||
|
|
@ -13,9 +13,8 @@ MEDS
|
|||
W "Getting Med Template into MINXML using",!
|
||||
W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
|
||||
D QUERY^GPLXPATH(T,XPATH,"MINXML")
|
||||
B
|
||||
W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
|
||||
W "OUTXML will be ^TMP($J,""OUT"")",!
|
||||
N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
|
||||
D EXTRACT^CCRMEDS("MINXML",DFN,OUTXML)
|
||||
D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
|
||||
Q
|
||||
|
|
|
|||
248
p/GPLACTOR.m
248
p/GPLACTOR.m
|
|
@ -1,134 +1,132 @@
|
|||
GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
||||
;;0.3;CCDCCR;nopatch;noreleasedate
|
||||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||||
;General Public License See attached copy of the License.
|
||||
;;0.4;CCDCCR;nopatch;noreleasedate
|
||||
; 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.
|
||||
;
|
||||
;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.
|
||||
; PROCESS THE ACTORS SECTION OF THE CCR
|
||||
;
|
||||
;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.
|
||||
; ===Revision History===
|
||||
; 0.1 Initial Writing of Skeleton--GPL
|
||||
; 0.2 Patient Data Extraction--SMH
|
||||
; 0.3 Information System Info Extraction--SMH
|
||||
; 0.4 Patient data rouine refactored; adjustments here--SMH
|
||||
;
|
||||
;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.
|
||||
;
|
||||
; PROCESS THE ACTORS SECTION OF THE CCR
|
||||
;
|
||||
; ===Revision History===
|
||||
; 0.1 Initial Writing of Skeleton--GPL
|
||||
; 0.2 Patient Data Extraction--SMH
|
||||
; 0.3 Information System Info Extraction--SMH
|
||||
;
|
||||
EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
||||
; IPXML is the Input Actor Template into which we substitute values
|
||||
; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
||||
; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
|
||||
; ^TMP(7542,1,"ACTORS",0)=Count
|
||||
; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
||||
; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
||||
; AXML is the output arrary, to contain XML.
|
||||
;
|
||||
N I,J,AMAP,AOID,ATYP,AIEN
|
||||
D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
||||
D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
||||
I DEBUG W "PROCESSING ACTORS ",!
|
||||
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
||||
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
||||
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
||||
. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
||||
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
||||
. I ATYP="" Q ; NOT A VALID ACTOR
|
||||
. ;
|
||||
. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
||||
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
||||
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
||||
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="NOK" D ; NOK ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
||||
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
||||
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
||||
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
||||
;
|
||||
N ACTTMP
|
||||
D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W "ACTORS Missing list: ",!
|
||||
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
||||
Q
|
||||
;
|
||||
; IPXML is the Input Actor Template into which we substitute values
|
||||
; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
||||
; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
|
||||
; ^TMP(7542,1,"ACTORS",0)=Count
|
||||
; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
||||
; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
||||
; AXML is the output arrary, to contain XML.
|
||||
;
|
||||
N I,J,AMAP,AOID,ATYP,AIEN
|
||||
D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
||||
D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
||||
I DEBUG W "PROCESSING ACTORS ",!
|
||||
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
||||
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
||||
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
||||
. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
||||
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
||||
. I ATYP="" Q ; NOT A VALID ACTOR
|
||||
. ;
|
||||
. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
||||
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
||||
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
||||
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="NOK" D ; NOK ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
||||
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
||||
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
||||
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
||||
;
|
||||
N ACTTMP
|
||||
D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W "ACTORS Missing list: ",!
|
||||
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
||||
Q
|
||||
;
|
||||
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
||||
;
|
||||
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
||||
N AMAP,ZX
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
D INIT^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
|
||||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
|
||||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
|
||||
S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
|
||||
S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
|
||||
S @AMAP@("ACTORSSN")=""
|
||||
S @AMAP@("ACTORSSNTEXT")=""
|
||||
S @AMAP@("ACTORSSNSOURCEID")=""
|
||||
S ZX=$$SSN^CCRDPT
|
||||
I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
||||
. S @AMAP@("ACTORSSN")=ZX
|
||||
. S @AMAP@("ACTORSSNTEXT")="SSN"
|
||||
. S @AMAP@("ACTORSSNSOURCEID")=AOID
|
||||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
|
||||
S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
|
||||
S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
|
||||
S @AMAP@("ACTORRESTEL")=""
|
||||
S @AMAP@("ACTORRESTELTEXT")=""
|
||||
S ZX=$$RESTEL^CCRDPT
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORRESTEL")=ZX
|
||||
. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
||||
S @AMAP@("ACTORWORKTEL")=""
|
||||
S @AMAP@("ACTORWORKTELTEXT")=""
|
||||
S ZX=$$WORKTEL^CCRDPT
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORWORKTEL")=ZX
|
||||
. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
||||
S @AMAP@("ACTORCELLTEL")=""
|
||||
S @AMAP@("ACTORCELLTELTEXT")=""
|
||||
S ZX=$$CELLTEL^CCRDPT
|
||||
I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORCELLTEL")=ZX
|
||||
. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
||||
S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
|
||||
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
||||
S @AMAP@("ACTORIEN")=AIEN
|
||||
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
D DESTROY^CCRDPT
|
||||
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
||||
N AMAP,ZX
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORSSN")=""
|
||||
S @AMAP@("ACTORSSNTEXT")=""
|
||||
S @AMAP@("ACTORSSNSOURCEID")=""
|
||||
S ZX=$$SSN^CCRDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
||||
. S @AMAP@("ACTORSSN")=ZX
|
||||
. S @AMAP@("ACTORSSNTEXT")="SSN"
|
||||
. S @AMAP@("ACTORSSNSOURCEID")=AOID
|
||||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORRESTEL")=""
|
||||
S @AMAP@("ACTORRESTELTEXT")=""
|
||||
S ZX=$$RESTEL^CCRDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORRESTEL")=ZX
|
||||
. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
||||
S @AMAP@("ACTORWORKTEL")=""
|
||||
S @AMAP@("ACTORWORKTELTEXT")=""
|
||||
S ZX=$$WORKTEL^CCRDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORWORKTEL")=ZX
|
||||
. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
||||
S @AMAP@("ACTORCELLTEL")=""
|
||||
S @AMAP@("ACTORCELLTELTEXT")=""
|
||||
S ZX=$$CELLTEL^CCRDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORCELLTEL")=ZX
|
||||
. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
||||
S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
||||
S @AMAP@("ACTORIEN")=AIEN
|
||||
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
|
||||
;
|
||||
; N AMAP
|
||||
|
|
|
|||
Loading…
Reference in New Issue