Context Navigation

← Previous Change
Next Change →

Changeset 40 for ccr/trunk/p

Timestamp:

Jul 3, 2008, 9:02:47 PM (16 years ago)

Author:

Christopher Edwards

Message:

fixed spacing issues

Location:

ccr/trunk/p

Files:

: 9 edited

CCRDPT.m (modified) (1 diff)
CCRDPTT.m (modified) (1 diff)
CCRUTIL.m (modified) (1 diff)
GPLACTORS.m (modified) (1 diff)
GPLCCD0.m (modified) (1 diff)
GPLCCR0.m (modified) (1 diff)
GPLPROBS.m (modified) (1 diff)
GPLUNIT.m (modified) (1 diff)
GPLVITALS.m (modified) (1 diff)

Legend:

: Unmodified
: Added
: Removed

ccr/trunk/p/CCRDPT.m

-              r26
+              r40
 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)
+          ;

ccr/trunk/p/CCRDPTT.m

-              r26
+              r40
 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

ccr/trunk/p/CCRUTIL.m

-              r36
+              r40
 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")
+          ;

ccr/trunk/p/GPLACTORS.m

-              r37
+              r40
 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

ccr/trunk/p/GPLCCD0.m

-              r3
+              r40
 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";<TEMPLATE>".E S INTEST=1 ; entering section
        . I LINE?." "1";</TEMPLATE>".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";<TEMPLATE>".E S INTEST=1 ; entering section
