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

89
p/CCRDPT.m
View File

@ -4,13 +4,15 @@ 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 ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
; DESTROY to clean-up. ; 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 ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for
; INIT 9 lines Copy DFN global to a local variable ; INIT 9 lines Copy DFN global to a local variable
; DESTROY 6 lines Kill local variable ; DESTROY 6 lines Kill local variable
; FAMILY 6 lines Family Name ; FAMILY 6 lines Family Name
; GIVEN 6 lines Given Name ; GIVEN 6 lines Given Name
; MIDDLE 6 lines Middle Name ; MIDDLE 6 lines Middle Name
; SUFFIX 6 lines Suffi Name ; SUFFIX 6 lines Suffix Name
; DISPNAME 5 lines Display Name ; DISPNAME 5 lines Display Name
; DOB 6 lines Date of Birth ; DOB 6 lines Date of Birth
; GENDER 4 lines Get Gender ; GENDER 4 lines Get Gender
@ -164,66 +166,83 @@ DESTROY ; Kill local variable; PUBLIC
; ;
FAMILY() ; Family Name; PUBLIC; Extrinsic FAMILY() ; Family Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
N NAME S NAME=$P(PT(0),"^",1) N NAME S NAME=$P(PT(0),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("FAMILY") Q NAME("FAMILY")
; ;
GIVEN() ; Given Name; PUBLIC; Extrinsic GIVEN() ; Given Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
N NAME S NAME=$P(PT(0),"^",1) N NAME S NAME=$P(PT(0),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("GIVEN") Q NAME("GIVEN")
; ;
MIDDLE() ; Middle Name; PUBLIC; Extrinsic MIDDLE() ; Middle Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
N NAME S NAME=$P(PT(0),"^",1) N NAME S NAME=$P(PT(0),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("MIDDLE") Q NAME("MIDDLE")
; ;
SUFFIX() ; Suffi Name; PUBLIC; Extrinsic SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
N NAME S NAME=$P(PT(0),"^",1) N NAME S NAME=$P(PT(0),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("SUFFIX") Q NAME("SUFFIX")
; ;
DISPNAME() ; Display Name; PUBLIC; Extrinsic DISPNAME() ; Display Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
N NAME S NAME=$P(PT(0),"^",1) N NAME S NAME=$P(PT(0),"^",1)
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
DOB() ; Date of Birth; PUBLIC; Extrinsic DOB() ; Date of Birth; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
N DOB S DOB=$P(PT(0),"^",3) N DOB S DOB=$P(PT(0),"^",3)
; Date in FM Date Format. Convert to UTC/ISO 8601. ; Date in FM Date Format. Convert to UTC/ISO 8601.
Q $$FMDTOUTC^CCRUTIL(DOB,"D") Q $$FMDTOUTC^CCRUTIL(DOB,"D")
; ;
GENDER() ; Get Gender; PUBLIC; Extrinsic GENDER() ; Get Gender; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
Q $P(PT(0),"^",2) Q $P(PT(0),"^",2)
; ;
SSN() ; Get SSN for ID; PUBLIC; Extrinsic SSN() ; Get SSN for ID; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(0))="" ""
Q $P(PT(0),"^",9) Q $P(PT(0),"^",9)
; ;
ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
; Vista only stores a home address for the patient. ; Vista only stores a home address for the patient.
Q:$G(PT(0))="" ""
Q "Home" Q "Home"
; ;
ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.11))="" ""
Q $P(PT(.11),"^",1) Q $P(PT(.11),"^",1)
; ;
ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
; Vista has Lines 2,3; CCR has only line 1,2; so compromise ; 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) Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
; ;
CITY() ; Get City for Home Address; PUBLIC; Extrinsic CITY() ; Get City for Home Address; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.11))="" ""
Q $P(PT(.11),"^",4) Q $P(PT(.11),"^",4)
; ;
STATE() ; Get State for Home Address; PUBLIC; Extrinsic STATE() ; Get State for Home Address; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.11))="" ""
; State is stored as a pointer ; State is stored as a pointer
N STATENUM S STATENUM=$P(PT(.11),"^",5) 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 ; ^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) ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
; ==>US STATE OR POSSESSION [6S] ^ ; ==>US STATE OR POSSESSION [6S] ^
Q:STATENUM="" "" ; To prevent global undefined below if no state
Q $P(^DIC(5,STATENUM,0),"^",1) Q $P(^DIC(5,STATENUM,0),"^",1)
; ;
ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.11))="" ""
Q $P(PT(.11),"^",6) Q $P(PT(.11),"^",6)
; ;
COUNTY() ; Get County for our Address; PUBLIC; Extrinsic COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.11))="" ""
Q $P(PT(.11),"^",7) Q $P(PT(.11),"^",7)
; ;
COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
; Unfortunately, I can't find where that is stored, so the inevitable... ; Unfortunately, I can't find where that is stored, so the inevitable...
Q:$G(PT(.11))="" ""
Q "USA" Q "USA"
; ;
RESTEL() ; Residential Telephone; PUBLIC; Extrinsic RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.13))="" ""
Q $P(PT(.13),"^",1) Q $P(PT(.13),"^",1)
; ;
WORKTEL() ; Work Telephone; PUBLIC; Extrinsic WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.13))="" ""
Q $P(PT(.13),"^",2) Q $P(PT(.13),"^",2)
; ;
EMAIL() ; Email Adddress; PUBLIC; Extrinsic EMAIL() ; Email Adddress; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.13))="" ""
Q $P(PT(.13),"^",3) Q $P(PT(.13),"^",3)
; ;
CELLTEL() ; Cell Phone; PUBLIC; Extrinsic CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.13))="" ""
Q $P(PT(.13),"^",4) Q $P(PT(.13),"^",4)
; ;
NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
N NAME S NAME=$P(PT(.21),"^",1) N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("FAMILY") Q NAME("FAMILY")
; ;
NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
N NAME S NAME=$P(PT(.21),"^",1) N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("GIVEN") Q NAME("GIVEN")
; ;
NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
N NAME S NAME=$P(PT(.21),"^",1) N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("MIDDLE") Q NAME("MIDDLE")
; ;
NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
N NAME S NAME=$P(PT(.21),"^",1) N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("SUFFIX") Q NAME("SUFFIX")
; ;
NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
N NAME S NAME=$P(PT(.21),"^",1) N NAME S NAME=$P(PT(.21),"^",1)
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
Q $P(PT(.21),"^",2) Q $P(PT(.21),"^",2)
; ;
NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
Q $P(PT(.21),"^",3) Q $P(PT(.21),"^",3)
; ;
NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
; As before, CCR only allows two fileds for the address, so we have to compromise ; 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) Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
; ;
NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
Q $P(PT(.21),"^",6) Q $P(PT(.21),"^",6)
; ;
NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
N STATENUM S STATENUM=$P(PT(.21),"^",7) N STATENUM S STATENUM=$P(PT(.21),"^",7)
Q:STATENUM="" ""
Q $P(^DIC(5,STATENUM,0),"^",1) Q $P(^DIC(5,STATENUM,0),"^",1)
; ;
NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
Q $P(PT(.21),"^",8) Q $P(PT(.21),"^",8)
; ;
NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
Q $P(PT(.21),"^",9) Q $P(PT(.21),"^",9)
; ;
NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
Q $P(PT(.21),"^",11) Q $P(PT(.21),"^",11)
; ;
NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.21))="" ""
Q $P(PT(.21),"^",10) Q $P(PT(.21),"^",10)
; ;
NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
N NAME S NAME=$P(PT(.211),"^",1) N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("FAMILY") Q NAME("FAMILY")
; ;
NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
; PREREQ: PT Defined Q:$G(PT(.211))="" ""
N NAME S NAME=$P(PT(.211),"^",1) N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("GIVEN") Q NAME("GIVEN")
; ;
NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
N NAME S NAME=$P(PT(.211),"^",1) N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("MIDDLE") Q NAME("MIDDLE")
; ;
NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
N NAME S NAME=$P(PT(.211),"^",1) N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("SUFFIX") Q NAME("SUFFIX")
NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
N NAME S NAME=$P(PT(.211),"^",1) N NAME S NAME=$P(PT(.211),"^",1)
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
Q $P(PT(.211),"^",2) Q $P(PT(.211),"^",2)
; ;
NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
Q $P(PT(.211),"^",3) Q $P(PT(.211),"^",3)
; ;
NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
; As before, CCR only allows two fileds for the address, so we have to compromise ; 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) Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
; ;
NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
Q $P(PT(.211),"^",6) Q $P(PT(.211),"^",6)
; ;
NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
N STATENUM S STATENUM=$P(PT(.211),"^",7) 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 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
; ;
NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
Q $P(PT(.211),"^",8) Q $P(PT(.211),"^",8)
; ;
NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
Q $P(PT(.211),"^",9) Q $P(PT(.211),"^",9)
; ;
NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
Q $P(PT(.211),"^",11) Q $P(PT(.211),"^",11)
; ;
NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.211))="" ""
Q $P(PT(.211),"^",10) Q $P(PT(.211),"^",10)
; ;
EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
N NAME S NAME=$P(PT(.33),"^",1) N NAME S NAME=$P(PT(.33),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("FAMILY") Q NAME("FAMILY")
; ;
EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
N NAME S NAME=$P(PT(.33),"^",1) N NAME S NAME=$P(PT(.33),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("GIVEN") Q NAME("GIVEN")
; ;
EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
N NAME S NAME=$P(PT(.33),"^",1) N NAME S NAME=$P(PT(.33),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("MIDDLE") Q NAME("MIDDLE")
; ;
EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
N NAME S NAME=$P(PT(.33),"^",1) N NAME S NAME=$P(PT(.33),"^",1)
D NAMECOMP^XLFNAME(.NAME) D NAMECOMP^XLFNAME(.NAME)
Q NAME("SUFFIX") Q NAME("SUFFIX")
EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
N NAME S NAME=$P(PT(.33),"^",1) N NAME S NAME=$P(PT(.33),"^",1)
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
Q $P(PT(.33),"^",2) Q $P(PT(.33),"^",2)
; ;
EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
Q $P(PT(.33),"^",3) Q $P(PT(.33),"^",3)
; ;
EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
; As before, CCR only allows two fileds for the address, so we have to compromise ; 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) Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
; ;
EMERCITY() ; EMER City; PUBLIC; Extrinsic EMERCITY() ; EMER City; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
Q $P(PT(.33),"^",6) Q $P(PT(.33),"^",6)
; ;
EMERSTAT() ; EMER State; PUBLIC; Extrinsic EMERSTAT() ; EMER State; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
N STATENUM S STATENUM=$P(PT(.33),"^",7) 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 Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
; ;
EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
Q $P(PT(.33),"^",8) Q $P(PT(.33),"^",8)
; ;
EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
Q $P(PT(.33),"^",9) Q $P(PT(.33),"^",9)
; ;
EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
Q $P(PT(.33),"^",11) Q $P(PT(.33),"^",11)
; ;
EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
; PREREQ: PT Defined ; PREREQ: PT Defined
Q:$G(PT(.33))="" ""
Q $P(PT(.33),"^",10) Q $P(PT(.33),"^",10)
; ;

5
p/CCRDPTT.m
View File

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