diff --git a/p/CCRDPT.m b/p/CCRDPT.m
index d253b36..f57536b 100644
--- a/p/CCRDPT.m
+++ b/p/CCRDPT.m
@@ -1,545 +1,545 @@
CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
- ;;0.1;CCRCCD;;Jun 15, 2008;
-
- ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
- ; DESTROY to clean-up.
-
- ; The first line of every routine tests if the global exists.
-
- ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for
- ; INIT 9 lines Copy DFN global to a local variable
- ; DESTROY 6 lines Kill local variable
- ; FAMILY 6 lines Family Name
- ; GIVEN 6 lines Given Name
- ; MIDDLE 6 lines Middle Name
- ; SUFFIX 6 lines Suffix Name
- ; DISPNAME 5 lines Display Name
- ; DOB 6 lines Date of Birth
- ; GENDER 4 lines Get Gender
- ; SSN 4 lines Get SSN for ID
- ; ADDRTYPE 4 lines Get Home Address
- ; ADDR1 4 lines Get Home Address line 1
- ; ADDR2 5 lines Get Home Address line 2
- ; CITY 4 lines Get City for Home Address
- ; STATE 11 lines Get State for Home Address
- ; ZIP 4 lines Get Zip code for Home Address
- ; COUNTY 4 lines Get County for our Address
- ; COUNTRY 4 lines Get Country for our Address
- ; RESTEL 4 lines Residential Telephone
- ; WORKTEL 4 lines Work Telephone
- ; EMAIL 4 lines Email Adddress
- ; CELLTEL 4 lines Cell Phone
- ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name
- ; NOK1GIV 6 lines NOK1 Given Name
- ; NOK1MID 6 lines NOK1 Middle Name
- ; NOK1SUF 6 lines NOK1 Suffi Name
- ; NOK1DISP 5 lines NOK1 Display Name
- ; NOK1REL 4 lines NOK1 Relationship to the patient
- ; NOK1ADD1 4 lines NOK1 Address 1
- ; NOK1ADD2 5 lines NOK1 Address 2
- ; NOK1CITY 4 lines NOK1 City
- ; NOK1STAT 5 lines NOK1 State
- ; NOK1ZIP 4 lines NOK1 Zip Code
- ; NOK1HTEL; 4 lines NOK1 Home Telephone
- ; NOK1WTEL; 4 lines NOK1 Work Telephone
- ; NOK1SAME; 4 lines Is NOK1's Address the same the patient?
- ; NOK2FAM 6 lines NOK2 Family Name
- ; NOK2GIV 6 lines NOK2 Given Name
- ; NOK2MID 6 lines NOK2 Middle Name
- ; NOK2SUF 5 lines NOK2 Suffi Name
- ; NOK2DISP 5 lines NOK2 Display Name
- ; NOK2REL 4 lines NOK2 Relationship to the patient
- ; NOK2ADD1 4 lines NOK2 Address 1
- ; NOK2ADD2 5 lines NOK2 Address 2
- ; NOK2CITY 4 lines NOK2 City
- ; NOK2STAT 5 lines NOK2 State
- ; NOK2ZIP 4 lines NOK2 Zip Code
- ; NOK2HTEL; 4 lines NOK2 Home Telephone
- ; NOK2WTEL; 4 lines NOK2 Work Telephone
- ; NOK2SAME; 4 lines Is NOK2's Address the same the patient?
- ; EMERFAM 6 lines Emergency Contact (EMER) Family Name
- ; EMERGIV 6 lines EMER Given Name
- ; EMERMID 6 lines EMER Middle Name
- ; EMERSUF 5 lines EMER Suffi Name
- ; EMERDISP 5 lines EMER Display Name
- ; EMERREL 4 lines EMER Relationship to the patient
- ; EMERADD1 4 lines EMER Address 1
- ; EMERADD2 5 lines EMER Address 2
- ; EMERCITY 4 lines EMER City
- ; EMERSTAT 5 lines EMER State
- ; EMERZIP 4 lines EMER Zip Code
- ; EMERHTEL; 4 lines EMER Home Telephone
- ; EMERWTEL; 4 lines EMER Work Telephone
- ; EMERSAME; 4 lines Is EMER's Address the same the NOK?
-
- W "No Entry at top!" Q
-
- ; The following is a map of the relevant data in the patient global.
- ;
- ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
- ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
- ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
- ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
- ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
- ; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
- ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
- ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
- ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
- ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
- ; ==>[21S] ^
- ; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS
- ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
- ; ==>COMPONENTS [3P:20] ^
- ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
- ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
- ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
- ; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^
- ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
- ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
- ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
- ; ==>^
- ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
- ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
- ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
- ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
- ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
- ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
- ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
- ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
- ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
- ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
- ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
- ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
- ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
- ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
- ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
- ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
- ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
- ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
- ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
- ; ==>SITE [14P:4] ^
- ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
- ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
- ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
- ; ==>3] [5F] ^
- ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
- ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
- ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
- ; ==>^
- ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
- ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
- ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
- ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
- ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
- ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
- ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
- ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
- ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
- ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
- ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
- ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
- ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514)
- ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
- ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
- ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
- ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
- ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
- ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
- ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
- ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
- ; ==>[11F] ^
-
+ ;;0.1;CCRCCD;;Jun 15, 2008;
+
+ ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
+ ; DESTROY to clean-up.
+
+ ; The first line of every routine tests if the global exists.
+
+ ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for
+ ; INIT 9 lines Copy DFN global to a local variable
+ ; DESTROY 6 lines Kill local variable
+ ; FAMILY 6 lines Family Name
+ ; GIVEN 6 lines Given Name
+ ; MIDDLE 6 lines Middle Name
+ ; SUFFIX 6 lines Suffix Name
+ ; DISPNAME 5 lines Display Name
+ ; DOB 6 lines Date of Birth
+ ; GENDER 4 lines Get Gender
+ ; SSN 4 lines Get SSN for ID
+ ; ADDRTYPE 4 lines Get Home Address
+ ; ADDR1 4 lines Get Home Address line 1
+ ; ADDR2 5 lines Get Home Address line 2
+ ; CITY 4 lines Get City for Home Address
+ ; STATE 11 lines Get State for Home Address
+ ; ZIP 4 lines Get Zip code for Home Address
+ ; COUNTY 4 lines Get County for our Address
+ ; COUNTRY 4 lines Get Country for our Address
+ ; RESTEL 4 lines Residential Telephone
+ ; WORKTEL 4 lines Work Telephone
+ ; EMAIL 4 lines Email Adddress
+ ; CELLTEL 4 lines Cell Phone
+ ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name
+ ; NOK1GIV 6 lines NOK1 Given Name
+ ; NOK1MID 6 lines NOK1 Middle Name
+ ; NOK1SUF 6 lines NOK1 Suffi Name
+ ; NOK1DISP 5 lines NOK1 Display Name
+ ; NOK1REL 4 lines NOK1 Relationship to the patient
+ ; NOK1ADD1 4 lines NOK1 Address 1
+ ; NOK1ADD2 5 lines NOK1 Address 2
+ ; NOK1CITY 4 lines NOK1 City
+ ; NOK1STAT 5 lines NOK1 State
+ ; NOK1ZIP 4 lines NOK1 Zip Code
+ ; NOK1HTEL; 4 lines NOK1 Home Telephone
+ ; NOK1WTEL; 4 lines NOK1 Work Telephone
+ ; NOK1SAME; 4 lines Is NOK1's Address the same the patient?
+ ; NOK2FAM 6 lines NOK2 Family Name
+ ; NOK2GIV 6 lines NOK2 Given Name
+ ; NOK2MID 6 lines NOK2 Middle Name
+ ; NOK2SUF 5 lines NOK2 Suffi Name
+ ; NOK2DISP 5 lines NOK2 Display Name
+ ; NOK2REL 4 lines NOK2 Relationship to the patient
+ ; NOK2ADD1 4 lines NOK2 Address 1
+ ; NOK2ADD2 5 lines NOK2 Address 2
+ ; NOK2CITY 4 lines NOK2 City
+ ; NOK2STAT 5 lines NOK2 State
+ ; NOK2ZIP 4 lines NOK2 Zip Code
+ ; NOK2HTEL; 4 lines NOK2 Home Telephone
+ ; NOK2WTEL; 4 lines NOK2 Work Telephone
+ ; NOK2SAME; 4 lines Is NOK2's Address the same the patient?
+ ; EMERFAM 6 lines Emergency Contact (EMER) Family Name
+ ; EMERGIV 6 lines EMER Given Name
+ ; EMERMID 6 lines EMER Middle Name
+ ; EMERSUF 5 lines EMER Suffi Name
+ ; EMERDISP 5 lines EMER Display Name
+ ; EMERREL 4 lines EMER Relationship to the patient
+ ; EMERADD1 4 lines EMER Address 1
+ ; EMERADD2 5 lines EMER Address 2
+ ; EMERCITY 4 lines EMER City
+ ; EMERSTAT 5 lines EMER State
+ ; EMERZIP 4 lines EMER Zip Code
+ ; EMERHTEL; 4 lines EMER Home Telephone
+ ; EMERWTEL; 4 lines EMER Work Telephone
+ ; EMERSAME; 4 lines Is EMER's Address the same the NOK?
+
+ W "No Entry at top!" Q
+
+ ; The following is a map of the relevant data in the patient global.
+ ;
+ ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
+ ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
+ ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
+ ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
+ ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
+ ; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
+ ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
+ ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
+ ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
+ ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
+ ; ==>[21S] ^
+ ; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS
+ ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
+ ; ==>COMPONENTS [3P:20] ^
+ ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
+ ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
+ ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
+ ; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^
+ ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
+ ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
+ ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
+ ; ==>^
+ ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
+ ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
+ ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
+ ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
+ ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
+ ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
+ ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
+ ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
+ ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
+ ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
+ ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
+ ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
+ ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
+ ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
+ ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
+ ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
+ ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
+ ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
+ ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
+ ; ==>SITE [14P:4] ^
+ ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
+ ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
+ ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
+ ; ==>3] [5F] ^
+ ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
+ ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
+ ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
+ ; ==>^
+ ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
+ ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
+ ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
+ ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
+ ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
+ ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
+ ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
+ ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
+ ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
+ ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
+ ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
+ ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
+ ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514)
+ ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
+ ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
+ ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
+ ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
+ ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
+ ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
+ ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
+ ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
+ ; ==>[11F] ^
+
INIT(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.
- M PT=^DPT(DFN)
- Q
- ;
+ ; INPUT: Patient IEN (DFN)
+ ; OUTPUT: PT in the Symbol Table, representing the patient global
+
+ ; Instead of accessing a global each single read (SLOOOOW)
+ ; read it off a local variable stored in Memory.
+ M PT=^DPT(DFN)
+ Q
+ ;
DESTROY ; Kill local variable; PUBLIC
- ; INPUT: None
- ; OUTPUT: Kill PT from the Symbol Table after you are done
- K PT
- Q
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; PREREQ: PT Defined
+ Q:$G(PT(0))="" ""
+ N NAME S NAME=$P(PT(0),"^",1)
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+ ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+OB() ; Date of Birth; PUBLIC; Extrinsic
+ ; PREREQ: PT Defined
+ Q:$G(PT(0))="" ""
+ N DOB S DOB=$P(PT(0),"^",3)
+ ; Date in FM Date Format. Convert to UTC/ISO 8601.
+ Q $$FMDTOUTC^CCRUTIL(DOB,"D")
+ ;
GENDER() ; Get Gender; PUBLIC; Extrinsic
- ; PREREQ: PT Defined
- Q:$G(PT(0))="" ""
- Q $P(PT(0),"^",2)
- ;
+ ; 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)
- ;
+ ; 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"
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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"
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ 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")
- ;
+ ; 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")
+ ; 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
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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")
- ;
+ ; 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")
+ ; 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
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; 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)
- ;
+ ; PREREQ: PT Defined
+ Q:$G(PT(.33))="" ""
+ Q $P(PT(.33),"^",10)
+ ;
diff --git a/p/CCRDPTT.m b/p/CCRDPTT.m
index cbea70c..c48d53a 100644
--- a/p/CCRDPTT.m
+++ b/p/CCRDPTT.m
@@ -1,28 +1,28 @@
-CCRDPTT; Unit Tester...
-
- ; Get the functions in the routine using Rick's routine
- ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
- ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
- ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
- ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
- ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
- ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
- ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
- ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
- ; etc.
-
- ; Load Routine Entry points; We get a sweeeeeet array
- D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
- N X,Y
- ; Select Patient
- S DIC=2,DIC(0)="AEMQ" D ^DIC
+CCRDPTT ; Unit Tester...
+
+ ; Get the functions in the routine using Rick's routine
+ ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
+ ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
+ ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
+ ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
+ ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
+ ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
+ ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
+ ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
+ ; etc.
+
+ ; Load Routine Entry points; We get a sweeeeeet array
+ D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
+ N X,Y
+ ; Select Patient
+ 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
- . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
- . W "valued at "
- . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
- . W !
- Q
+ 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
+ . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
+ . W "valued at "
+ . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
+ . W !
+ Q
diff --git a/p/CCRUTIL.m b/p/CCRUTIL.m
index c41d912..79c4041 100644
--- a/p/CCRUTIL.m
+++ b/p/CCRUTIL.m
@@ -1,27 +1,27 @@
-CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
- ;;0.1;CCRCCD;;Jun 15, 2008;
-
- W "No Entry at Top!" Q
-
-FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
- ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
- ; If not passed, or passed incorrectly, it's assumed that it is D.
- ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
- ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
- ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
- N UTC,Y,M,D,H,MM,S,OFF
- S Y=1700+$E(DATE,1,3)
- S M=$E(DATE,4,5)
- S D=$E(DATE,6,7)
- S H=$E(DATE,9,10)
- S MM=$E(DATE,11,12)
- S S=$E(DATE,13,14)
- S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
- ; If H, MM and S are empty, it means that the FM date didn't supply the time.
- ; In this case, set H, MM and S to "00"
- S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00"
- I S="" S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_OFF
- E S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_":"_S_OFF
- I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
- E Q $P(UTC,"T")
- ;
+CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
+ ;;0.1;CCRCCD;;Jun 15, 2008;
+
+ W "No Entry at Top!" Q
+
+FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
+ ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+ ; If not passed, or passed incorrectly, it's assumed that it is D.
+ ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+ ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+ ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+ N UTC,Y,M,D,H,MM,S,OFF
+ S Y=1700+$E(DATE,1,3)
+ S M=$E(DATE,4,5)
+ S D=$E(DATE,6,7)
+ S H=$E(DATE,9,10)
+ S MM=$E(DATE,11,12)
+ S S=$E(DATE,13,14)
+ S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+ ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+ ; In this case, set H, MM and S to "00"
+ S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00"
+ I S="" S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_OFF
+ E S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_":"_S_OFF
+ I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+ E Q $P(UTC,"T")
+ ;
diff --git a/p/GPLACTORS.m b/p/GPLACTORS.m
index 8689e6b..797132e 100644
--- a/p/GPLACTORS.m
+++ b/p/GPLACTORS.m
@@ -1,10 +1,10 @@
GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
- ;
- ; PROCESS THE ACTORS SECTION OF THE CCR
- ;
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;
+ ; PROCESS THE ACTORS SECTION OF THE CCR
+ ;
EXTRACT(IPXML,ALST,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
- ;
+ ;
N I,J,ATMP,FIRST,AMAP,AOID,ATYP,AIEN
S FIRST=1 ; NEED TO KNOW WHICH IS THE FIRST ACTOR
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
diff --git a/p/GPLCCD0.m b/p/GPLCCD0.m
index 736352e..5c3d69c 100644
--- a/p/GPLCCD0.m
+++ b/p/GPLCCD0.m
@@ -1,223 +1,223 @@
GPLCCD0 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
- W "This is a CCD TEMPLATE with processing routines",!
- W !
- Q
- ;
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ W "This is a CCD TEMPLATE with processing routines",!
+ W !
+ Q
+ ;
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
- ; ZARY IS PASSED BY NAME
- ; BAT is a string identifying the section
- ; LINE is a test which will evaluate to true or false
- ; I '$G(@ZARY) D
- . S @ZARY@(0)=0 ; initially there are no elements
- . W "GOT HERE LOADING "_LINE,!
- N CNT ; count of array elements
- S CNT=@ZARY@(0) ; contains array count
- S CNT=CNT+1 ; increment count
- S @ZARY@(CNT)=LINE ; put the line in the array
- ; S @ZARY@(BAT,CNT)="" ; index the test by battery
- S @ZARY@(0)=CNT ; update the array counter
- Q
- ;
-ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
- ; ZARY IS PASSED BY NAME
- ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
- ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
- K @ZARY S @ZARY=""
- S @ZARY@(0)=0 ; initialize array count
- N LINE,LABEL,BODY
- N INTEST S INTEST=0 ; switch for in the TEMPLATE section
- N SECTION S SECTION="[anonymous]" ; NO section LABEL
- ;
- N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
- . I LINE?." "1";".E S INTEST=1 ; entering section
- . I LINE?." "1";".E S INTEST=0 ; leaving section
- . I INTEST D ; within the section
- . . I LINE?." "1";><".E D ; sub-section name found
- . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
- . . I LINE?." "1";;".E D ; line found
- . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
- Q
- ;
+ ; ZARY IS PASSED BY NAME
+ ; BAT is a string identifying the section
+ ; LINE is a test which will evaluate to true or false
+ ; I '$G(@ZARY) D
+ . S @ZARY@(0)=0 ; initially there are no elements
+ . W "GOT HERE LOADING "_LINE,!
+ N CNT ; count of array elements
+ S CNT=@ZARY@(0) ; contains array count
+ S CNT=CNT+1 ; increment count
+ S @ZARY@(CNT)=LINE ; put the line in the array
+ ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+ S @ZARY@(0)=CNT ; update the array counter
+ Q
+ ;
+ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+ ; ZARY IS PASSED BY NAME
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+ K @ZARY S @ZARY=""
+ S @ZARY@(0)=0 ; initialize array count
+ N LINE,LABEL,BODY
+ N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+ N SECTION S SECTION="[anonymous]" ; NO section LABEL
+ ;
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
+ . I LINE?." "1";".E S INTEST=1 ; entering section
+ . I LINE?." "1";".E S INTEST=0 ; leaving section
+ . I INTEST D ; within the section
+ . . I LINE?." "1";><".E D ; sub-section name found
+ . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+ . . I LINE?." "1";;".E D ; line found
+ . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+ Q
+ ;
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
- D ZLOAD(ARY,"GPLCCD0")
- ; ZWR @ARY
- Q
- ;
+ D ZLOAD(ARY,"GPLCCD0")
+ ; ZWR @ARY
+ Q
+ ;
;
;;
;;
;;
-;;
-;;
-;;
-;;
-;; < value="DOCTITLE"/>@@DOCTITLE@@Good Health Clinic Continuity of Care Document
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@PATIENTGIVENNAME@@
-;; @@PATIENTFAMILYNAME@@
-;; @@PATIENTNAMESUFFIX@@
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@SITENAME@@Good Health Clinic
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; Dr.@@AUTHORGIVENNAME@@Robert@@AUTHORFAMILYNAME@@Dolin
-;;
-;;
-;;
-;; @@AUTHORSITE@@Good Health Clinic
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@INFORMANTORG@@Good Health Clinic
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@CUSTODIANORG@@Good Health Clinic
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@LEGALORG@@Good Health Clinic
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@GUARSTREET@@17 Daws Rd.
-;; @@GUARCITY@@Blue Bell
-;; @@GUARSTATE@@MA
-;; @@GUARZIP@@02368
-;;
-;;
-;;
-;;
-;; @@GUARGIVENNAME@@Kenneth
-;; @@GUARFAMILYNAME@@Ross
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@NOKGIVENNAME@@Henrietta
-;; @@NOKFAMILYNAME@@Levin
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; @@PCPNAMEPREFIX@@Dr.@@PCPNAMEGIVEN@@Robert@@PCPNAMEFAMILY@@Dolin
-;;
-;;
-;;
-;; @@PCPORG@@Good Health Clinic
-;;
-;;
-;;
-;;
-;;
-;;
-;;
+;;
+;;
+;;
+;;
+;;< value="DOCTITLE"/>@@DOCTITLE@@Good Health Clinic Continuity of Care Document
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@PATIENTGIVENNAME@@
+;;@@PATIENTFAMILYNAME@@
+;;@@PATIENTNAMESUFFIX@@
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@SITENAME@@Good Health Clinic
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;Dr.@@AUTHORGIVENNAME@@Robert@@AUTHORFAMILYNAME@@Dolin
+;;
+;;
+;;
+;;@@AUTHORSITE@@Good Health Clinic
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@INFORMANTORG@@Good Health Clinic
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@CUSTODIANORG@@Good Health Clinic
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@LEGALORG@@Good Health Clinic
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@GUARSTREET@@17 Daws Rd.
+;;@@GUARCITY@@Blue Bell
+;;@@GUARSTATE@@MA
+;;@@GUARZIP@@02368
+;;
+;;
+;;
+;;
+;;@@GUARGIVENNAME@@Kenneth
+;;@@GUARFAMILYNAME@@Ross
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@NOKGIVENNAME@@Henrietta
+;;@@NOKFAMILYNAME@@Levin
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@PCPNAMEPREFIX@@Dr.@@PCPNAMEGIVEN@@Robert@@PCPNAMEFAMILY@@Dolin
+;;
+;;
+;;
+;;@@PCPORG@@Good Health Clinic
+;;
+;;
+;;
+;;
+;;
+;;
+;;
;;
;;
-;;
-;;
-;; Summary Purpose
-;; Transfer of care
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
+;;
+;;
+;;Summary Purpose
+;;Transfer of care
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
;;
;;
;;
;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;;
-;; < value="OBSERVATIONRANGE"/>
-;;
-;; @@OBSRANGETEXT@@M 13-18 g/dl; F 12-16 g/dl
-;;
-;;
-;;
-;;
-;;
-;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;
+;;@@OBSRANGETEXT@@M 13-18 g/dl; F 12-16 g/dl
+;;
+;;
+;;
+;;
+;;
+;;
;;
;;
;;
diff --git a/p/GPLCCR0.m b/p/GPLCCR0.m
index dd5804e..4dfe6cf 100644
--- a/p/GPLCCR0.m
+++ b/p/GPLCCR0.m
@@ -1,49 +1,49 @@
-GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
- W "This is a CCR TEMPLATE with processing routines",!
- W !
- Q
- ;
+GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ W "This is a CCR TEMPLATE with processing routines",!
+ W !
+ Q
+ ;
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
- ; ZARY IS PASSED BY NAME
- ; BAT is a string identifying the section
- ; LINE is a test which will evaluate to true or false
- ; I '$G(@ZARY) D
- . S @ZARY@(0)=0 ; initially there are no elements
- . W "GOT HERE LOADING "_LINE,!
- N CNT ; count of array elements
- S CNT=@ZARY@(0) ; contains array count
- S CNT=CNT+1 ; increment count
- S @ZARY@(CNT)=LINE ; put the line in the array
- ; S @ZARY@(BAT,CNT)="" ; index the test by battery
- S @ZARY@(0)=CNT ; update the array counter
- Q
- ;
+ ; ZARY IS PASSED BY NAME
+ ; BAT is a string identifying the section
+ ; LINE is a test which will evaluate to true or false
+ ; I '$G(@ZARY) D
+ . S @ZARY@(0)=0 ; initially there are no elements
+ . W "GOT HERE LOADING "_LINE,!
+ N CNT ; count of array elements
+ S CNT=@ZARY@(0) ; contains array count
+ S CNT=CNT+1 ; increment count
+ S @ZARY@(CNT)=LINE ; put the line in the array
+ ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+ S @ZARY@(0)=CNT ; update the array counter
+ Q
+ ;
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
- ; ZARY IS PASSED BY NAME
- ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
- ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
- K @ZARY S @ZARY=""
- S @ZARY@(0)=0 ; initialize array count
- N LINE,LABEL,BODY
- N INTEST S INTEST=0 ; switch for in the TEMPLATE section
- N SECTION S SECTION="[anonymous]" ; NO section LABEL
- ;
- N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
- . I LINE?." "1";".E S INTEST=1 ; entering section
- . I LINE?." "1";".E S INTEST=0 ; leaving section
- . I INTEST D ; within the section
- . . I LINE?." "1";><".E D ; sub-section name found
- . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
- . . I LINE?." "1";;".E D ; line found
- . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
- Q
- ;
+ ; ZARY IS PASSED BY NAME
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+ K @ZARY S @ZARY=""
+ S @ZARY@(0)=0 ; initialize array count
+ N LINE,LABEL,BODY
+ N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+ N SECTION S SECTION="[anonymous]" ; NO section LABEL
+ ;
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
+ . I LINE?." "1";".E S INTEST=1 ; entering section
+ . I LINE?." "1";".E S INTEST=0 ; leaving section
+ . I INTEST D ; within the section
+ . . I LINE?." "1";><".E D ; sub-section name found
+ . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+ . . I LINE?." "1";;".E D ; line found
+ . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+ Q
+ ;
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
- D ZLOAD(ARY,"GPLCCR0")
- ; ZWR @ARY
- Q
- ;
+ D ZLOAD(ARY,"GPLCCR0")
+ ; ZWR @ARY
+ Q
+ ;
;
;;
;;
diff --git a/p/GPLPROBS.m b/p/GPLPROBS.m
index 1637b7e..e01a24b 100644
--- a/p/GPLPROBS.m
+++ b/p/GPLPROBS.m
@@ -1,63 +1,64 @@
GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
- ;
- ; PROCESS THE PROBLEMS SECTION OF THE CCR
- ;
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;
+ ; PROCESS THE PROBLEMS SECTION OF THE CCR
+ ;
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
- ;
- ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
- ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
- ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
- ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
- ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
- ;
- N RPCRSLT,J,K,PTMP,X,VMAP,TBUF
- D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
- I '$D(RPCRSLT(0)) W "ERROR CALLING LIST^ORQQPL3 ",! Q
- ZWR RPCRSLT
- S TVMAP=$NA(^TMP($J,"PROBVALS"))
- S TARYTMP=$NA(^TMP($J,"PROBARYTMP"))
- F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
- . S VMAP=$NA(@TVMAP@(J))
- . K @VMAP
- . I DEBUG W "VMAP= ",VMAP,!
- . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
- . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
- . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
- . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
- . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
- . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
- . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
- . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
- . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
- . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
- . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
- . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
- . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
- . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
- . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
- . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
- . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
- . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
- . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
- . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
- . S ARYTMP=$NA(@TARYTMP@(J))
- . ; W "ARYTMP= ",ARYTMP,!
- . K @ARYTMP
- . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
- . I J=1 D ; FIRST ONE IS JUST A COPY
- . . ; W "FIRST ONE",!
- . . D CP^GPLXPATH(ARYTMP,OUTXML)
- . . ; W "OUTXML ",OUTXML,!
- . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
- . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
- ; ZWR ^TMP($J,"PROBVALS",*)
- ; ZWR ^TMP($J,"PROBARYTMP",*) ; SHOW THE RESULTS
- ; ZWR @OUTXML
- ; $$HTML^DILF(
- N PROBSTMP,I
- D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
- I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - STRINGS MARKED AS @@X@@
- . W "PROBLEMS Missing list: ",!
- . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
- Q
+ ;
+ ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+ ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+ ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+ ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+ ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+ ;
+ N RPCRSLT,J,K,PTMP,X,VMAP,TBUF
+ D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+ I '$D(RPCRSLT(0)) W "ERROR CALLING LIST^ORQQPL3 ",! Q
+ ZWR RPCRSLT
+ S TVMAP=$NA(^TMP($J,"PROBVALS"))
+ S TARYTMP=$NA(^TMP($J,"PROBARYTMP"))
+ F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
+ . S VMAP=$NA(@TVMAP@(J))
+ . K @VMAP
+ . I DEBUG W "VMAP= ",VMAP,!
+ . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+ . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
+ . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
+ . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
+ . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+ . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+ . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
+ . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
+ . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
+ . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
+ . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
+ . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
+ . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
+ . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
+ . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+ . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
+ . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
+ . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
+ . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
+ . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
+ . S ARYTMP=$NA(@TARYTMP@(J))
+ . ; W "ARYTMP= ",ARYTMP,!
+ . K @ARYTMP
+ . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
+ . I J=1 D ; FIRST ONE IS JUST A COPY
+ . . ; W "FIRST ONE",!
+ . . D CP^GPLXPATH(ARYTMP,OUTXML)
+ . . ; W "OUTXML ",OUTXML,!
+ . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
+ . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
+ ; ZWR ^TMP($J,"PROBVALS",*)
+ ; ZWR ^TMP($J,"PROBARYTMP",*) ; SHOW THE RESULTS
+ ; ZWR @OUTXML
+ ; $$HTML^DILF(
+ N PROBSTMP,I
+ D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
+ I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - STRINGS MARKED AS @@X@@
+ . W "PROBLEMS Missing list: ",!
+ . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
+ Q
+ ;
diff --git a/p/GPLUNIT.m b/p/GPLUNIT.m
index f5ce75f..1037908 100644
--- a/p/GPLUNIT.m
+++ b/p/GPLUNIT.m
@@ -1,140 +1,140 @@
GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
- W "This is a unit testing library",!
- W !
- Q
- ;
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ W "This is a unit testing library",!
+ W !
+ Q
+ ;
ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
- ; ZARY IS PASSED BY REFERENCE
- ; BAT is a string identifying the test battery
- ; TST is a test which will evaluate to true or false
- ; I '$G(ZARY) D
- ; . S ZARY(0)=0 ; initially there are no elements
- ; W "GOT HERE LOADING "_TST,!
- N CNT ; count of array elements
- S CNT=ZARY(0) ; contains array count
- S CNT=CNT+1 ; increment count
- S ZARY(CNT)=TST ; put the test in the array
- I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
- . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
- . S II=$P(ZARY(BAT),"^",2)
- . S $P(ZARY(BAT),"^",2)=II+1
- I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
- . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
- . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
- . ; S TN=$NA(ZARY("TESTS"))
- . ; D PUSH^GPLXPATH(TN,BAT)
- S ZARY(0)=CNT ; update the array counter
- Q
- ;
+ ; ZARY IS PASSED BY REFERENCE
+ ; BAT is a string identifying the test battery
+ ; TST is a test which will evaluate to true or false
+ ; I '$G(ZARY) D
+ ; . S ZARY(0)=0 ; initially there are no elements
+ ; W "GOT HERE LOADING "_TST,!
+ N CNT ; count of array elements
+ S CNT=ZARY(0) ; contains array count
+ S CNT=CNT+1 ; increment count
+ S ZARY(CNT)=TST ; put the test in the array
+ I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
+ . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+ . S II=$P(ZARY(BAT),"^",2)
+ . S $P(ZARY(BAT),"^",2)=II+1
+ I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
+ . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+ . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+ . ; S TN=$NA(ZARY("TESTS"))
+ . ; D PUSH^GPLXPATH(TN,BAT)
+ S ZARY(0)=CNT ; update the array counter
+ Q
+ ;
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
- ; ZARY IS PASSED BY NAME
- ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
- ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
- K @ZARY
- S @ZARY@(0)=0 ; initialize array count
- N LINE,LABEL,BODY
- N INTEST S INTEST=0 ; switch for in the test case section
- N SECTION S SECTION="[anonymous]" ; test case section
- ;
- N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
- . I LINE?." "1";;>".E S INTEST=1 ; entering test section
- . I LINE?." "1";;>".E S INTEST=1 ; entering TEMPLATE section
- . I LINE?." "1";;>".E S INTEST=0 ; leaving test section
- . I LINE?." "1";;>".E S INTEST=0 ; leaving TEMPLATE section
- . I INTEST D ; within the testing section
- . . I LINE?." "1";;><".E D ; section name found
- . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
- . . I LINE?." "1";;>>".E D ; test case found
- . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
- S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
- Q
- ;
+ ; ZARY IS PASSED BY NAME
+ ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+ ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+ K @ZARY
+ S @ZARY@(0)=0 ; initialize array count
+ N LINE,LABEL,BODY
+ N INTEST S INTEST=0 ; switch for in the test case section
+ N SECTION S SECTION="[anonymous]" ; test case section
+ ;
+ N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
+ . I LINE?." "1";;>".E S INTEST=1 ; entering test section
+ . I LINE?." "1";;>".E S INTEST=1 ; entering TEMPLATE section
+ . I LINE?." "1";;>".E S INTEST=0 ; leaving test section
+ . I LINE?." "1";;>".E S INTEST=0 ; leaving TEMPLATE section
+ . I INTEST D ; within the testing section
+ . . I LINE?." "1";;><".E D ; section name found
+ . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+ . . I LINE?." "1";;>>".E D ; test case found
+ . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+ S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+ Q
+ ;
ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST
- N I,ZX,ZR,ZP
- S DEBUG=0
- ; I WHICH="ALL" D Q ; RUN ALL THE TESTS
- ; . W "DOING ALL",!
- ; . N J,NT
- ; . S NT=$NA(ZARY("TESTS"))
- ; . W NT,@NT@(0),!
- ; . F J=1:1:@NT@(0) D ;
- ; . . W @NT@(J),!
- ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
- I '$D(ZARY(WHICH)) D ; TEST SECTION DOESN'T EXIST
- . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
- . Q ; EXIT
- N FIRST,LAST
- S FIRST=$P(ZARY(WHICH),"^",1)
- S LAST=$P(ZARY(WHICH),"^",2)
- F I=FIRST:1:LAST D
- . I ZARY(I)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
- . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
- . . ; W ZP,!
- . . S ZX=ZP
- . . W "RUNNING: "_ZP
- . . X ZX
- . . W "..SUCCESS: ",WHICH,!
- . I ZARY(I)?1"?"1.E D ; THIS IS A TEST
- . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
- . . S ZX="S ZR="_ZP
- . . W "TRYING: "_ZP
- . . X ZX
- . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
- . . I '$D(TPASSED) D ; NOT INITIALIZED YET
- . . . S TPASSED=0 S TFAILED=0
- . . I ZR S TPASSED=TPASSED+1
- . . I 'ZR S TFAILED=TFAILED+1
- Q
- ;
+ N I,ZX,ZR,ZP
+ S DEBUG=0
+ ; I WHICH="ALL" D Q ; RUN ALL THE TESTS
+ ; . W "DOING ALL",!
+ ; . N J,NT
+ ; . S NT=$NA(ZARY("TESTS"))
+ ; . W NT,@NT@(0),!
+ ; . F J=1:1:@NT@(0) D ;
+ ; . . W @NT@(J),!
+ ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
+ I '$D(ZARY(WHICH)) D ; TEST SECTION DOESN'T EXIST
+ . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+ . Q ; EXIT
+ N FIRST,LAST
+ S FIRST=$P(ZARY(WHICH),"^",1)
+ S LAST=$P(ZARY(WHICH),"^",2)
+ F I=FIRST:1:LAST D
+ . I ZARY(I)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
+ . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
+ . . ; W ZP,!
+ . . S ZX=ZP
+ . . W "RUNNING: "_ZP
+ . . X ZX
+ . . W "..SUCCESS: ",WHICH,!
+ . I ZARY(I)?1"?"1.E D ; THIS IS A TEST
+ . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
+ . . S ZX="S ZR="_ZP
+ . . W "TRYING: "_ZP
+ . . X ZX
+ . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+ . . I '$D(TPASSED) D ; NOT INITIALIZED YET
+ . . . S TPASSED=0 S TFAILED=0
+ . . I ZR S TPASSED=TPASSED+1
+ . . I 'ZR S TFAILED=TFAILED+1
+ Q
+ ;
TEST ; RUN ALL THE TEST CASES
- N ZTMP
- D ZLOAD(.ZTMP)
- D ZTEST(.ZTMP,"ALL")
- W "PASSED: ",TPASSED,!
- W "FAILED: ",TFAILED,!
- W !
- W "THE TESTS!",!
- ZWR ZTMP
- Q
- ;
+ N ZTMP
+ D ZLOAD(.ZTMP)
+ D ZTEST(.ZTMP,"ALL")
+ W "PASSED: ",TPASSED,!
+ W "FAILED: ",TFAILED,!
+ W !
+ W "THE TESTS!",!
+ ZWR ZTMP
+ Q
+ ;
GTSTS(GTZARY,RTN) ; return an array of test names
- N I,J S I="" S I=$O(GTZARY("TESTS",I))
- F J=0:0 Q:I="" D
- . D PUSH^GPLXPATH(RTN,I)
- . S I=$O(GTZARY("TESTS",I))
- Q
- ;
+ N I,J S I="" S I=$O(GTZARY("TESTS",I))
+ F J=0:0 Q:I="" D
+ . D PUSH^GPLXPATH(RTN,I)
+ . S I=$O(GTZARY("TESTS",I))
+ Q
+ ;
TESTALL(RNM) ; RUN ALL THE TESTS
- N I,J,TZTMP,TSTS,TOTP,TOTF
- S TOTP=0 S TOTF=0
- D ZLOAD^GPLUNIT("TZTMP",RNM)
- D GTSTS(.TZTMP,"TSTS")
- F I=1:1:TSTS(0) D ;
- . S TPASSED=0 S TFAILED=0
- . D ZTEST^GPLUNIT(.TZTMP,TSTS(I))
- . S TOTP=TOTP+TPASSED
- . S TOTF=TOTF+TFAILED
- . S $P(TSTS(I),"^",2)=TPASSED
- . S $P(TSTS(I),"^",3)=TFAILED
- F I=1:1:TSTS(0) D ;
- . W "TEST=> ",$P(TSTS(I),"^",1)
- . W " PASSED=>",$P(TSTS(I),"^",2)
- . W " FAILED=>",$P(TSTS(I),"^",3),!
- W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
- Q
- ;
+ N I,J,TZTMP,TSTS,TOTP,TOTF
+ S TOTP=0 S TOTF=0
+ D ZLOAD^GPLUNIT("TZTMP",RNM)
+ D GTSTS(.TZTMP,"TSTS")
+ F I=1:1:TSTS(0) D ;
+ . S TPASSED=0 S TFAILED=0
+ . D ZTEST^GPLUNIT(.TZTMP,TSTS(I))
+ . S TOTP=TOTP+TPASSED
+ . S TOTF=TOTF+TFAILED
+ . S $P(TSTS(I),"^",2)=TPASSED
+ . S $P(TSTS(I),"^",3)=TFAILED
+ F I=1:1:TSTS(0) D ;
+ . W "TEST=> ",$P(TSTS(I),"^",1)
+ . W " PASSED=>",$P(TSTS(I),"^",2)
+ . W " FAILED=>",$P(TSTS(I),"^",3),!
+ W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+ Q
+ ;
TLIST(ZARY) ; LIST ALL THE TESTS
- ; THEY ARE MARKED AS ;;> IN THE TEST CASES
- ; ZARY IS PASSED BY REFERENCE
- N I,J,K S I="" S I=$O(ZARY("TESTS",I))
- S K=1
- F J=0:0 Q:I="" D
- . ; W "I IS NOW=",I,!
- . W I," "
- . S I=$O(ZARY("TESTS",I))
- . S K=K+1 I K=6 D
- . . W !
- . . S K=1
- Q
- ;
+ ; THEY ARE MARKED AS ;;> IN THE TEST CASES
+ ; ZARY IS PASSED BY REFERENCE
+ N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+ S K=1
+ F J=0:0 Q:I="" D
+ . ; W "I IS NOW=",I,!
+ . W I," "
+ . S I=$O(ZARY("TESTS",I))
+ . S K=K+1 I K=6 D
+ . . W !
+ . . S K=1
+ Q
+ ;
diff --git a/p/GPLVITALS.m b/p/GPLVITALS.m
index de03fc0..eb0b704 100644
--- a/p/GPLVITALS.m
+++ b/p/GPLVITALS.m
@@ -1,85 +1,85 @@
-GPLVITALS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/03/08
- ;;0.1;CCDCCR;;JUL 3,2008;
-EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
- ;
- ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
- ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
- ;
- N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
- D VITALS^ORQQVI(.VITRSLT,DFN,"","")
- I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q
- ; ZWR RPCRSLT
- S VITTVMAP=$NA(^TMP($J,"VITALS"))
- S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP"))
- F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST
- . I $D(VITRSLT(J)) D
- . . S VITVMAP=$NA(@VITTVMAP@(J))
- . . K @VITVMAP
- . . I DEBUG W "VMAP= ",VMAP,!
- . . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
- . . I $P(VITPTMP,U,2)="HT" D
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
- . . . W "CONVERTED DATE TIME: ",@VITVMAP@("VITALSIGNSEXACTDATETIME"),!
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
- . . . ;S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
- . . . ;S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
- . . E I $P(VITPTMP,U,2)="WT" D
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
- . . . ;S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
- . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
- . . E D
- . . . ;W "IN VITAL: OTHER",!
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
- . . . ;S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
- . . K @VITARYTMP
- . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
- . . I J=1 D ; FIRST ONE IS JUST A COPY
- . . . ; W "FIRST ONE",!
- . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
- . . . ; W "OUTXML ",OUTXML,!
- . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
- . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
- ; ZWR ^TMP($J,"VITALS",*)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
- ; ZWR @OUTXML
- N VITTMP,I
- D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
- I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
- . W "VITALS MISSING ",!
- . F I=1:1:VITTMP(0) W VITTMP(I),!
- Q
- ;
+GPLVITALS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/03/08
+ ;;0.1;CCDCCR;;JUL 3,2008;
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+ ;
+ ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+ ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+ ;
+ N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
+ D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+ I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q
+ ; ZWR RPCRSLT
+ S VITTVMAP=$NA(^TMP($J,"VITALS"))
+ S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP"))
+ F J=1:1:VITRSLT(1) D ; FOR EACH VITAL IN THE LIST
+ . I $D(VITRSLT(J)) D
+ . . S VITVMAP=$NA(@VITTVMAP@(J))
+ . . K @VITVMAP
+ . . I DEBUG W "VMAP= ",VMAP,!
+ . . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
+ . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
+ . . I $P(VITPTMP,U,2)="HT" D
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+ . . . W "CONVERTED DATE TIME: ",@VITVMAP@("VITALSIGNSEXACTDATETIME"),!
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+ . . . ;S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+ . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+ . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+ . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+ . . . ;S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
+ . . E I $P(VITPTMP,U,2)="WT" D
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+ . . . ;S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+ . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+ . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+ . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
+ . . . ;S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+ . . E D
+ . . . ;W "IN VITAL: OTHER",!
+ . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+ . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+ . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+ . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVERSION")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")=""
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+ . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+ . . . ;S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
+ . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+ . . K @VITARYTMP
+ . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
+ . . I J=1 D ; FIRST ONE IS JUST A COPY
+ . . . ; W "FIRST ONE",!
+ . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
+ . . . ; W "OUTXML ",OUTXML,!
+ . . I J>1 D ; AFTER THE FIRST, INSERT INNER XML
+ . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
+ ; ZWR ^TMP($J,"VITALS",*)
+ ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+ ; ZWR @OUTXML
+ N VITTMP,I
+ D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+ I VITTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . W "VITALS MISSING ",!
+ . F I=1:1:VITTMP(0) W VITTMP(I),!
+ Q
+ ;