+          . I LINE?." "1";</TEMPLATE>".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
+          ;
 ;<TEMPLATE>
 ;;<?xml version="1.0"?>
 ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
 ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
 ;;      <typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
 ;;      <templateId root="2.16.840.1.113883.10.20.1"/>
 ;;      <id root="db734647-fc99-424c-a864-7e3cda82e703"/>
 ;;      <code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
 ;;      <title>< value="DOCTITLE"/>@@DOCTITLE@@Good Health Clinic Continuity of Care Document</title>
 ;;      <effectiveTime value="@@EFFECTIVETIME@@20000407130000+0500"/>
 ;;      <confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
 ;;      <languageCode code="en-US"/>
 ;;      <recordTarget>
 ;;              <patientRole>
 ;;                      <id extension="996-756-495" root="2.16.840.1.113883.19.5"/>
 ;;                      <patient>
 ;;                              <name>
 ;;                                      <given>@@PATIENTGIVENNAME@@</given>
 ;;                                      <family>@@PATIENTFAMILYNAME@@</family>
 ;;                                      <suffix>@@PATIENTNAMESUFFIX@@</suffix>
 ;;                              </name>
 ;;                              <administrativeGenderCode code="@@PATIENTGENDER@@M" codeSystem="2.16.840.1.113883.5.1"/>
 ;;                              <birthTime value="@@PATIENTDATEOFBIRTH@@19320924"/>
 ;;                      </patient>
 ;;                      <providerOrganization>
 ;;                              <id root="2.16.840.1.113883.19.5"/>
 ;;                              <name>@@SITENAME@@Good Health Clinic</name>
 ;;                      </providerOrganization>
 ;;              </patientRole>
 ;;      </recordTarget>
 ;;      <author>
 ;;              <time value="20000407130000+0500"/>
 ;;              <assignedAuthor>
 ;;                      <id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
 ;;                      <assignedPerson>
 ;;                              <name><prefix>Dr.</prefix><given>@@AUTHORGIVENNAME@@Robert</given><family>@@AUTHORFAMILYNAME@@Dolin</family></name>
 ;;                      </assignedPerson>
 ;;                      <representedOrganization>
 ;;                              <id root="2.16.840.1.113883.19.5"/>
 ;;                              <name>@@AUTHORSITE@@Good Health Clinic</name>
 ;;                      </representedOrganization>
 ;;              </assignedAuthor>
 ;;      </author>
 ;;      <informant>
 ;;              <assignedEntity>
 ;;                      <id nullFlavor="NI"/>
 ;;                      <representedOrganization>
 ;;                              <id root="2.16.840.1.113883.19.5"/>
 ;;                              <name>@@INFORMANTORG@@Good Health Clinic</name>
 ;;                      </representedOrganization>
 ;;              </assignedEntity>
 ;;      </informant>
 ;;      <custodian>
 ;;              <assignedCustodian>
 ;;                      <representedCustodianOrganization>
 ;;                              <id root="2.16.840.1.113883.19.5"/>
 ;;                              <name>@@CUSTODIANORG@@Good Health Clinic</name>
 ;;                      </representedCustodianOrganization>
 ;;              </assignedCustodian>
 ;;      </custodian>
 ;;      <legalAuthenticator>
 ;;              <time value="20000407130000+0500"/>
 ;;              <signatureCode code="S"/>
 ;;              <assignedEntity>
 ;;                      <id nullFlavor="NI"/>
 ;;                      <representedOrganization>
 ;;                              <id root="2.16.840.1.113883.19.5"/>
 ;;                              <name>@@LEGALORG@@Good Health Clinic</name>
 ;;                      </representedOrganization>
 ;;              </assignedEntity>
 ;;      </legalAuthenticator>
 ;;      <participant typeCode="IND">
 ;;              <associatedEntity classCode="GUAR">
 ;;                      <id root="4ff51570-83a9-47b7-91f2-93ba30373141"/>
 ;;                      <addr>
 ;;                              <streetAddressLine>@@GUARSTREET@@17 Daws Rd.</streetAddressLine>
 ;;                              <city>@@GUARCITY@@Blue Bell</city>
 ;;                              <state>@@GUARSTATE@@MA</state>
 ;;                              <postalCode>@@GUARZIP@@02368</postalCode>
 ;;                      </addr>
 ;;                      <telecom value="tel:@@GUARTELE@@(888)555-1212"/>
 ;;                      <associatedPerson>
 ;;                              <name>
 ;;                                      <given>@@GUARGIVENNAME@@Kenneth</given>
 ;;                                      <family>@@GUARFAMILYNAME@@Ross</family>
 ;;                              </name>
 ;;                      </associatedPerson>
 ;;              </associatedEntity>
 ;;      </participant>
 ;;      <participant typeCode="IND">
 ;;              <associatedEntity classCode="NOK">
 ;;                      <id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
 ;;                      <code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="@@NOKRELATION@@Biiological mother"/>
 ;;                      <telecom value="tel:@@NOKTELE@@(999)555-1212"/>
 ;;                      <associatedPerson>
 ;;                              <name>
 ;;                                      <given>@@NOKGIVENNAME@@Henrietta</given>
 ;;                                      <family>@@NOKFAMILYNAME@@Levin</family>
 ;;                              </name>
 ;;                      </associatedPerson>
 ;;              </associatedEntity>
 ;;      </participant>
 ;;      <documentationOf>
 ;;              <serviceEvent classCode="PCPR">
 ;;                      <effectiveTime><low value="@@DOCPERIODLOW@@19320924"/><high value="@@DOCPERIODHIGH@@20000407"/></effectiveTime>
 ;;                      <performer typeCode="PRF">
 ;;                              <functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
 ;;                              <time><low value="@@PCPPERIODLOW@@1990"/><high value='@@PCPPERIODHIGH@@20000407'/></time>
 ;;                              <assignedEntity>
 ;;                                      <id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
 ;;                                      <assignedPerson>
 ;;                                              <name><prefix>@@PCPNAMEPREFIX@@Dr.</prefix><given>@@PCPNAMEGIVEN@@Robert</given><family>@@PCPNAMEFAMILY@@Dolin</family></name>
 ;;                                      </assignedPerson>
 ;;                                      <representedOrganization>
 ;;                                              <id root="2.16.840.1.113883.19.5"/>
 ;;                                              <name>@@PCPORG@@Good Health Clinic</name>
 ;;                                      </representedOrganization>
 ;;                              </assignedEntity>
 ;;                      </performer>
 ;;              </serviceEvent>
 ;;      </documentationOf>
 ;;      <component>
 ;;              <structuredBody>
