iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Updated the patient demographics extraction routine (CCRDPT), fixing bugs and improving documentation. Most bugs consisted of undefined errors; thus $Get was added to everything. 

Run the unit tester by "D ^CCRDPTT".
This commit is contained in:
sam 2008-06-30 04:50:31 +00:00
parent 97d6a8097c
commit 58976179fd
2 changed files with 151 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

217
p/CCRDPT.m
View File

@ -3,72 +3,74 @@ CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
; 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 Suffi 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?
; 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
@ -164,66 +166,83 @@ DESTROY ; Kill local variable; PUBLIC
;
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)
;
@ -231,232 +250,296 @@ STATE() ; Get State for Home Address; PUBLIC; Extrinsic
; ^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
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)
;

5
p/CCRDPTT.m
View File

@ -12,10 +12,7 @@ CCRDPTT; Unit Tester...
; etc.
; Load Routine Entry points; We get a sweeeeeet array
N OUT
D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
ZWR OUT(,0)
N X,Y
; Select Patient
S DIC=2,DIC(0)="AEMQ" D ^DIC
@ -23,7 +20,7 @@ CCRDPTT; Unit Tester...
W "You have selected patient "_Y,!!
D INIT^CCRDPT($P(Y,"^"))
ZWR PT
N I S I=160 F S I=$O(OUT(I)) Q:I="" D
N I S I=165 F S I=$O(OUT(I)) Q:I="" D
. W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
. W "valued at "
. W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")