+;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
+;;<templateId root="2.16.840.1.113883.10.20.1"/>
+;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
+;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
+;;<title>< value="DOCTITLE"/>@@DOCTITLE@@Good Health Clinic Continuity of Care Document</title>
+;;<effectiveTime value="@@EFFECTIVETIME@@20000407130000+0500"/>
+;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+;;<languageCode code="en-US"/>
+;;<recordTarget>
+;;<patientRole>
+;;<id extension="996-756-495" root="2.16.840.1.113883.19.5"/>
+;;<patient>
+;;<name>
+;;<given>@@PATIENTGIVENNAME@@</given>
+;;<family>@@PATIENTFAMILYNAME@@</family>
+;;<suffix>@@PATIENTNAMESUFFIX@@</suffix>
+;;</name>
+;;<administrativeGenderCode code="@@PATIENTGENDER@@M" codeSystem="2.16.840.1.113883.5.1"/>
+;;<birthTime value="@@PATIENTDATEOFBIRTH@@19320924"/>
+;;</patient>
+;;<providerOrganization>
+;;<id root="2.16.840.1.113883.19.5"/>
+;;<name>@@SITENAME@@Good Health Clinic</name>
+;;</providerOrganization>
+;;</patientRole>
+;;</recordTarget>
+;;<author>
+;;<time value="20000407130000+0500"/>
+;;<assignedAuthor>
+;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+;;<assignedPerson>
+;;<name><prefix>Dr.</prefix><given>@@AUTHORGIVENNAME@@Robert</given><family>@@AUTHORFAMILYNAME@@Dolin</family></name>
+;;</assignedPerson>
+;;<representedOrganization>
+;;<id root="2.16.840.1.113883.19.5"/>
+;;<name>@@AUTHORSITE@@Good Health Clinic</name>
+;;</representedOrganization>
+;;</assignedAuthor>
+;;</author>
+;;<informant>
+;;<assignedEntity>
+;;<id nullFlavor="NI"/>
+;;<representedOrganization>
+;;<id root="2.16.840.1.113883.19.5"/>
+;;<name>@@INFORMANTORG@@Good Health Clinic</name>
+;;</representedOrganization>
+;;</assignedEntity>
+;;</informant>
+;;<custodian>
+;;<assignedCustodian>
+;;<representedCustodianOrganization>
+;;<id root="2.16.840.1.113883.19.5"/>
+;;<name>@@CUSTODIANORG@@Good Health Clinic</name>
+;;</representedCustodianOrganization>
+;;</assignedCustodian>
+;;</custodian>
+;;<legalAuthenticator>
+;;<time value="20000407130000+0500"/>
+;;<signatureCode code="S"/>
+;;<assignedEntity>
+;;<id nullFlavor="NI"/>
+;;<representedOrganization>
+;;<id root="2.16.840.1.113883.19.5"/>
+;;<name>@@LEGALORG@@Good Health Clinic</name>
+;;</representedOrganization>
+;;</assignedEntity>
+;;</legalAuthenticator>
+;;<participant typeCode="IND">
+;;<associatedEntity classCode="GUAR">
+;;<id root="4ff51570-83a9-47b7-91f2-93ba30373141"/>
+;;<addr>
+;;<streetAddressLine>@@GUARSTREET@@17 Daws Rd.</streetAddressLine>
+;;<city>@@GUARCITY@@Blue Bell</city>
+;;<state>@@GUARSTATE@@MA</state>
+;;<postalCode>@@GUARZIP@@02368</postalCode>
+;;</addr>
+;;<telecom value="tel:@@GUARTELE@@(888)555-1212"/>
+;;<associatedPerson>
+;;<name>
+;;<given>@@GUARGIVENNAME@@Kenneth</given>
+;;<family>@@GUARFAMILYNAME@@Ross</family>
+;;</name>
+;;</associatedPerson>
+;;</associatedEntity>
+;;</participant>
+;;<participant typeCode="IND">
+;;<associatedEntity classCode="NOK">
+;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
+;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="@@NOKRELATION@@Biiological mother"/>
+;;<telecom value="tel:@@NOKTELE@@(999)555-1212"/>
+;;<associatedPerson>
+;;<name>
+;;<given>@@NOKGIVENNAME@@Henrietta</given>
+;;<family>@@NOKFAMILYNAME@@Levin</family>
+;;</name>
+;;</associatedPerson>
+;;</associatedEntity>
+;;</participant>
+;;<documentationOf>
+;;<serviceEvent classCode="PCPR">
+;;<effectiveTime><low value="@@DOCPERIODLOW@@19320924"/><high value="@@DOCPERIODHIGH@@20000407"/></effectiveTime>
+;;<performer typeCode="PRF">
+;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+;;<time><low value="@@PCPPERIODLOW@@1990"/><high value='@@PCPPERIODHIGH@@20000407'/></time>
+;;<assignedEntity>
+;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+;;<assignedPerson>
+;;<name><prefix>@@PCPNAMEPREFIX@@Dr.</prefix><given>@@PCPNAMEGIVEN@@Robert</given><family>@@PCPNAMEFAMILY@@Dolin</family></name>
+;;</assignedPerson>
+;;<representedOrganization>
+;;<id root="2.16.840.1.113883.19.5"/>
+;;<name>@@PCPORG@@Good Health Clinic</name>
+;;</representedOrganization>
+;;</assignedEntity>
+;;</performer>
+;;</serviceEvent>
+;;</documentationOf>
+;;<component>
+;;<structuredBody>
 ;;<component>
 ;;<section>
 ;;      <templateId root='2.16.840.1.113883.10.20.1.13'/>
 ;;      <code code="48764-5" codeSystem="2.16.840.1.113883.6.1"/>
 ;;      <title>Summary Purpose</title>
 ;;      <text>Transfer of care</text>
 ;;      <entry typeCode="DRIV">
 ;;              <act classCode="ACT" moodCode="EVN">
 ;;                      <templateId root='2.16.840.1.113883.10.20.1.30'/>
 ;;                      <code code="23745001" codeSystem="2.16.840.1.113883.6.96" displayName="Documentation procedure"/>
 ;;                      <statusCode code="completed"/>
 ;;                      <entryRelationship typeCode="RSON">
 ;;                              <act classCode="ACT" moodCode="EVN">
 ;;                                      <code code="308292007" codeSystem="2.16.840.1.113883.6.96" displayName="@@DOCPURPOSE@@Transfer of care"/>
 ;;                                      <statusCode code="completed"/>
 ;;                              </act>
 ;;                      </entryRelationship>
 ;;              </act>
 ;;      </entry>
+;;<templateId root='2.16.840.1.113883.10.20.1.13'/>
+;;<code code="48764-5" codeSystem="2.16.840.1.113883.6.1"/>
+;;<title>Summary Purpose</title>
+;;<text>Transfer of care</text>
+;;<entry typeCode="DRIV">
+;;<act classCode="ACT" moodCode="EVN">
+;;<templateId root='2.16.840.1.113883.10.20.1.30'/>
+;;<code code="23745001" codeSystem="2.16.840.1.113883.6.96" displayName="Documentation procedure"/>
+;;<statusCode code="completed"/>
+;;<entryRelationship typeCode="RSON">
+;;<act classCode="ACT" moodCode="EVN">
+;;<code code="308292007" codeSystem="2.16.840.1.113883.6.96" displayName="@@DOCPURPOSE@@Transfer of care"/>
+;;<statusCode code="completed"/>
+;;</act>
+;;</entryRelationship>
+;;</act>
+;;</entry>
 ;;</section>
 ;;</component>
 ;;<component>
 ;;<section>
 ;;      <templateId root="2.16.840.1.113883.10.20.1.14"/>
 ;;      <code code="30954-2" codeSystem="2.16.840.1.113883.6.1"/>
 ;;      <entry typeCode="DRIV">
 ;;              <organizer classCode="BATTERY" moodCode="EVN">
 ;;                      <templateId root="2.16.840.1.113883.10.20.1.32"/>
 ;;                      <id root="7d5a02b0-67a4-11db-bd13-0800200c9a66"/>
 ;;                      <code code="@@BATTERYCODE@@43789009" codeSystem="@@BATTERYSYSTEM@@2.16.840.1.113883.6.96" displayName="@@BATTERYNAME@@CBC WO DIFFERENTIAL"/>
 ;;                      <statusCode code="completed"/>
 ;;                      <effectiveTime value="@@BATTERYTIME@@200003231430"/>
 ;;                      <component>
 ;;                              <observation classCode="OBS" moodCode="EVN">
 ;;                                      <templateId root="2.16.840.1.113883.10.20.1.31"/>
 ;;                                      <id root="107c2dc0-67a5-11db-bd13-0800200c9a66"/>
 ;;                                      <code code="@@COMPONENTCODE@@30313-1" codeSystem="@@COMPONENTSYSTEM@@2.16.840.1.113883.6.1" displayName="@@COMPONENTNAME@@HGB"/>
 ;;                                      <statusCode code="completed"/>
 ;;                                      <effectiveTime value="@@COMPONENTTIME@@200003231430"/>
 ;;                                      <value xsi:type="@@COMPONENTTYPE@@PQ" value="@@COMPONENTVALUE@13.2" unit="@@COMPONENTUNIT@@g/dl"/>
 ;;                                      <interpretationCode code="N" codeSystem="2.16.840.1.113883.5.83"/>
 ;;                                      <referenceRange>
 ;;                                              < value="OBSERVATIONRANGE"/>
 ;;                                              <observationRange>
 ;;                                                      <text>@@OBSRANGETEXT@@M 13-18 g/dl; F 12-16 g/dl</text>
 ;;                                              </observationRange>
 ;;                                      </referenceRange>
 ;;                              </observation>
 ;;                      </component>
 ;;              </organizer>
 ;;      </entry>
+;;<templateId root="2.16.840.1.113883.10.20.1.14"/>
+;;<code code="30954-2" codeSystem="2.16.840.1.113883.6.1"/>
+;;<entry typeCode="DRIV">
+;;<organizer classCode="BATTERY" moodCode="EVN">
+;;<templateId root="2.16.840.1.113883.10.20.1.32"/>
+;;<id root="7d5a02b0-67a4-11db-bd13-0800200c9a66"/>
+;;<code code="@@BATTERYCODE@@43789009" codeSystem="@@BATTERYSYSTEM@@2.16.840.1.113883.6.96" displayName="@@BATTERYNAME@@CBC WO DIFFERENTIAL"/>
+;;<statusCode code="completed"/>
+;;<effectiveTime value="@@BATTERYTIME@@200003231430"/>
+;;<component>
+;;<observation classCode="OBS" moodCode="EVN">
+;;<templateId root="2.16.840.1.113883.10.20.1.31"/>
+;;<id root="107c2dc0-67a5-11db-bd13-0800200c9a66"/>
+;;<code code="@@COMPONENTCODE@@30313-1" codeSystem="@@COMPONENTSYSTEM@@2.16.840.1.113883.6.1" displayName="@@COMPONENTNAME@@HGB"/>
+;;<statusCode code="completed"/>
+;;<effectiveTime value="@@COMPONENTTIME@@200003231430"/>
+;;<value xsi:type="@@COMPONENTTYPE@@PQ" value="@@COMPONENTVALUE@13.2" unit="@@COMPONENTUNIT@@g/dl"/>
+;;<interpretationCode code="N" codeSystem="2.16.840.1.113883.5.83"/>
+;;<referenceRange>
+;;<value="OBSERVATIONRANGE"/>
+;;<observationRange>
+;;<text>@@OBSRANGETEXT@@M 13-18 g/dl; F 12-16 g/dl</text>
+;;</observationRange>
+;;</referenceRange>
+;;</observation>
+;;</component>
+;;</organizer>
+;;</entry>
 ;;</section>
 ;;</component>

ccr/trunk/p/GPLCCR0.m

-              r36
+              r40
 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";<TEMPLATE>".E S INTEST=1 ; entering section
               . I LINE?." "1";</TEMPLATE>".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";<TEMPLATE>".E S INTEST=1 ; entering section
+          . I LINE?." "1";</TEMPLATE>".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
+          ;
 ;<TEMPLATE>
 ;;<?xml version="1.0" encoding="UTF-8"?>

ccr/trunk/p/GPLPROBS.m

-              r22
+              r40
 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
+          ;

ccr/trunk/p/GPLUNIT.m

-              r28
+              r40
 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";;><TEST>".E S INTEST=1 ; entering test section
        . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
        . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
        . I LINE?." "1";;></TEMPLATE>".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";;><TEST>".E S INTEST=1 ; entering test section
+          . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+          . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+          . I LINE?." "1";;></TEMPLATE>".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 ;;><TESTNAME> 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 ;;><TESTNAME> 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
+          ;

ccr/trunk/p/GPLVITALS.m

-              r36
+              r40
 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
+          ;

Note: See TracChangeset for help on using the changeset viewer.

Context Navigation

Changeset 40 for ccr/trunk/p

Legend:

Download in other formats: