Index: ccr/tags/CCR_1_0_4/p/CCRDPT.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCRDPT.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCRDPT.m	(revision 169)
@@ -0,0 +1,556 @@
+CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
+  ;;0.1;CCRCCD;;Jun 15, 2008;
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+    ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
+    ; DESTROY to clean-up.
+    ; The first line of every routine tests if the global exists.
+    ;
+    ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
+    ; INIT        9 lines  Copy DFN global to a local variable
+    ; DESTROY     6 lines  Kill local variable
+    ; FAMILY      6 lines  Family Name
+    ; GIVEN       6 lines  Given Name
+    ; MIDDLE      6 lines  Middle Name
+    ; SUFFIX      6 lines  Suffix Name
+    ; DISPNAME    5 lines  Display Name
+    ; DOB         6 lines  Date of Birth
+    ; GENDER      4 lines  Get Gender
+    ; SSN         4 lines  Get SSN for ID
+    ; ADDRTYPE    4 lines  Get Home Address
+    ; ADDR1       4 lines  Get Home Address line 1
+    ; ADDR2       5 lines  Get Home Address line 2
+    ; CITY        4 lines  Get City for Home Address
+    ; STATE      11 lines  Get State for Home Address
+    ; ZIP         4 lines  Get Zip code for Home Address
+    ; COUNTY      4 lines  Get County for our Address
+    ; COUNTRY     4 lines  Get Country for our Address
+    ; RESTEL      4 lines  Residential Telephone
+    ; WORKTEL     4 lines  Work Telephone
+    ; EMAIL       4 lines  Email Adddress
+    ; CELLTEL     4 lines  Cell Phone
+    ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
+    ; NOK1GIV     6 lines  NOK1 Given Name
+    ; NOK1MID     6 lines  NOK1 Middle Name
+    ; NOK1SUF     6 lines  NOK1 Suffi Name
+    ; NOK1DISP    5 lines  NOK1 Display Name
+    ; NOK1REL     4 lines  NOK1 Relationship to the patient
+    ; NOK1ADD1    4 lines  NOK1 Address 1
+    ; NOK1ADD2    5 lines  NOK1 Address 2
+    ; NOK1CITY    4 lines  NOK1 City
+    ; NOK1STAT    5 lines  NOK1 State
+    ; NOK1ZIP     4 lines  NOK1 Zip Code
+    ; NOK1HTEL;   4 lines  NOK1 Home Telephone
+    ; NOK1WTEL;   4 lines  NOK1 Work Telephone
+    ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
+    ; NOK2FAM     6 lines  NOK2 Family Name
+    ; NOK2GIV     6 lines  NOK2 Given Name
+    ; NOK2MID     6 lines  NOK2 Middle Name
+    ; NOK2SUF     5 lines  NOK2 Suffi Name
+    ; NOK2DISP    5 lines  NOK2 Display Name
+    ; NOK2REL     4 lines  NOK2 Relationship to the patient
+    ; NOK2ADD1    4 lines  NOK2 Address 1
+    ; NOK2ADD2    5 lines  NOK2 Address 2
+    ; NOK2CITY    4 lines  NOK2 City
+    ; NOK2STAT    5 lines  NOK2 State
+    ; NOK2ZIP     4 lines  NOK2 Zip Code
+    ; NOK2HTEL;   4 lines  NOK2 Home Telephone
+    ; NOK2WTEL;   4 lines  NOK2 Work Telephone
+    ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
+    ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
+    ; EMERGIV     6 lines  EMER Given Name
+    ; EMERMID     6 lines  EMER Middle Name
+    ; EMERSUF     5 lines  EMER Suffi Name
+    ; EMERDISP    5 lines  EMER Display Name
+    ; EMERREL     4 lines  EMER Relationship to the patient
+    ; EMERADD1    4 lines  EMER Address 1
+    ; EMERADD2    5 lines  EMER Address 2
+    ; EMERCITY    4 lines  EMER City
+    ; EMERSTAT    5 lines  EMER State
+    ; EMERZIP     4 lines  EMER Zip Code
+    ; EMERHTEL;   4 lines  EMER Home Telephone
+    ; EMERWTEL;   4 lines  EMER Work Telephone
+    ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
+    ;
+          W "No Entry at top!" Q
+   ; The following is a map of the relevant data in the patient global.
+    ;
+    ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
+    ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
+    ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
+    ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
+    ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
+    ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
+    ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
+    ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
+    ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
+    ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
+    ; ==>[21S] ^
+    ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
+    ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
+    ; ==>COMPONENTS [3P:20] ^
+    ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
+    ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
+    ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
+    ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
+    ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
+    ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
+    ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
+    ; ==>^
+    ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
+    ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
+    ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
+    ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
+    ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
+    ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
+    ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
+    ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
+    ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
+    ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
+    ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
+    ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
+    ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
+    ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
+    ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
+    ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
+    ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
+    ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
+    ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
+    ; ==>SITE [14P:4] ^
+    ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
+    ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
+    ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
+    ; ==>3] [5F] ^
+    ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
+    ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
+    ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
+    ; ==>^
+    ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
+    ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
+    ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
+    ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
+    ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
+    ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
+    ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
+    ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
+    ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
+    ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
+    ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
+    ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
+    ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
+    ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
+    ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
+    ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
+    ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
+    ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
+    ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
+    ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
+    ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
+    ; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
+    ; INPUT: Patient IEN (DFN)
+    ; OUTPUT: PT in the Symbol Table, representing the patient global
+    ; Instead of accessing a global each single read (SLOOOOW)
+    ; read it off a local variable stored in Memory.
+INIT(DFN) ;
+          M PT=^DPT(DFN)
+          Q
+          ;
+DESTROY ; Kill local variable; PUBLIC
+          ; INPUT: None
+          ; OUTPUT: Kill PT from the Symbol Table after you are done
+          K PT
+          Q
+          ;
+FAMILY() ; Family Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          N NAME S NAME=$P(PT(0),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("FAMILY")
+          ;
+GIVEN() ; Given Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          N NAME S NAME=$P(PT(0),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("GIVEN")
+          ;
+MIDDLE() ; Middle Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          N NAME S NAME=$P(PT(0),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("MIDDLE")
+          ;
+SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          N NAME S NAME=$P(PT(0),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("SUFFIX")
+          ;
+DISPNAME() ; Display Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          N NAME S NAME=$P(PT(0),"^",1)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+DOB() ; Date of Birth; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          N DOB S DOB=$P(PT(0),"^",3)
+          ; Date in FM Date Format. Convert to UTC/ISO 8601.
+          Q $$FMDTOUTC^CCRUTIL(DOB,"D")
+          ;
+GENDER() ; Get Gender; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          Q $P(PT(0),"^",2)
+          ;
+SSN() ; Get SSN for ID; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(0))="" ""
+          Q $P(PT(0),"^",9)
+          ;
+ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
+          ; Vista only stores a home address for the patient.
+          Q:$G(PT(0))="" ""
+          Q "Home"
+          ;
+ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.11))="" ""
+          Q $P(PT(.11),"^",1)
+          ;
+ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
+          Q:$G(PT(.11))="" ""
+          ; If the thrid address is empty, just return the 2nd.
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+          Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
+          Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
+          ;
+CITY() ; Get City for Home Address; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.11))="" ""
+          Q $P(PT(.11),"^",4)
+          ;
+STATE() ; Get State for Home Address; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.11))="" ""
+          ; State is stored as a pointer
+          N STATENUM S STATENUM=$P(PT(.11),"^",5)
+          ;
+          ; State File Global is below
+          ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
+          ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
+          ; ==>US STATE OR POSSESSION [6S] ^
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+          ;
+ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.11))="" ""
+          Q $P(PT(.11),"^",6)
+          ;
+COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.11))="" ""
+          Q $P(PT(.11),"^",7)
+          ;
+COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
+          ; Unfortunately, I can't find where that is stored, so the inevitable...
+          Q:$G(PT(.11))="" ""
+          Q "USA"
+          ;
+RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.13))="" ""
+          Q $P(PT(.13),"^",1)
+          ;
+WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.13))="" ""
+          Q $P(PT(.13),"^",2)
+          ;
+EMAIL() ; Email Adddress; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.13))="" ""
+          Q $P(PT(.13),"^",3)
+          ;
+CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.13))="" ""
+          Q $P(PT(.13),"^",4)
+          ;
+NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          N NAME S NAME=$P(PT(.21),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("FAMILY")
+          ;
+NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          N NAME S NAME=$P(PT(.21),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("GIVEN")
+          ;
+NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          N NAME S NAME=$P(PT(.21),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("MIDDLE")
+          ;
+NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          N NAME S NAME=$P(PT(.21),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("SUFFIX")
+          ;
+NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          N NAME S NAME=$P(PT(.21),"^",1)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          Q $P(PT(.21),"^",2)
+          ;
+NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          Q $P(PT(.21),"^",3)
+          ;
+NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+          Q:$G(PT(.21))="" ""
+          ; If the thrid address is empty, just return the 2nd.
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+          Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
+          Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
+          ;
+NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          Q $P(PT(.21),"^",6)
+          ;
+NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          N STATENUM S STATENUM=$P(PT(.21),"^",7)
+          Q:STATENUM="" ""
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+          ;
+NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          Q $P(PT(.21),"^",8)
+          ;
+NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          Q $P(PT(.21),"^",9)
+          ;
+NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          Q $P(PT(.21),"^",11)
+          ;
+NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.21))="" ""
+          Q $P(PT(.21),"^",10)
+          ;
+NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          N NAME S NAME=$P(PT(.211),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("FAMILY")
+          ;
+NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          N NAME S NAME=$P(PT(.211),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("GIVEN")
+          ;
+NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          N NAME S NAME=$P(PT(.211),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("MIDDLE")
+          ;
+NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          N NAME S NAME=$P(PT(.211),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("SUFFIX")
+NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          N NAME S NAME=$P(PT(.211),"^",1)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          Q $P(PT(.211),"^",2)
+          ;
+NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          Q $P(PT(.211),"^",3)
+          ;
+NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+          Q:$G(PT(.211))="" ""
+          ; If the thrid address is empty, just return the 2nd.
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+          Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
+          Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
+          ;
+NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          Q $P(PT(.211),"^",6)
+          ;
+NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          N STATENUM S STATENUM=$P(PT(.211),"^",7)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+          ;
+NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          Q $P(PT(.211),"^",8)
+          ;
+NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          Q $P(PT(.211),"^",9)
+          ;
+NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          Q $P(PT(.211),"^",11)
+          ;
+NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.211))="" ""
+          Q $P(PT(.211),"^",10)
+          ;
+EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          N NAME S NAME=$P(PT(.33),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("FAMILY")
+          ;
+EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          N NAME S NAME=$P(PT(.33),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("GIVEN")
+          ;
+EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          N NAME S NAME=$P(PT(.33),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("MIDDLE")
+          ;
+EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          N NAME S NAME=$P(PT(.33),"^",1)
+          D NAMECOMP^XLFNAME(.NAME)
+          Q NAME("SUFFIX")
+EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          N NAME S NAME=$P(PT(.33),"^",1)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          Q $P(PT(.33),"^",2)
+          ;
+EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          Q $P(PT(.33),"^",3)
+          ;
+EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+          Q:$G(PT(.33))="" ""
+          ; If the thrid address is empty, just return the 2nd.
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+          Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
+          Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
+          ;
+EMERCITY() ; EMER City; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          Q $P(PT(.33),"^",6)
+          ;
+EMERSTAT() ; EMER State; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          N STATENUM S STATENUM=$P(PT(.33),"^",7)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+          ;
+EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          Q $P(PT(.33),"^",8)
+          ;
+EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          Q $P(PT(.33),"^",9)
+          ;
+EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          Q $P(PT(.33),"^",11)
+          ;
+EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
+          ; PREREQ: PT Defined
+          Q:$G(PT(.33))="" ""
+          Q $P(PT(.33),"^",10)
+          ;
Index: ccr/tags/CCR_1_0_4/p/CCRDPTT.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCRDPTT.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCRDPTT.m	(revision 169)
@@ -0,0 +1,45 @@
+CCRDPTT ; Unit Tester...
+  ;;0.1;CCRCCD;;Jun 15, 2008;
+ ;
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+          ; 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
Index: ccr/tags/CCR_1_0_4/p/CCRMEDS.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCRMEDS.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCRMEDS.m	(revision 169)
@@ -0,0 +1,177 @@
+CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
+          ;;0.1;CCDCCR;;JUL 16,2008;
+          ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+          ; General Public License See attached copy of the License.
+          ;
+          ; This program is free software; you can redistribute it and/or modify
+          ; it under the terms of the GNU General Public License as published by
+          ; the Free Software Foundation; either version 2 of the License, or
+          ; (at your option) any later version.
+          ;
+          ; This program is distributed in the hope that it will be useful,
+          ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+          ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+          ; GNU General Public License for more details.
+          ;
+          ; You should have received a copy of the GNU General Public License along
+          ; with this program; if not, write to the Free Software Foundation, Inc.,
+          ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+          ;
+          W "NO ENTRY FROM TOP",!
+          Q
+          ;
+EXTRACT(MINXML,DFN,OUTXML)      ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+          ;
+          ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+          ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+          ;
+          ; MEDS is return array from RPC.
+          ; MAP is a mapping variable map (store result) for each med
+          ; MED is holds each array element from MEDS(J), one medicine
+          ; J is a counter.
+          ;
+          ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+          ; med data available.
+          ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+          ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+          ; D PARY^GPLXPATH(MINXML)
+          N MEDS,MAP
+          K ^TMP($J)
+          D RX^PSO52API(DFN,"CCDCCR")
+          M MEDS=^TMP($J,"CCDCCR",DFN)
+          ; @(0) contains the number of meds or -1^NO DATA FOUND
+          ; If it is -1, we quit.
+          I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
+          I DEBUG ZWR MEDS
+          N RXIEN S RXIEN=0
+          N MEDCOUNT S MEDCOUNT=0
+          F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+          . S MEDCOUNT=MEDCOUNT+1
+          . I DEBUG W "RXIEN IS ",RXIEN,!
+          . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
+          . K @MAP
+          . I DEBUG W "MAP= ",MAP,!
+          . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+          . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+          . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+          . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
+          . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+          . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
+          . S @MAP@("MEDRXNOTXT")="Prescription Number"
+          . S @MAP@("MEDRXNO")=MED(.01)
+          . S @MAP@("MEDTYPETEXT")="Medication"
+          . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+          . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+          . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+          . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+          . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
+          . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+          . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
+          . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+          . N MEDIEN S MEDIEN=$P(MED(6),U)
+          . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+          . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+          . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+          . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+          . ; Units, concentration, etc, come from another call
+          . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+          . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+          . ; NDF Entry IEN, and VA Product Name
+          . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+          . ; Documented in the same manual.
+          . D NDF^PSS50(MEDIEN,,,,,"CONC")
+          . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
+          . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+          . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+          . N CONCDATA
+          . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+          . ; and this will crash the call. So...
+          . I NDFIEN="" S CONCDATA=""
+          . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+          . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+          . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+          . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+          . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
+          . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+          . ; Oddly, there is no easy place to find the dispense unit.
+          . ; It's not included in the original call, so we have to go to the drug file.
+          . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+          . ; Node 14.5 is the Dispense Unit
+          . D DATA^PSS50(MEDIEN,,,,,"QTY")
+          . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+          . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+          . ;
+          . ; --- START OF DIRECTIONS ---
+          . ;
+          . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+          . S @MAP@("MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+          . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+          . ; we want the compoenents.
+          . ; It's in node 6 of ^PSRX(IEN)
+          . ; So, here we go again
+          . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
+          . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
+          . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
+          . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
+          . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,1,0)
+          . S @MAP@("MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
+          . S @MAP@("MEDDOSEVALUE")=$P(SIGDATA,U,1)
+          . S @MAP@("MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+          . S @MAP@("MEDRATEVALUE")=""  ; For inpatient
+          . S @MAP@("MEDRATEUNIT")=""  ; For inpatient
+          . S @MAP@("MEDVEHICLETEXT")=""  ; For inpatient
+          . S @MAP@("MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
+          . S @MAP@("MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
+          . ; Invervals... again another call.
+          . ; In the wisdom of the original programmers, the schedule is a free text field
+          . ; However, it gets translated by a call to the administration schedule file
+          . ; to see if that schedule exists.
+          . ; That's the same thing I am going to do.
+          . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
+          . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
+          . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
+          . ; So...
+          . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
+          . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
+          . N INTERVAL
+          . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
+          . E  D
+          . . N SUB S SUB=$O(SCHEDATA(0))
+          . . S INTERVAL=SCHEDATA(SUB,2)
+          . S @MAP@("MEDINTERVALVALUE")=INTERVAL
+          . S @MAP@("MEDINTERVALUNIT")="Minute"
+          . S @MAP@("MEDDURATIONVALUE")=$P(SIGDATA,U,5)
+          . S @MAP@("MEDDURATIONUNIT")=""
+          . S @MAP@("MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
+          . S @MAP@("MEDPROBLEMOBJECTID")=""
+          . S @MAP@("MEDPROBLEMTYPETXT")=""
+          . S @MAP@("MEDPROBLEMDESCRIPTION")=""
+          . S @MAP@("MEDPROBLEMCODEVALUE")=""
+          . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
+          . S @MAP@("MEDPROBLEMCODINGVERSION")=""
+          . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
+          . S @MAP@("MEDSTOPINDICATOR")=""
+          . S @MAP@("MEDDIRSEQ")=""
+          . S @MAP@("MEDMULDIRMOD")=""
+          . ;
+          . ; --- END OF DIRECTIONS ---
+          . ;
+          . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
+          . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
+          . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
+          . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
+          . S @MAP@("MEDRFNO")=MED(9)
+          . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT"))
+          . K @RESULT
+          . ; D MAP^GPLXPATH($NA(INXML),MAP,RESULT)
+          . D MAP^GPLXPATH(MINXML,MAP,RESULT)
+          . ; D PARY^GPLXPATH(RESULT)
+          . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+          . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+          N MEDTMP,MEDI
+          D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+          I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+          . W "MEDICATION MISSING ",!
+          . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+          Q
+          ;
Index: ccr/tags/CCR_1_0_4/p/CCRSYS.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCRSYS.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCRSYS.m	(revision 169)
@@ -0,0 +1,58 @@
+CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
+        ;;0.1;CCDCCR;;;
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+    ;
+        W "Enter at appropriate points." Q
+        ;
+        ; Originally, I was going to use VEPERVER, but VEPERVER
+        ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
+        ; manner (press any key to continue),
+        ; and is really a very half finished routine
+        ;
+        ; So for now, I am hard-coding the values.
+        ;
+SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
+        Q "WorldVistA EHR/VOE"
+        ;
+SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
+        Q "1.0"
+        ;
+PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
+         ; DFN = IEN of the Patient to be tested
+         ; 1 = Merged or Test Patient
+         ; 0 = Non-test Patient
+         ;
+         I DFN="" Q 0  ; BAD DFN PASSED
+         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
+         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
+         ;
+         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
+         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
+         N DIERR,DATA
+         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
+         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
+         ; 1 = Test Patient
+         ; 0 = Non-test Patient
+         I DATA Q DATA
+         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
+         D CLEAN^DILF
+         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
+         I $E(DATA,1,3)="000" Q 1
+         I $E(DATA,1,3)="666" Q 1
+         Q 0
+         ;
Index: ccr/tags/CCR_1_0_4/p/CCRUNIT.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCRUNIT.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCRUNIT.m	(revision 169)
@@ -0,0 +1,21 @@
+CCRUNIT ; A routine that tests some crap
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 0
+        Q
+        ;
+MEDS
+        N DEBUG S DEBUG=0
+        N DFN S DFN=3
+        K ^TMP($J)
+        W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+        N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
+        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+        W "XPATH is: "_XPATH,!
+        W "Getting Med Template into INXML using",!
+        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+        D QUERY^GPLXPATH(T,XPATH,"INXML")
+        B
+		W "Executing EXTRACT^CCRMEDS(INXML,DFN,OUTXML)",!
+        W "OUTXML will be ^TMP($J,""OUT"")",!
+        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+        D EXTRACT^CCRMEDS(.INXML,DFN,OUTXML)
+        Q
Index: ccr/tags/CCR_1_0_4/p/CCRUTIL.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCRUTIL.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCRUTIL.m	(revision 169)
@@ -0,0 +1,136 @@
+CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
+ ;;0.1;CCRCCD;;Jun 15, 2008;
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+ 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)
+ I $L(H)=1 S H="0"_H
+ S MM=$E(DATE,11,12)
+ I $L(MM)=1 S MM="0"_MM
+ S S=$E(DATE,13,14)
+ I $L(S)=1 S S="0"_S
+ 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" ; IF ONLY SOME ARE MISSING?
+ S:'$L(H) H="00"
+ S:'$L(MM) MM="00"
+ S:'$L(S) S="00"
+ S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+ I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+ E  Q $P(UTC,"T")
+ ;
+SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+ ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+ ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+ ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+ ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+ ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+ ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+ ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+ N VSRT ; TEMP FOR HASHING DATES
+ N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+ S ZCNT=0 ; COUNTING NUMBER OF DATES
+ S ZTMP="" ;
+ F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
+ . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+ . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
+ . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
+ . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
+ . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
+ . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
+ . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
+ . I DEBUG W "ZTMP=",ZTMP," "
+ S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
+ ; I DEBUG ZWR V2
+ ; I DEBUG ZWR VSRT
+ N ZD,ZT ; DATA AND TIME ITERATORS
+ N ZDONE ; DONE FLAG
+ S (ZD,ZT)=""
+ S ZDONE=0
+ N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
+ S UORDR=ORDR ; DIRECTION TO SORT
+ I ORDR="" S UORDR=1
+ N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
+ F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
+ . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE
+ . I ZD="" S ZDONE=1
+ . I 'ZDONE D  ; MORE DATES
+ . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
+ . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
+ . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
+ . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
+ . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
+ Q ZCNT
+ ;
+SORTDT2(V1,V2,ORDR) ; REWRITE TO USE 3 INSTEAD OF 2 LVLS OF INDEX
+ ; AND $Q INSTEAD OF $O
+ ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+ ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+ ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+ ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+ ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+ ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+ ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+ ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+ N VSRT ; TEMP FOR HASHING DATES
+ N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+ S ZCNT=0 ; COUNTING NUMBER OF DATES
+ S ZTMP="" ;
+ F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
+ . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+ . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
+ . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
+ . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
+ . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
+ . . S VSRT(ZP1,ZP2,ZCNT)=ZCNT ; HASH ON DATE AND TIME
+ . I DEBUG W "ZTMP=",ZTMP," "
+ S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
+ ; I DEBUG ZWR V2
+ ; I DEBUG ZWR VSRT
+ N ZD,ZT ; DATA AND TIME ITERATORS
+ N ZDONE ; DONE FLAG
+ S (ZD,ZT)=""
+ S ZDONE=0
+ N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
+ S UORDR=ORDR ; DIRECTION TO SORT
+ I ORDR="" S UORDR=1
+ N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
+ F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
+ . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE fix this
+ . I ZD="" S ZDONE=1
+ . I 'ZDONE D  ; MORE DATES
+ . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
+ . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
+ . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
+ . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
+ . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
+ Q ZCNT
+ ;
Index: ccr/tags/CCR_1_0_4/p/CCRVA200.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCRVA200.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCRVA200.m	(revision 169)
@@ -0,0 +1,167 @@
+CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 0
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+        Q
+        ; This routine uses Kernel APIs and Direct Global Access to get
+        ; Proivder Data from File 200.
+        ;
+        ; The Global is VA(200,*)
+        ;
+FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
+        ; INPUT: DUZ (i.e. File 200 IEN) ByVal
+        ; OUTPUT: String
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+        D NAMECOMP^XLFNAME(.NAME)
+        Q NAME("FAMILY")
+        ;
+GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+        D NAMECOMP^XLFNAME(.NAME)
+        Q NAME("GIVEN")
+        ;
+MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+        D NAMECOMP^XLFNAME(.NAME)
+        Q NAME("MIDDLE")
+        ;
+SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+        D NAMECOMP^XLFNAME(.NAME)
+        Q NAME("SUFFIX")
+        ;
+TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String
+        ; Gets External Value of Title field in New Person File.
+        ; It's actually a pointer to file 3.1
+        ; 200=New Person File; 8 is Title Field
+        Q $$GET1^DIQ(200,DUZ_",",8)
+        ;
+NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: Delimited String in format:
+        ;       IDType^ID^IDDescription
+        ; If the NPI doesn't exist, "" is returned.
+        ; This routine uses a call documented in the Kernel dev guide
+        ; This call returns as "NPI^TimeEntered^ActiveInactive"
+        ; It returns -1 for NPI if NPI doesn't exist.
+        N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+        Q:NPI=-1 ""
+        Q "NPI^"_NPI_"^HHS"
+        ;
+SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
+        ; Uses a Kernel API. Returns -1 if a specialty is not specified
+        ;       in file 200.
+        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
+        N STR S STR=$$GET^XUA4A72(DUZ)
+        Q:+STR<0 ""
+        ; Sometimes we have 3 pieces, or 2. Deal with that.
+        Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+        Q $P(STR,U,2)_"-"_$P(STR,U,3)
+        ;
+ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
+        ; INPUT: DUZ, but not needed really... here for future expansion
+        ; OUTPUT: At this point "Work"
+        Q "Work"
+        ;
+ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; Output: String.
+        ;
+        ; First, get site number from the institution file.
+        ; 1st piece returned by $$SITE^VASITE, which gets the system institution
+        N INST S INST=$P($$SITE^VASITE(),U)
+        ;
+        ; Second, get mailing address
+        ; There are two APIs to get the address, one for physical and one for
+        ; mailing. We will check if mailing exists first, since that's the
+        ; one we want to use; then check for physical. If neither exists,
+        ; then we return nothing. We check for the existence of an address
+        ; by the length of the returned string.
+        ; NOTE: API doesn't support Address 2, so I won't even include it
+        ; in the template.
+        N ADD
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+        Q:$L(ADD) $P(ADD,U)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+        Q:$L(ADD) $P(ADD,U)
+        Q ""
+        ;
+CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; Output: String.
+        ; See ADD1 for comments
+        N INST S INST=$P($$SITE^VASITE(),U)
+        N ADD
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+        Q:$L(ADD) $P(ADD,U,2)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+        Q:$L(ADD) $P(ADD,U,2)
+        Q ""
+        ;
+STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; Output: String.
+        ; See ADD1 for comments
+        N INST S INST=$P($$SITE^VASITE(),U)
+        N ADD
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+        Q:$L(ADD) $P(ADD,U,3)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+        Q:$L(ADD) $P(ADD,U,3)
+        Q ""
+        ;
+POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String.
+        ; See ADD1 for comments
+        N INST S INST=$P($$SITE^VASITE(),U)
+        N ADD
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+        Q:$L(ADD) $P(ADD,U,4)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+        Q:$L(ADD) $P(ADD,U,4)
+        Q ""
+        ;
+TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String.
+        ; Direct global access
+        N TEL S TEL=$G(^VA(200,DUZ,.13))
+        Q $P(TEL,U,2)
+        ;
+TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String.
+        Q "Office"
+        ;
+EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
+        ; INPUT: DUZ ByVal
+        ; OUTPUT: String
+        ; Direct global access
+        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+        Q $P(EMAIL,U)
+        ;
Index: ccr/tags/CCR_1_0_4/p/CCR_1_0_1.txt
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCR_1_0_1.txt	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCR_1_0_1.txt	(revision 169)
@@ -0,0 +1,100 @@
+CCR Package version 1.0.1
+
+The purpose of the CCR package is to provide support for exporting and eventually importing patient information from/to VistA in XML documents conforming to the Continuity of Care Record (CCR - ASTM) and Continuity of Care Document (CCD - HL7) standards.
+
+This version of the CCR package provides:
+
+EXPORT^GPLCCR
+A command line interface to export a single patient's CCR to a host directory by specifying the patient by name.
+
+EXPORT^GPLCCD
+A command line interface to export a single patient's CCD to a host directory by specifying the patient by name.
+
+XPAT^GPLCCR(DFN,OUTDIR,OUTFILE)
+A command line and program interface to export a single patient's CCR using the IEN of the patient in the ^DPT file (DFN).
+OUTDIR specifies an existing directory on the Host system into which the CCR XML document will be written. If OUTDIR is null (""), the output directory name will be taken from ^TMP("GPLCCR","ODIR").
+OUFILE specifies the host file name of the CCR XML document that will be written for this patient. If OUTFILE is null ("") the document name will default to PAT_x_CCR_V1.xml where x is the DFN of the patient.
+
+CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)
+An RPC and program interface to return in return array CCRGRTN (passed by reference) a single patient's CCR.
+DFN is the patient's IEN
+CCRPART is what portion of the CCR should be returned. If "CCR" is specified, the entire CCR will be returned. If "PROBLEMS", "VITALS", or "MEDICATIONS" is specified, only that section of the CCR will be returned.
+TIME1,TIME2 specify a beginning and end timeframe for the data to be included in the CCR. These parameters are not implemented in this release.
+HDRARY will specify the values of certain header variables for the CCR. This parameter is not implemented in this release.
+
+ANALYZE^GPLRIMA(BGNDFN,DFNCNT)
+A command line and program interface to analyze the data from multiple patients into categories that can be batch extracted.
+BGNDFN is the beginning DFN to be analyzed. If BGNDFN is null ("") its value will be taken from ^TMP("GPLRIM","RESUME"). If this variable does not exist, the routine will start with the first IEN in the patient file ^DPT. ^TMP("GPLRIM","RESUME") is updated to the "next" patient to be analyzed on successful completion.
+DFNCNT is the count of how many patient records will be analyzed in this execution.
+For example ANALYZE^GPLRIMA(1000,1000) would start at patient DFN 1000 and analyzes 1000 patient records. ANALYZE^GPLRIMA("",1000) would then analyze the next 1000 patients. When the end of the patient file is reached, the routine terminates with a message that RESET^GPLRIMA would need to be called to restart the analysis.
+
+The categories into which the records are analyzed consist of attribute strings. The attributes represent characteristics of the variables that can be extracted for a given patient into the CCR or the CCD. This version supports the following attributes:
+VITALS : the patient has variables for the VITALS section of the CCR/CCD
+PROBLEMS : the patient has variables for the PROBLEMS section of the CCR/CCD
+MEDS : the patient has variables for the MEDICATIONS section of the CCR/CCD
+HEADER : the patient has variables for the HEADER section of the CCR/CCD. All patients are marked with the HEADER attribute in this version.
+NOTEXTRACTED : the CCR or CCD has not yet been produced/extracted for this patient. All patient records are marked with the NOTEXTRACTED attribute in this version for batch control processing (not implemented in this version).
+
+ANAZYZE^GPLRIMA calls the variable extraction routines that would be used to produce a CCR or a CCD and saves the results to ^TMP("GPLRIM",DFN) for each patient. In addition, the attribute string for each patient is saved in ^TMP("GPLRIM","ATTR")
+
+Categories are created as they first occur based on each unique combination of attributes that is encountered. They are named after the attribute table that is used for the analysis. This version supports only the attribute table .RIMTBL. and the categories are named "RIMTBL_x". An example set of categories from a demo systems is:
+
+GTM>D CLIST^GPLRIMA
+(RIMTBL_1:105) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS^^^^^MEDS
+(RIMTBL_2:596) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS
+(RIMTBL_3:44) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^VITALS
+(RIMTBL_4:821) ^NOTEXTRACTED^HEADER
+(RIMTBL_5:18) ^NOTEXTRACTED^HEADER^^^^^^^^VITALS^^^^^MEDS
+(RIMTBL_6:14) ^NOTEXTRACTED^HEADER^^^PROBLEMS
+(RIMTBL_7:15) ^NOTEXTRACTED^HEADER^^^^^^^^^^^^^MEDS
+(RIMTBL_8:5) ^NOTEXTRACTED^HEADER^^^PROBLEMS^^^^^^^^^^MEDS
+
+for RIMTBL_1 in this example, 105 is the record count of patients who have this combination of attributes. The list of patients for each category is also maintained for batch extraction.
+
+CLIST^GPLRIMA
+A command line interface to show a summary of the categories, record counts, and attributes that have been analyzed so far. It produces the listing in the example above from information stored in ^TMP("GPLRIM","CATS","RIMTBL"). It is intended for future versions that attribute tables be supported in addition to the default "RIMTBL".
+
+CPAT^GPLRIMA(CPATCAT)
+A command line interface which shows the DFN numbers of the patients represented by the category CPATCAT. DFNs are listed 10 per line. For example:
+
+GTM>D CPAT^GPLRIMA("RIMTBL_1")
+1 3 8 25 42 69 123 140 146 149
+151 168 204 205 217 218 224 228 229 231
+236 237 240 253 260 267 271 301 347 350
+366 379 384 391 407 418 419 420 428 433
+442 520 569 600 620 692 706 715 722 723
+724 728 730 744 745 746 747 748 749 750
+751 752 753 754 755 756 757 758 759 760
+761 762 763 764 765 766 767 768 769 770
+771 772 773 774 775 776 777 778 779 780
+100000 100001 100002 100003 100004 100005 100006 100007 100008 100009
+100010 100011 100012 100013 100014
+
+These are the 105 patient records included in category "RIMTBL_1" from the above example.
+
+
+XCPAT^GPLRIMA(CPATCAT)
+A command line interface to extract a batch of patient CCR documents that are associated with the category CPATCAT. For example,
+
+XCPAT^GPLRIMA("RIMTBL_1") to extract the CCR documents for the 105 patients in the above example.
+
+RESET^GPLRIMA
+A command line interface to kill all ANALYZE^GPLRIMA results stored so far so that the analysis can be done again. It kills ^TMP("GPLRIM","RESUME") and all extraction variables that have been saved in ^TMP("GPLRIM")
+
+NOTES:
+This version of the package is a prototype, and does not yet make use of the standard VistA features that are appropriate for it to use.
+
+^TMP("GPLCCR","ODIR") must be set manually to the output directory on the Host System. It is intended that this be maintainable in a parameter file.
+
+CCRRPC^GPLCCR and CCDRPC^GPLCCD are intended to be RPC interfaces to the package but there is no entry for them in the RPC table and the RPC method of access has not been tested.
+
+Most of the command line interface functions in the package are intended to also be made available as RPC calls. This will provide the ability to invoke and control batch extraction and analysis via RPCs
+
+The "RIM" variables and attributes that are now being stored in ^TMP("GPLRIM") are intended to be maintained in a standard FILEMAN global, and to take advantage of FILEMAN indexing for efficient batch analysis and processing.
+
+It is intended that menu interfaces be provided in addition to command line interfaces for all package functions.
+
+
+
+
+
Index: ccr/tags/CCR_1_0_4/p/CCR_1_0_1_T2_CACHE.KID
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCR_1_0_1_T2_CACHE.KID	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCR_1_0_1_T2_CACHE.KID	(revision 169)
@@ -0,0 +1,8916 @@
+KIDS Distribution saved on Sep 01, 2008@17:43:26
+FIRST CCR DISTRO
+**KIDS**:CCR*1.0*1^
+
+**INSTALL NAME**
+CCR*1.0*1
+"BLD",6955,0)
+CCR*1.0*1^^0^3080901^n
+"BLD",6955,1,0)
+^^22^22^3080901^
+"BLD",6955,1,1,0)
+CCR AND CCD EXPORT TOOLS 
+"BLD",6955,1,2,0)
+ 
+"BLD",6955,1,3,0)
+SINGLE XML EXPORT TO A HOST DIRECTORY AT 
+"BLD",6955,1,4,0)
+ 
+"BLD",6955,1,5,0)
+BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
+"BLD",6955,1,6,0)
+DIRECTORY
+"BLD",6955,1,7,0)
+ 
+"BLD",6955,1,8,0)
+EXPORT^GPLCRR FOR THE CCR
+"BLD",6955,1,9,0)
+EXPORT^GPLCCD FOR THE CCD
+"BLD",6955,1,10,0)
+XPAT^GPLCCR(DFN,"","") 
+"BLD",6955,1,11,0)
+ 
+"BLD",6955,1,12,0)
+BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
+"BLD",6955,1,13,0)
+ 
+"BLD",6955,1,14,0)
+ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
+"BLD",6955,1,15,0)
+RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
+"BLD",6955,1,16,0)
+ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
+"BLD",6955,1,17,0)
+ 
+"BLD",6955,1,18,0)
+CLIST^GPLRIMA TO LIST CATEGORY TOTALS
+"BLD",6955,1,19,0)
+CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
+"BLD",6955,1,20,0)
+XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
+"BLD",6955,1,21,0)
+ 
+"BLD",6955,1,22,0)
+TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
+"BLD",6955,4,0)
+^9.64PA^^
+"BLD",6955,6.3)
+3
+"BLD",6955,"KRN",0)
+^9.67PA^8989.52^19
+"BLD",6955,"KRN",.4,0)
+.4
+"BLD",6955,"KRN",.401,0)
+.401
+"BLD",6955,"KRN",.402,0)
+.402
+"BLD",6955,"KRN",.403,0)
+.403
+"BLD",6955,"KRN",.5,0)
+.5
+"BLD",6955,"KRN",.84,0)
+.84
+"BLD",6955,"KRN",3.6,0)
+3.6
+"BLD",6955,"KRN",3.8,0)
+3.8
+"BLD",6955,"KRN",9.2,0)
+9.2
+"BLD",6955,"KRN",9.8,0)
+9.8
+"BLD",6955,"KRN",9.8,"NM",0)
+^9.68A^19^19
+"BLD",6955,"KRN",9.8,"NM",1,0)
+CCRDPT^^0^B312345713
+"BLD",6955,"KRN",9.8,"NM",2,0)
+CCRDPTT^^0^B4863621
+"BLD",6955,"KRN",9.8,"NM",3,0)
+CCRMEDS^^0^B36357726
+"BLD",6955,"KRN",9.8,"NM",4,0)
+CCRSYS^^0^B1690193
+"BLD",6955,"KRN",9.8,"NM",5,0)
+CCRUNIT^^0^B8574
+"BLD",6955,"KRN",9.8,"NM",6,0)
+CCRUTIL^^0^B17726385
+"BLD",6955,"KRN",9.8,"NM",7,0)
+CCRVA200^^0^B35847405
+"BLD",6955,"KRN",9.8,"NM",8,0)
+GPLACTOR^^0^B58306782
+"BLD",6955,"KRN",9.8,"NM",9,0)
+GPLXPATH^^0^B261673629
+"BLD",6955,"KRN",9.8,"NM",10,0)
+GPLUNIT^^0^B31630479
+"BLD",6955,"KRN",9.8,"NM",11,0)
+GPLPROBS^^0^B24846496
+"BLD",6955,"KRN",9.8,"NM",12,0)
+GPLVITAL^^0^B98509194
+"BLD",6955,"KRN",9.8,"NM",13,0)
+GPLRIMA^^0^B96435476
+"BLD",6955,"KRN",9.8,"NM",14,0)
+GPLCCR^^0^B66792391
+"BLD",6955,"KRN",9.8,"NM",15,0)
+GPLCCR0^^0^B658213703
+"BLD",6955,"KRN",9.8,"NM",16,0)
+GPLCCD^^0^B106978605
+"BLD",6955,"KRN",9.8,"NM",17,0)
+GPLCCD1^^0^B100039732
+"BLD",6955,"KRN",9.8,"NM",18,0)
+GPLMEDS^^0^B27482404
+"BLD",6955,"KRN",9.8,"NM",19,0)
+GPLXPAT0^^0^B44173297
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPT",1)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPTT",2)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS",3)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRSYS",4)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUNIT",5)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUTIL",6)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRVA200",7)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLACTOR",8)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",16)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",17)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",14)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",15)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLMEDS",18)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",11)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",13)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",10)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",12)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",19)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
+
+"BLD",6955,"KRN",19,0)
+19
+"BLD",6955,"KRN",19.1,0)
+19.1
+"BLD",6955,"KRN",101,0)
+101
+"BLD",6955,"KRN",409.61,0)
+409.61
+"BLD",6955,"KRN",771,0)
+771
+"BLD",6955,"KRN",870,0)
+870
+"BLD",6955,"KRN",8989.51,0)
+8989.51
+"BLD",6955,"KRN",8989.52,0)
+8989.52
+"BLD",6955,"KRN",8994,0)
+8994
+"BLD",6955,"KRN","B",.4,.4)
+
+"BLD",6955,"KRN","B",.401,.401)
+
+"BLD",6955,"KRN","B",.402,.402)
+
+"BLD",6955,"KRN","B",.403,.403)
+
+"BLD",6955,"KRN","B",.5,.5)
+
+"BLD",6955,"KRN","B",.84,.84)
+
+"BLD",6955,"KRN","B",3.6,3.6)
+
+"BLD",6955,"KRN","B",3.8,3.8)
+
+"BLD",6955,"KRN","B",9.2,9.2)
+
+"BLD",6955,"KRN","B",9.8,9.8)
+
+"BLD",6955,"KRN","B",19,19)
+
+"BLD",6955,"KRN","B",19.1,19.1)
+
+"BLD",6955,"KRN","B",101,101)
+
+"BLD",6955,"KRN","B",409.61,409.61)
+
+"BLD",6955,"KRN","B",771,771)
+
+"BLD",6955,"KRN","B",870,870)
+
+"BLD",6955,"KRN","B",8989.51,8989.51)
+
+"BLD",6955,"KRN","B",8989.52,8989.52)
+
+"BLD",6955,"KRN","B",8994,8994)
+
+"BLD",6955,"QUES",0)
+^9.62^^
+"BLD",6955,"REQB",0)
+^9.611^^
+"MBREQ")
+0
+"QUES","XPF1",0)
+Y
+"QUES","XPF1","??")
+^D REP^XPDH
+"QUES","XPF1","A")
+Shall I write over your |FLAG| File
+"QUES","XPF1","B")
+YES
+"QUES","XPF1","M")
+D XPF1^XPDIQ
+"QUES","XPF2",0)
+Y
+"QUES","XPF2","??")
+^D DTA^XPDH
+"QUES","XPF2","A")
+Want my data |FLAG| yours
+"QUES","XPF2","B")
+YES
+"QUES","XPF2","M")
+D XPF2^XPDIQ
+"QUES","XPI1",0)
+YO
+"QUES","XPI1","??")
+^D INHIBIT^XPDH
+"QUES","XPI1","A")
+Want KIDS to INHIBIT LOGONs during the install
+"QUES","XPI1","B")
+NO
+"QUES","XPI1","M")
+D XPI1^XPDIQ
+"QUES","XPM1",0)
+PO^VA(200,:EM
+"QUES","XPM1","??")
+^D MG^XPDH
+"QUES","XPM1","A")
+Enter the Coordinator for Mail Group '|FLAG|'
+"QUES","XPM1","B")
+
+"QUES","XPM1","M")
+D XPM1^XPDIQ
+"QUES","XPO1",0)
+Y
+"QUES","XPO1","??")
+^D MENU^XPDH
+"QUES","XPO1","A")
+Want KIDS to Rebuild Menu Trees Upon Completion of Install
+"QUES","XPO1","B")
+NO
+"QUES","XPO1","M")
+D XPO1^XPDIQ
+"QUES","XPZ1",0)
+Y
+"QUES","XPZ1","??")
+^D OPT^XPDH
+"QUES","XPZ1","A")
+Want to DISABLE Scheduled Options, Menu Options, and Protocols
+"QUES","XPZ1","B")
+NO
+"QUES","XPZ1","M")
+D XPZ1^XPDIQ
+"QUES","XPZ2",0)
+Y
+"QUES","XPZ2","??")
+^D RTN^XPDH
+"QUES","XPZ2","A")
+Want to MOVE routines to other CPUs
+"QUES","XPZ2","B")
+NO
+"QUES","XPZ2","M")
+D XPZ2^XPDIQ
+"RTN")
+19
+"RTN","CCRDPT")
+0^1^B312345713
+"RTN","CCRDPT",1,0)
+CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
+"RTN","CCRDPT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 3
+"RTN","CCRDPT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPT",5,0)
+ ;
+"RTN","CCRDPT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPT",9,0)
+ ;(at your option) any later version.
+"RTN","CCRDPT",10,0)
+ ;
+"RTN","CCRDPT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPT",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPT",15,0)
+ ;
+"RTN","CCRDPT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPT",19,0)
+    ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
+"RTN","CCRDPT",20,0)
+    ; DESTROY to clean-up.
+"RTN","CCRDPT",21,0)
+    ; The first line of every routine tests if the global exists.
+"RTN","CCRDPT",22,0)
+    ;
+"RTN","CCRDPT",23,0)
+    ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
+"RTN","CCRDPT",24,0)
+    ; INIT        9 lines  Copy DFN global to a local variable
+"RTN","CCRDPT",25,0)
+    ; DESTROY     6 lines  Kill local variable
+"RTN","CCRDPT",26,0)
+    ; FAMILY      6 lines  Family Name
+"RTN","CCRDPT",27,0)
+    ; GIVEN       6 lines  Given Name
+"RTN","CCRDPT",28,0)
+    ; MIDDLE      6 lines  Middle Name
+"RTN","CCRDPT",29,0)
+    ; SUFFIX      6 lines  Suffix Name
+"RTN","CCRDPT",30,0)
+    ; DISPNAME    5 lines  Display Name
+"RTN","CCRDPT",31,0)
+    ; DOB         6 lines  Date of Birth
+"RTN","CCRDPT",32,0)
+    ; GENDER      4 lines  Get Gender
+"RTN","CCRDPT",33,0)
+    ; SSN         4 lines  Get SSN for ID
+"RTN","CCRDPT",34,0)
+    ; ADDRTYPE    4 lines  Get Home Address
+"RTN","CCRDPT",35,0)
+    ; ADDR1       4 lines  Get Home Address line 1
+"RTN","CCRDPT",36,0)
+    ; ADDR2       5 lines  Get Home Address line 2
+"RTN","CCRDPT",37,0)
+    ; CITY        4 lines  Get City for Home Address
+"RTN","CCRDPT",38,0)
+    ; STATE      11 lines  Get State for Home Address
+"RTN","CCRDPT",39,0)
+    ; ZIP         4 lines  Get Zip code for Home Address
+"RTN","CCRDPT",40,0)
+    ; COUNTY      4 lines  Get County for our Address
+"RTN","CCRDPT",41,0)
+    ; COUNTRY     4 lines  Get Country for our Address
+"RTN","CCRDPT",42,0)
+    ; RESTEL      4 lines  Residential Telephone
+"RTN","CCRDPT",43,0)
+    ; WORKTEL     4 lines  Work Telephone
+"RTN","CCRDPT",44,0)
+    ; EMAIL       4 lines  Email Adddress
+"RTN","CCRDPT",45,0)
+    ; CELLTEL     4 lines  Cell Phone
+"RTN","CCRDPT",46,0)
+    ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
+"RTN","CCRDPT",47,0)
+    ; NOK1GIV     6 lines  NOK1 Given Name
+"RTN","CCRDPT",48,0)
+    ; NOK1MID     6 lines  NOK1 Middle Name
+"RTN","CCRDPT",49,0)
+    ; NOK1SUF     6 lines  NOK1 Suffi Name
+"RTN","CCRDPT",50,0)
+    ; NOK1DISP    5 lines  NOK1 Display Name
+"RTN","CCRDPT",51,0)
+    ; NOK1REL     4 lines  NOK1 Relationship to the patient
+"RTN","CCRDPT",52,0)
+    ; NOK1ADD1    4 lines  NOK1 Address 1
+"RTN","CCRDPT",53,0)
+    ; NOK1ADD2    5 lines  NOK1 Address 2
+"RTN","CCRDPT",54,0)
+    ; NOK1CITY    4 lines  NOK1 City
+"RTN","CCRDPT",55,0)
+    ; NOK1STAT    5 lines  NOK1 State
+"RTN","CCRDPT",56,0)
+    ; NOK1ZIP     4 lines  NOK1 Zip Code
+"RTN","CCRDPT",57,0)
+    ; NOK1HTEL;   4 lines  NOK1 Home Telephone
+"RTN","CCRDPT",58,0)
+    ; NOK1WTEL;   4 lines  NOK1 Work Telephone
+"RTN","CCRDPT",59,0)
+    ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
+"RTN","CCRDPT",60,0)
+    ; NOK2FAM     6 lines  NOK2 Family Name
+"RTN","CCRDPT",61,0)
+    ; NOK2GIV     6 lines  NOK2 Given Name
+"RTN","CCRDPT",62,0)
+    ; NOK2MID     6 lines  NOK2 Middle Name
+"RTN","CCRDPT",63,0)
+    ; NOK2SUF     5 lines  NOK2 Suffi Name
+"RTN","CCRDPT",64,0)
+    ; NOK2DISP    5 lines  NOK2 Display Name
+"RTN","CCRDPT",65,0)
+    ; NOK2REL     4 lines  NOK2 Relationship to the patient
+"RTN","CCRDPT",66,0)
+    ; NOK2ADD1    4 lines  NOK2 Address 1
+"RTN","CCRDPT",67,0)
+    ; NOK2ADD2    5 lines  NOK2 Address 2
+"RTN","CCRDPT",68,0)
+    ; NOK2CITY    4 lines  NOK2 City
+"RTN","CCRDPT",69,0)
+    ; NOK2STAT    5 lines  NOK2 State
+"RTN","CCRDPT",70,0)
+    ; NOK2ZIP     4 lines  NOK2 Zip Code
+"RTN","CCRDPT",71,0)
+    ; NOK2HTEL;   4 lines  NOK2 Home Telephone
+"RTN","CCRDPT",72,0)
+    ; NOK2WTEL;   4 lines  NOK2 Work Telephone
+"RTN","CCRDPT",73,0)
+    ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
+"RTN","CCRDPT",74,0)
+    ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
+"RTN","CCRDPT",75,0)
+    ; EMERGIV     6 lines  EMER Given Name
+"RTN","CCRDPT",76,0)
+    ; EMERMID     6 lines  EMER Middle Name
+"RTN","CCRDPT",77,0)
+    ; EMERSUF     5 lines  EMER Suffi Name
+"RTN","CCRDPT",78,0)
+    ; EMERDISP    5 lines  EMER Display Name
+"RTN","CCRDPT",79,0)
+    ; EMERREL     4 lines  EMER Relationship to the patient
+"RTN","CCRDPT",80,0)
+    ; EMERADD1    4 lines  EMER Address 1
+"RTN","CCRDPT",81,0)
+    ; EMERADD2    5 lines  EMER Address 2
+"RTN","CCRDPT",82,0)
+    ; EMERCITY    4 lines  EMER City
+"RTN","CCRDPT",83,0)
+    ; EMERSTAT    5 lines  EMER State
+"RTN","CCRDPT",84,0)
+    ; EMERZIP     4 lines  EMER Zip Code
+"RTN","CCRDPT",85,0)
+    ; EMERHTEL;   4 lines  EMER Home Telephone
+"RTN","CCRDPT",86,0)
+    ; EMERWTEL;   4 lines  EMER Work Telephone
+"RTN","CCRDPT",87,0)
+    ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
+"RTN","CCRDPT",88,0)
+    ;
+"RTN","CCRDPT",89,0)
+          W "No Entry at top!" Q
+"RTN","CCRDPT",90,0)
+   ; The following is a map of the relevant data in the patient global.
+"RTN","CCRDPT",91,0)
+    ;
+"RTN","CCRDPT",92,0)
+    ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
+"RTN","CCRDPT",93,0)
+    ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
+"RTN","CCRDPT",94,0)
+    ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
+"RTN","CCRDPT",95,0)
+    ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
+"RTN","CCRDPT",96,0)
+    ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
+"RTN","CCRDPT",97,0)
+    ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
+"RTN","CCRDPT",98,0)
+    ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
+"RTN","CCRDPT",99,0)
+    ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
+"RTN","CCRDPT",100,0)
+    ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
+"RTN","CCRDPT",101,0)
+    ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
+"RTN","CCRDPT",102,0)
+    ; ==>[21S] ^
+"RTN","CCRDPT",103,0)
+    ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
+"RTN","CCRDPT",104,0)
+    ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
+"RTN","CCRDPT",105,0)
+    ; ==>COMPONENTS [3P:20] ^
+"RTN","CCRDPT",106,0)
+    ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
+"RTN","CCRDPT",107,0)
+    ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
+"RTN","CCRDPT",108,0)
+    ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
+"RTN","CCRDPT",109,0)
+    ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
+"RTN","CCRDPT",110,0)
+    ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
+"RTN","CCRDPT",111,0)
+    ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
+"RTN","CCRDPT",112,0)
+    ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
+"RTN","CCRDPT",113,0)
+    ; ==>^
+"RTN","CCRDPT",114,0)
+    ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
+"RTN","CCRDPT",115,0)
+    ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
+"RTN","CCRDPT",116,0)
+    ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
+"RTN","CCRDPT",117,0)
+    ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
+"RTN","CCRDPT",118,0)
+    ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
+"RTN","CCRDPT",119,0)
+    ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
+"RTN","CCRDPT",120,0)
+    ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
+"RTN","CCRDPT",121,0)
+    ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
+"RTN","CCRDPT",122,0)
+    ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
+"RTN","CCRDPT",123,0)
+    ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
+"RTN","CCRDPT",124,0)
+    ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
+"RTN","CCRDPT",125,0)
+    ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
+"RTN","CCRDPT",126,0)
+    ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
+"RTN","CCRDPT",127,0)
+    ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
+"RTN","CCRDPT",128,0)
+    ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
+"RTN","CCRDPT",129,0)
+    ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
+"RTN","CCRDPT",130,0)
+    ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
+"RTN","CCRDPT",131,0)
+    ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
+"RTN","CCRDPT",132,0)
+    ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
+"RTN","CCRDPT",133,0)
+    ; ==>SITE [14P:4] ^
+"RTN","CCRDPT",134,0)
+    ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
+"RTN","CCRDPT",135,0)
+    ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
+"RTN","CCRDPT",136,0)
+    ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
+"RTN","CCRDPT",137,0)
+    ; ==>3] [5F] ^
+"RTN","CCRDPT",138,0)
+    ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
+"RTN","CCRDPT",139,0)
+    ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
+"RTN","CCRDPT",140,0)
+    ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
+"RTN","CCRDPT",141,0)
+    ; ==>^
+"RTN","CCRDPT",142,0)
+    ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
+"RTN","CCRDPT",143,0)
+    ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
+"RTN","CCRDPT",144,0)
+    ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
+"RTN","CCRDPT",145,0)
+    ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
+"RTN","CCRDPT",146,0)
+    ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
+"RTN","CCRDPT",147,0)
+    ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
+"RTN","CCRDPT",148,0)
+    ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
+"RTN","CCRDPT",149,0)
+    ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
+"RTN","CCRDPT",150,0)
+    ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
+"RTN","CCRDPT",151,0)
+    ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
+"RTN","CCRDPT",152,0)
+    ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
+"RTN","CCRDPT",153,0)
+    ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
+"RTN","CCRDPT",154,0)
+    ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
+"RTN","CCRDPT",155,0)
+    ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
+"RTN","CCRDPT",156,0)
+    ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
+"RTN","CCRDPT",157,0)
+    ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
+"RTN","CCRDPT",158,0)
+    ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
+"RTN","CCRDPT",159,0)
+    ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
+"RTN","CCRDPT",160,0)
+    ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
+"RTN","CCRDPT",161,0)
+    ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
+"RTN","CCRDPT",162,0)
+    ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
+"RTN","CCRDPT",163,0)
+    ; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
+"RTN","CCRDPT",164,0)
+    ; INPUT: Patient IEN (DFN)
+"RTN","CCRDPT",165,0)
+    ; OUTPUT: PT in the Symbol Table, representing the patient global
+"RTN","CCRDPT",166,0)
+    ; Instead of accessing a global each single read (SLOOOOW)
+"RTN","CCRDPT",167,0)
+    ; read it off a local variable stored in Memory.
+"RTN","CCRDPT",168,0)
+INIT(DFN) ;
+"RTN","CCRDPT",169,0)
+          M PT=^DPT(DFN)
+"RTN","CCRDPT",170,0)
+          Q
+"RTN","CCRDPT",171,0)
+          ;
+"RTN","CCRDPT",172,0)
+DESTROY ; Kill local variable; PUBLIC
+"RTN","CCRDPT",173,0)
+          ; INPUT: None
+"RTN","CCRDPT",174,0)
+          ; OUTPUT: Kill PT from the Symbol Table after you are done
+"RTN","CCRDPT",175,0)
+          K PT
+"RTN","CCRDPT",176,0)
+          Q
+"RTN","CCRDPT",177,0)
+          ;
+"RTN","CCRDPT",178,0)
+FAMILY() ; Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",179,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",180,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",181,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",182,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",183,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",184,0)
+          ;
+"RTN","CCRDPT",185,0)
+GIVEN() ; Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",186,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",187,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",188,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",189,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",190,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",191,0)
+          ;
+"RTN","CCRDPT",192,0)
+MIDDLE() ; Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",193,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",194,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",195,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",196,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",197,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",198,0)
+          ;
+"RTN","CCRDPT",199,0)
+SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",200,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",201,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",202,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",203,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",204,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",205,0)
+          ;
+"RTN","CCRDPT",206,0)
+DISPNAME() ; Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",207,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",208,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",209,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",210,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",211,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",212,0)
+DOB() ; Date of Birth; PUBLIC; Extrinsic
+"RTN","CCRDPT",213,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",214,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",215,0)
+          N DOB S DOB=$P(PT(0),"^",3)
+"RTN","CCRDPT",216,0)
+          ; Date in FM Date Format. Convert to UTC/ISO 8601.
+"RTN","CCRDPT",217,0)
+          Q $$FMDTOUTC^CCRUTIL(DOB,"D")
+"RTN","CCRDPT",218,0)
+          ;
+"RTN","CCRDPT",219,0)
+GENDER() ; Get Gender; PUBLIC; Extrinsic
+"RTN","CCRDPT",220,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",221,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",222,0)
+          Q $P(PT(0),"^",2)
+"RTN","CCRDPT",223,0)
+          ;
+"RTN","CCRDPT",224,0)
+SSN() ; Get SSN for ID; PUBLIC; Extrinsic
+"RTN","CCRDPT",225,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",226,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",227,0)
+          Q $P(PT(0),"^",9)
+"RTN","CCRDPT",228,0)
+          ;
+"RTN","CCRDPT",229,0)
+ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",230,0)
+          ; Vista only stores a home address for the patient.
+"RTN","CCRDPT",231,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",232,0)
+          Q "Home"
+"RTN","CCRDPT",233,0)
+          ;
+"RTN","CCRDPT",234,0)
+ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",235,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",236,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",237,0)
+          Q $P(PT(.11),"^",1)
+"RTN","CCRDPT",238,0)
+          ;
+"RTN","CCRDPT",239,0)
+ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",240,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",241,0)
+          ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
+"RTN","CCRDPT",242,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",243,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",244,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",245,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",246,0)
+          Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
+"RTN","CCRDPT",247,0)
+          Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
+"RTN","CCRDPT",248,0)
+          ;
+"RTN","CCRDPT",249,0)
+CITY() ; Get City for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",250,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",251,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",252,0)
+          Q $P(PT(.11),"^",4)
+"RTN","CCRDPT",253,0)
+          ;
+"RTN","CCRDPT",254,0)
+STATE() ; Get State for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",255,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",256,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",257,0)
+          ; State is stored as a pointer
+"RTN","CCRDPT",258,0)
+          N STATENUM S STATENUM=$P(PT(.11),"^",5)
+"RTN","CCRDPT",259,0)
+          ;
+"RTN","CCRDPT",260,0)
+          ; State File Global is below
+"RTN","CCRDPT",261,0)
+          ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
+"RTN","CCRDPT",262,0)
+          ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
+"RTN","CCRDPT",263,0)
+          ; ==>US STATE OR POSSESSION [6S] ^
+"RTN","CCRDPT",264,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",265,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",266,0)
+          ;
+"RTN","CCRDPT",267,0)
+ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",268,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",269,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",270,0)
+          Q $P(PT(.11),"^",6)
+"RTN","CCRDPT",271,0)
+          ;
+"RTN","CCRDPT",272,0)
+COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",273,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",274,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",275,0)
+          Q $P(PT(.11),"^",7)
+"RTN","CCRDPT",276,0)
+          ;
+"RTN","CCRDPT",277,0)
+COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",278,0)
+          ; Unfortunately, I can't find where that is stored, so the inevitable...
+"RTN","CCRDPT",279,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",280,0)
+          Q "USA"
+"RTN","CCRDPT",281,0)
+          ;
+"RTN","CCRDPT",282,0)
+RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",283,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",284,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",285,0)
+          Q $P(PT(.13),"^",1)
+"RTN","CCRDPT",286,0)
+          ;
+"RTN","CCRDPT",287,0)
+WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",288,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",289,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",290,0)
+          Q $P(PT(.13),"^",2)
+"RTN","CCRDPT",291,0)
+          ;
+"RTN","CCRDPT",292,0)
+EMAIL() ; Email Adddress; PUBLIC; Extrinsic
+"RTN","CCRDPT",293,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",294,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",295,0)
+          Q $P(PT(.13),"^",3)
+"RTN","CCRDPT",296,0)
+          ;
+"RTN","CCRDPT",297,0)
+CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
+"RTN","CCRDPT",298,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",299,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",300,0)
+          Q $P(PT(.13),"^",4)
+"RTN","CCRDPT",301,0)
+          ;
+"RTN","CCRDPT",302,0)
+NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",303,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",304,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",305,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",306,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",307,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",308,0)
+          ;
+"RTN","CCRDPT",309,0)
+NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",310,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",311,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",312,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",313,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",314,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",315,0)
+          ;
+"RTN","CCRDPT",316,0)
+NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",317,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",318,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",319,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",320,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",321,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",322,0)
+          ;
+"RTN","CCRDPT",323,0)
+NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",324,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",325,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",326,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",327,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",328,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",329,0)
+          ;
+"RTN","CCRDPT",330,0)
+NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",331,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",332,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",333,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",334,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",335,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",336,0)
+NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",337,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",338,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",339,0)
+          Q $P(PT(.21),"^",2)
+"RTN","CCRDPT",340,0)
+          ;
+"RTN","CCRDPT",341,0)
+NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",342,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",343,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",344,0)
+          Q $P(PT(.21),"^",3)
+"RTN","CCRDPT",345,0)
+          ;
+"RTN","CCRDPT",346,0)
+NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",347,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",348,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",349,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",350,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",351,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",352,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",353,0)
+          Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
+"RTN","CCRDPT",354,0)
+          Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
+"RTN","CCRDPT",355,0)
+          ;
+"RTN","CCRDPT",356,0)
+NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",357,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",358,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",359,0)
+          Q $P(PT(.21),"^",6)
+"RTN","CCRDPT",360,0)
+          ;
+"RTN","CCRDPT",361,0)
+NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",362,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",363,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",364,0)
+          N STATENUM S STATENUM=$P(PT(.21),"^",7)
+"RTN","CCRDPT",365,0)
+          Q:STATENUM="" ""
+"RTN","CCRDPT",366,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",367,0)
+          ;
+"RTN","CCRDPT",368,0)
+NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",369,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",370,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",371,0)
+          Q $P(PT(.21),"^",8)
+"RTN","CCRDPT",372,0)
+          ;
+"RTN","CCRDPT",373,0)
+NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",374,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",375,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",376,0)
+          Q $P(PT(.21),"^",9)
+"RTN","CCRDPT",377,0)
+          ;
+"RTN","CCRDPT",378,0)
+NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",379,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",380,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",381,0)
+          Q $P(PT(.21),"^",11)
+"RTN","CCRDPT",382,0)
+          ;
+"RTN","CCRDPT",383,0)
+NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",384,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",385,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",386,0)
+          Q $P(PT(.21),"^",10)
+"RTN","CCRDPT",387,0)
+          ;
+"RTN","CCRDPT",388,0)
+NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",389,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",390,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",391,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",392,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",393,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",394,0)
+          ;
+"RTN","CCRDPT",395,0)
+NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
+"RTN","CCRDPT",396,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",397,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",398,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",399,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",400,0)
+          ;
+"RTN","CCRDPT",401,0)
+NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",402,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",403,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",404,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",405,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",406,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",407,0)
+          ;
+"RTN","CCRDPT",408,0)
+NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",409,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",410,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",411,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",412,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",413,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",414,0)
+NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",415,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",416,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",417,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",418,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",419,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",420,0)
+NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",421,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",422,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",423,0)
+          Q $P(PT(.211),"^",2)
+"RTN","CCRDPT",424,0)
+          ;
+"RTN","CCRDPT",425,0)
+NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",426,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",427,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",428,0)
+          Q $P(PT(.211),"^",3)
+"RTN","CCRDPT",429,0)
+          ;
+"RTN","CCRDPT",430,0)
+NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",431,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",432,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",433,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",434,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",435,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",436,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",437,0)
+          Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
+"RTN","CCRDPT",438,0)
+          Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
+"RTN","CCRDPT",439,0)
+          ;
+"RTN","CCRDPT",440,0)
+NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",441,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",442,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",443,0)
+          Q $P(PT(.211),"^",6)
+"RTN","CCRDPT",444,0)
+          ;
+"RTN","CCRDPT",445,0)
+NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",446,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",447,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",448,0)
+          N STATENUM S STATENUM=$P(PT(.211),"^",7)
+"RTN","CCRDPT",449,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",450,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",451,0)
+          ;
+"RTN","CCRDPT",452,0)
+NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",453,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",454,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",455,0)
+          Q $P(PT(.211),"^",8)
+"RTN","CCRDPT",456,0)
+          ;
+"RTN","CCRDPT",457,0)
+NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",458,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",459,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",460,0)
+          Q $P(PT(.211),"^",9)
+"RTN","CCRDPT",461,0)
+          ;
+"RTN","CCRDPT",462,0)
+NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",463,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",464,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",465,0)
+          Q $P(PT(.211),"^",11)
+"RTN","CCRDPT",466,0)
+          ;
+"RTN","CCRDPT",467,0)
+NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",468,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",469,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",470,0)
+          Q $P(PT(.211),"^",10)
+"RTN","CCRDPT",471,0)
+          ;
+"RTN","CCRDPT",472,0)
+EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",473,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",474,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",475,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",476,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",477,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",478,0)
+          ;
+"RTN","CCRDPT",479,0)
+EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",480,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",481,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",482,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",483,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",484,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",485,0)
+          ;
+"RTN","CCRDPT",486,0)
+EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",487,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",488,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",489,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",490,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",491,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",492,0)
+          ;
+"RTN","CCRDPT",493,0)
+EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",494,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",495,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",496,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",497,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",498,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",499,0)
+EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",500,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",501,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",502,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",503,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",504,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",505,0)
+EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",506,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",507,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",508,0)
+          Q $P(PT(.33),"^",2)
+"RTN","CCRDPT",509,0)
+          ;
+"RTN","CCRDPT",510,0)
+EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",511,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",512,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",513,0)
+          Q $P(PT(.33),"^",3)
+"RTN","CCRDPT",514,0)
+          ;
+"RTN","CCRDPT",515,0)
+EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",516,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",517,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",518,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",519,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",520,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",521,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",522,0)
+          Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
+"RTN","CCRDPT",523,0)
+          Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
+"RTN","CCRDPT",524,0)
+          ;
+"RTN","CCRDPT",525,0)
+EMERCITY() ; EMER City; PUBLIC; Extrinsic
+"RTN","CCRDPT",526,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",527,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",528,0)
+          Q $P(PT(.33),"^",6)
+"RTN","CCRDPT",529,0)
+          ;
+"RTN","CCRDPT",530,0)
+EMERSTAT() ; EMER State; PUBLIC; Extrinsic
+"RTN","CCRDPT",531,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",532,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",533,0)
+          N STATENUM S STATENUM=$P(PT(.33),"^",7)
+"RTN","CCRDPT",534,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",535,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",536,0)
+          ;
+"RTN","CCRDPT",537,0)
+EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",538,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",539,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",540,0)
+          Q $P(PT(.33),"^",8)
+"RTN","CCRDPT",541,0)
+          ;
+"RTN","CCRDPT",542,0)
+EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",543,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",544,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",545,0)
+          Q $P(PT(.33),"^",9)
+"RTN","CCRDPT",546,0)
+          ;
+"RTN","CCRDPT",547,0)
+EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",548,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",549,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",550,0)
+          Q $P(PT(.33),"^",11)
+"RTN","CCRDPT",551,0)
+          ;
+"RTN","CCRDPT",552,0)
+EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
+"RTN","CCRDPT",553,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",554,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",555,0)
+          Q $P(PT(.33),"^",10)
+"RTN","CCRDPT",556,0)
+          ;
+"RTN","CCRDPTT")
+0^2^B4863621
+"RTN","CCRDPTT",1,0)
+CCRDPTT ; Unit Tester...
+"RTN","CCRDPTT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 3
+"RTN","CCRDPTT",3,0)
+ ;
+"RTN","CCRDPTT",4,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPTT",5,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPTT",6,0)
+ ;
+"RTN","CCRDPTT",7,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPTT",8,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPTT",9,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPTT",10,0)
+ ;(at your option) any later version.
+"RTN","CCRDPTT",11,0)
+ ;
+"RTN","CCRDPTT",12,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPTT",13,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPTT",14,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPTT",15,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPTT",16,0)
+ ;
+"RTN","CCRDPTT",17,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPTT",18,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPTT",19,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPTT",20,0)
+          ; Get the functions in the routine using Rick's routine
+"RTN","CCRDPTT",21,0)
+          ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
+"RTN","CCRDPTT",22,0)
+          ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
+"RTN","CCRDPTT",23,0)
+          ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
+"RTN","CCRDPTT",24,0)
+          ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
+"RTN","CCRDPTT",25,0)
+          ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
+"RTN","CCRDPTT",26,0)
+          ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",27,0)
+          ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",28,0)
+          ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
+"RTN","CCRDPTT",29,0)
+          ; etc.
+"RTN","CCRDPTT",30,0)
+          ;
+"RTN","CCRDPTT",31,0)
+          ; Load Routine Entry points; We get a sweeeeeet array
+"RTN","CCRDPTT",32,0)
+          D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
+"RTN","CCRDPTT",33,0)
+          N X,Y
+"RTN","CCRDPTT",34,0)
+          ; Select Patient
+"RTN","CCRDPTT",35,0)
+          S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","CCRDPTT",36,0)
+          ;
+"RTN","CCRDPTT",37,0)
+          W "You have selected patient "_Y,!!
+"RTN","CCRDPTT",38,0)
+          D INIT^CCRDPT($P(Y,"^"))
+"RTN","CCRDPTT",39,0)
+          ; ZWR PT
+"RTN","CCRDPTT",40,0)
+          N I S I=165 F  S I=$O(OUT(I)) Q:I=""  D
+"RTN","CCRDPTT",41,0)
+          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
+"RTN","CCRDPTT",42,0)
+          . W "valued at "
+"RTN","CCRDPTT",43,0)
+          . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
+"RTN","CCRDPTT",44,0)
+          . W !
+"RTN","CCRDPTT",45,0)
+          Q
+"RTN","CCRMEDS")
+0^3^B36357726
+"RTN","CCRMEDS",1,0)
+CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
+"RTN","CCRMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 3
+"RTN","CCRMEDS",3,0)
+   ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRMEDS",4,0)
+   ; General Public License See attached copy of the License.
+"RTN","CCRMEDS",5,0)
+   ; 
+"RTN","CCRMEDS",6,0)
+   ; This program is free software; you can redistribute it and/or modify
+"RTN","CCRMEDS",7,0)
+   ; it under the terms of the GNU General Public License as published by
+"RTN","CCRMEDS",8,0)
+   ; the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRMEDS",9,0)
+   ; (at your option) any later version.
+"RTN","CCRMEDS",10,0)
+   ; 
+"RTN","CCRMEDS",11,0)
+   ; This program is distributed in the hope that it will be useful,
+"RTN","CCRMEDS",12,0)
+   ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRMEDS",13,0)
+   ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRMEDS",14,0)
+   ; GNU General Public License for more details.
+"RTN","CCRMEDS",15,0)
+   ; 
+"RTN","CCRMEDS",16,0)
+   ; You should have received a copy of the GNU General Public License along
+"RTN","CCRMEDS",17,0)
+   ; with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRMEDS",18,0)
+   ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRMEDS",19,0)
+   ;
+"RTN","CCRMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","CCRMEDS",21,0)
+   Q
+"RTN","CCRMEDS",22,0)
+   ;
+"RTN","CCRMEDS",23,0)
+EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","CCRMEDS",24,0)
+   ;
+"RTN","CCRMEDS",25,0)
+   ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","CCRMEDS",26,0)
+   ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","CCRMEDS",27,0)
+   ; 
+"RTN","CCRMEDS",28,0)
+   ; MEDS is return array from RPC.
+"RTN","CCRMEDS",29,0)
+   ; MAP is a mapping variable map (store result) for each med
+"RTN","CCRMEDS",30,0)
+   ; MED is holds each array element from MEDS(J), one medicine
+"RTN","CCRMEDS",31,0)
+   ; J is a counter.
+"RTN","CCRMEDS",32,0)
+   ;
+"RTN","CCRMEDS",33,0)
+   ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+"RTN","CCRMEDS",34,0)
+   ; med data available.
+"RTN","CCRMEDS",35,0)
+   ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+"RTN","CCRMEDS",36,0)
+   ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+"RTN","CCRMEDS",37,0)
+ 
+"RTN","CCRMEDS",38,0)
+   N MEDS,MAP
+"RTN","CCRMEDS",39,0)
+   K ^TMP($J)
+"RTN","CCRMEDS",40,0)
+   D RX^PSO52API(DFN,"CCDCCR")
+"RTN","CCRMEDS",41,0)
+   M MEDS=^TMP($J,"CCDCCR",DFN)
+"RTN","CCRMEDS",42,0)
+   ; @(0) contains the number of meds or -1^NO DATA FOUND
+"RTN","CCRMEDS",43,0)
+   ; If it is -1, we quit.
+"RTN","CCRMEDS",44,0)
+   I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT  
+"RTN","CCRMEDS",45,0)
+   I DEBUG ZWR MEDS
+"RTN","CCRMEDS",46,0)
+   N RXIEN S RXIEN=0
+"RTN","CCRMEDS",47,0)
+   F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+"RTN","CCRMEDS",48,0)
+   . I DEBUG W "RXIEN IS ",RXIEN,!
+"RTN","CCRMEDS",49,0)
+   . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J))
+"RTN","CCRMEDS",50,0)
+   . K @MAP
+"RTN","CCRMEDS",51,0)
+   . I DEBUG W "MAP= ",MAP,!
+"RTN","CCRMEDS",52,0)
+   . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+"RTN","CCRMEDS",53,0)
+   . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+"RTN","CCRMEDS",54,0)
+   . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+"RTN","CCRMEDS",55,0)
+   . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
+"RTN","CCRMEDS",56,0)
+   . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+"RTN","CCRMEDS",57,0)
+   . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
+"RTN","CCRMEDS",58,0)
+   . S @MAP@("MEDRXNOTXT")="Prescription Number"
+"RTN","CCRMEDS",59,0)
+   . S @MAP@("MEDRXNO")=MED(.01)
+"RTN","CCRMEDS",60,0)
+   . S @MAP@("MEDTYPETEXT")="Medication"
+"RTN","CCRMEDS",61,0)
+   . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+"RTN","CCRMEDS",62,0)
+   . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+"RTN","CCRMEDS",63,0)
+   . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+"RTN","CCRMEDS",64,0)
+   . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+"RTN","CCRMEDS",65,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
+"RTN","CCRMEDS",66,0)
+   . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+"RTN","CCRMEDS",67,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
+"RTN","CCRMEDS",68,0)
+   . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+"RTN","CCRMEDS",69,0)
+   . N MEDIEN S MEDIEN=$P(MED(6),U)
+"RTN","CCRMEDS",70,0)
+   . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","CCRMEDS",71,0)
+   . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","CCRMEDS",72,0)
+   . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","CCRMEDS",73,0)
+   . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","CCRMEDS",74,0)
+   . ; Units, concentration, etc, come from another call
+"RTN","CCRMEDS",75,0)
+   . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","CCRMEDS",76,0)
+   . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","CCRMEDS",77,0)
+   . ; NDF Entry IEN, and VA Product Name
+"RTN","CCRMEDS",78,0)
+   . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",79,0)
+   . ; Documented in the same manual.
+"RTN","CCRMEDS",80,0)
+   . N IEN S IEN=^PSDRUG($P(MED(6),U))
+"RTN","CCRMEDS",81,0)
+   . D NDF^PSS50(IEN,,,,,"CONC")
+"RTN","CCRMEDS",82,0)
+   . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN)
+"RTN","CCRMEDS",83,0)
+   . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","CCRMEDS",84,0)
+   . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","CCRMEDS",85,0)
+   . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","CCRMEDS",86,0)
+   . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","CCRMEDS",87,0)
+   . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","CCRMEDS",88,0)
+   . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","CCRMEDS",89,0)
+   . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
+"RTN","CCRMEDS",90,0)
+   . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+"RTN","CCRMEDS",91,0)
+   . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","CCRMEDS",92,0)
+   . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","CCRMEDS",93,0)
+   . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",94,0)
+   . ; Node 14.5 is the Dispense Unit
+"RTN","CCRMEDS",95,0)
+   . D DATA^PSS50(IEN,,,,,"QTY")
+"RTN","CCRMEDS",96,0)
+   . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN)
+"RTN","CCRMEDS",97,0)
+   . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","CCRMEDS",98,0)
+   . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""
+"RTN","CCRMEDS",99,0)
+   . S @MAP@("MEDDOSEINDICATOR")
+"RTN","CCRMEDS",100,0)
+   . S @MAP@("MEDDELIVERYMETHOD")
+"RTN","CCRMEDS",101,0)
+   . S @MAP@("MEDDOSEVALUE")
+"RTN","CCRMEDS",102,0)
+   . S @MAP@("MEDDOSEUNIT")
+"RTN","CCRMEDS",103,0)
+   . S @MAP@("MEDRATEVALUE")
+"RTN","CCRMEDS",104,0)
+   . S @MAP@("MEDRATEUNIT")
+"RTN","CCRMEDS",105,0)
+   . S @MAP@("MEDVEHICLETEXT")
+"RTN","CCRMEDS",106,0)
+   . S @MAP@("MEDDIRECTIONROUTETEXT")
+"RTN","CCRMEDS",107,0)
+   . S @MAP@("MEDFREQUENCYVALUE")
+"RTN","CCRMEDS",108,0)
+   . S @MAP@("MEDFREQUENCYUNIT")
+"RTN","CCRMEDS",109,0)
+   . S @MAP@("MEDINTERVALVALUE")
+"RTN","CCRMEDS",110,0)
+   . S @MAP@("MEDINTERVALUNIT")
+"RTN","CCRMEDS",111,0)
+   . S @MAP@("MEDDURATIONVALUE")
+"RTN","CCRMEDS",112,0)
+   . S @MAP@("MEDDURATIONUNIT")
+"RTN","CCRMEDS",113,0)
+   . S @MAP@("MEDPRNFLAG")
+"RTN","CCRMEDS",114,0)
+   . S @MAP@("MEDPROBLEMOBJECTID")=""
+"RTN","CCRMEDS",115,0)
+   . S @MAP@("MEDPROBLEMDESCRIPTION")=""
+"RTN","CCRMEDS",116,0)
+   . S @MAP@("MEDPROBLEMCODEVALUE")=""
+"RTN","CCRMEDS",117,0)
+   . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
+"RTN","CCRMEDS",118,0)
+   . S @MAP@("MEDPROBLEMCODINGVERSION")=""
+"RTN","CCRMEDS",119,0)
+   . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
+"RTN","CCRMEDS",120,0)
+   . S @MAP@("MEDSTOPINDICATOR")
+"RTN","CCRMEDS",121,0)
+   . S @MAP@("MEDDIRSEQ")
+"RTN","CCRMEDS",122,0)
+   . S @MAP@("MEDMULDIRMOD")
+"RTN","CCRMEDS",123,0)
+   . S @MAP@("MEDPTINSTRUCTIONS")
+"RTN","CCRMEDS",124,0)
+   . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")
+"RTN","CCRMEDS",125,0)
+   . S @MAP@("MEDRFNO")=MED(9)
+"RTN","CCRMEDS",126,0)
+   . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J))
+"RTN","CCRMEDS",127,0)
+   . K @RESULT
+"RTN","CCRMEDS",128,0)
+   . D MAP^GPLXPATH(INXML,MAP,RESULT)
+"RTN","CCRMEDS",129,0)
+   . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+"RTN","CCRMEDS",130,0)
+   . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+"RTN","CCRMEDS",131,0)
+   N MEDTMP,MEDI
+"RTN","CCRMEDS",132,0)
+   D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","CCRMEDS",133,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","CCRMEDS",134,0)
+   . W "MEDICATION MISSING ",!
+"RTN","CCRMEDS",135,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","CCRMEDS",136,0)
+   Q
+"RTN","CCRMEDS",137,0)
+   ;
+"RTN","CCRSYS")
+0^4^B1690193
+"RTN","CCRSYS",1,0)
+CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
+"RTN","CCRSYS",2,0)
+        ;;0.1;CCDCCR;;;Build 3
+"RTN","CCRSYS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRSYS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRSYS",5,0)
+ ;
+"RTN","CCRSYS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRSYS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRSYS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRSYS",9,0)
+ ;(at your option) any later version.
+"RTN","CCRSYS",10,0)
+ ;
+"RTN","CCRSYS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRSYS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRSYS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRSYS",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRSYS",15,0)
+ ;
+"RTN","CCRSYS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRSYS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRSYS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRSYS",19,0)
+    ;
+"RTN","CCRSYS",20,0)
+        W "Enter at appropriate points." Q
+"RTN","CCRSYS",21,0)
+        ;
+"RTN","CCRSYS",22,0)
+        ; Originally, I was going to use VEPERVER, but VEPERVER
+"RTN","CCRSYS",23,0)
+        ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
+"RTN","CCRSYS",24,0)
+        ; manner (press any key to continue),
+"RTN","CCRSYS",25,0)
+        ; and is really a very half finished routine
+"RTN","CCRSYS",26,0)
+        ;
+"RTN","CCRSYS",27,0)
+        ; So for now, I am hard-coding the values.
+"RTN","CCRSYS",28,0)
+        ;
+"RTN","CCRSYS",29,0)
+SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
+"RTN","CCRSYS",30,0)
+        Q "WorldVistA EHR/VOE"
+"RTN","CCRSYS",31,0)
+        ;
+"RTN","CCRSYS",32,0)
+SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
+"RTN","CCRSYS",33,0)
+        Q "1.0"
+"RTN","CCRSYS",34,0)
+        ;
+"RTN","CCRUNIT")
+0^5^B8574
+"RTN","CCRUNIT",1,0)
+CCRUNIT ; A routine that tests some crap
+"RTN","CCRUNIT",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 3
+"RTN","CCRUNIT",3,0)
+        Q
+"RTN","CCRUNIT",4,0)
+        ;
+"RTN","CCRUNIT",5,0)
+MEDS
+"RTN","CCRUNIT",6,0)
+        N DEBUG S DEBUG=0
+"RTN","CCRUNIT",7,0)
+        N DFN S DFN=1
+"RTN","CCRUNIT",8,0)
+        K ^TMP($J)
+"RTN","CCRUNIT",9,0)
+        W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+"RTN","CCRUNIT",10,0)
+        N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
+"RTN","CCRUNIT",11,0)
+        B
+"RTN","CCRUNIT",12,0)
+        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+"RTN","CCRUNIT",13,0)
+        W "XPATH is: "_XPATH,!
+"RTN","CCRUNIT",14,0)
+        W "Getting Med Template into INXML using",!
+"RTN","CCRUNIT",15,0)
+        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+"RTN","CCRUNIT",16,0)
+        N INXML
+"RTN","CCRUNIT",17,0)
+        D QUERY^GPLXPATH(T,XPATH,"INXML")
+"RTN","CCRUNIT",18,0)
+        B
+"RTN","CCRUNIT",19,0)
+        W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
+"RTN","CCRUNIT",20,0)
+        W "OUTXML will be ^TMP($J,""OUT"")",!
+"RTN","CCRUNIT",21,0)
+        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+"RTN","CCRUNIT",22,0)
+        D EXTRACT^GPLMEDS("INXML",DFN,OUTXML)
+"RTN","CCRUNIT",23,0)
+        Q
+"RTN","CCRUTIL")
+0^6^B17726385
+"RTN","CCRUTIL",1,0)
+CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
+"RTN","CCRUTIL",2,0)
+          ;;0.1;CCRCCD;;Jun 15, 2008;Build 3
+"RTN","CCRUTIL",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRUTIL",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRUTIL",5,0)
+ ;
+"RTN","CCRUTIL",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRUTIL",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRUTIL",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRUTIL",9,0)
+ ;(at your option) any later version.
+"RTN","CCRUTIL",10,0)
+ ;
+"RTN","CCRUTIL",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRUTIL",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRUTIL",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRUTIL",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRUTIL",15,0)
+ ;
+"RTN","CCRUTIL",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRUTIL",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRUTIL",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRUTIL",19,0)
+    ;
+"RTN","CCRUTIL",20,0)
+          W "No Entry at Top!"
+"RTN","CCRUTIL",21,0)
+          Q
+"RTN","CCRUTIL",22,0)
+          ;
+"RTN","CCRUTIL",23,0)
+FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
+"RTN","CCRUTIL",24,0)
+          ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+"RTN","CCRUTIL",25,0)
+          ; If not passed, or passed incorrectly, it's assumed that it is D.
+"RTN","CCRUTIL",26,0)
+          ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+"RTN","CCRUTIL",27,0)
+          ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+"RTN","CCRUTIL",28,0)
+          ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+"RTN","CCRUTIL",29,0)
+          N UTC,Y,M,D,H,MM,S,OFF
+"RTN","CCRUTIL",30,0)
+          S Y=1700+$E(DATE,1,3)
+"RTN","CCRUTIL",31,0)
+          S M=$E(DATE,4,5)
+"RTN","CCRUTIL",32,0)
+          S D=$E(DATE,6,7)
+"RTN","CCRUTIL",33,0)
+          S H=$E(DATE,9,10)
+"RTN","CCRUTIL",34,0)
+          I $L(H)=1 S H="0"_H
+"RTN","CCRUTIL",35,0)
+          S MM=$E(DATE,11,12)
+"RTN","CCRUTIL",36,0)
+          I $L(MM)=1 S MM="0"_MM
+"RTN","CCRUTIL",37,0)
+          S S=$E(DATE,13,14)
+"RTN","CCRUTIL",38,0)
+          I $L(S)=1 S S="0"_S
+"RTN","CCRUTIL",39,0)
+          S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+"RTN","CCRUTIL",40,0)
+          ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+"RTN","CCRUTIL",41,0)
+          ; In this case, set H, MM and S to "00"
+"RTN","CCRUTIL",42,0)
+          ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
+"RTN","CCRUTIL",43,0)
+          S:'$L(H) H="00"
+"RTN","CCRUTIL",44,0)
+          S:'$L(MM) MM="00"
+"RTN","CCRUTIL",45,0)
+          S:'$L(S) S="00"
+"RTN","CCRUTIL",46,0)
+          S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+"RTN","CCRUTIL",47,0)
+          I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+"RTN","CCRUTIL",48,0)
+          E  Q $P(UTC,"T")
+"RTN","CCRUTIL",49,0)
+          ;
+"RTN","CCRUTIL",50,0)
+SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+"RTN","CCRUTIL",51,0)
+               ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+"RTN","CCRUTIL",52,0)
+               ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+"RTN","CCRUTIL",53,0)
+               ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+"RTN","CCRUTIL",54,0)
+               ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+"RTN","CCRUTIL",55,0)
+               ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+"RTN","CCRUTIL",56,0)
+               ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+"RTN","CCRUTIL",57,0)
+               ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+"RTN","CCRUTIL",58,0)
+          N VSRT ; TEMP FOR HASHING DATES
+"RTN","CCRUTIL",59,0)
+          N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+"RTN","CCRUTIL",60,0)
+          S ZCNT=0 ; COUNTING NUMBER OF DATES
+"RTN","CCRUTIL",61,0)
+          S ZTMP="" ;
+"RTN","CCRUTIL",62,0)
+          F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
+"RTN","CCRUTIL",63,0)
+          . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","CCRUTIL",64,0)
+          . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
+"RTN","CCRUTIL",65,0)
+          . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
+"RTN","CCRUTIL",66,0)
+          . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
+"RTN","CCRUTIL",67,0)
+          . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
+"RTN","CCRUTIL",68,0)
+          . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
+"RTN","CCRUTIL",69,0)
+          . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
+"RTN","CCRUTIL",70,0)
+          . I DEBUG W "ZTMP=",ZTMP," "
+"RTN","CCRUTIL",71,0)
+          S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
+"RTN","CCRUTIL",72,0)
+          ; I DEBUG ZWR V2
+"RTN","CCRUTIL",73,0)
+          ; I DEBUG ZWR VSRT
+"RTN","CCRUTIL",74,0)
+          N ZD,ZT ; DATA AND TIME ITERATORS
+"RTN","CCRUTIL",75,0)
+          N ZDONE ; DONE FLAG
+"RTN","CCRUTIL",76,0)
+          S (ZD,ZT)=""
+"RTN","CCRUTIL",77,0)
+          S ZDONE=0
+"RTN","CCRUTIL",78,0)
+          N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
+"RTN","CCRUTIL",79,0)
+          S UORDR=ORDR ; DIRECTION TO SORT
+"RTN","CCRUTIL",80,0)
+          I ORDR="" S UORDR=1
+"RTN","CCRUTIL",81,0)
+          N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
+"RTN","CCRUTIL",82,0)
+          F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
+"RTN","CCRUTIL",83,0)
+          . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE
+"RTN","CCRUTIL",84,0)
+          . I ZD="" S ZDONE=1
+"RTN","CCRUTIL",85,0)
+          . I 'ZDONE D  ; MORE DATES
+"RTN","CCRUTIL",86,0)
+          . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
+"RTN","CCRUTIL",87,0)
+          . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
+"RTN","CCRUTIL",88,0)
+          . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
+"RTN","CCRUTIL",89,0)
+          . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
+"RTN","CCRUTIL",90,0)
+          . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
+"RTN","CCRUTIL",91,0)
+          Q ZCNT
+"RTN","CCRUTIL",92,0)
+          ;
+"RTN","CCRVA200")
+0^7^B35847405
+"RTN","CCRVA200",1,0)
+CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
+"RTN","CCRVA200",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 3
+"RTN","CCRVA200",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRVA200",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRVA200",5,0)
+ ;
+"RTN","CCRVA200",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRVA200",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRVA200",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRVA200",9,0)
+ ;(at your option) any later version.
+"RTN","CCRVA200",10,0)
+ ;
+"RTN","CCRVA200",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRVA200",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRVA200",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRVA200",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRVA200",15,0)
+ ;
+"RTN","CCRVA200",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRVA200",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRVA200",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRVA200",19,0)
+        Q
+"RTN","CCRVA200",20,0)
+        ; This routine uses Kernel APIs and Direct Global Access to get
+"RTN","CCRVA200",21,0)
+        ; Proivder Data from File 200.
+"RTN","CCRVA200",22,0)
+        ;
+"RTN","CCRVA200",23,0)
+        ; The Global is VA(200,*)
+"RTN","CCRVA200",24,0)
+        ;
+"RTN","CCRVA200",25,0)
+FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",26,0)
+        ; INPUT: DUZ (i.e. File 200 IEN) ByVal
+"RTN","CCRVA200",27,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",28,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",29,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",30,0)
+        Q NAME("FAMILY")
+"RTN","CCRVA200",31,0)
+        ;
+"RTN","CCRVA200",32,0)
+GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",33,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",34,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",35,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",36,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",37,0)
+        Q NAME("GIVEN")
+"RTN","CCRVA200",38,0)
+        ;
+"RTN","CCRVA200",39,0)
+MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",40,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",41,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",42,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",43,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",44,0)
+        Q NAME("MIDDLE")
+"RTN","CCRVA200",45,0)
+        ;
+"RTN","CCRVA200",46,0)
+SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",47,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",48,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",49,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",50,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",51,0)
+        Q NAME("SUFFIX")
+"RTN","CCRVA200",52,0)
+        ;
+"RTN","CCRVA200",53,0)
+TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",54,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",55,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",56,0)
+        ; Gets External Value of Title field in New Person File.
+"RTN","CCRVA200",57,0)
+        ; It's actually a pointer to file 3.1
+"RTN","CCRVA200",58,0)
+        ; 200=New Person File; 8 is Title Field
+"RTN","CCRVA200",59,0)
+        Q $$GET1^DIQ(200,DUZ_",",8)
+"RTN","CCRVA200",60,0)
+        ;
+"RTN","CCRVA200",61,0)
+NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",62,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",63,0)
+        ; OUTPUT: Delimited String in format:
+"RTN","CCRVA200",64,0)
+        ;       IDType^ID^IDDescription
+"RTN","CCRVA200",65,0)
+        ; If the NPI doesn't exist, "" is returned.
+"RTN","CCRVA200",66,0)
+        ; This routine uses a call documented in the Kernel dev guide
+"RTN","CCRVA200",67,0)
+        ; This call returns as "NPI^TimeEntered^ActiveInactive"
+"RTN","CCRVA200",68,0)
+        ; It returns -1 for NPI if NPI doesn't exist.
+"RTN","CCRVA200",69,0)
+        N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+"RTN","CCRVA200",70,0)
+        Q:NPI=-1 ""
+"RTN","CCRVA200",71,0)
+        Q "NPI^"_NPI_"^HHS"
+"RTN","CCRVA200",72,0)
+        ;
+"RTN","CCRVA200",73,0)
+SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",74,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",75,0)
+        ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
+"RTN","CCRVA200",76,0)
+        ; Uses a Kernel API. Returns -1 if a specialty is not specified
+"RTN","CCRVA200",77,0)
+        ;       in file 200.
+"RTN","CCRVA200",78,0)
+        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
+"RTN","CCRVA200",79,0)
+        N STR S STR=$$GET^XUA4A72(DUZ)
+"RTN","CCRVA200",80,0)
+        Q:+STR<0 ""
+"RTN","CCRVA200",81,0)
+        ; Sometimes we have 3 pieces, or 2. Deal with that.
+"RTN","CCRVA200",82,0)
+        Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+"RTN","CCRVA200",83,0)
+        Q $P(STR,U,2)_"-"_$P(STR,U,3)
+"RTN","CCRVA200",84,0)
+        ;
+"RTN","CCRVA200",85,0)
+ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",86,0)
+        ; INPUT: DUZ, but not needed really... here for future expansion
+"RTN","CCRVA200",87,0)
+        ; OUTPUT: At this point "Work"
+"RTN","CCRVA200",88,0)
+        Q "Work"
+"RTN","CCRVA200",89,0)
+        ;
+"RTN","CCRVA200",90,0)
+ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",91,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",92,0)
+        ; Output: String.
+"RTN","CCRVA200",93,0)
+        ;
+"RTN","CCRVA200",94,0)
+        ; First, get site number from the institution file.
+"RTN","CCRVA200",95,0)
+        ; 1st piece returned by $$SITE^VASITE, which gets the system institution
+"RTN","CCRVA200",96,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",97,0)
+        ;
+"RTN","CCRVA200",98,0)
+        ; Second, get mailing address
+"RTN","CCRVA200",99,0)
+        ; There are two APIs to get the address, one for physical and one for
+"RTN","CCRVA200",100,0)
+        ; mailing. We will check if mailing exists first, since that's the
+"RTN","CCRVA200",101,0)
+        ; one we want to use; then check for physical. If neither exists,
+"RTN","CCRVA200",102,0)
+        ; then we return nothing. We check for the existence of an address
+"RTN","CCRVA200",103,0)
+        ; by the length of the returned string.
+"RTN","CCRVA200",104,0)
+        ; NOTE: API doesn't support Address 2, so I won't even include it
+"RTN","CCRVA200",105,0)
+        ; in the template.
+"RTN","CCRVA200",106,0)
+        N ADD
+"RTN","CCRVA200",107,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",108,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",109,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",110,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",111,0)
+        Q ""
+"RTN","CCRVA200",112,0)
+        ;
+"RTN","CCRVA200",113,0)
+CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",114,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",115,0)
+        ; Output: String.
+"RTN","CCRVA200",116,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",117,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",118,0)
+        N ADD
+"RTN","CCRVA200",119,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",120,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",121,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",122,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",123,0)
+        Q ""
+"RTN","CCRVA200",124,0)
+        ;
+"RTN","CCRVA200",125,0)
+STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",126,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",127,0)
+        ; Output: String.
+"RTN","CCRVA200",128,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",129,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",130,0)
+        N ADD
+"RTN","CCRVA200",131,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",132,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",133,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",134,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",135,0)
+        Q ""
+"RTN","CCRVA200",136,0)
+        ;
+"RTN","CCRVA200",137,0)
+POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",138,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",139,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",140,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",141,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",142,0)
+        N ADD
+"RTN","CCRVA200",143,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",144,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",145,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",146,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",147,0)
+        Q ""
+"RTN","CCRVA200",148,0)
+        ;
+"RTN","CCRVA200",149,0)
+TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",150,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",151,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",152,0)
+        ; Direct global access
+"RTN","CCRVA200",153,0)
+        N TEL S TEL=$G(^VA(200,DUZ,.13))
+"RTN","CCRVA200",154,0)
+        Q $P(TEL,U,2)
+"RTN","CCRVA200",155,0)
+        ;
+"RTN","CCRVA200",156,0)
+TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",157,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",158,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",159,0)
+        Q "Office"
+"RTN","CCRVA200",160,0)
+        ;
+"RTN","CCRVA200",161,0)
+EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",162,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",163,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",164,0)
+        ; Direct global access
+"RTN","CCRVA200",165,0)
+        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+"RTN","CCRVA200",166,0)
+        Q $P(EMAIL,U)
+"RTN","CCRVA200",167,0)
+        ;
+"RTN","GPLACTOR")
+0^8^B58306782
+"RTN","GPLACTOR",1,0)
+GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+"RTN","GPLACTOR",2,0)
+ ;;0.3;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLACTOR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLACTOR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLACTOR",5,0)
+ ;
+"RTN","GPLACTOR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLACTOR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLACTOR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLACTOR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLACTOR",10,0)
+ ;
+"RTN","GPLACTOR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLACTOR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLACTOR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLACTOR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLACTOR",15,0)
+ ;
+"RTN","GPLACTOR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLACTOR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLACTOR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLACTOR",19,0)
+    ;
+"RTN","GPLACTOR",20,0)
+    ;  PROCESS THE ACTORS SECTION OF THE CCR
+"RTN","GPLACTOR",21,0)
+    ;
+"RTN","GPLACTOR",22,0)
+    ; ===Revision History===
+"RTN","GPLACTOR",23,0)
+    ; 0.1 Initial Writing of Skeleton--GPL
+"RTN","GPLACTOR",24,0)
+    ; 0.2 Patient Data Extraction--SMH
+"RTN","GPLACTOR",25,0)
+    ; 0.3 Information System Info Extraction--SMH
+"RTN","GPLACTOR",26,0)
+    ;
+"RTN","GPLACTOR",27,0)
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+"RTN","GPLACTOR",28,0)
+  ; IPXML is the Input Actor Template into which we  substitute values
+"RTN","GPLACTOR",29,0)
+  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+"RTN","GPLACTOR",30,0)
+  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
+"RTN","GPLACTOR",31,0)
+  ; ^TMP(7542,1,"ACTORS",0)=Count
+"RTN","GPLACTOR",32,0)
+  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+"RTN","GPLACTOR",33,0)
+  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+"RTN","GPLACTOR",34,0)
+  ; AXML is the output arrary, to contain XML.
+"RTN","GPLACTOR",35,0)
+  ;
+"RTN","GPLACTOR",36,0)
+           N I,J,AMAP,AOID,ATYP,AIEN
+"RTN","GPLACTOR",37,0)
+           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+"RTN","GPLACTOR",38,0)
+           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+"RTN","GPLACTOR",39,0)
+           W "PROCESSING ACTORS ",!
+"RTN","GPLACTOR",40,0)
+           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+"RTN","GPLACTOR",41,0)
+           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",42,0)
+           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+"RTN","GPLACTOR",43,0)
+           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+"RTN","GPLACTOR",44,0)
+           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+"RTN","GPLACTOR",45,0)
+           . I ATYP="" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",46,0)
+           . ;
+"RTN","GPLACTOR",47,0)
+           . W AOID_" "_ATYP_" "_AIEN,!
+"RTN","GPLACTOR",48,0)
+           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+"RTN","GPLACTOR",49,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+"RTN","GPLACTOR",50,0)
+           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",51,0)
+           . ;
+"RTN","GPLACTOR",52,0)
+           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+"RTN","GPLACTOR",53,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+"RTN","GPLACTOR",54,0)
+           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",55,0)
+           . ;
+"RTN","GPLACTOR",56,0)
+           . I ATYP="NOK" D  ; NOK ACTOR TYPE
+"RTN","GPLACTOR",57,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+"RTN","GPLACTOR",58,0)
+           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",59,0)
+           . ;
+"RTN","GPLACTOR",60,0)
+           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",61,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+"RTN","GPLACTOR",62,0)
+           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",63,0)
+           . ;
+"RTN","GPLACTOR",64,0)
+           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",65,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+"RTN","GPLACTOR",66,0)
+           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",67,0)
+           . ;
+"RTN","GPLACTOR",68,0)
+           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+"RTN","GPLACTOR",69,0)
+           ;
+"RTN","GPLACTOR",70,0)
+           N ACTTMP
+"RTN","GPLACTOR",71,0)
+           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLACTOR",72,0)
+           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLACTOR",73,0)
+           . ; STRINGS MARKED AS @@X@@
+"RTN","GPLACTOR",74,0)
+           . W "ACTORS Missing list: ",!
+"RTN","GPLACTOR",75,0)
+           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+"RTN","GPLACTOR",76,0)
+           Q
+"RTN","GPLACTOR",77,0)
+           ;
+"RTN","GPLACTOR",78,0)
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+"RTN","GPLACTOR",79,0)
+     ;
+"RTN","GPLACTOR",80,0)
+     W "PROCESSING ACTOR PATIENT ",AIEN,!
+"RTN","GPLACTOR",81,0)
+     N AMAP,ZX
+"RTN","GPLACTOR",82,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",83,0)
+     K @AMAP
+"RTN","GPLACTOR",84,0)
+     D INIT^CCRDPT(AIEN)
+"RTN","GPLACTOR",85,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",86,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
+"RTN","GPLACTOR",87,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
+"RTN","GPLACTOR",88,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
+"RTN","GPLACTOR",89,0)
+     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
+"RTN","GPLACTOR",90,0)
+     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
+"RTN","GPLACTOR",91,0)
+     S @AMAP@("ACTORSSN")=""
+"RTN","GPLACTOR",92,0)
+     S @AMAP@("ACTORSSNTEXT")=""
+"RTN","GPLACTOR",93,0)
+     S @AMAP@("ACTORSSNSOURCEID")=""
+"RTN","GPLACTOR",94,0)
+     S ZX=$$SSN^CCRDPT
+"RTN","GPLACTOR",95,0)
+     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+"RTN","GPLACTOR",96,0)
+     . S @AMAP@("ACTORSSN")=ZX
+"RTN","GPLACTOR",97,0)
+     . S @AMAP@("ACTORSSNTEXT")="SSN"
+"RTN","GPLACTOR",98,0)
+     . S @AMAP@("ACTORSSNSOURCEID")=AOID
+"RTN","GPLACTOR",99,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
+"RTN","GPLACTOR",100,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
+"RTN","GPLACTOR",101,0)
+     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
+"RTN","GPLACTOR",102,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
+"RTN","GPLACTOR",103,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
+"RTN","GPLACTOR",104,0)
+     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
+"RTN","GPLACTOR",105,0)
+     S @AMAP@("ACTORRESTEL")=""
+"RTN","GPLACTOR",106,0)
+     S @AMAP@("ACTORRESTELTEXT")=""
+"RTN","GPLACTOR",107,0)
+     S ZX=$$RESTEL^CCRDPT
+"RTN","GPLACTOR",108,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",109,0)
+     . S @AMAP@("ACTORRESTEL")=ZX
+"RTN","GPLACTOR",110,0)
+     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+"RTN","GPLACTOR",111,0)
+     S @AMAP@("ACTORWORKTEL")=""
+"RTN","GPLACTOR",112,0)
+     S @AMAP@("ACTORWORKTELTEXT")=""
+"RTN","GPLACTOR",113,0)
+     S ZX=$$WORKTEL^CCRDPT
+"RTN","GPLACTOR",114,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",115,0)
+     . S @AMAP@("ACTORWORKTEL")=ZX
+"RTN","GPLACTOR",116,0)
+     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+"RTN","GPLACTOR",117,0)
+     S @AMAP@("ACTORCELLTEL")=""
+"RTN","GPLACTOR",118,0)
+     S @AMAP@("ACTORCELLTELTEXT")=""
+"RTN","GPLACTOR",119,0)
+     S ZX=$$CELLTEL^CCRDPT
+"RTN","GPLACTOR",120,0)
+     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+"RTN","GPLACTOR",121,0)
+     . S @AMAP@("ACTORCELLTEL")=ZX
+"RTN","GPLACTOR",122,0)
+     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+"RTN","GPLACTOR",123,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
+"RTN","GPLACTOR",124,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+"RTN","GPLACTOR",125,0)
+     S @AMAP@("ACTORIEN")=AIEN
+"RTN","GPLACTOR",126,0)
+     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+"RTN","GPLACTOR",127,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",128,0)
+         D DESTROY^CCRDPT
+"RTN","GPLACTOR",129,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",130,0)
+     Q
+"RTN","GPLACTOR",131,0)
+     ;
+"RTN","GPLACTOR",132,0)
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+"RTN","GPLACTOR",133,0)
+     ;
+"RTN","GPLACTOR",134,0)
+     ; N AMAP
+"RTN","GPLACTOR",135,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",136,0)
+     K @AMAP
+"RTN","GPLACTOR",137,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",138,0)
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
+"RTN","GPLACTOR",139,0)
+         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
+"RTN","GPLACTOR",140,0)
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+"RTN","GPLACTOR",141,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",142,0)
+     Q
+"RTN","GPLACTOR",143,0)
+     ;
+"RTN","GPLACTOR",144,0)
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+"RTN","GPLACTOR",145,0)
+     ;
+"RTN","GPLACTOR",146,0)
+     ; N AMAP
+"RTN","GPLACTOR",147,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",148,0)
+     K @AMAP
+"RTN","GPLACTOR",149,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",150,0)
+     S @AMAP@("ACTORDISPLAYNAME")=""
+"RTN","GPLACTOR",151,0)
+     S @AMAP@("ACTORRELATION")=""
+"RTN","GPLACTOR",152,0)
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+"RTN","GPLACTOR",153,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",154,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",155,0)
+     Q
+"RTN","GPLACTOR",156,0)
+     ;
+"RTN","GPLACTOR",157,0)
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+"RTN","GPLACTOR",158,0)
+     ;
+"RTN","GPLACTOR",159,0)
+     ; N AMAP
+"RTN","GPLACTOR",160,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",161,0)
+     K @AMAP
+"RTN","GPLACTOR",162,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",163,0)
+     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
+"RTN","GPLACTOR",164,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",165,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",166,0)
+     Q
+"RTN","GPLACTOR",167,0)
+     ;
+"RTN","GPLACTOR",168,0)
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+"RTN","GPLACTOR",169,0)
+     ;
+"RTN","GPLACTOR",170,0)
+     ; N AMAP
+"RTN","GPLACTOR",171,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",172,0)
+     K @AMAP
+"RTN","GPLACTOR",173,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",174,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
+"RTN","GPLACTOR",175,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",176,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
+"RTN","GPLACTOR",177,0)
+         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",178,0)
+         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
+"RTN","GPLACTOR",179,0)
+         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
+"RTN","GPLACTOR",180,0)
+         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
+"RTN","GPLACTOR",181,0)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
+"RTN","GPLACTOR",182,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",183,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
+"RTN","GPLACTOR",184,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
+"RTN","GPLACTOR",185,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
+"RTN","GPLACTOR",186,0)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
+"RTN","GPLACTOR",187,0)
+     S @AMAP@("ACTORTELEPHONE")=""
+"RTN","GPLACTOR",188,0)
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+"RTN","GPLACTOR",189,0)
+     S ZX=$$TEL^CCRVA200(AIEN)
+"RTN","GPLACTOR",190,0)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+"RTN","GPLACTOR",191,0)
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+"RTN","GPLACTOR",192,0)
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",193,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
+"RTN","GPLACTOR",194,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",195,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",196,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",197,0)
+     Q
+"RTN","GPLACTOR",198,0)
+     ;
+"RTN","GPLCCD")
+0^16^B106978605
+"RTN","GPLCCD",1,0)
+GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
+"RTN","GPLCCD",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCD",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD",5,0)
+ ;
+"RTN","GPLCCD",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD",10,0)
+ ;
+"RTN","GPLCCD",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD",15,0)
+ ;
+"RTN","GPLCCD",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD",19,0)
+ ;
+"RTN","GPLCCD",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCD",21,0)
+ ;
+"RTN","GPLCCD",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCD",23,0)
+       ; Select a patient.
+"RTN","GPLCCD",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCD",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCD",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCD",27,0)
+       ; N CCDGLO
+"RTN","GPLCCD",28,0)
+       D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+"RTN","GPLCCD",29,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
+"RTN","GPLCCD",30,0)
+       S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+"RTN","GPLCCD",31,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCD",32,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCD",33,0)
+       . S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCD",34,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCD",35,0)
+       . ;S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCD",36,0)
+       S ODIR=@ODIRGLB
+"RTN","GPLCCD",37,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCD",38,0)
+       Q
+"RTN","GPLCCD",39,0)
+       ;
+"RTN","GPLCCD",40,0)
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCD",41,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCD",42,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCD",43,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCD",44,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCD",45,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCD",46,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCD",47,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCD",48,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCD",49,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCD",50,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+"RTN","GPLCCD",51,0)
+    S DEBUG=0
+"RTN","GPLCCD",52,0)
+    N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+"RTN","GPLCCD",53,0)
+    I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+"RTN","GPLCCD",54,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCD",55,0)
+    I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+"RTN","GPLCCD",56,0)
+    E  S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCD",57,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCD",58,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCD",59,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCD",60,0)
+    I CCD D LOAD^GPLCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",61,0)
+    E  D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",62,0)
+    D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCD",63,0)
+    N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+"RTN","GPLCCD",64,0)
+    S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+"RTN","GPLCCD",65,0)
+    S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+"RTN","GPLCCD",66,0)
+    S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+"RTN","GPLCCD",67,0)
+    S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+"RTN","GPLCCD",68,0)
+    S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+"RTN","GPLCCD",69,0)
+    S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+"RTN","GPLCCD",70,0)
+    ;
+"RTN","GPLCCD",71,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCD",72,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCD",73,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",74,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",75,0)
+    I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCD",76,0)
+    I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+"RTN","GPLCCD",77,0)
+    ;
+"RTN","GPLCCD",78,0)
+    I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCD",79,0)
+    ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+"RTN","GPLCCD",80,0)
+    S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+"RTN","GPLCCD",81,0)
+    D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
+"RTN","GPLCCD",82,0)
+    D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+"RTN","GPLCCD",83,0)
+    I DEBUG D PARY^GPLXPATH("ACTT2")
+"RTN","GPLCCD",84,0)
+    D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
+"RTN","GPLCCD",85,0)
+    I DEBUG D PARY^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",86,0)
+    K ACTT1 K ACCT2
+"RTN","GPLCCD",87,0)
+    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+"RTN","GPLCCD",88,0)
+    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+"RTN","GPLCCD",89,0)
+    D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+"RTN","GPLCCD",90,0)
+    D CP^GPLXPATH("ACTT2",CCDGLO)
+"RTN","GPLCCD",91,0)
+    ;
+"RTN","GPLCCD",92,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCD",93,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCD",94,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCD",95,0)
+    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCD",96,0)
+    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCD",97,0)
+    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCD",98,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCD",99,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCD",100,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCD",101,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCD",102,0)
+    . S IXML="INXML"
+"RTN","GPLCCD",103,0)
+    . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+"RTN","GPLCCD",104,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCD",105,0)
+    . ; W OXML,!
+"RTN","GPLCCD",106,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCD",107,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCD",108,0)
+    . X CALL
+"RTN","GPLCCD",109,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCD",110,0)
+    . . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+"RTN","GPLCCD",111,0)
+    . . I CCD D UNSHAVE("ITMP",OXML)
+"RTN","GPLCCD",112,0)
+    . . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+"RTN","GPLCCD",113,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCD",114,0)
+    . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",115,0)
+    . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCD",116,0)
+    ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+"RTN","GPLCCD",117,0)
+    ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCD",118,0)
+    ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCD",119,0)
+    ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCD",120,0)
+    ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",121,0)
+    N I,J,DONE S DONE=0
+"RTN","GPLCCD",122,0)
+    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCD",123,0)
+    . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCD",124,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCD",125,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCD",126,0)
+    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+"RTN","GPLCCD",127,0)
+    . N I
+"RTN","GPLCCD",128,0)
+    . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+"RTN","GPLCCD",129,0)
+    . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",130,0)
+    . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+"RTN","GPLCCD",131,0)
+    . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",132,0)
+    . . . S @CCDGLO@(I)="</structuredBody></component>"
+"RTN","GPLCCD",133,0)
+    S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+"RTN","GPLCCD",134,0)
+    S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+"RTN","GPLCCD",135,0)
+    Q
+"RTN","GPLCCD",136,0)
+    ;
+"RTN","GPLCCD",137,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCD",138,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCD",139,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCD",140,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCD",141,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCD",142,0)
+    ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCD",143,0)
+    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCD",144,0)
+    Q
+"RTN","GPLCCD",145,0)
+    ;
+"RTN","GPLCCD",146,0)
+SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+"RTN","GPLCCD",147,0)
+    ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+"RTN","GPLCCD",148,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",149,0)
+    W SHXML,!
+"RTN","GPLCCD",150,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",151,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+"RTN","GPLCCD",152,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+"RTN","GPLCCD",153,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+"RTN","GPLCCD",154,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",155,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",156,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",157,0)
+    Q
+"RTN","GPLCCD",158,0)
+    ;
+"RTN","GPLCCD",159,0)
+UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+"RTN","GPLCCD",160,0)
+    ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+"RTN","GPLCCD",161,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",162,0)
+    W SHXML,!
+"RTN","GPLCCD",163,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",164,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+"RTN","GPLCCD",165,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+"RTN","GPLCCD",166,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+"RTN","GPLCCD",167,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",168,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",169,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",170,0)
+    Q
+"RTN","GPLCCD",171,0)
+    ;
+"RTN","GPLCCD",172,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCD",173,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCD",174,0)
+    ; K @VMAP
+"RTN","GPLCCD",175,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCD",176,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCD",177,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCD",178,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCD",179,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCD",180,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCD",181,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",182,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",183,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCD",184,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCD",185,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCD",186,0)
+    N CTMP
+"RTN","GPLCCD",187,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCD",188,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCD",189,0)
+    Q
+"RTN","GPLCCD",190,0)
+    ;
+"RTN","GPLCCD",191,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCD",192,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCD",193,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCD",194,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCD",195,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCD",196,0)
+    ;OR INSTITUTION
+"RTN","GPLCCD",197,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCD",198,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCD",199,0)
+    N I,J,K,L
+"RTN","GPLCCD",200,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCD",201,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCD",202,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCD",203,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCD",204,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCD",205,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCD",206,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCD",207,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCD",208,0)
+    F J=0:0 D  Q:$O(K(I))=""  ;
+"RTN","GPLCCD",209,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCD",210,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCD",211,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCD",212,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCD",213,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCD",214,0)
+    Q
+"RTN","GPLCCD",215,0)
+    ;
+"RTN","GPLCCD",216,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCD",217,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCD",218,0)
+  Q
+"RTN","GPLCCD",219,0)
+  ;
+"RTN","GPLCCD",220,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCD",221,0)
+  N ZTMP
+"RTN","GPLCCD",222,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",223,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCD",224,0)
+  Q
+"RTN","GPLCCD",225,0)
+  ;
+"RTN","GPLCCD",226,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCD",227,0)
+  N ZTMP
+"RTN","GPLCCD",228,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",229,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCD",230,0)
+  Q
+"RTN","GPLCCD",231,0)
+  ;
+"RTN","GPLCCD",232,0)
+ ;;><TEST>
+"RTN","GPLCCD",233,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCD",234,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",235,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCD",236,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCD",237,0)
+ ;;><VITALS>
+"RTN","GPLCCD",238,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",239,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCD",240,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCD",241,0)
+ ;;><CCR>
+"RTN","GPLCCD",242,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",243,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",244,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",245,0)
+ ;;><ACTLST>
+"RTN","GPLCCD",246,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",247,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",248,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCD",249,0)
+ ;;><ACTORS>
+"RTN","GPLCCD",250,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCD",251,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCD",252,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCD",253,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCD",254,0)
+ ;;><TRIM>
+"RTN","GPLCCD",255,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCD",256,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",257,0)
+ ;;><CCD>
+"RTN","GPLCCD",258,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",259,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
+"RTN","GPLCCD",260,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",261,0)
+ ;;></TEST>
+"RTN","GPLCCD1")
+0^17^B100039732
+"RTN","GPLCCD1",1,0)
+GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
+"RTN","GPLCCD1",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCD1",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD1",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD1",5,0)
+ ;
+"RTN","GPLCCD1",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD1",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD1",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD1",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD1",10,0)
+ ;
+"RTN","GPLCCD1",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD1",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD1",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD1",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD1",15,0)
+ ;
+"RTN","GPLCCD1",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD1",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD1",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD1",19,0)
+ ;
+"RTN","GPLCCD1",20,0)
+          W "This is a CCD TEMPLATE with processing routines",!
+"RTN","GPLCCD1",21,0)
+          W !
+"RTN","GPLCCD1",22,0)
+          Q
+"RTN","GPLCCD1",23,0)
+          ;
+"RTN","GPLCCD1",24,0)
+ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
+"RTN","GPLCCD1",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCD1",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCD1",28,0)
+          ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
+"RTN","GPLCCD1",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCD1",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCD1",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCD1",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCD1",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCD1",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCD1",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCD1",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCD1",37,0)
+          Q
+"RTN","GPLCCD1",38,0)
+          ;
+"RTN","GPLCCD1",39,0)
+ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+"RTN","GPLCCD1",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCD1",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCD1",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCD1",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCD1",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCD1",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCD1",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCD1",48,0)
+          ;
+"RTN","GPLCCD1",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCD1",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCD1",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCD1",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCD1",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCD1",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCD1",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCD1",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCD1",57,0)
+          Q
+"RTN","GPLCCD1",58,0)
+          ;
+"RTN","GPLCCD1",59,0)
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCD1",60,0)
+          D ZLOAD(ARY,"GPLCCD1")
+"RTN","GPLCCD1",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCD1",62,0)
+          Q
+"RTN","GPLCCD1",63,0)
+          ;
+"RTN","GPLCCD1",64,0)
+TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+"RTN","GPLCCD1",65,0)
+          Q
+"RTN","GPLCCD1",66,0)
+MARKUP ;<MARKUP>
+"RTN","GPLCCD1",67,0)
+ ;;<Body>
+"RTN","GPLCCD1",68,0)
+ ;;<Problems>
+"RTN","GPLCCD1",69,0)
+ ;;</Problems>
+"RTN","GPLCCD1",70,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",71,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",72,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",73,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",74,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",75,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",76,0)
+ ;;<Medications>
+"RTN","GPLCCD1",77,0)
+ ;;</Medications>
+"RTN","GPLCCD1",78,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",79,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",80,0)
+ ;;<Results>
+"RTN","GPLCCD1",81,0)
+ ;;</Results>
+"RTN","GPLCCD1",82,0)
+ ;;</Body>
+"RTN","GPLCCD1",83,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCD1",84,0)
+ ;</MARKUP>
+"RTN","GPLCCD1",85,0)
+ ;;<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">
+"RTN","GPLCCD1",86,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",87,0)
+ Q
+"RTN","GPLCCD1",88,0)
+ ;
+"RTN","GPLCCD1",89,0)
+ ;<TEMPLATE>
+"RTN","GPLCCD1",90,0)
+ ;;<?xml version="1.0"?>
+"RTN","GPLCCD1",91,0)
+ ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
+"RTN","GPLCCD1",92,0)
+ ;;<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">
+"RTN","GPLCCD1",93,0)
+ ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
+"RTN","GPLCCD1",94,0)
+ ;;<templateId root="2.16.840.1.113883.10.20.1"/>
+"RTN","GPLCCD1",95,0)
+ ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
+"RTN","GPLCCD1",96,0)
+ ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
+"RTN","GPLCCD1",97,0)
+ ;;<title>Continuity of Care Document</title>
+"RTN","GPLCCD1",98,0)
+ ;;<effectiveTime value="20000407130000+0500"/>
+"RTN","GPLCCD1",99,0)
+ ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+"RTN","GPLCCD1",100,0)
+ ;;<languageCode code="en-US"/>
+"RTN","GPLCCD1",101,0)
+ ;;<recordTarget>
+"RTN","GPLCCD1",102,0)
+ ;;<patientRole>
+"RTN","GPLCCD1",103,0)
+ ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",104,0)
+ ;;<patient>
+"RTN","GPLCCD1",105,0)
+ ;;<name>
+"RTN","GPLCCD1",106,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",107,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",108,0)
+ ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
+"RTN","GPLCCD1",109,0)
+ ;;</name>
+"RTN","GPLCCD1",110,0)
+ ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
+"RTN","GPLCCD1",111,0)
+ ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
+"RTN","GPLCCD1",112,0)
+ ;;</patient>
+"RTN","GPLCCD1",113,0)
+ ;;<providerOrganization>
+"RTN","GPLCCD1",114,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",115,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",116,0)
+ ;;</providerOrganization>
+"RTN","GPLCCD1",117,0)
+ ;;</patientRole>
+"RTN","GPLCCD1",118,0)
+ ;;</recordTarget>
+"RTN","GPLCCD1",119,0)
+ ;;<author>
+"RTN","GPLCCD1",120,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",121,0)
+ ;;<assignedAuthor>
+"RTN","GPLCCD1",122,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",123,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",124,0)
+ ;;<name>
+"RTN","GPLCCD1",125,0)
+ ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
+"RTN","GPLCCD1",126,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",127,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",128,0)
+ ;;</name>
+"RTN","GPLCCD1",129,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",130,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",131,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",132,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",133,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",134,0)
+ ;;</assignedAuthor>
+"RTN","GPLCCD1",135,0)
+ ;;</author>
+"RTN","GPLCCD1",136,0)
+ ;;<informant>
+"RTN","GPLCCD1",137,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",138,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",139,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",140,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",141,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",142,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",143,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",144,0)
+ ;;</informant>
+"RTN","GPLCCD1",145,0)
+ ;;<custodian>
+"RTN","GPLCCD1",146,0)
+ ;;<assignedCustodian>
+"RTN","GPLCCD1",147,0)
+ ;;<representedCustodianOrganization>
+"RTN","GPLCCD1",148,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",149,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",150,0)
+ ;;</representedCustodianOrganization>
+"RTN","GPLCCD1",151,0)
+ ;;</assignedCustodian>
+"RTN","GPLCCD1",152,0)
+ ;;</custodian>
+"RTN","GPLCCD1",153,0)
+ ;;<legalAuthenticator>
+"RTN","GPLCCD1",154,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",155,0)
+ ;;<signatureCode code="S"/>
+"RTN","GPLCCD1",156,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",157,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",158,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",159,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",160,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",161,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",162,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",163,0)
+ ;;</legalAuthenticator>
+"RTN","GPLCCD1",164,0)
+ ;;<Actors>
+"RTN","GPLCCD1",165,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCD1",166,0)
+ ;;<participant typeCode="IND">
+"RTN","GPLCCD1",167,0)
+ ;;<associatedEntity classCode="NOK">
+"RTN","GPLCCD1",168,0)
+ ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
+"RTN","GPLCCD1",169,0)
+ ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
+"RTN","GPLCCD1",170,0)
+ ;;<telecom value="tel:(999)555-1212"/>
+"RTN","GPLCCD1",171,0)
+ ;;<associatedPerson>
+"RTN","GPLCCD1",172,0)
+ ;;<name>
+"RTN","GPLCCD1",173,0)
+ ;;<given>Henrietta</given>
+"RTN","GPLCCD1",174,0)
+ ;;<family>Levin</family>
+"RTN","GPLCCD1",175,0)
+ ;;</name>
+"RTN","GPLCCD1",176,0)
+ ;;</associatedPerson>
+"RTN","GPLCCD1",177,0)
+ ;;</associatedEntity>
+"RTN","GPLCCD1",178,0)
+ ;;</participant>
+"RTN","GPLCCD1",179,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCD1",180,0)
+ ;;</Actors>
+"RTN","GPLCCD1",181,0)
+ ;;<documentationOf>
+"RTN","GPLCCD1",182,0)
+ ;;<serviceEvent classCode="PCPR">
+"RTN","GPLCCD1",183,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",184,0)
+ ;;<high value="@@DATETIME@@"/>
+"RTN","GPLCCD1",185,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",186,0)
+ ;;<performer typeCode="PRF">
+"RTN","GPLCCD1",187,0)
+ ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+"RTN","GPLCCD1",188,0)
+ ;;<time>
+"RTN","GPLCCD1",189,0)
+ ;;<low value="1990"/>
+"RTN","GPLCCD1",190,0)
+ ;;<high value='20000407'/>
+"RTN","GPLCCD1",191,0)
+ ;;</time>
+"RTN","GPLCCD1",192,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",193,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",194,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",195,0)
+ ;;<name>
+"RTN","GPLCCD1",196,0)
+ ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
+"RTN","GPLCCD1",197,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",198,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",199,0)
+ ;;</name>
+"RTN","GPLCCD1",200,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",201,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",202,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",203,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",204,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",205,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",206,0)
+ ;;</performer>
+"RTN","GPLCCD1",207,0)
+ ;;</serviceEvent>
+"RTN","GPLCCD1",208,0)
+ ;;</documentationOf>
+"RTN","GPLCCD1",209,0)
+ ;;<Body>
+"RTN","GPLCCD1",210,0)
+ ;;<PROBLEMS-HTML>
+"RTN","GPLCCD1",211,0)
+ ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
+"RTN","GPLCCD1",212,0)
+ ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
+"RTN","GPLCCD1",213,0)
+ ;;<td>@@PROBLEMDATEOFONSET@@</td>
+"RTN","GPLCCD1",214,0)
+ ;;<td>Active</td></tr>
+"RTN","GPLCCD1",215,0)
+ ;;</tbody></table></text>
+"RTN","GPLCCD1",216,0)
+ ;;</PROBLEMS-HTML>
+"RTN","GPLCCD1",217,0)
+ ;;<Problems>
+"RTN","GPLCCD1",218,0)
+ ;;<component>
+"RTN","GPLCCD1",219,0)
+ ;;<section>
+"RTN","GPLCCD1",220,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
+"RTN","GPLCCD1",221,0)
+ ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
+"RTN","GPLCCD1",222,0)
+ ;;<title>Problems</title>
+"RTN","GPLCCD1",223,0)
+ ;;<entry typeCode="DRIV">
+"RTN","GPLCCD1",224,0)
+ ;;<act classCode="ACT" moodCode="EVN">
+"RTN","GPLCCD1",225,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
+"RTN","GPLCCD1",226,0)
+ ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
+"RTN","GPLCCD1",227,0)
+ ;;<code nullFlavor="NA"/>
+"RTN","GPLCCD1",228,0)
+ ;;<entryRelationship typeCode="SUBJ">
+"RTN","GPLCCD1",229,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",230,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
+"RTN","GPLCCD1",231,0)
+ ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
+"RTN","GPLCCD1",232,0)
+ ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
+"RTN","GPLCCD1",233,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",234,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",235,0)
+ ;;<low value="@@PROBLEMDATEOFONSET@@"/>
+"RTN","GPLCCD1",236,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",237,0)
+ ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
+"RTN","GPLCCD1",238,0)
+ ;;<entryRelationship typeCode="REFR">
+"RTN","GPLCCD1",239,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",240,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
+"RTN","GPLCCD1",241,0)
+ ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+"RTN","GPLCCD1",242,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",243,0)
+ ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
+"RTN","GPLCCD1",244,0)
+ ;;</observation>
+"RTN","GPLCCD1",245,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",246,0)
+ ;;</observation>
+"RTN","GPLCCD1",247,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",248,0)
+ ;;</act>
+"RTN","GPLCCD1",249,0)
+ ;;</entry>
+"RTN","GPLCCD1",250,0)
+ ;;</section>
+"RTN","GPLCCD1",251,0)
+ ;;</component>
+"RTN","GPLCCD1",252,0)
+ ;;</Problems>
+"RTN","GPLCCD1",253,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",254,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",255,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",256,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",257,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",258,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",259,0)
+ ;;<Medications>
+"RTN","GPLCCD1",260,0)
+ ;;</Medications>
+"RTN","GPLCCD1",261,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",262,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",263,0)
+ ;;<Results>
+"RTN","GPLCCD1",264,0)
+ ;;</Results>
+"RTN","GPLCCD1",265,0)
+ ;;</Body>
+"RTN","GPLCCD1",266,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",267,0)
+ ;</TEMPLATE>
+"RTN","GPLCCR")
+0^14^B66792391
+"RTN","GPLCCR",1,0)
+GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
+"RTN","GPLCCR",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR",5,0)
+ ;
+"RTN","GPLCCR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR",10,0)
+ ;
+"RTN","GPLCCR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR",15,0)
+ ;
+"RTN","GPLCCR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR",19,0)
+ ;
+"RTN","GPLCCR",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCR",21,0)
+ ;
+"RTN","GPLCCR",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCR",23,0)
+       ; Select a patient.
+"RTN","GPLCCR",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCR",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCR",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCR",27,0)
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+"RTN","GPLCCR",28,0)
+       Q
+"RTN","GPLCCR",29,0)
+       ;
+"RTN","GPLCCR",30,0)
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","GPLCCR",31,0)
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+"RTN","GPLCCR",32,0)
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+"RTN","GPLCCR",33,0)
+       N CCRGLO
+"RTN","GPLCCR",34,0)
+       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
+"RTN","GPLCCR",35,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
+"RTN","GPLCCR",36,0)
+       S ONAM=FN
+"RTN","GPLCCR",37,0)
+       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
+"RTN","GPLCCR",38,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCR",39,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCR",40,0)
+       . ;S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCR",41,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCR",42,0)
+       . S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCR",43,0)
+       S ODIR=DIR
+"RTN","GPLCCR",44,0)
+       I DIR="" S ODIR=@ODIRGLB
+"RTN","GPLCCR",45,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCR",46,0)
+       Q
+"RTN","GPLCCR",47,0)
+       ;
+"RTN","GPLCCR",48,0)
+CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCR",49,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCR",50,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCR",51,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCR",52,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCR",53,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCR",54,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCR",55,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCR",56,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCR",57,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCR",58,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
+"RTN","GPLCCR",59,0)
+    I '$D(DEBUG) S DEBUG=0
+"RTN","GPLCCR",60,0)
+    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
+"RTN","GPLCCR",61,0)
+    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
+"RTN","GPLCCR",62,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCR",63,0)
+    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCR",64,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCR",65,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCR",66,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCR",67,0)
+    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCR",68,0)
+    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCR",69,0)
+    ;
+"RTN","GPLCCR",70,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCR",71,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCR",72,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",73,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",74,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCR",75,0)
+    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+"RTN","GPLCCR",76,0)
+    ;
+"RTN","GPLCCR",77,0)
+    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCR",78,0)
+    ;
+"RTN","GPLCCR",79,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCR",80,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCR",81,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCR",82,0)
+    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCR",83,0)
+    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCR",84,0)
+    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCR",85,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCR",86,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCR",87,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCR",88,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCR",89,0)
+    . S IXML="INXML"
+"RTN","GPLCCR",90,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCR",91,0)
+    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
+"RTN","GPLCCR",92,0)
+    . ; W OXML,!
+"RTN","GPLCCR",93,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCR",94,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCR",95,0)
+    . X CALL
+"RTN","GPLCCR",96,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCR",97,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCR",98,0)
+    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",99,0)
+    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCR",100,0)
+    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCR",101,0)
+    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCR",102,0)
+    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCR",103,0)
+    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",104,0)
+    N TRIMI,J,DONE S DONE=0
+"RTN","GPLCCR",105,0)
+    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCR",106,0)
+    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCR",107,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCR",108,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCR",109,0)
+    Q
+"RTN","GPLCCR",110,0)
+    ;
+"RTN","GPLCCR",111,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCR",112,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCR",113,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCR",114,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCR",115,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCR",116,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCR",117,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCR",118,0)
+    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
+"RTN","GPLCCR",119,0)
+    Q
+"RTN","GPLCCR",120,0)
+    ;
+"RTN","GPLCCR",121,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCR",122,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCR",123,0)
+    ; K @VMAP
+"RTN","GPLCCR",124,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCR",125,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCR",126,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCR",127,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCR",128,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCR",129,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCR",130,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",131,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",132,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCR",133,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCR",134,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCR",135,0)
+    N CTMP
+"RTN","GPLCCR",136,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCR",137,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCR",138,0)
+    Q
+"RTN","GPLCCR",139,0)
+    ;
+"RTN","GPLCCR",140,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCR",141,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCR",142,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCR",143,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCR",144,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCR",145,0)
+    ;OR INSTITUTION
+"RTN","GPLCCR",146,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCR",147,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCR",148,0)
+    N I,J,K,L
+"RTN","GPLCCR",149,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCR",150,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCR",151,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCR",152,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCR",153,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCR",154,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCR",155,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCR",156,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCR",157,0)
+    F J=0:0 D  Q:$O(K(I))=""
+"RTN","GPLCCR",158,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCR",159,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCR",160,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCR",161,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCR",162,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCR",163,0)
+    Q
+"RTN","GPLCCR",164,0)
+    ;
+"RTN","GPLCCR",165,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCR",166,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCR",167,0)
+  Q
+"RTN","GPLCCR",168,0)
+  ;
+"RTN","GPLCCR",169,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCR",170,0)
+  N ZTMP
+"RTN","GPLCCR",171,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",172,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCR",173,0)
+  Q
+"RTN","GPLCCR",174,0)
+  ;
+"RTN","GPLCCR",175,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCR",176,0)
+  N ZTMP
+"RTN","GPLCCR",177,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",178,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCR",179,0)
+  Q
+"RTN","GPLCCR",180,0)
+  ;
+"RTN","GPLCCR",181,0)
+ ;;><TEST>
+"RTN","GPLCCR",182,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCR",183,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",184,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCR",185,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCR",186,0)
+ ;;><VITALS>
+"RTN","GPLCCR",187,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",188,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCR",189,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCR",190,0)
+ ;;><CCR>
+"RTN","GPLCCR",191,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",192,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",193,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCR",194,0)
+ ;;><ACTLST>
+"RTN","GPLCCR",195,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",196,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",197,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCR",198,0)
+ ;;><ACTORS>
+"RTN","GPLCCR",199,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCR",200,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCR",201,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCR",202,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCR",203,0)
+ ;;><TRIM>
+"RTN","GPLCCR",204,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCR",205,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
+"RTN","GPLCCR0")
+0^15^B658213703
+"RTN","GPLCCR0",1,0)
+GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+"RTN","GPLCCR0",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCR0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR0",5,0)
+ ;
+"RTN","GPLCCR0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR0",10,0)
+ ;
+"RTN","GPLCCR0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR0",15,0)
+ ;
+"RTN","GPLCCR0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR0",19,0)
+ ;
+"RTN","GPLCCR0",20,0)
+          W "This is a CCR TEMPLATE with processing routines",!
+"RTN","GPLCCR0",21,0)
+          W !
+"RTN","GPLCCR0",22,0)
+          Q
+"RTN","GPLCCR0",23,0)
+          ;
+"RTN","GPLCCR0",24,0)
+ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
+"RTN","GPLCCR0",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCR0",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCR0",28,0)
+          ; I '$G(@ZARY) D  ;
+"RTN","GPLCCR0",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCR0",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCR0",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCR0",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCR0",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCR0",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCR0",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCR0",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCR0",37,0)
+          Q
+"RTN","GPLCCR0",38,0)
+          ;
+"RTN","GPLCCR0",39,0)
+ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
+"RTN","GPLCCR0",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCR0",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCR0",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCR0",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCR0",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCR0",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCR0",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCR0",48,0)
+          ;
+"RTN","GPLCCR0",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCR0",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCR0",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCR0",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCR0",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCR0",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCR0",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCR0",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCR0",57,0)
+          Q
+"RTN","GPLCCR0",58,0)
+          ;
+"RTN","GPLCCR0",59,0)
+LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCR0",60,0)
+          D ZLOAD(ARY,"GPLCCR0")
+"RTN","GPLCCR0",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCR0",62,0)
+          Q
+"RTN","GPLCCR0",63,0)
+          ;
+"RTN","GPLCCR0",64,0)
+ ;<TEMPLATE>
+"RTN","GPLCCR0",65,0)
+ ;;<?xml version="1.0" encoding="UTF-8"?>
+"RTN","GPLCCR0",66,0)
+ ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
+"RTN","GPLCCR0",67,0)
+ ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
+"RTN","GPLCCR0",68,0)
+ ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
+"RTN","GPLCCR0",69,0)
+ ;;<Language>
+"RTN","GPLCCR0",70,0)
+ ;;<Text>English</Text>
+"RTN","GPLCCR0",71,0)
+ ;;</Language>
+"RTN","GPLCCR0",72,0)
+ ;;<Version>V1.0</Version>
+"RTN","GPLCCR0",73,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",74,0)
+ ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",75,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",76,0)
+ ;;<Patient>
+"RTN","GPLCCR0",77,0)
+ ;;<ActorID>@@ACTORPATIENT@@</ActorID>
+"RTN","GPLCCR0",78,0)
+ ;;</Patient>
+"RTN","GPLCCR0",79,0)
+ ;;<From>
+"RTN","GPLCCR0",80,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",81,0)
+ ;;<ActorID>@@ACTORFROM@@</ActorID>
+"RTN","GPLCCR0",82,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",83,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",84,0)
+ ;;<ActorID>@@ACTORFROM2@@</ActorID>
+"RTN","GPLCCR0",85,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",86,0)
+ ;;</From>
+"RTN","GPLCCR0",87,0)
+ ;;<To>
+"RTN","GPLCCR0",88,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",89,0)
+ ;;<ActorID>@@ACTORTO@@</ActorID>
+"RTN","GPLCCR0",90,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",91,0)
+ ;;<Text>@@ACTORTOTEXT@@</Text>
+"RTN","GPLCCR0",92,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",93,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",94,0)
+ ;;</To>
+"RTN","GPLCCR0",95,0)
+ ;;<Purpose>
+"RTN","GPLCCR0",96,0)
+ ;;<Description>
+"RTN","GPLCCR0",97,0)
+ ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
+"RTN","GPLCCR0",98,0)
+ ;;</Description>
+"RTN","GPLCCR0",99,0)
+ ;;</Purpose>
+"RTN","GPLCCR0",100,0)
+ ;;<Body>
+"RTN","GPLCCR0",101,0)
+ ;;<Problems>
+"RTN","GPLCCR0",102,0)
+ ;;<Problem>
+"RTN","GPLCCR0",103,0)
+ ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",104,0)
+ ;;<Type>
+"RTN","GPLCCR0",105,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",106,0)
+ ;;</Type>
+"RTN","GPLCCR0",107,0)
+ ;;<Description>
+"RTN","GPLCCR0",108,0)
+ ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",109,0)
+ ;;<Code>
+"RTN","GPLCCR0",110,0)
+ ;;<Value>@@PROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",111,0)
+ ;;<CodingSystem>ICD9CM</CodingSystem>
+"RTN","GPLCCR0",112,0)
+ ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",113,0)
+ ;;</Code>
+"RTN","GPLCCR0",114,0)
+ ;;</Description>
+"RTN","GPLCCR0",115,0)
+ ;;<Source>
+"RTN","GPLCCR0",116,0)
+ ;;<Actor>
+"RTN","GPLCCR0",117,0)
+ ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",118,0)
+ ;;</Actor>
+"RTN","GPLCCR0",119,0)
+ ;;</Source>
+"RTN","GPLCCR0",120,0)
+ ;;</Problem>
+"RTN","GPLCCR0",121,0)
+ ;;</Problems>
+"RTN","GPLCCR0",122,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCR0",123,0)
+ ;;<FamilyProblemHistory>
+"RTN","GPLCCR0",124,0)
+ ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",125,0)
+ ;;<Source>
+"RTN","GPLCCR0",126,0)
+ ;;<Actor>
+"RTN","GPLCCR0",127,0)
+ ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
+"RTN","GPLCCR0",128,0)
+ ;;</Actor>
+"RTN","GPLCCR0",129,0)
+ ;;</Source>
+"RTN","GPLCCR0",130,0)
+ ;;<FamilyMember>
+"RTN","GPLCCR0",131,0)
+ ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
+"RTN","GPLCCR0",132,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",133,0)
+ ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
+"RTN","GPLCCR0",134,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",135,0)
+ ;;<Source>
+"RTN","GPLCCR0",136,0)
+ ;;<Actor>
+"RTN","GPLCCR0",137,0)
+ ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",138,0)
+ ;;</Actor>
+"RTN","GPLCCR0",139,0)
+ ;;</Source>
+"RTN","GPLCCR0",140,0)
+ ;;</FamilyMember>
+"RTN","GPLCCR0",141,0)
+ ;;<Problem>
+"RTN","GPLCCR0",142,0)
+ ;;<Type>
+"RTN","GPLCCR0",143,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",144,0)
+ ;;</Type>
+"RTN","GPLCCR0",145,0)
+ ;;<Description>
+"RTN","GPLCCR0",146,0)
+ ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",147,0)
+ ;;<Code>
+"RTN","GPLCCR0",148,0)
+ ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
+"RTN","GPLCCR0",149,0)
+ ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",150,0)
+ ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
+"RTN","GPLCCR0",151,0)
+ ;;</Code>
+"RTN","GPLCCR0",152,0)
+ ;;</Description>
+"RTN","GPLCCR0",153,0)
+ ;;<Source>
+"RTN","GPLCCR0",154,0)
+ ;;<Actor>
+"RTN","GPLCCR0",155,0)
+ ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
+"RTN","GPLCCR0",156,0)
+ ;;</Actor>
+"RTN","GPLCCR0",157,0)
+ ;;</Source>
+"RTN","GPLCCR0",158,0)
+ ;;</Problem>
+"RTN","GPLCCR0",159,0)
+ ;;</FamilyProblemHistory>
+"RTN","GPLCCR0",160,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCR0",161,0)
+ ;;<SocialHistory>
+"RTN","GPLCCR0",162,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",163,0)
+ ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",164,0)
+ ;;<Type>
+"RTN","GPLCCR0",165,0)
+ ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
+"RTN","GPLCCR0",166,0)
+ ;;</Type>
+"RTN","GPLCCR0",167,0)
+ ;;<Description>
+"RTN","GPLCCR0",168,0)
+ ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",169,0)
+ ;;</Description>
+"RTN","GPLCCR0",170,0)
+ ;;<Source>
+"RTN","GPLCCR0",171,0)
+ ;;<Actor>
+"RTN","GPLCCR0",172,0)
+ ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",173,0)
+ ;;</Actor>
+"RTN","GPLCCR0",174,0)
+ ;;</Source>
+"RTN","GPLCCR0",175,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",176,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",177,0)
+ ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
+"RTN","GPLCCR0",178,0)
+ ;;<Type>
+"RTN","GPLCCR0",179,0)
+ ;;<Text>Ethnic Origin</Text>
+"RTN","GPLCCR0",180,0)
+ ;;</Type>
+"RTN","GPLCCR0",181,0)
+ ;;<Description>
+"RTN","GPLCCR0",182,0)
+ ;;<Text>Not Hispanic or Latino</Text>
+"RTN","GPLCCR0",183,0)
+ ;;</Description>
+"RTN","GPLCCR0",184,0)
+ ;;<Source>
+"RTN","GPLCCR0",185,0)
+ ;;<Actor>
+"RTN","GPLCCR0",186,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",187,0)
+ ;;</Actor>
+"RTN","GPLCCR0",188,0)
+ ;;</Source>
+"RTN","GPLCCR0",189,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",190,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",191,0)
+ ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
+"RTN","GPLCCR0",192,0)
+ ;;<Type>
+"RTN","GPLCCR0",193,0)
+ ;;<Text>Race</Text>
+"RTN","GPLCCR0",194,0)
+ ;;</Type>
+"RTN","GPLCCR0",195,0)
+ ;;<Description>
+"RTN","GPLCCR0",196,0)
+ ;;<Text>White</Text>
+"RTN","GPLCCR0",197,0)
+ ;;</Description>
+"RTN","GPLCCR0",198,0)
+ ;;<Source>
+"RTN","GPLCCR0",199,0)
+ ;;<Actor>
+"RTN","GPLCCR0",200,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",201,0)
+ ;;</Actor>
+"RTN","GPLCCR0",202,0)
+ ;;</Source>
+"RTN","GPLCCR0",203,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",204,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",205,0)
+ ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
+"RTN","GPLCCR0",206,0)
+ ;;<Type>
+"RTN","GPLCCR0",207,0)
+ ;;<Text>Occupation</Text>
+"RTN","GPLCCR0",208,0)
+ ;;</Type>
+"RTN","GPLCCR0",209,0)
+ ;;<Description>
+"RTN","GPLCCR0",210,0)
+ ;;<Text>Physician</Text>
+"RTN","GPLCCR0",211,0)
+ ;;</Description>
+"RTN","GPLCCR0",212,0)
+ ;;<Source>
+"RTN","GPLCCR0",213,0)
+ ;;<Actor>
+"RTN","GPLCCR0",214,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",215,0)
+ ;;</Actor>
+"RTN","GPLCCR0",216,0)
+ ;;</Source>
+"RTN","GPLCCR0",217,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",218,0)
+ ;;</SocialHistory>
+"RTN","GPLCCR0",219,0)
+ ;;<Alerts>
+"RTN","GPLCCR0",220,0)
+ ;;<Alert>
+"RTN","GPLCCR0",221,0)
+ ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",222,0)
+ ;;<Description>
+"RTN","GPLCCR0",223,0)
+ ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",224,0)
+ ;;<Code>
+"RTN","GPLCCR0",225,0)
+ ;;<Value>@@ALERTCODEVALUE@@</Value>
+"RTN","GPLCCR0",226,0)
+ ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",227,0)
+ ;;</Code>
+"RTN","GPLCCR0",228,0)
+ ;;</Description>
+"RTN","GPLCCR0",229,0)
+ ;;<Status>
+"RTN","GPLCCR0",230,0)
+ ;;<Text>@@ALERTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",231,0)
+ ;;</Status>
+"RTN","GPLCCR0",232,0)
+ ;;<Source>
+"RTN","GPLCCR0",233,0)
+ ;;<Actor>
+"RTN","GPLCCR0",234,0)
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",235,0)
+ ;;</Actor>
+"RTN","GPLCCR0",236,0)
+ ;;</Source>
+"RTN","GPLCCR0",237,0)
+ ;;<Agent>
+"RTN","GPLCCR0",238,0)
+ ;;<Products>
+"RTN","GPLCCR0",239,0)
+ ;;<Product>
+"RTN","GPLCCR0",240,0)
+ ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",241,0)
+ ;;<Source>
+"RTN","GPLCCR0",242,0)
+ ;;<Actor>
+"RTN","GPLCCR0",243,0)
+ ;;<ActorID>@@ALERTAGENTPRODUCTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",244,0)
+ ;;</Actor>
+"RTN","GPLCCR0",245,0)
+ ;;</Source>
+"RTN","GPLCCR0",246,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",247,0)
+ ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",248,0)
+ ;;<Code>
+"RTN","GPLCCR0",249,0)
+ ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
+"RTN","GPLCCR0",250,0)
+ ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",251,0)
+ ;;</Code>
+"RTN","GPLCCR0",252,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",253,0)
+ ;;</Product>
+"RTN","GPLCCR0",254,0)
+ ;;</Products>
+"RTN","GPLCCR0",255,0)
+ ;;</Agent>
+"RTN","GPLCCR0",256,0)
+ ;;<Reaction>
+"RTN","GPLCCR0",257,0)
+ ;;<Description>
+"RTN","GPLCCR0",258,0)
+ ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",259,0)
+ ;;<Code>
+"RTN","GPLCCR0",260,0)
+ ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",261,0)
+ ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",262,0)
+ ;;</Code>
+"RTN","GPLCCR0",263,0)
+ ;;</Description>
+"RTN","GPLCCR0",264,0)
+ ;;</Reaction>
+"RTN","GPLCCR0",265,0)
+ ;;</Alert>
+"RTN","GPLCCR0",266,0)
+ ;;</Alerts>
+"RTN","GPLCCR0",267,0)
+ ;;<Medications>
+"RTN","GPLCCR0",268,0)
+ ;;<Medication>
+"RTN","GPLCCR0",269,0)
+ ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",270,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",271,0)
+ ;;<Type>
+"RTN","GPLCCR0",272,0)
+ ;;<Text>@@MEDISSUEDATETXT@@</Text>
+"RTN","GPLCCR0",273,0)
+ ;;</Type>
+"RTN","GPLCCR0",274,0)
+ ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
+"RTN","GPLCCR0",275,0)
+ ;;<Type>
+"RTN","GPLCCR0",276,0)
+ ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
+"RTN","GPLCCR0",277,0)
+ ;;</Type>
+"RTN","GPLCCR0",278,0)
+ ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
+"RTN","GPLCCR0",279,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",280,0)
+ ;;<IDs>
+"RTN","GPLCCR0",281,0)
+ ;;<Type>
+"RTN","GPLCCR0",282,0)
+ ;;<Text>@@MEDRXNOTXT@@</Text>
+"RTN","GPLCCR0",283,0)
+ ;;</Type>
+"RTN","GPLCCR0",284,0)
+ ;;<ID>@@MEDRXNO@@</ID>
+"RTN","GPLCCR0",285,0)
+ ;;</IDs>
+"RTN","GPLCCR0",286,0)
+ ;;<Type>
+"RTN","GPLCCR0",287,0)
+ ;;<Text>@@MEDTYPETEXT@@</Text>
+"RTN","GPLCCR0",288,0)
+ ;;</Type>
+"RTN","GPLCCR0",289,0)
+ ;;<Description>
+"RTN","GPLCCR0",290,0)
+ ;;<Text>@@MEDDETAILUNADORNED@@</Text>
+"RTN","GPLCCR0",291,0)
+ ;;</Description>
+"RTN","GPLCCR0",292,0)
+ ;;<Status>
+"RTN","GPLCCR0",293,0)
+ ;;<Text>@@MEDSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",294,0)
+ ;;</Status>
+"RTN","GPLCCR0",295,0)
+ ;;<Source>
+"RTN","GPLCCR0",296,0)
+ ;;<Actor>
+"RTN","GPLCCR0",297,0)
+ ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",298,0)
+ ;;</Actor>
+"RTN","GPLCCR0",299,0)
+ ;;</Source>
+"RTN","GPLCCR0",300,0)
+ ;;<Product>
+"RTN","GPLCCR0",301,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",302,0)
+ ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",303,0)
+ ;;<Code>
+"RTN","GPLCCR0",304,0)
+ ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
+"RTN","GPLCCR0",305,0)
+ ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",306,0)
+ ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
+"RTN","GPLCCR0",307,0)
+ ;;</Code>
+"RTN","GPLCCR0",308,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",309,0)
+ ;;<BrandName>
+"RTN","GPLCCR0",310,0)
+ ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
+"RTN","GPLCCR0",311,0)
+ ;;</BrandName>
+"RTN","GPLCCR0",312,0)
+ ;;<Strength>
+"RTN","GPLCCR0",313,0)
+ ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
+"RTN","GPLCCR0",314,0)
+ ;;<Units>
+"RTN","GPLCCR0",315,0)
+ ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
+"RTN","GPLCCR0",316,0)
+ ;;</Units>
+"RTN","GPLCCR0",317,0)
+ ;;</Strength>
+"RTN","GPLCCR0",318,0)
+ ;;<Form>
+"RTN","GPLCCR0",319,0)
+ ;;<Text>@@MEDFORMTEXT@@</Text>
+"RTN","GPLCCR0",320,0)
+ ;;</Form>
+"RTN","GPLCCR0",321,0)
+ ;;<Concentration>
+"RTN","GPLCCR0",322,0)
+ ;;<Value>@@MEDCONCVALUE@@</Value>
+"RTN","GPLCCR0",323,0)
+ ;;<Units>
+"RTN","GPLCCR0",324,0)
+ ;;<Unit>@@MEDCONCUNIT@@</Unit>
+"RTN","GPLCCR0",325,0)
+ ;;</Units>
+"RTN","GPLCCR0",326,0)
+ ;;</Concentration>
+"RTN","GPLCCR0",327,0)
+ ;;<Size>
+"RTN","GPLCCR0",328,0)
+ ;;<Text>@@MEDSIZETEXT@@</Text>
+"RTN","GPLCCR0",329,0)
+ ;;</Size>
+"RTN","GPLCCR0",330,0)
+ ;;</Product>
+"RTN","GPLCCR0",331,0)
+ ;;<Quantity>
+"RTN","GPLCCR0",332,0)
+ ;;<Value>@@MEDQUANTITYVALUE@@</Value>
+"RTN","GPLCCR0",333,0)
+ ;;<Units>
+"RTN","GPLCCR0",334,0)
+ ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
+"RTN","GPLCCR0",335,0)
+ ;;</Units>
+"RTN","GPLCCR0",336,0)
+ ;;</Quantity>
+"RTN","GPLCCR0",337,0)
+ ;;<Directions>
+"RTN","GPLCCR0",338,0)
+ ;;<Direction>
+"RTN","GPLCCR0",339,0)
+ ;;<Description>
+"RTN","GPLCCR0",340,0)
+ ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",341,0)
+ ;;</Description>
+"RTN","GPLCCR0",342,0)
+ ;;<DoseIndicator>
+"RTN","GPLCCR0",343,0)
+ ;;<Text>@@MEDDOSEINDICATOR@@</Text>
+"RTN","GPLCCR0",344,0)
+ ;;</DoseIndicator>
+"RTN","GPLCCR0",345,0)
+ ;;<DeliveryMethod>
+"RTN","GPLCCR0",346,0)
+ ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
+"RTN","GPLCCR0",347,0)
+ ;;</DeliveryMethod>
+"RTN","GPLCCR0",348,0)
+ ;;<Dose>
+"RTN","GPLCCR0",349,0)
+ ;;<Value>@@MEDDOSEVALUE@@</Value>
+"RTN","GPLCCR0",350,0)
+ ;;<Units>
+"RTN","GPLCCR0",351,0)
+ ;;<Unit>@@MEDDOSEUNIT@@</Unit>
+"RTN","GPLCCR0",352,0)
+ ;;</Units>
+"RTN","GPLCCR0",353,0)
+ ;;<Rate>
+"RTN","GPLCCR0",354,0)
+ ;;<Value>@@MEDRATEVALUE@@</Value>
+"RTN","GPLCCR0",355,0)
+ ;;<Units>
+"RTN","GPLCCR0",356,0)
+ ;;<Unit>@@MEDRATEUNIT@@</Unit>
+"RTN","GPLCCR0",357,0)
+ ;;</Units>
+"RTN","GPLCCR0",358,0)
+ ;;</Rate>
+"RTN","GPLCCR0",359,0)
+ ;;</Dose>
+"RTN","GPLCCR0",360,0)
+ ;;<Vehicle>
+"RTN","GPLCCR0",361,0)
+ ;;<Text>@@MEDVEHICLETEXT@@</Text>
+"RTN","GPLCCR0",362,0)
+ ;;</Vehicle>
+"RTN","GPLCCR0",363,0)
+ ;;<Route>
+"RTN","GPLCCR0",364,0)
+ ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
+"RTN","GPLCCR0",365,0)
+ ;;</Route>
+"RTN","GPLCCR0",366,0)
+ ;;<Frequency>
+"RTN","GPLCCR0",367,0)
+ ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
+"RTN","GPLCCR0",368,0)
+ ;;<Units>
+"RTN","GPLCCR0",369,0)
+ ;;<Unit>@@MEDFREQUENCYUNIT@@</Unit>
+"RTN","GPLCCR0",370,0)
+ ;;</Units>
+"RTN","GPLCCR0",371,0)
+ ;;</Frequency>
+"RTN","GPLCCR0",372,0)
+ ;;<Interval>
+"RTN","GPLCCR0",373,0)
+ ;;<Value>@@MEDINTERVALVALUE@@</Value>
+"RTN","GPLCCR0",374,0)
+ ;;<Units>
+"RTN","GPLCCR0",375,0)
+ ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
+"RTN","GPLCCR0",376,0)
+ ;;</Units>
+"RTN","GPLCCR0",377,0)
+ ;;</Interval>
+"RTN","GPLCCR0",378,0)
+ ;;<Duration>
+"RTN","GPLCCR0",379,0)
+ ;;<Value>@@MEDDURATIONVALUE@@</Value>
+"RTN","GPLCCR0",380,0)
+ ;;<Units>
+"RTN","GPLCCR0",381,0)
+ ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
+"RTN","GPLCCR0",382,0)
+ ;;</Units>
+"RTN","GPLCCR0",383,0)
+ ;;</Duration>
+"RTN","GPLCCR0",384,0)
+ ;;<Indication>
+"RTN","GPLCCR0",385,0)
+ ;;<PRNFlag>
+"RTN","GPLCCR0",386,0)
+ ;;<Text>@@MEDPRNFLAG@@</Text>
+"RTN","GPLCCR0",387,0)
+ ;;</PRNFlag>
+"RTN","GPLCCR0",388,0)
+ ;;<Problem>
+"RTN","GPLCCR0",389,0)
+ ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",390,0)
+ ;;<Type>
+"RTN","GPLCCR0",391,0)
+ ;;<Text>@@PROBLEM@@</Text>
+"RTN","GPLCCR0",392,0)
+ ;;</Type>
+"RTN","GPLCCR0",393,0)
+ ;;<Description>
+"RTN","GPLCCR0",394,0)
+ ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",395,0)
+ ;;<Code>
+"RTN","GPLCCR0",396,0)
+ ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",397,0)
+ ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",398,0)
+ ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",399,0)
+ ;;</Code>
+"RTN","GPLCCR0",400,0)
+ ;;</Description>
+"RTN","GPLCCR0",401,0)
+ ;;<Source>
+"RTN","GPLCCR0",402,0)
+ ;;<Actor>
+"RTN","GPLCCR0",403,0)
+ ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",404,0)
+ ;;</Actor>
+"RTN","GPLCCR0",405,0)
+ ;;</Source>
+"RTN","GPLCCR0",406,0)
+ ;;</Problem>
+"RTN","GPLCCR0",407,0)
+ ;;</Indication>
+"RTN","GPLCCR0",408,0)
+ ;;<StopIndicator>
+"RTN","GPLCCR0",409,0)
+ ;;<Text>@@MEDSTOPINDICATOR@@</Text>
+"RTN","GPLCCR0",410,0)
+ ;;</StopIndicator>
+"RTN","GPLCCR0",411,0)
+ ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
+"RTN","GPLCCR0",412,0)
+ ;;<MultipleDirectionModifier>
+"RTN","GPLCCR0",413,0)
+ ;;<Text>@@MEDMULDIRMOD@@</Text>
+"RTN","GPLCCR0",414,0)
+ ;;</MultipleDirectionModifier>
+"RTN","GPLCCR0",415,0)
+ ;;</Direction>
+"RTN","GPLCCR0",416,0)
+ ;;</Directions>
+"RTN","GPLCCR0",417,0)
+ ;;<PatientInstructions>
+"RTN","GPLCCR0",418,0)
+ ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",419,0)
+ ;;</PatientInstructions>
+"RTN","GPLCCR0",420,0)
+ ;;<FullfillmentInstructions>
+"RTN","GPLCCR0",421,0)
+ ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",422,0)
+ ;;</FullfillmentInstructions>
+"RTN","GPLCCR0",423,0)
+ ;;<Refills>
+"RTN","GPLCCR0",424,0)
+ ;;<Refill>
+"RTN","GPLCCR0",425,0)
+ ;;<Number>@@MEDRFNO@@</Number>
+"RTN","GPLCCR0",426,0)
+ ;;</Refill>
+"RTN","GPLCCR0",427,0)
+ ;;</Refills>
+"RTN","GPLCCR0",428,0)
+ ;;</Medication>
+"RTN","GPLCCR0",429,0)
+ ;;</Medications>
+"RTN","GPLCCR0",430,0)
+ ;;<VitalSigns>
+"RTN","GPLCCR0",431,0)
+ ;;<Result>
+"RTN","GPLCCR0",432,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",433,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",434,0)
+ ;;<Type>
+"RTN","GPLCCR0",435,0)
+ ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
+"RTN","GPLCCR0",436,0)
+ ;;</Type>
+"RTN","GPLCCR0",437,0)
+ ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",438,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",439,0)
+ ;;<Description>
+"RTN","GPLCCR0",440,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",441,0)
+ ;;</Description>
+"RTN","GPLCCR0",442,0)
+ ;;<Source>
+"RTN","GPLCCR0",443,0)
+ ;;<Actor>
+"RTN","GPLCCR0",444,0)
+ ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",445,0)
+ ;;</Actor>
+"RTN","GPLCCR0",446,0)
+ ;;</Source>
+"RTN","GPLCCR0",447,0)
+ ;;<Test>
+"RTN","GPLCCR0",448,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",449,0)
+ ;;<Type>
+"RTN","GPLCCR0",450,0)
+ ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
+"RTN","GPLCCR0",451,0)
+ ;;</Type>
+"RTN","GPLCCR0",452,0)
+ ;;<Description>
+"RTN","GPLCCR0",453,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",454,0)
+ ;;<Code>
+"RTN","GPLCCR0",455,0)
+ ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",456,0)
+ ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",457,0)
+ ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
+"RTN","GPLCCR0",458,0)
+ ;;</Code>
+"RTN","GPLCCR0",459,0)
+ ;;</Description>
+"RTN","GPLCCR0",460,0)
+ ;;<Source>
+"RTN","GPLCCR0",461,0)
+ ;;<Actor>
+"RTN","GPLCCR0",462,0)
+ ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",463,0)
+ ;;</Actor>
+"RTN","GPLCCR0",464,0)
+ ;;</Source>
+"RTN","GPLCCR0",465,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",466,0)
+ ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
+"RTN","GPLCCR0",467,0)
+ ;;<Units>
+"RTN","GPLCCR0",468,0)
+ ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
+"RTN","GPLCCR0",469,0)
+ ;;</Units>
+"RTN","GPLCCR0",470,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",471,0)
+ ;;</Test>
+"RTN","GPLCCR0",472,0)
+ ;;</Result>
+"RTN","GPLCCR0",473,0)
+ ;;</VitalSigns>
+"RTN","GPLCCR0",474,0)
+ ;;<Results>
+"RTN","GPLCCR0",475,0)
+ ;;<Result>
+"RTN","GPLCCR0",476,0)
+ ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",477,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",478,0)
+ ;;<Type>
+"RTN","GPLCCR0",479,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",480,0)
+ ;;</Type>
+"RTN","GPLCCR0",481,0)
+ ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",482,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",483,0)
+ ;;<Description>
+"RTN","GPLCCR0",484,0)
+ ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",485,0)
+ ;;<Code>
+"RTN","GPLCCR0",486,0)
+ ;;<Value>@@RESULTCODE@@</Value>
+"RTN","GPLCCR0",487,0)
+ ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",488,0)
+ ;;</Code>
+"RTN","GPLCCR0",489,0)
+ ;;</Description>
+"RTN","GPLCCR0",490,0)
+ ;;<Status>
+"RTN","GPLCCR0",491,0)
+ ;;<Text>@@RESULTSTATUS@@</Text>
+"RTN","GPLCCR0",492,0)
+ ;;</Status>
+"RTN","GPLCCR0",493,0)
+ ;;<Source>
+"RTN","GPLCCR0",494,0)
+ ;;<Actor>
+"RTN","GPLCCR0",495,0)
+ ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",496,0)
+ ;;</Actor>
+"RTN","GPLCCR0",497,0)
+ ;;</Source>
+"RTN","GPLCCR0",498,0)
+ ;;<TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",499,0)
+ ;;<Test>
+"RTN","GPLCCR0",500,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",501,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",502,0)
+ ;;<Type>
+"RTN","GPLCCR0",503,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",504,0)
+ ;;</Type>
+"RTN","GPLCCR0",505,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",506,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",507,0)
+ ;;<Description>
+"RTN","GPLCCR0",508,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",509,0)
+ ;;<Code>
+"RTN","GPLCCR0",510,0)
+ ;;<Value>@@RESULTTESTCODE@@</Value>
+"RTN","GPLCCR0",511,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",512,0)
+ ;;</Code>
+"RTN","GPLCCR0",513,0)
+ ;;</Description>
+"RTN","GPLCCR0",514,0)
+ ;;<Status>
+"RTN","GPLCCR0",515,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",516,0)
+ ;;</Status>
+"RTN","GPLCCR0",517,0)
+ ;;<Source>
+"RTN","GPLCCR0",518,0)
+ ;;<Actor>
+"RTN","GPLCCR0",519,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",520,0)
+ ;;</Actor>
+"RTN","GPLCCR0",521,0)
+ ;;</Source>
+"RTN","GPLCCR0",522,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",523,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",524,0)
+ ;;<Units>
+"RTN","GPLCCR0",525,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",526,0)
+ ;;</Units>
+"RTN","GPLCCR0",527,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",528,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",529,0)
+ ;;<Normal>
+"RTN","GPLCCR0",530,0)
+ ;;<Description>
+"RTN","GPLCCR0",531,0)
+ ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",532,0)
+ ;;</Description>
+"RTN","GPLCCR0",533,0)
+ ;;<Source>
+"RTN","GPLCCR0",534,0)
+ ;;<Actor>
+"RTN","GPLCCR0",535,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",536,0)
+ ;;</Actor>
+"RTN","GPLCCR0",537,0)
+ ;;</Source>
+"RTN","GPLCCR0",538,0)
+ ;;</Normal>
+"RTN","GPLCCR0",539,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",540,0)
+ ;;<Flag>
+"RTN","GPLCCR0",541,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",542,0)
+ ;;</Flag>
+"RTN","GPLCCR0",543,0)
+ ;;</Test>
+"RTN","GPLCCR0",544,0)
+ ;;</TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",545,0)
+ ;;<TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",546,0)
+ ;;<Test>
+"RTN","GPLCCR0",547,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",548,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",549,0)
+ ;;<Type>
+"RTN","GPLCCR0",550,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",551,0)
+ ;;</Type>
+"RTN","GPLCCR0",552,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",553,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",554,0)
+ ;;<Description>
+"RTN","GPLCCR0",555,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",556,0)
+ ;;<Code>
+"RTN","GPLCCR0",557,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",558,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",559,0)
+ ;;</Code>
+"RTN","GPLCCR0",560,0)
+ ;;</Description>
+"RTN","GPLCCR0",561,0)
+ ;;<Status>
+"RTN","GPLCCR0",562,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",563,0)
+ ;;</Status>
+"RTN","GPLCCR0",564,0)
+ ;;<Source>
+"RTN","GPLCCR0",565,0)
+ ;;<Actor>
+"RTN","GPLCCR0",566,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",567,0)
+ ;;</Actor>
+"RTN","GPLCCR0",568,0)
+ ;;</Source>
+"RTN","GPLCCR0",569,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",570,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",571,0)
+ ;;<Units>
+"RTN","GPLCCR0",572,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",573,0)
+ ;;</Units>
+"RTN","GPLCCR0",574,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",575,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",576,0)
+ ;;<Normal>
+"RTN","GPLCCR0",577,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
+"RTN","GPLCCR0",578,0)
+ ;;<Units>
+"RTN","GPLCCR0",579,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
+"RTN","GPLCCR0",580,0)
+ ;;</Units>
+"RTN","GPLCCR0",581,0)
+ ;;<ValueSequencePosition>1</ValueSequencePosition>
+"RTN","GPLCCR0",582,0)
+ ;;<Source>
+"RTN","GPLCCR0",583,0)
+ ;;<Actor>
+"RTN","GPLCCR0",584,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",585,0)
+ ;;</Actor>
+"RTN","GPLCCR0",586,0)
+ ;;</Source>
+"RTN","GPLCCR0",587,0)
+ ;;</Normal>
+"RTN","GPLCCR0",588,0)
+ ;;<Normal>
+"RTN","GPLCCR0",589,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
+"RTN","GPLCCR0",590,0)
+ ;;<Units>
+"RTN","GPLCCR0",591,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
+"RTN","GPLCCR0",592,0)
+ ;;</Units>
+"RTN","GPLCCR0",593,0)
+ ;;<ValueSequencePosition>2</ValueSequencePosition>
+"RTN","GPLCCR0",594,0)
+ ;;<VariableNomalModifier>
+"RTN","GPLCCR0",595,0)
+ ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
+"RTN","GPLCCR0",596,0)
+ ;;</VariableNomalModifier>
+"RTN","GPLCCR0",597,0)
+ ;;<Source>
+"RTN","GPLCCR0",598,0)
+ ;;<Actor>
+"RTN","GPLCCR0",599,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",600,0)
+ ;;</Actor>
+"RTN","GPLCCR0",601,0)
+ ;;</Source>
+"RTN","GPLCCR0",602,0)
+ ;;</Normal>
+"RTN","GPLCCR0",603,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",604,0)
+ ;;<Flag>
+"RTN","GPLCCR0",605,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",606,0)
+ ;;</Flag>
+"RTN","GPLCCR0",607,0)
+ ;;</Test>
+"RTN","GPLCCR0",608,0)
+ ;;</TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",609,0)
+ ;;</Result>
+"RTN","GPLCCR0",610,0)
+ ;;</Results>
+"RTN","GPLCCR0",611,0)
+ ;;<HealthCareProviders>
+"RTN","GPLCCR0",612,0)
+ ;;<Provider>
+"RTN","GPLCCR0",613,0)
+ ;;<ActorID>AA0005</ActorID>
+"RTN","GPLCCR0",614,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",615,0)
+ ;;<Text>Primary Provider</Text>
+"RTN","GPLCCR0",616,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",617,0)
+ ;;</Provider>
+"RTN","GPLCCR0",618,0)
+ ;;</HealthCareProviders>
+"RTN","GPLCCR0",619,0)
+ ;;</Body>
+"RTN","GPLCCR0",620,0)
+ ;;<Actors>
+"RTN","GPLCCR0",621,0)
+ ;;<ACTOR-PATIENT>
+"RTN","GPLCCR0",622,0)
+ ;;<Actor>
+"RTN","GPLCCR0",623,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",624,0)
+ ;;<Person>
+"RTN","GPLCCR0",625,0)
+ ;;<Name>
+"RTN","GPLCCR0",626,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",627,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",628,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",629,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",630,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",631,0)
+ ;;</Name>
+"RTN","GPLCCR0",632,0)
+ ;;<DateOfBirth>
+"RTN","GPLCCR0",633,0)
+ ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
+"RTN","GPLCCR0",634,0)
+ ;;</DateOfBirth>
+"RTN","GPLCCR0",635,0)
+ ;;<Gender>
+"RTN","GPLCCR0",636,0)
+ ;;<Text>@@ACTORGENDER@@</Text>
+"RTN","GPLCCR0",637,0)
+ ;;<Code>
+"RTN","GPLCCR0",638,0)
+ ;;<Value>@@ACTORGENDER@@</Value>
+"RTN","GPLCCR0",639,0)
+ ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
+"RTN","GPLCCR0",640,0)
+ ;;</Code>
+"RTN","GPLCCR0",641,0)
+ ;;</Gender>
+"RTN","GPLCCR0",642,0)
+ ;;</Person>
+"RTN","GPLCCR0",643,0)
+ ;;<IDs>
+"RTN","GPLCCR0",644,0)
+ ;;<Type>
+"RTN","GPLCCR0",645,0)
+ ;;<Text>@@ACTORSSNTEXT@@</Text>
+"RTN","GPLCCR0",646,0)
+ ;;</Type>
+"RTN","GPLCCR0",647,0)
+ ;;<ID>@@ACTORSSN@@</ID>
+"RTN","GPLCCR0",648,0)
+ ;;<Source>
+"RTN","GPLCCR0",649,0)
+ ;;<Actor>
+"RTN","GPLCCR0",650,0)
+ ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
+"RTN","GPLCCR0",651,0)
+ ;;</Actor>
+"RTN","GPLCCR0",652,0)
+ ;;</Source>
+"RTN","GPLCCR0",653,0)
+ ;;</IDs>
+"RTN","GPLCCR0",654,0)
+ ;;<Address>
+"RTN","GPLCCR0",655,0)
+ ;;<Type>
+"RTN","GPLCCR0",656,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",657,0)
+ ;;</Type>
+"RTN","GPLCCR0",658,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",659,0)
+ ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
+"RTN","GPLCCR0",660,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",661,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",662,0)
+ ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
+"RTN","GPLCCR0",663,0)
+ ;;</Address>
+"RTN","GPLCCR0",664,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",665,0)
+ ;;<Value>@@ACTORRESTEL@@</Value>
+"RTN","GPLCCR0",666,0)
+ ;;<Type>
+"RTN","GPLCCR0",667,0)
+ ;;<Text>@@ACTORRESTELTEXT@@</Text>
+"RTN","GPLCCR0",668,0)
+ ;;</Type>
+"RTN","GPLCCR0",669,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",670,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",671,0)
+ ;;<Value>@@ACTORWORKTEL@@</Value>
+"RTN","GPLCCR0",672,0)
+ ;;<Type>
+"RTN","GPLCCR0",673,0)
+ ;;<Text>@@ACTORWORKTELTEXT@@</Text>
+"RTN","GPLCCR0",674,0)
+ ;;</Type>
+"RTN","GPLCCR0",675,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",676,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",677,0)
+ ;;<Value>@@ACTORCELLTEL@@</Value>
+"RTN","GPLCCR0",678,0)
+ ;;<Type>
+"RTN","GPLCCR0",679,0)
+ ;;<Text>@@ACTORCELLTELTEXT@@</Text>
+"RTN","GPLCCR0",680,0)
+ ;;</Type>
+"RTN","GPLCCR0",681,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",682,0)
+ ;;<EMail>
+"RTN","GPLCCR0",683,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",684,0)
+ ;;</EMail>
+"RTN","GPLCCR0",685,0)
+ ;;<Source>
+"RTN","GPLCCR0",686,0)
+ ;;<Actor>
+"RTN","GPLCCR0",687,0)
+ ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",688,0)
+ ;;</Actor>
+"RTN","GPLCCR0",689,0)
+ ;;</Source>
+"RTN","GPLCCR0",690,0)
+ ;;</Actor>
+"RTN","GPLCCR0",691,0)
+ ;;</ACTOR-PATIENT>
+"RTN","GPLCCR0",692,0)
+ ;;<ACTOR-SYSTEM>
+"RTN","GPLCCR0",693,0)
+ ;;<Actor>
+"RTN","GPLCCR0",694,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",695,0)
+ ;;<InformationSystem>
+"RTN","GPLCCR0",696,0)
+ ;;<Name>@@ACTORINFOSYSNAME@@</Name>
+"RTN","GPLCCR0",697,0)
+ ;;<Version>@@ACTORINFOSYSVER@@</Version>
+"RTN","GPLCCR0",698,0)
+ ;;</InformationSystem>
+"RTN","GPLCCR0",699,0)
+ ;;<Source>
+"RTN","GPLCCR0",700,0)
+ ;;<Actor>
+"RTN","GPLCCR0",701,0)
+ ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",702,0)
+ ;;</Actor>
+"RTN","GPLCCR0",703,0)
+ ;;</Source>
+"RTN","GPLCCR0",704,0)
+ ;;</Actor>
+"RTN","GPLCCR0",705,0)
+ ;;</ACTOR-SYSTEM>
+"RTN","GPLCCR0",706,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCR0",707,0)
+ ;;<Actor>
+"RTN","GPLCCR0",708,0)
+ ;;<ActorObjectID>AA0003</ActorObjectID>
+"RTN","GPLCCR0",709,0)
+ ;;<Person>
+"RTN","GPLCCR0",710,0)
+ ;;<Name>
+"RTN","GPLCCR0",711,0)
+ ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
+"RTN","GPLCCR0",712,0)
+ ;;</Name>
+"RTN","GPLCCR0",713,0)
+ ;;</Person>
+"RTN","GPLCCR0",714,0)
+ ;;<Relation>
+"RTN","GPLCCR0",715,0)
+ ;;<Text>@@ACTORRELATION@@</Text>
+"RTN","GPLCCR0",716,0)
+ ;;</Relation>
+"RTN","GPLCCR0",717,0)
+ ;;<Source>
+"RTN","GPLCCR0",718,0)
+ ;;<Actor>
+"RTN","GPLCCR0",719,0)
+ ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
+"RTN","GPLCCR0",720,0)
+ ;;</Actor>
+"RTN","GPLCCR0",721,0)
+ ;;</Source>
+"RTN","GPLCCR0",722,0)
+ ;;</Actor>
+"RTN","GPLCCR0",723,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCR0",724,0)
+ ;;<ACTOR-PROVIDER>
+"RTN","GPLCCR0",725,0)
+ ;;<Actor>
+"RTN","GPLCCR0",726,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",727,0)
+ ;;<Person>
+"RTN","GPLCCR0",728,0)
+ ;;<Name>
+"RTN","GPLCCR0",729,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",730,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",731,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",732,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",733,0)
+ ;;<Title>@@ACTORTITLE@@</Title>
+"RTN","GPLCCR0",734,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",735,0)
+ ;;</Name>
+"RTN","GPLCCR0",736,0)
+ ;;</Person>
+"RTN","GPLCCR0",737,0)
+ ;;<IDs>
+"RTN","GPLCCR0",738,0)
+ ;;<Type>
+"RTN","GPLCCR0",739,0)
+ ;;<Text>@@IDTYPE@@</Text>
+"RTN","GPLCCR0",740,0)
+ ;;</Type>
+"RTN","GPLCCR0",741,0)
+ ;;<ID>@@ID@@</ID>
+"RTN","GPLCCR0",742,0)
+ ;;<IssuedBy>
+"RTN","GPLCCR0",743,0)
+ ;;<Description>
+"RTN","GPLCCR0",744,0)
+ ;;<Text>@@IDDESC@@</Text>
+"RTN","GPLCCR0",745,0)
+ ;;</Description>
+"RTN","GPLCCR0",746,0)
+ ;;</IssuedBy>
+"RTN","GPLCCR0",747,0)
+ ;;</IDs>
+"RTN","GPLCCR0",748,0)
+ ;;<Specialty>
+"RTN","GPLCCR0",749,0)
+ ;;<Text>@@ACTORSPECIALITY@@</Text>
+"RTN","GPLCCR0",750,0)
+ ;;</Specialty>
+"RTN","GPLCCR0",751,0)
+ ;;<Address>
+"RTN","GPLCCR0",752,0)
+ ;;<Type>
+"RTN","GPLCCR0",753,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",754,0)
+ ;;</Type>
+"RTN","GPLCCR0",755,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",756,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",757,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",758,0)
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+"RTN","GPLCCR0",759,0)
+ ;;</Address>
+"RTN","GPLCCR0",760,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",761,0)
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+"RTN","GPLCCR0",762,0)
+ ;;<Type>
+"RTN","GPLCCR0",763,0)
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+"RTN","GPLCCR0",764,0)
+ ;;</Type>
+"RTN","GPLCCR0",765,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",766,0)
+ ;;<Email>
+"RTN","GPLCCR0",767,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",768,0)
+ ;;</Email>
+"RTN","GPLCCR0",769,0)
+ ;;<Source>
+"RTN","GPLCCR0",770,0)
+ ;;<Actor>
+"RTN","GPLCCR0",771,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",772,0)
+ ;;</Actor>
+"RTN","GPLCCR0",773,0)
+ ;;</Source>
+"RTN","GPLCCR0",774,0)
+ ;;</Actor>
+"RTN","GPLCCR0",775,0)
+ ;;</ACTOR-PROVIDER>
+"RTN","GPLCCR0",776,0)
+ ;;<ACTOR-ORG>
+"RTN","GPLCCR0",777,0)
+ ;;<Actor>
+"RTN","GPLCCR0",778,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",779,0)
+ ;;<Organization>
+"RTN","GPLCCR0",780,0)
+ ;;<Name>@@ORGANIZATIONNAME@@</Name>
+"RTN","GPLCCR0",781,0)
+ ;;</Organization>
+"RTN","GPLCCR0",782,0)
+ ;;<Source>
+"RTN","GPLCCR0",783,0)
+ ;;<Actor>
+"RTN","GPLCCR0",784,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",785,0)
+ ;;</Actor>
+"RTN","GPLCCR0",786,0)
+ ;;</Source>
+"RTN","GPLCCR0",787,0)
+ ;;</Actor>
+"RTN","GPLCCR0",788,0)
+ ;;</ACTOR-ORG>
+"RTN","GPLCCR0",789,0)
+ ;;</Actors>
+"RTN","GPLCCR0",790,0)
+ ;;<Signatures>
+"RTN","GPLCCR0",791,0)
+ ;;<CCRSignature>
+"RTN","GPLCCR0",792,0)
+ ;;<SignatureObjectID>S0001</SignatureObjectID>
+"RTN","GPLCCR0",793,0)
+ ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
+"RTN","GPLCCR0",794,0)
+ ;;<Source>
+"RTN","GPLCCR0",795,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",796,0)
+ ;;</Source>
+"RTN","GPLCCR0",797,0)
+ ;;<Signature>
+"RTN","GPLCCR0",798,0)
+ ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
+"RTN","GPLCCR0",799,0)
+ ;;<SignedInfo>
+"RTN","GPLCCR0",800,0)
+ ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
+"RTN","GPLCCR0",801,0)
+ ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
+"RTN","GPLCCR0",802,0)
+ ;;<Reference URI="">
+"RTN","GPLCCR0",803,0)
+ ;;<Transforms>
+"RTN","GPLCCR0",804,0)
+ ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
+"RTN","GPLCCR0",805,0)
+ ;;</Transforms>
+"RTN","GPLCCR0",806,0)
+ ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
+"RTN","GPLCCR0",807,0)
+ ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
+"RTN","GPLCCR0",808,0)
+ ;;</Reference>
+"RTN","GPLCCR0",809,0)
+ ;;</SignedInfo>
+"RTN","GPLCCR0",810,0)
+ ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
+"RTN","GPLCCR0",811,0)
+ ;;<KeyInfo>
+"RTN","GPLCCR0",812,0)
+ ;;<KeyValue>
+"RTN","GPLCCR0",813,0)
+ ;;<RSAKeyValue>
+"RTN","GPLCCR0",814,0)
+ ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
+"RTN","GPLCCR0",815,0)
+ ;;<Exponent>AQAB</Exponent>
+"RTN","GPLCCR0",816,0)
+ ;;</RSAKeyValue>
+"RTN","GPLCCR0",817,0)
+ ;;</KeyValue>
+"RTN","GPLCCR0",818,0)
+ ;;</KeyInfo>
+"RTN","GPLCCR0",819,0)
+ ;;</Signature>
+"RTN","GPLCCR0",820,0)
+ ;;</Signature>
+"RTN","GPLCCR0",821,0)
+ ;;</CCRSignature>
+"RTN","GPLCCR0",822,0)
+ ;;</Signatures>
+"RTN","GPLCCR0",823,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCR0",824,0)
+ ;</TEMPLATE>
+"RTN","GPLMEDS")
+0^18^B27482404
+"RTN","GPLMEDS",1,0)
+GPLMEDS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
+"RTN","GPLMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 3
+"RTN","GPLMEDS",3,0)
+   ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLMEDS",4,0)
+   ;General Public License See attached copy of the License.
+"RTN","GPLMEDS",5,0)
+   ;
+"RTN","GPLMEDS",6,0)
+   ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLMEDS",7,0)
+   ;it under the terms of the GNU General Public License as published by
+"RTN","GPLMEDS",8,0)
+   ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLMEDS",9,0)
+   ;(at your option) any later version.
+"RTN","GPLMEDS",10,0)
+   ;
+"RTN","GPLMEDS",11,0)
+   ;This program is distributed in the hope that it will be useful,
+"RTN","GPLMEDS",12,0)
+   ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLMEDS",13,0)
+   ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLMEDS",14,0)
+   ;GNU General Public License for more details.
+"RTN","GPLMEDS",15,0)
+   ;
+"RTN","GPLMEDS",16,0)
+   ;You should have received a copy of the GNU General Public License along
+"RTN","GPLMEDS",17,0)
+   ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLMEDS",18,0)
+   ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLMEDS",19,0)
+   ;
+"RTN","GPLMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","GPLMEDS",21,0)
+   Q
+"RTN","GPLMEDS",22,0)
+   ;
+"RTN","GPLMEDS",23,0)
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","GPLMEDS",24,0)
+   ;
+"RTN","GPLMEDS",25,0)
+   ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLMEDS",26,0)
+   ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLMEDS",27,0)
+   ;
+"RTN","GPLMEDS",28,0)
+   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+"RTN","GPLMEDS",29,0)
+   D ACTIVE^ORWPS(.MEDRSLT,DFN)
+"RTN","GPLMEDS",30,0)
+   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+"RTN","GPLMEDS",31,0)
+   . W "ERROR RUNNINIG MEDICATIONS RPC",!
+"RTN","GPLMEDS",32,0)
+   . S @MEDOUTXML@(0)=0
+"RTN","GPLMEDS",33,0)
+   . Q
+"RTN","GPLMEDS",34,0)
+   ; I DEBUG ZWR MEDRSLT
+"RTN","GPLMEDS",35,0)
+   M GPLMEDS=MEDRSLT
+"RTN","GPLMEDS",36,0)
+   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
+"RTN","GPLMEDS",37,0)
+   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+"RTN","GPLMEDS",38,0)
+   K @MEDTVMAP,@MEDTARYTMP
+"RTN","GPLMEDS",39,0)
+   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
+"RTN","GPLMEDS",40,0)
+   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
+"RTN","GPLMEDS",41,0)
+   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
+"RTN","GPLMEDS",42,0)
+   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
+"RTN","GPLMEDS",43,0)
+   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
+"RTN","GPLMEDS",44,0)
+   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
+"RTN","GPLMEDS",45,0)
+   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
+"RTN","GPLMEDS",46,0)
+   . . S ZI=ZI+1 ; INCREMENT MED COUNT
+"RTN","GPLMEDS",47,0)
+   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
+"RTN","GPLMEDS",48,0)
+   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
+"RTN","GPLMEDS",49,0)
+   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
+"RTN","GPLMEDS",50,0)
+   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
+"RTN","GPLMEDS",51,0)
+   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
+"RTN","GPLMEDS",52,0)
+   ZWR ZA
+"RTN","GPLMEDS",53,0)
+   F ZI=1:1:ZA(0) D  ; FOR EACH MED
+"RTN","GPLMEDS",54,0)
+   . I DEBUG W "ZI IS ",ZI,!
+"RTN","GPLMEDS",55,0)
+   . S MEDVMAP=$NA(@MEDTVMAP@(ZI))
+"RTN","GPLMEDS",56,0)
+   . K @MEDVMAP
+"RTN","GPLMEDS",57,0)
+   . I DEBUG W "VMAP= ",MEDVMAP,!
+"RTN","GPLMEDS",58,0)
+   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
+"RTN","GPLMEDS",59,0)
+   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
+"RTN","GPLMEDS",60,0)
+   . S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS
+"RTN","GPLMEDS",61,0)
+   . S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+"RTN","GPLMEDS",62,0)
+   . S @MEDVMAP@("MEDDATETIMEAGE")=""
+"RTN","GPLMEDS",63,0)
+   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
+"RTN","GPLMEDS",64,0)
+   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
+"RTN","GPLMEDS",65,0)
+   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+"RTN","GPLMEDS",66,0)
+   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLMEDS",67,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+"RTN","GPLMEDS",68,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=""
+"RTN","GPLMEDS",69,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+"RTN","GPLMEDS",70,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
+"RTN","GPLMEDS",71,0)
+   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
+"RTN","GPLMEDS",72,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
+"RTN","GPLMEDS",73,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
+"RTN","GPLMEDS",74,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
+"RTN","GPLMEDS",75,0)
+   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
+"RTN","GPLMEDS",76,0)
+   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
+"RTN","GPLMEDS",77,0)
+   . S @MEDVMAP@("MEDFORMTEXT")=""
+"RTN","GPLMEDS",78,0)
+   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
+"RTN","GPLMEDS",79,0)
+   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
+"RTN","GPLMEDS",80,0)
+   . S @MEDVMAP@("MEDRFNO")=""
+"RTN","GPLMEDS",81,0)
+   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
+"RTN","GPLMEDS",82,0)
+   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
+"RTN","GPLMEDS",83,0)
+   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
+"RTN","GPLMEDS",84,0)
+   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
+"RTN","GPLMEDS",85,0)
+   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
+"RTN","GPLMEDS",86,0)
+   . . S ZN=0 ; DON'T KNOW WHY
+"RTN","GPLMEDS",87,0)
+   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
+"RTN","GPLMEDS",88,0)
+   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
+"RTN","GPLMEDS",89,0)
+   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
+"RTN","GPLMEDS",90,0)
+   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
+"RTN","GPLMEDS",91,0)
+   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
+"RTN","GPLMEDS",92,0)
+   . S @MEDVMAP@("MEDDOSEVALUE")=""
+"RTN","GPLMEDS",93,0)
+   . S @MEDVMAP@("MEDDOSEUNIT")=""
+"RTN","GPLMEDS",94,0)
+   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
+"RTN","GPLMEDS",95,0)
+   . S @MEDVMAP@("MEDDURATIONVALUE")=""
+"RTN","GPLMEDS",96,0)
+   . S @MEDVMAP@("MEDDURATIONUNIT")=""
+"RTN","GPLMEDS",97,0)
+   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
+"RTN","GPLMEDS",98,0)
+   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
+"RTN","GPLMEDS",99,0)
+   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
+"RTN","GPLMEDS",100,0)
+   . K @MEDARYTMP
+"RTN","GPLMEDS",101,0)
+   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+"RTN","GPLMEDS",102,0)
+   . I ZI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLMEDS",103,0)
+   . . ; W "FIRST ONE",!
+"RTN","GPLMEDS",104,0)
+   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
+"RTN","GPLMEDS",105,0)
+   . I ZI>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLMEDS",106,0)
+   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+"RTN","GPLMEDS",107,0)
+   N MEDTMP,MEDI
+"RTN","GPLMEDS",108,0)
+   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLMEDS",109,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLMEDS",110,0)
+   . W "MEDICATION MISSING ",!
+"RTN","GPLMEDS",111,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","GPLMEDS",112,0)
+   Q
+"RTN","GPLMEDS",113,0)
+   ;
+"RTN","GPLPROBS")
+0^11^B24846496
+"RTN","GPLPROBS",1,0)
+GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
+"RTN","GPLPROBS",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLPROBS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLPROBS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLPROBS",5,0)
+ ;
+"RTN","GPLPROBS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLPROBS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLPROBS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLPROBS",9,0)
+ ;(at your option) any later version.
+"RTN","GPLPROBS",10,0)
+ ;
+"RTN","GPLPROBS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLPROBS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLPROBS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLPROBS",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLPROBS",15,0)
+ ;
+"RTN","GPLPROBS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLPROBS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLPROBS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLPROBS",19,0)
+ ;
+"RTN","GPLPROBS",20,0)
+           ;
+"RTN","GPLPROBS",21,0)
+           ;  PROCESS THE PROBLEMS SECTION OF THE CCR
+"RTN","GPLPROBS",22,0)
+           ;
+"RTN","GPLPROBS",23,0)
+EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+"RTN","GPLPROBS",24,0)
+          ;
+"RTN","GPLPROBS",25,0)
+          ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLPROBS",26,0)
+          ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLPROBS",27,0)
+          ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+"RTN","GPLPROBS",28,0)
+          ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+"RTN","GPLPROBS",29,0)
+          ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+"RTN","GPLPROBS",30,0)
+          ;
+"RTN","GPLPROBS",31,0)
+          N RPCRSLT,J,K,PTMP,X,VMAP,TBU
+"RTN","GPLPROBS",32,0)
+          S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
+"RTN","GPLPROBS",33,0)
+          S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
+"RTN","GPLPROBS",34,0)
+          K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLPROBS",35,0)
+          D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+"RTN","GPLPROBS",36,0)
+          I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
+"RTN","GPLPROBS",37,0)
+          . W "NULL RESULT FROM LIST^ORQQPL3 ",!
+"RTN","GPLPROBS",38,0)
+          . S @OUTXML@(0)=0
+"RTN","GPLPROBS",39,0)
+          . ; Q
+"RTN","GPLPROBS",40,0)
+          ; I DEBUG ZWR RPCRSLT
+"RTN","GPLPROBS",41,0)
+          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
+"RTN","GPLPROBS",42,0)
+          . S VMAP=$NA(@TVMAP@(J))
+"RTN","GPLPROBS",43,0)
+          . K @VMAP
+"RTN","GPLPROBS",44,0)
+          . W "VMAP= ",VMAP,!
+"RTN","GPLPROBS",45,0)
+          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+"RTN","GPLPROBS",46,0)
+          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
+"RTN","GPLPROBS",47,0)
+          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
+"RTN","GPLPROBS",48,0)
+          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
+"RTN","GPLPROBS",49,0)
+          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+"RTN","GPLPROBS",50,0)
+          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+"RTN","GPLPROBS",51,0)
+          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
+"RTN","GPLPROBS",52,0)
+          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
+"RTN","GPLPROBS",53,0)
+          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
+"RTN","GPLPROBS",54,0)
+          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
+"RTN","GPLPROBS",55,0)
+          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
+"RTN","GPLPROBS",56,0)
+          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
+"RTN","GPLPROBS",57,0)
+          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
+"RTN","GPLPROBS",58,0)
+          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
+"RTN","GPLPROBS",59,0)
+          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+"RTN","GPLPROBS",60,0)
+          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
+"RTN","GPLPROBS",61,0)
+          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
+"RTN","GPLPROBS",62,0)
+          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
+"RTN","GPLPROBS",63,0)
+          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
+"RTN","GPLPROBS",64,0)
+          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
+"RTN","GPLPROBS",65,0)
+          . S ARYTMP=$NA(@TARYTMP@(J))
+"RTN","GPLPROBS",66,0)
+          . ; W "ARYTMP= ",ARYTMP,!
+"RTN","GPLPROBS",67,0)
+          . K @ARYTMP
+"RTN","GPLPROBS",68,0)
+          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
+"RTN","GPLPROBS",69,0)
+          . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",70,0)
+          . . ; W "FIRST ONE",!
+"RTN","GPLPROBS",71,0)
+          . . D CP^GPLXPATH(ARYTMP,OUTXML)
+"RTN","GPLPROBS",72,0)
+          . . ; W "OUTXML ",OUTXML,!
+"RTN","GPLPROBS",73,0)
+          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLPROBS",74,0)
+          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
+"RTN","GPLPROBS",75,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
+"RTN","GPLPROBS",76,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLPROBS",77,0)
+          ; ZWR @OUTXML
+"RTN","GPLPROBS",78,0)
+          ; $$HTML^DILF(
+"RTN","GPLPROBS",79,0)
+          ; GENERATE THE NARITIVE HTML FOR THE CCD
+"RTN","GPLPROBS",80,0)
+          I CCD D  ; IF THIS IS FOR A CCD
+"RTN","GPLPROBS",81,0)
+          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
+"RTN","GPLPROBS",82,0)
+          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
+"RTN","GPLPROBS",83,0)
+          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
+"RTN","GPLPROBS",84,0)
+          . . W "VMAP =",VMAP,!
+"RTN","GPLPROBS",85,0)
+          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
+"RTN","GPLPROBS",86,0)
+          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
+"RTN","GPLPROBS",87,0)
+          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
+"RTN","GPLPROBS",88,0)
+          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
+"RTN","GPLPROBS",89,0)
+          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
+"RTN","GPLPROBS",90,0)
+          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",91,0)
+          . . . D CP^GPLXPATH("HOUT","HTMLO")
+"RTN","GPLPROBS",92,0)
+          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
+"RTN","GPLPROBS",93,0)
+          . . . W "DOING INNER",!
+"RTN","GPLPROBS",94,0)
+          . . . N HTMLBLD,HTMLTMP
+"RTN","GPLPROBS",95,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
+"RTN","GPLPROBS",96,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
+"RTN","GPLPROBS",97,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
+"RTN","GPLPROBS",98,0)
+          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
+"RTN","GPLPROBS",99,0)
+          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
+"RTN","GPLPROBS",100,0)
+          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
+"RTN","GPLPROBS",101,0)
+          . I DEBUG D PARY^GPLXPATH("HTMLO")
+"RTN","GPLPROBS",102,0)
+          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+"RTN","GPLPROBS",103,0)
+          N PROBSTMP,I
+"RTN","GPLPROBS",104,0)
+          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLPROBS",105,0)
+          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLPROBS",106,0)
+          . ; STRINGS MARKED AS @@X@@
+"RTN","GPLPROBS",107,0)
+          . W "PROBLEMS Missing list: ",!
+"RTN","GPLPROBS",108,0)
+          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
+"RTN","GPLPROBS",109,0)
+          Q
+"RTN","GPLPROBS",110,0)
+          ;
+"RTN","GPLRIMA")
+0^13^B96435476
+"RTN","GPLRIMA",1,0)
+GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+"RTN","GPLRIMA",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLRIMA",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLRIMA",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLRIMA",5,0)
+ ;
+"RTN","GPLRIMA",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLRIMA",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLRIMA",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLRIMA",9,0)
+ ;(at your option) any later version.
+"RTN","GPLRIMA",10,0)
+ ;
+"RTN","GPLRIMA",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLRIMA",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLRIMA",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLRIMA",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLRIMA",15,0)
+ ;
+"RTN","GPLRIMA",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLRIMA",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLRIMA",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLRIMA",19,0)
+ ;
+"RTN","GPLRIMA",20,0)
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+"RTN","GPLRIMA",21,0)
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+"RTN","GPLRIMA",22,0)
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+"RTN","GPLRIMA",23,0)
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+"RTN","GPLRIMA",24,0)
+ ; CONVEYED VIA THE CCR OR CCD.
+"RTN","GPLRIMA",25,0)
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+"RTN","GPLRIMA",26,0)
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+"RTN","GPLRIMA",27,0)
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+"RTN","GPLRIMA",28,0)
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+"RTN","GPLRIMA",29,0)
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+"RTN","GPLRIMA",30,0)
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+"RTN","GPLRIMA",31,0)
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+"RTN","GPLRIMA",32,0)
+ ;
+"RTN","GPLRIMA",33,0)
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+"RTN","GPLRIMA",34,0)
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+"RTN","GPLRIMA",35,0)
+ ;    CONVEYANCE TO THE RIM APPLICATION.
+"RTN","GPLRIMA",36,0)
+ ;
+"RTN","GPLRIMA",37,0)
+ ;
+"RTN","GPLRIMA",38,0)
+ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
+"RTN","GPLRIMA",39,0)
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+"RTN","GPLRIMA",40,0)
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+"RTN","GPLRIMA",41,0)
+    ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
+"RTN","GPLRIMA",42,0)
+    ;
+"RTN","GPLRIMA",43,0)
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+"RTN","GPLRIMA",44,0)
+    N CCRGLO
+"RTN","GPLRIMA",45,0)
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
+"RTN","GPLRIMA",46,0)
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+"RTN","GPLRIMA",47,0)
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+"RTN","GPLRIMA",48,0)
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+"RTN","GPLRIMA",49,0)
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+"RTN","GPLRIMA",50,0)
+    I RIMDFN="" S RIMDFN=RESUME
+"RTN","GPLRIMA",51,0)
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+"RTN","GPLRIMA",52,0)
+    . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
+"RTN","GPLRIMA",53,0)
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+"RTN","GPLRIMA",54,0)
+    . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
+"RTN","GPLRIMA",55,0)
+    . W RIMDFN,!
+"RTN","GPLRIMA",56,0)
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+"RTN","GPLRIMA",57,0)
+    . ;
+"RTN","GPLRIMA",58,0)
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
+"RTN","GPLRIMA",59,0)
+    . ;
+"RTN","GPLRIMA",60,0)
+    . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+"RTN","GPLRIMA",61,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
+"RTN","GPLRIMA",62,0)
+    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+"RTN","GPLRIMA",63,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
+"RTN","GPLRIMA",64,0)
+    . I $D(^TMP("GPLCCR",$J,"MEDICATIONS",1)) D  ; MEDS VARS EXISTS
+"RTN","GPLRIMA",65,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDICATIONS")
+"RTN","GPLRIMA",66,0)
+    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+"RTN","GPLRIMA",67,0)
+    . ;
+"RTN","GPLRIMA",68,0)
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+"RTN","GPLRIMA",69,0)
+    . ;
+"RTN","GPLRIMA",70,0)
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+"RTN","GPLRIMA",71,0)
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+"RTN","GPLRIMA",72,0)
+    . ;
+"RTN","GPLRIMA",73,0)
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
+"RTN","GPLRIMA",74,0)
+    . ;
+"RTN","GPLRIMA",75,0)
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+"RTN","GPLRIMA",76,0)
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+"RTN","GPLRIMA",77,0)
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+"RTN","GPLRIMA",78,0)
+    . ;
+"RTN","GPLRIMA",79,0)
+    . N CATNAME,CATTBL
+"RTN","GPLRIMA",80,0)
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+"RTN","GPLRIMA",81,0)
+    . S CATNAME=""
+"RTN","GPLRIMA",82,0)
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+"RTN","GPLRIMA",83,0)
+    . W "CATEGORY NAME: ",CATNAME,!
+"RTN","GPLRIMA",84,0)
+    . ;
+"RTN","GPLRIMA",85,0)
+    . S RIMDFN=$O(^DPT(RIMDFN)) ; NEXT PATIENT
+"RTN","GPLRIMA",86,0)
+    S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+"RTN","GPLRIMA",87,0)
+    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
+"RTN","GPLRIMA",88,0)
+    Q
+"RTN","GPLRIMA",89,0)
+    ;
+"RTN","GPLRIMA",90,0)
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+"RTN","GPLRIMA",91,0)
+    N SBASE,SATTR
+"RTN","GPLRIMA",92,0)
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+"RTN","GPLRIMA",93,0)
+    D APOST("SATTR","RIMTBL","HEADER")
+"RTN","GPLRIMA",94,0)
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+"RTN","GPLRIMA",95,0)
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+"RTN","GPLRIMA",96,0)
+    . W "POSTING PROBLEMS",!
+"RTN","GPLRIMA",97,0)
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+"RTN","GPLRIMA",98,0)
+    I $D(@SBASE@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS")
+"RTN","GPLRIMA",99,0)
+    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+"RTN","GPLRIMA",100,0)
+    W "ATTRIBUTES: ",SATTR,!
+"RTN","GPLRIMA",101,0)
+    Q SATTR
+"RTN","GPLRIMA",102,0)
+    ;
+"RTN","GPLRIMA",103,0)
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+"RTN","GPLRIMA",104,0)
+    K ^TMP("GPLRIM","RESUME")
+"RTN","GPLRIMA",105,0)
+    K ^TMP("GPLRIM")
+"RTN","GPLRIMA",106,0)
+    Q
+"RTN","GPLRIMA",107,0)
+    ;
+"RTN","GPLRIMA",108,0)
+CLIST ; LIST THE CATEGORIES
+"RTN","GPLRIMA",109,0)
+    ;
+"RTN","GPLRIMA",110,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",111,0)
+    N CLBASE,CLNUM,ZI,CLIDX
+"RTN","GPLRIMA",112,0)
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+"RTN","GPLRIMA",113,0)
+    S CLNUM=@CLBASE@(0)
+"RTN","GPLRIMA",114,0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+"RTN","GPLRIMA",115,0)
+    . S CLIDX=@CLBASE@(ZI)
+"RTN","GPLRIMA",116,0)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+"RTN","GPLRIMA",117,0)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+"RTN","GPLRIMA",118,0)
+    . W CLIDX,!
+"RTN","GPLRIMA",119,0)
+    ; D PARY^GPLXPATH(CLBASE)
+"RTN","GPLRIMA",120,0)
+    Q
+"RTN","GPLRIMA",121,0)
+    ;
+"RTN","GPLRIMA",122,0)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+"RTN","GPLRIMA",123,0)
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+"RTN","GPLRIMA",124,0)
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+"RTN","GPLRIMA",125,0)
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+"RTN","GPLRIMA",126,0)
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+"RTN","GPLRIMA",127,0)
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+"RTN","GPLRIMA",128,0)
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+"RTN","GPLRIMA",129,0)
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+"RTN","GPLRIMA",130,0)
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+"RTN","GPLRIMA",131,0)
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+"RTN","GPLRIMA",132,0)
+    ; NUMBER IE CTBL_X(CDFN)=""
+"RTN","GPLRIMA",133,0)
+    ;
+"RTN","GPLRIMA",134,0)
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+"RTN","GPLRIMA",135,0)
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+"RTN","GPLRIMA",136,0)
+    W "CBASE: ",CCTBL,!
+"RTN","GPLRIMA",137,0)
+    ;
+"RTN","GPLRIMA",138,0)
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+"RTN","GPLRIMA",139,0)
+    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+"RTN","GPLRIMA",140,0)
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+"RTN","GPLRIMA",141,0)
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+"RTN","GPLRIMA",142,0)
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+"RTN","GPLRIMA",143,0)
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+"RTN","GPLRIMA",144,0)
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+"RTN","GPLRIMA",145,0)
+    ;
+"RTN","GPLRIMA",146,0)
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+"RTN","GPLRIMA",147,0)
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",148,0)
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+"RTN","GPLRIMA",149,0)
+    ;
+"RTN","GPLRIMA",150,0)
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+"RTN","GPLRIMA",151,0)
+    ;
+"RTN","GPLRIMA",152,0)
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+"RTN","GPLRIMA",153,0)
+    W "PATS BASE: ",CPATLIST,!
+"RTN","GPLRIMA",154,0)
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+"RTN","GPLRIMA",155,0)
+    ;
+"RTN","GPLRIMA",156,0)
+    Q
+"RTN","GPLRIMA",157,0)
+    ;
+"RTN","GPLRIMA",158,0)
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+"RTN","GPLRIMA",159,0)
+    ;
+"RTN","GPLRIMA",160,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",161,0)
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+"RTN","GPLRIMA",162,0)
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+"RTN","GPLRIMA",163,0)
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+"RTN","GPLRIMA",164,0)
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+"RTN","GPLRIMA",165,0)
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+"RTN","GPLRIMA",166,0)
+    . S ZCNT=0
+"RTN","GPLRIMA",167,0)
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+"RTN","GPLRIMA",168,0)
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+"RTN","GPLRIMA",169,0)
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+"RTN","GPLRIMA",170,0)
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+"RTN","GPLRIMA",171,0)
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",172,0)
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+"RTN","GPLRIMA",173,0)
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+"RTN","GPLRIMA",174,0)
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+"RTN","GPLRIMA",175,0)
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+"RTN","GPLRIMA",176,0)
+    . S ZTOT=ZTOT+ZCNT
+"RTN","GPLRIMA",177,0)
+    W "TOTAL: ",ZTOT,!
+"RTN","GPLRIMA",178,0)
+    Q
+"RTN","GPLRIMA",179,0)
+    ;
+"RTN","GPLRIMA",180,0)
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+"RTN","GPLRIMA",181,0)
+    ; INLST IS PASSED BY NAME
+"RTN","GPLRIMA",182,0)
+    N ZI,ZDX,ZCOUNT
+"RTN","GPLRIMA",183,0)
+    W INLST,!
+"RTN","GPLRIMA",184,0)
+    S ZCOUNT=0
+"RTN","GPLRIMA",185,0)
+    S ZDX=""
+"RTN","GPLRIMA",186,0)
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+"RTN","GPLRIMA",187,0)
+    . S ZCOUNT=ZCOUNT+1
+"RTN","GPLRIMA",188,0)
+    . S ZDX=$O(@INLST@(ZDX))
+"RTN","GPLRIMA",189,0)
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+"RTN","GPLRIMA",190,0)
+    Q ZCOUNT
+"RTN","GPLRIMA",191,0)
+    ;
+"RTN","GPLRIMA",192,0)
+XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+"RTN","GPLRIMA",193,0)
+    ;
+"RTN","GPLRIMA",194,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",195,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",196,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",197,0)
+    S ZI=""
+"RTN","GPLRIMA",198,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",199,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",200,0)
+    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
+"RTN","GPLRIMA",201,0)
+    Q
+"RTN","GPLRIMA",202,0)
+    ;
+"RTN","GPLRIMA",203,0)
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+"RTN","GPLRIMA",204,0)
+    ;
+"RTN","GPLRIMA",205,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",206,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",207,0)
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+"RTN","GPLRIMA",208,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",209,0)
+    S ZI=""
+"RTN","GPLRIMA",210,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",211,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",212,0)
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+"RTN","GPLRIMA",213,0)
+    . W ZI," "
+"RTN","GPLRIMA",214,0)
+    . I ZC=10 D  ; NEW LINE
+"RTN","GPLRIMA",215,0)
+    . . S ZC=0
+"RTN","GPLRIMA",216,0)
+    . . W !
+"RTN","GPLRIMA",217,0)
+    Q
+"RTN","GPLRIMA",218,0)
+    ;
+"RTN","GPLRIMA",219,0)
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+"RTN","GPLRIMA",220,0)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+"RTN","GPLRIMA",221,0)
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+"RTN","GPLRIMA",222,0)
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+"RTN","GPLRIMA",223,0)
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+"RTN","GPLRIMA",224,0)
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+"RTN","GPLRIMA",225,0)
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+"RTN","GPLRIMA",226,0)
+    ;
+"RTN","GPLRIMA",227,0)
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+"RTN","GPLRIMA",228,0)
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+"RTN","GPLRIMA",229,0)
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+"RTN","GPLRIMA",230,0)
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+"RTN","GPLRIMA",231,0)
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+"RTN","GPLRIMA",232,0)
+    Q
+"RTN","GPLRIMA",233,0)
+    ;
+"RTN","GPLRIMA",234,0)
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+"RTN","GPLRIMA",235,0)
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
+"RTN","GPLRIMA",236,0)
+      I '$D(@RIMBASE) S @RIMBASE=""
+"RTN","GPLRIMA",237,0)
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
+"RTN","GPLRIMA",238,0)
+      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+"RTN","GPLRIMA",239,0)
+      Q
+"RTN","GPLRIMA",240,0)
+      ;
+"RTN","GPLRIMA",241,0)
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+"RTN","GPLRIMA",242,0)
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",243,0)
+      K @RIMTBL
+"RTN","GPLRIMA",244,0)
+      D APUSH(RIMTBL,"EXTRACTED")
+"RTN","GPLRIMA",245,0)
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+"RTN","GPLRIMA",246,0)
+      D APUSH(RIMTBL,"HEADER")
+"RTN","GPLRIMA",247,0)
+      D APUSH(RIMTBL,"NOPCP")
+"RTN","GPLRIMA",248,0)
+      D APUSH(RIMTBL,"PCP")
+"RTN","GPLRIMA",249,0)
+      D APUSH(RIMTBL,"PROBLEMS")
+"RTN","GPLRIMA",250,0)
+      D APUSH(RIMTBL,"PROBCODE")
+"RTN","GPLRIMA",251,0)
+      D APUSH(RIMTBL,"PROBNOCODE")
+"RTN","GPLRIMA",252,0)
+      D APUSH(RIMTBL,"PROBDATE")
+"RTN","GPLRIMA",253,0)
+      D APUSH(RIMTBL,"PROBNODATE")
+"RTN","GPLRIMA",254,0)
+      D APUSH(RIMTBL,"VITALS")
+"RTN","GPLRIMA",255,0)
+      D APUSH(RIMTBL,"VITALSCODE")
+"RTN","GPLRIMA",256,0)
+      D APUSH(RIMTBL,"VITALSNOCODE")
+"RTN","GPLRIMA",257,0)
+      D APUSH(RIMTBL,"VITALSDATE")
+"RTN","GPLRIMA",258,0)
+      D APUSH(RIMTBL,"VITALSNODATE")
+"RTN","GPLRIMA",259,0)
+      D APUSH(RIMTBL,"MEDS")
+"RTN","GPLRIMA",260,0)
+      D APUSH(RIMTBL,"MEDSCODE")
+"RTN","GPLRIMA",261,0)
+      D APUSH(RIMTBL,"MEDSNOCODE")
+"RTN","GPLRIMA",262,0)
+      D APUSH(RIMTBL,"MEDSDATE")
+"RTN","GPLRIMA",263,0)
+      D APUSH(RIMTBL,"MEDSNODATE")
+"RTN","GPLRIMA",264,0)
+      Q
+"RTN","GPLRIMA",265,0)
+      ;
+"RTN","GPLRIMA",266,0)
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+"RTN","GPLRIMA",267,0)
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+"RTN","GPLRIMA",268,0)
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+"RTN","GPLRIMA",269,0)
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+"RTN","GPLRIMA",270,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+"RTN","GPLRIMA",271,0)
+    N USETBL
+"RTN","GPLRIMA",272,0)
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+"RTN","GPLRIMA",273,0)
+    . W "ERROR NO SUCH TABLE",!
+"RTN","GPLRIMA",274,0)
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+"RTN","GPLRIMA",275,0)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+"RTN","GPLRIMA",276,0)
+    Q
+"RTN","GPLUNIT")
+0^10^B31630479
+"RTN","GPLUNIT",1,0)
+GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
+"RTN","GPLUNIT",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLUNIT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLUNIT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLUNIT",5,0)
+ ;
+"RTN","GPLUNIT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLUNIT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLUNIT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLUNIT",9,0)
+ ;(at your option) any later version.
+"RTN","GPLUNIT",10,0)
+ ;
+"RTN","GPLUNIT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLUNIT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLUNIT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLUNIT",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLUNIT",15,0)
+ ;
+"RTN","GPLUNIT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLUNIT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLUNIT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLUNIT",19,0)
+ ;
+"RTN","GPLUNIT",20,0)
+          W "This is a unit testing library",!
+"RTN","GPLUNIT",21,0)
+          W !
+"RTN","GPLUNIT",22,0)
+          Q
+"RTN","GPLUNIT",23,0)
+          ;
+"RTN","GPLUNIT",24,0)
+ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
+"RTN","GPLUNIT",25,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",26,0)
+          ; BAT is a string identifying the test battery
+"RTN","GPLUNIT",27,0)
+          ; TST is a test which will evaluate to true or false
+"RTN","GPLUNIT",28,0)
+          ; I '$G(ZARY) D
+"RTN","GPLUNIT",29,0)
+          ; . S ZARY(0)=0 ; initially there are no elements
+"RTN","GPLUNIT",30,0)
+          ; W "GOT HERE LOADING "_TST,!
+"RTN","GPLUNIT",31,0)
+          N CNT ; count of array elements
+"RTN","GPLUNIT",32,0)
+          S CNT=ZARY(0) ; contains array count
+"RTN","GPLUNIT",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLUNIT",34,0)
+          S ZARY(CNT)=TST ; put the test in the array
+"RTN","GPLUNIT",35,0)
+          I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
+"RTN","GPLUNIT",36,0)
+          . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+"RTN","GPLUNIT",37,0)
+          . S II=$P(ZARY(BAT),"^",2)
+"RTN","GPLUNIT",38,0)
+          . S $P(ZARY(BAT),"^",2)=II+1
+"RTN","GPLUNIT",39,0)
+          I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
+"RTN","GPLUNIT",40,0)
+          . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+"RTN","GPLUNIT",41,0)
+          . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+"RTN","GPLUNIT",42,0)
+          . ; S TN=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",43,0)
+          . ; D PUSH^GPLXPATH(TN,BAT)
+"RTN","GPLUNIT",44,0)
+          S ZARY(0)=CNT ; update the array counter
+"RTN","GPLUNIT",45,0)
+          Q
+"RTN","GPLUNIT",46,0)
+          ;
+"RTN","GPLUNIT",47,0)
+ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
+"RTN","GPLUNIT",48,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLUNIT",49,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLUNIT",50,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLUNIT",51,0)
+          K @ZARY
+"RTN","GPLUNIT",52,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLUNIT",53,0)
+          N LINE,LABEL,BODY
+"RTN","GPLUNIT",54,0)
+          N INTEST S INTEST=0 ; switch for in the test case section
+"RTN","GPLUNIT",55,0)
+          N SECTION S SECTION="[anonymous]" ; test case section
+"RTN","GPLUNIT",56,0)
+          ;
+"RTN","GPLUNIT",57,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLUNIT",58,0)
+          . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
+"RTN","GPLUNIT",59,0)
+          . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+"RTN","GPLUNIT",60,0)
+          . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+"RTN","GPLUNIT",61,0)
+          . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
+"RTN","GPLUNIT",62,0)
+          . I INTEST  D  ; within the testing section
+"RTN","GPLUNIT",63,0)
+          . . I LINE?." "1";;><".E  D  ; section name found
+"RTN","GPLUNIT",64,0)
+          . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+"RTN","GPLUNIT",65,0)
+          . . I LINE?." "1";;>>".E  D  ; test case found
+"RTN","GPLUNIT",66,0)
+          . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+"RTN","GPLUNIT",67,0)
+          S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+"RTN","GPLUNIT",68,0)
+          Q
+"RTN","GPLUNIT",69,0)
+          ;
+"RTN","GPLUNIT",70,0)
+ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+"RTN","GPLUNIT",71,0)
+          N ZI,ZX,ZR,ZP
+"RTN","GPLUNIT",72,0)
+          S DEBUG=0
+"RTN","GPLUNIT",73,0)
+          ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+"RTN","GPLUNIT",74,0)
+          ; . W "DOING ALL",!
+"RTN","GPLUNIT",75,0)
+          ; . N J,NT
+"RTN","GPLUNIT",76,0)
+          ; . S NT=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",77,0)
+          ; . W NT,@NT@(0),!
+"RTN","GPLUNIT",78,0)
+          ; . F J=1:1:@NT@(0) D  ;
+"RTN","GPLUNIT",79,0)
+          ; . . W @NT@(J),!
+"RTN","GPLUNIT",80,0)
+          ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
+"RTN","GPLUNIT",81,0)
+          I '$D(ZARY(WHICH))  D  ; TEST SECTION DOESN'T EXIST
+"RTN","GPLUNIT",82,0)
+          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+"RTN","GPLUNIT",83,0)
+          . Q  ; EXIT
+"RTN","GPLUNIT",84,0)
+          N FIRST,LAST
+"RTN","GPLUNIT",85,0)
+          S FIRST=$P(ZARY(WHICH),"^",1)
+"RTN","GPLUNIT",86,0)
+          S LAST=$P(ZARY(WHICH),"^",2)
+"RTN","GPLUNIT",87,0)
+          F ZI=FIRST:1:LAST  D
+"RTN","GPLUNIT",88,0)
+          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+"RTN","GPLUNIT",89,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",90,0)
+          . . ;  W ZP,!
+"RTN","GPLUNIT",91,0)
+          . . S ZX=ZP
+"RTN","GPLUNIT",92,0)
+          . . W "RUNNING: "_ZP
+"RTN","GPLUNIT",93,0)
+          . . X ZX
+"RTN","GPLUNIT",94,0)
+          . . W "..SUCCESS: ",WHICH,!
+"RTN","GPLUNIT",95,0)
+          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+"RTN","GPLUNIT",96,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",97,0)
+          . . S ZX="S ZR="_ZP
+"RTN","GPLUNIT",98,0)
+          . . W "TRYING: "_ZP
+"RTN","GPLUNIT",99,0)
+          . . X ZX
+"RTN","GPLUNIT",100,0)
+          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+"RTN","GPLUNIT",101,0)
+          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+"RTN","GPLUNIT",102,0)
+          . . . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",103,0)
+          . . I ZR S TPASSED=TPASSED+1
+"RTN","GPLUNIT",104,0)
+          . . I 'ZR S TFAILED=TFAILED+1
+"RTN","GPLUNIT",105,0)
+          Q
+"RTN","GPLUNIT",106,0)
+          ;
+"RTN","GPLUNIT",107,0)
+TEST   ; RUN ALL THE TEST CASES
+"RTN","GPLUNIT",108,0)
+          N ZTMP
+"RTN","GPLUNIT",109,0)
+          D ZLOAD(.ZTMP)
+"RTN","GPLUNIT",110,0)
+          D ZTEST(.ZTMP,"ALL")
+"RTN","GPLUNIT",111,0)
+          W "PASSED: ",TPASSED,!
+"RTN","GPLUNIT",112,0)
+          W "FAILED: ",TFAILED,!
+"RTN","GPLUNIT",113,0)
+          W !
+"RTN","GPLUNIT",114,0)
+          W "THE TESTS!",!
+"RTN","GPLUNIT",115,0)
+          ; I DEBUG ZWR ZTMP
+"RTN","GPLUNIT",116,0)
+          Q
+"RTN","GPLUNIT",117,0)
+          ;
+"RTN","GPLUNIT",118,0)
+GTSTS(GTZARY,RTN) ; return an array of test names
+"RTN","GPLUNIT",119,0)
+          N I,J S I="" S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",120,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",121,0)
+          . D PUSH^GPLXPATH(RTN,I)
+"RTN","GPLUNIT",122,0)
+          . S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",123,0)
+          Q
+"RTN","GPLUNIT",124,0)
+          ;
+"RTN","GPLUNIT",125,0)
+TESTALL(RNM) ; RUN ALL THE TESTS
+"RTN","GPLUNIT",126,0)
+          N ZI,J,TZTMP,TSTS,TOTP,TOTF
+"RTN","GPLUNIT",127,0)
+          S TOTP=0 S TOTF=0
+"RTN","GPLUNIT",128,0)
+          D ZLOAD^GPLUNIT("TZTMP",RNM)
+"RTN","GPLUNIT",129,0)
+          D GTSTS(.TZTMP,"TSTS")
+"RTN","GPLUNIT",130,0)
+          F ZI=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",131,0)
+          . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",132,0)
+          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
+"RTN","GPLUNIT",133,0)
+          . S TOTP=TOTP+TPASSED
+"RTN","GPLUNIT",134,0)
+          . S TOTF=TOTF+TFAILED
+"RTN","GPLUNIT",135,0)
+          . S $P(TSTS(ZI),"^",2)=TPASSED
+"RTN","GPLUNIT",136,0)
+          . S $P(TSTS(ZI),"^",3)=TFAILED
+"RTN","GPLUNIT",137,0)
+          F I=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",138,0)
+          . W "TEST=> ",$P(TSTS(ZI),"^",1)
+"RTN","GPLUNIT",139,0)
+          . W " PASSED=>",$P(TSTS(ZI),"^",2)
+"RTN","GPLUNIT",140,0)
+          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+"RTN","GPLUNIT",141,0)
+          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+"RTN","GPLUNIT",142,0)
+          Q
+"RTN","GPLUNIT",143,0)
+          ;
+"RTN","GPLUNIT",144,0)
+TLIST(ZARY) ; LIST ALL THE TESTS
+"RTN","GPLUNIT",145,0)
+          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
+"RTN","GPLUNIT",146,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",147,0)
+          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",148,0)
+          S K=1
+"RTN","GPLUNIT",149,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",150,0)
+          . ; W "I IS NOW=",I,!
+"RTN","GPLUNIT",151,0)
+          . W I," "
+"RTN","GPLUNIT",152,0)
+          . S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",153,0)
+          . S K=K+1 I K=6  D
+"RTN","GPLUNIT",154,0)
+          . . W !
+"RTN","GPLUNIT",155,0)
+          . . S K=1
+"RTN","GPLUNIT",156,0)
+          Q
+"RTN","GPLUNIT",157,0)
+          ;
+"RTN","GPLVITAL")
+0^12^B98509194
+"RTN","GPLVITAL",1,0)
+GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+"RTN","GPLVITAL",2,0)
+          ;;0.1;CCDCCR;;JUL 16,2008;Build 3
+"RTN","GPLVITAL",3,0)
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLVITAL",4,0)
+          ;General Public License See attached copy of the License.
+"RTN","GPLVITAL",5,0)
+          ;
+"RTN","GPLVITAL",6,0)
+          ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLVITAL",7,0)
+          ;it under the terms of the GNU General Public License as published by
+"RTN","GPLVITAL",8,0)
+          ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLVITAL",9,0)
+          ;(at your option) any later version.
+"RTN","GPLVITAL",10,0)
+          ;
+"RTN","GPLVITAL",11,0)
+          ;This program is distributed in the hope that it will be useful,
+"RTN","GPLVITAL",12,0)
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLVITAL",13,0)
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLVITAL",14,0)
+          ;GNU General Public License for more details.
+"RTN","GPLVITAL",15,0)
+          ;
+"RTN","GPLVITAL",16,0)
+          ;You should have received a copy of the GNU General Public License along
+"RTN","GPLVITAL",17,0)
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLVITAL",18,0)
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLVITAL",19,0)
+          ;
+"RTN","GPLVITAL",20,0)
+          W "NO ENTRY FROM TOP",!
+"RTN","GPLVITAL",21,0)
+          Q
+"RTN","GPLVITAL",22,0)
+          ;
+"RTN","GPLVITAL",23,0)
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+"RTN","GPLVITAL",24,0)
+          ;
+"RTN","GPLVITAL",25,0)
+          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLVITAL",26,0)
+          ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLVITAL",27,0)
+          ;
+"RTN","GPLVITAL",28,0)
+          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
+"RTN","GPLVITAL",29,0)
+          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+"RTN","GPLVITAL",30,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." D  ; NULL RESULT FROM RPC
+"RTN","GPLVITAL",31,0)
+          . W "NO VITALS FOUND FROM VITALS RPC",!
+"RTN","GPLVITAL",32,0)
+          . S @VITOUTXML@(0)=0
+"RTN","GPLVITAL",33,0)
+          . Q
+"RTN","GPLVITAL",34,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
+"RTN","GPLVITAL",35,0)
+          ; ZWR RPCRSLT
+"RTN","GPLVITAL",36,0)
+          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
+"RTN","GPLVITAL",37,0)
+          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
+"RTN","GPLVITAL",38,0)
+          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLVITAL",39,0)
+          N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+"RTN","GPLVITAL",40,0)
+          D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","GPLVITAL",41,0)
+          ; I DEBUG ZWR VDATES ;DEBUG
+"RTN","GPLVITAL",42,0)
+          S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+"RTN","GPLVITAL",43,0)
+          ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+"RTN","GPLVITAL",44,0)
+          F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+"RTN","GPLVITAL",45,0)
+          . I $D(VITRSLT(VSORT(J))) D
+"RTN","GPLVITAL",46,0)
+          . . S VITVMAP=$NA(@VITTVMAP@(J))
+"RTN","GPLVITAL",47,0)
+          . . K @VITVMAP
+"RTN","GPLVITAL",48,0)
+          . . I DEBUG W "VMAP= ",VITVMAP,!
+"RTN","GPLVITAL",49,0)
+          . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
+"RTN","GPLVITAL",50,0)
+          . . I DEBUG W "VITAL ",VSORT(J),!
+"RTN","GPLVITAL",51,0)
+          . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
+"RTN","GPLVITAL",52,0)
+          . . I DEBUG W $P(VITPTMP,U,4),!
+"RTN","GPLVITAL",53,0)
+          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+"RTN","GPLVITAL",54,0)
+          . . I $P(VITPTMP,U,2)="HT" D
+"RTN","GPLVITAL",55,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",56,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",57,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",58,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",59,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",60,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",61,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",62,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
+"RTN","GPLVITAL",63,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",64,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",65,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",66,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",67,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+"RTN","GPLVITAL",68,0)
+          . . E  I $P(VITPTMP,U,2)="WT" D
+"RTN","GPLVITAL",69,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",70,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",71,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",72,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",73,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",74,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",75,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",76,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
+"RTN","GPLVITAL",77,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",78,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",79,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",80,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",81,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+"RTN","GPLVITAL",82,0)
+          . . E  I $P(VITPTMP,U,2)="BP" D
+"RTN","GPLVITAL",83,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",84,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",85,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",86,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",87,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",88,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",89,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",90,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
+"RTN","GPLVITAL",91,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",92,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",93,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",94,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",95,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",96,0)
+          . . E  I $P(VITPTMP,U,2)="T" D
+"RTN","GPLVITAL",97,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",98,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",99,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",100,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",101,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",102,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",103,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",104,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
+"RTN","GPLVITAL",105,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",106,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",107,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",108,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",109,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+"RTN","GPLVITAL",110,0)
+          . . E  I $P(VITPTMP,U,2)="R" D
+"RTN","GPLVITAL",111,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",112,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",113,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",114,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",115,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",116,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",117,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",118,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
+"RTN","GPLVITAL",119,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",120,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",121,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",122,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",123,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",124,0)
+          . . E  I $P(VITPTMP,U,2)="P" D
+"RTN","GPLVITAL",125,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",126,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",127,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",128,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",129,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",130,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",131,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",132,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
+"RTN","GPLVITAL",133,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",134,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",135,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",136,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",137,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",138,0)
+          . . E  I $P(VITPTMP,U,2)="PN" D
+"RTN","GPLVITAL",139,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",140,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",141,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",142,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",143,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",144,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",145,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",146,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
+"RTN","GPLVITAL",147,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",148,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",149,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",150,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",151,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",152,0)
+          . . E  D
+"RTN","GPLVITAL",153,0)
+          . . . ;W "IN VITAL:  OTHER",!
+"RTN","GPLVITAL",154,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",155,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",156,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+"RTN","GPLVITAL",157,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",158,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",159,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+"RTN","GPLVITAL",160,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+"RTN","GPLVITAL",161,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+"RTN","GPLVITAL",162,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+"RTN","GPLVITAL",163,0)
+          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",164,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",165,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",166,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+"RTN","GPLVITAL",167,0)
+          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+"RTN","GPLVITAL",168,0)
+          . . K @VITARYTMP
+"RTN","GPLVITAL",169,0)
+          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
+"RTN","GPLVITAL",170,0)
+          . . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLVITAL",171,0)
+          . . . ; W "FIRST ONE",!
+"RTN","GPLVITAL",172,0)
+          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
+"RTN","GPLVITAL",173,0)
+          . . . W "VITOUTXML ",VITOUTXML,!
+"RTN","GPLVITAL",174,0)
+          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLVITAL",175,0)
+          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
+"RTN","GPLVITAL",176,0)
+          ; ZWR ^TMP($J,"VITALS",*)
+"RTN","GPLVITAL",177,0)
+          ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLVITAL",178,0)
+          I DEBUG D PARY^GPLXPATH(VITOUTXML)
+"RTN","GPLVITAL",179,0)
+          N VITTMP,I
+"RTN","GPLVITAL",180,0)
+          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLVITAL",181,0)
+          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLVITAL",182,0)
+          . W "VITALS MISSING ",!
+"RTN","GPLVITAL",183,0)
+          . F I=1:1:VITTMP(0) W VITTMP(I),!
+"RTN","GPLVITAL",184,0)
+          Q
+"RTN","GPLVITAL",185,0)
+          ;
+"RTN","GPLVITAL",186,0)
+VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+"RTN","GPLVITAL",187,0)
+         ; OF DATES IN THE VITALS RESULTS
+"RTN","GPLVITAL",188,0)
+         N VDTI,VDTJ,VTDCNT
+"RTN","GPLVITAL",189,0)
+         S VTDCNT=0 ; COUNT TO BUILD ARRAY
+"RTN","GPLVITAL",190,0)
+         S VDTJ="" ; USED TO VISIT THE RESULTS
+"RTN","GPLVITAL",191,0)
+         F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","GPLVITAL",192,0)
+         . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
+"RTN","GPLVITAL",193,0)
+         . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+"RTN","GPLVITAL",194,0)
+         . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","GPLVITAL",195,0)
+         Q
+"RTN","GPLVITAL",196,0)
+         ;
+"RTN","GPLXPAT0")
+0^19^B44173297
+"RTN","GPLXPAT0",1,0)
+GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
+"RTN","GPLXPAT0",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLXPAT0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPAT0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPAT0",5,0)
+ ;
+"RTN","GPLXPAT0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPAT0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPAT0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPAT0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPAT0",10,0)
+ ;
+"RTN","GPLXPAT0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPAT0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPAT0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPAT0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPAT0",15,0)
+ ;
+"RTN","GPLXPAT0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPAT0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPAT0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPAT0",19,0)
+ ;
+"RTN","GPLXPAT0",20,0)
+        W "NO ENTRY",!
+"RTN","GPLXPAT0",21,0)
+        Q
+"RTN","GPLXPAT0",22,0)
+        ;
+"RTN","GPLXPAT0",23,0)
+ ;;><TEST>
+"RTN","GPLXPAT0",24,0)
+ ;;><INIT>
+"RTN","GPLXPAT0",25,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLXPAT0",26,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FIRST")
+"RTN","GPLXPAT0",27,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","SECOND")
+"RTN","GPLXPAT0",28,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","THIRD")
+"RTN","GPLXPAT0",29,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
+"RTN","GPLXPAT0",30,0)
+ ;;>>?GPL(0)=4
+"RTN","GPLXPAT0",31,0)
+ ;;><INITXML>
+"RTN","GPLXPAT0",32,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",33,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",34,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",35,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",36,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
+"RTN","GPLXPAT0",37,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
+"RTN","GPLXPAT0",38,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
+"RTN","GPLXPAT0",39,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
+"RTN","GPLXPAT0",40,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
+"RTN","GPLXPAT0",41,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",42,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",43,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",44,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",45,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",46,0)
+ ;;><INITXML2>
+"RTN","GPLXPAT0",47,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",48,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",49,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",50,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",51,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
+"RTN","GPLXPAT0",52,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
+"RTN","GPLXPAT0",53,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","DATA2")
+"RTN","GPLXPAT0",54,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
+"RTN","GPLXPAT0",55,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",56,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
+"RTN","GPLXPAT0",57,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
+"RTN","GPLXPAT0",58,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
+"RTN","GPLXPAT0",59,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",60,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",61,0)
+ ;;><PUSHPOP>
+"RTN","GPLXPAT0",62,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",63,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",64,0)
+ ;;>>?GPL(GPL(0))="FOURTH"
+"RTN","GPLXPAT0",65,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",66,0)
+ ;;>>?GX="FOURTH"
+"RTN","GPLXPAT0",67,0)
+ ;;>>?GPL(GPL(0))="THIRD"
+"RTN","GPLXPAT0",68,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",69,0)
+ ;;>>?GX="THIRD"
+"RTN","GPLXPAT0",70,0)
+ ;;>>?GPL(GPL(0))="SECOND"
+"RTN","GPLXPAT0",71,0)
+ ;;><MKMDX>
+"RTN","GPLXPAT0",72,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",73,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",74,0)
+ ;;>>>S GX=""
+"RTN","GPLXPAT0",75,0)
+ ;;>>>D MKMDX^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",76,0)
+ ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
+"RTN","GPLXPAT0",77,0)
+ ;;><XNAME>
+"RTN","GPLXPAT0",78,0)
+ ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
+"RTN","GPLXPAT0",79,0)
+ ;;>>?$$XNAME^GPLXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
+"RTN","GPLXPAT0",80,0)
+ ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
+"RTN","GPLXPAT0",81,0)
+ ;;><INDEX>
+"RTN","GPLXPAT0",82,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",83,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
+"RTN","GPLXPAT0",84,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",85,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",86,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
+"RTN","GPLXPAT0",87,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
+"RTN","GPLXPAT0",88,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
+"RTN","GPLXPAT0",89,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
+"RTN","GPLXPAT0",90,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",91,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",92,0)
+ ;;><INDEX2>
+"RTN","GPLXPAT0",93,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML2")
+"RTN","GPLXPAT0",94,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",95,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",96,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
+"RTN","GPLXPAT0",97,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
+"RTN","GPLXPAT0",98,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
+"RTN","GPLXPAT0",99,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
+"RTN","GPLXPAT0",100,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",101,0)
+ ;;><MISSING>
+"RTN","GPLXPAT0",102,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",103,0)
+ ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
+"RTN","GPLXPAT0",104,0)
+ ;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
+"RTN","GPLXPAT0",105,0)
+ ;;>>?@OUTARY@(1)="DATA1"
+"RTN","GPLXPAT0",106,0)
+ ;;>>?@OUTARY@(2)="DATA2"
+"RTN","GPLXPAT0",107,0)
+ ;;><MAP>
+"RTN","GPLXPAT0",108,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",109,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",110,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",111,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",112,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",113,0)
+ ;;>>?@OUTARY@(6)="VALUE2"
+"RTN","GPLXPAT0",114,0)
+ ;;><MAP2>
+"RTN","GPLXPAT0",115,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",116,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",117,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",118,0)
+ ;;>>>S @MAPARY@("DATA1")="VALUE1"
+"RTN","GPLXPAT0",119,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",120,0)
+ ;;>>>S @MAPARY@("DATA3")="VALUE3"
+"RTN","GPLXPAT0",121,0)
+ ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
+"RTN","GPLXPAT0",122,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",123,0)
+ ;;>>>D PARY^GPLXPATH(OUTARY)
+"RTN","GPLXPAT0",124,0)
+ ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
+"RTN","GPLXPAT0",125,0)
+ ;;><QUEUE>
+"RTN","GPLXPAT0",126,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
+"RTN","GPLXPAT0",127,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
+"RTN","GPLXPAT0",128,0)
+ ;;>>?$P(BTLIST(2),";",2)=4
+"RTN","GPLXPAT0",129,0)
+ ;;><BUILD>
+"RTN","GPLXPAT0",130,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",131,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
+"RTN","GPLXPAT0",132,0)
+ ;;>>>D ZTEST^GPLXPATH("QUEUE")
+"RTN","GPLXPAT0",133,0)
+ ;;>>>D BUILD^GPLXPATH("BTLIST","G3")
+"RTN","GPLXPAT0",134,0)
+ ;;><CP>
+"RTN","GPLXPAT0",135,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",136,0)
+ ;;>>>D CP^GPLXPATH("GXML","G2")
+"RTN","GPLXPAT0",137,0)
+ ;;>>?G2(0)=13
+"RTN","GPLXPAT0",138,0)
+ ;;><QOPEN>
+"RTN","GPLXPAT0",139,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",140,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",141,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",142,0)
+ ;;>>?$P(GBL(1),";",3)=12
+"RTN","GPLXPAT0",143,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",144,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",145,0)
+ ;;><QOPEN2>
+"RTN","GPLXPAT0",146,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",147,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",148,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
+"RTN","GPLXPAT0",149,0)
+ ;;>>?$P(GBL(1),";",3)=11
+"RTN","GPLXPAT0",150,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",151,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",152,0)
+ ;;><QCLOSE>
+"RTN","GPLXPAT0",153,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",154,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",155,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",156,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",157,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",158,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",159,0)
+ ;;><QCLOSE2>
+"RTN","GPLXPAT0",160,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",161,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",162,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",163,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",164,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",165,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",166,0)
+ ;;>>?G2(1)="</THIRD>"
+"RTN","GPLXPAT0",167,0)
+ ;;><INSERT>
+"RTN","GPLXPAT0",168,0)
+ ;;>>>K G2,GBL,G3,G4
+"RTN","GPLXPAT0",169,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",170,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",171,0)
+ ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",172,0)
+ ;;>>>D INSERT^GPLXPATH("G3","G2","//")
+"RTN","GPLXPAT0",173,0)
+ ;;>>?G2(1)=GXML(9)
+"RTN","GPLXPAT0",174,0)
+ ;;><REPLACE>
+"RTN","GPLXPAT0",175,0)
+ ;;>>>K G2,GBL,G3
+"RTN","GPLXPAT0",176,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",177,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",178,0)
+ ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
+"RTN","GPLXPAT0",179,0)
+ ;;>>?GXML(2)="<FIFTH>"
+"RTN","GPLXPAT0",180,0)
+ ;;><INSINNER>
+"RTN","GPLXPAT0",181,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",182,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",183,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",184,0)
+ ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",185,0)
+ ;;>>?GXML(10)="<FIFTH>"
+"RTN","GPLXPAT0",186,0)
+ ;;><INSINNER2>
+"RTN","GPLXPAT0",187,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",188,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",189,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",190,0)
+ ;;>>>D INSINNER^GPLXPATH("G2","G2")
+"RTN","GPLXPAT0",191,0)
+ ;;>>?G2(8)="<FIFTH>"
+"RTN","GPLXPAT0",192,0)
+ ;;></TEST>
+"RTN","GPLXPATH")
+0^9^B261673629
+"RTN","GPLXPATH",1,0)
+GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
+"RTN","GPLXPATH",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLXPATH",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPATH",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPATH",5,0)
+ ;
+"RTN","GPLXPATH",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPATH",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPATH",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPATH",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPATH",10,0)
+ ;
+"RTN","GPLXPATH",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPATH",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPATH",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPATH",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPATH",15,0)
+ ;
+"RTN","GPLXPATH",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPATH",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPATH",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPATH",19,0)
+ ;
+"RTN","GPLXPATH",20,0)
+          W "This is an XML XPATH utility library",!
+"RTN","GPLXPATH",21,0)
+          W !
+"RTN","GPLXPATH",22,0)
+          Q
+"RTN","GPLXPATH",23,0)
+          ;
+"RTN","GPLXPATH",24,0)
+OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+"RTN","GPLXPATH",25,0)
+          ;
+"RTN","GPLXPATH",26,0)
+          N Y
+"RTN","GPLXPATH",27,0)
+          S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
+"RTN","GPLXPATH",28,0)
+          I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
+"RTN","GPLXPATH",29,0)
+          ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
+"RTN","GPLXPATH",30,0)
+          Q
+"RTN","GPLXPATH",31,0)
+          ;
+"RTN","GPLXPATH",32,0)
+PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+"RTN","GPLXPATH",33,0)
+          ;  VAL IS A STRING AND STK IS PASSED BY NAME
+"RTN","GPLXPATH",34,0)
+          ;
+"RTN","GPLXPATH",35,0)
+          I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
+"RTN","GPLXPATH",36,0)
+          S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
+"RTN","GPLXPATH",37,0)
+          S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+"RTN","GPLXPATH",38,0)
+          Q
+"RTN","GPLXPATH",39,0)
+          ;
+"RTN","GPLXPATH",40,0)
+POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+"RTN","GPLXPATH",41,0)
+          ; VAL AND STK ARE PASSED BY REFERENCE
+"RTN","GPLXPATH",42,0)
+          ;
+"RTN","GPLXPATH",43,0)
+          I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
+"RTN","GPLXPATH",44,0)
+          . S VAL=""
+"RTN","GPLXPATH",45,0)
+          . S @STK@(0)=0
+"RTN","GPLXPATH",46,0)
+          I @STK@(0)>0  D  ;
+"RTN","GPLXPATH",47,0)
+          . S VAL=@STK@(@STK@(0))
+"RTN","GPLXPATH",48,0)
+          . K @STK@(@STK@(0))
+"RTN","GPLXPATH",49,0)
+          . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+"RTN","GPLXPATH",50,0)
+          Q
+"RTN","GPLXPATH",51,0)
+          ;
+"RTN","GPLXPATH",52,0)
+MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+"RTN","GPLXPATH",53,0)
+          ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
+"RTN","GPLXPATH",54,0)
+          S RTN=""
+"RTN","GPLXPATH",55,0)
+          N I
+"RTN","GPLXPATH",56,0)
+          ; W "STK= ",STK,!
+"RTN","GPLXPATH",57,0)
+          I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",58,0)
+          . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
+"RTN","GPLXPATH",59,0)
+          . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
+"RTN","GPLXPATH",60,0)
+          . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
+"RTN","GPLXPATH",61,0)
+          Q
+"RTN","GPLXPATH",62,0)
+          ;
+"RTN","GPLXPATH",63,0)
+XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+"RTN","GPLXPATH",64,0)
+          ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
+"RTN","GPLXPATH",65,0)
+          ; ISTR IS PASSED BY VALUE
+"RTN","GPLXPATH",66,0)
+          N CUR,TMP
+"RTN","GPLXPATH",67,0)
+          I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
+"RTN","GPLXPATH",68,0)
+          . S TMP=$P(ISTR,"<",2)
+"RTN","GPLXPATH",69,0)
+          I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
+"RTN","GPLXPATH",70,0)
+          . S TMP=$P(TMP,"/",2)
+"RTN","GPLXPATH",71,0)
+          S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
+"RTN","GPLXPATH",72,0)
+          ; W "CUR= ",CUR,!
+"RTN","GPLXPATH",73,0)
+          I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
+"RTN","GPLXPATH",74,0)
+           . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
+"RTN","GPLXPATH",75,0)
+          ; W "CUR2= ",CUR,!
+"RTN","GPLXPATH",76,0)
+          Q CUR
+"RTN","GPLXPATH",77,0)
+          ;
+"RTN","GPLXPATH",78,0)
+INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
+"RTN","GPLXPATH",79,0)
+          ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
+"RTN","GPLXPATH",80,0)
+          ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
+"RTN","GPLXPATH",81,0)
+          ; XML SECTION
+"RTN","GPLXPATH",82,0)
+          ; ZXML IS PASSED BY NAME
+"RTN","GPLXPATH",83,0)
+          N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
+"RTN","GPLXPATH",84,0)
+          N GPLSTK ; LEAVE OUT FOR DEBUGGING
+"RTN","GPLXPATH",85,0)
+          I '$D(@ZXML@(0))  D  ; NO XML PASSED
+"RTN","GPLXPATH",86,0)
+          . W "ERROR IN XML FILE",!
+"RTN","GPLXPATH",87,0)
+          S GPLSTK(0)=0 ; INITIALIZE STACK
+"RTN","GPLXPATH",88,0)
+          F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
+"RTN","GPLXPATH",89,0)
+          . S LINE=@ZXML@(I)
+"RTN","GPLXPATH",90,0)
+          . ;W LINE,!
+"RTN","GPLXPATH",91,0)
+          . S FOUND=0  ; INTIALIZED FOUND FLAG
+"RTN","GPLXPATH",92,0)
+          . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
+"RTN","GPLXPATH",93,0)
+          . I FOUND'=1  D
+"RTN","GPLXPATH",94,0)
+          . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
+"RTN","GPLXPATH",95,0)
+          . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
+"RTN","GPLXPATH",96,0)
+          . . . ; ON THE SAME LINE
+"RTN","GPLXPATH",97,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",98,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",99,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",100,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",101,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",102,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",103,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",104,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",105,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",106,0)
+          . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
+"RTN","GPLXPATH",107,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",108,0)
+          . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
+"RTN","GPLXPATH",109,0)
+          . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
+"RTN","GPLXPATH",110,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",111,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",112,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",113,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",114,0)
+          . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",115,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",116,0)
+          . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
+"RTN","GPLXPATH",117,0)
+          . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
+"RTN","GPLXPATH",118,0)
+          . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
+"RTN","GPLXPATH",119,0)
+          . . . . Q
+"RTN","GPLXPATH",120,0)
+          . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
+"RTN","GPLXPATH",121,0)
+          . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
+"RTN","GPLXPATH",122,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",123,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",124,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",125,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",126,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",127,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",128,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",129,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",130,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",131,0)
+          . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
+"RTN","GPLXPATH",132,0)
+          S @ZXML@("INDEXED")=""
+"RTN","GPLXPATH",133,0)
+          S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
+"RTN","GPLXPATH",134,0)
+          Q
+"RTN","GPLXPATH",135,0)
+          ;
+"RTN","GPLXPATH",136,0)
+QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+"RTN","GPLXPATH",137,0)
+         ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
+"RTN","GPLXPATH",138,0)
+         ; IARY AND OARY ARE PASSED BY NAME
+"RTN","GPLXPATH",139,0)
+         I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
+"RTN","GPLXPATH",140,0)
+         . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
+"RTN","GPLXPATH",141,0)
+         N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
+"RTN","GPLXPATH",142,0)
+         N TMP,I,J,QXPATH
+"RTN","GPLXPATH",143,0)
+         S FIRST=1
+"RTN","GPLXPATH",144,0)
+         S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
+"RTN","GPLXPATH",145,0)
+         I XPATH'="//" D  ; NOT A ROOT QUERY
+"RTN","GPLXPATH",146,0)
+         . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
+"RTN","GPLXPATH",147,0)
+         . S FIRST=$P(TMP,"^",1)
+"RTN","GPLXPATH",148,0)
+         . S LAST=$P(TMP,"^",2)
+"RTN","GPLXPATH",149,0)
+         K @OARY
+"RTN","GPLXPATH",150,0)
+         S @OARY@(0)=+LAST-FIRST+1
+"RTN","GPLXPATH",151,0)
+         S J=1
+"RTN","GPLXPATH",152,0)
+         FOR I=FIRST:1:LAST  D
+"RTN","GPLXPATH",153,0)
+         . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
+"RTN","GPLXPATH",154,0)
+         . S J=J+1
+"RTN","GPLXPATH",155,0)
+         ; ZWR OARY
+"RTN","GPLXPATH",156,0)
+         Q
+"RTN","GPLXPATH",157,0)
+         ;
+"RTN","GPLXPATH",158,0)
+XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+"RTN","GPLXPATH",159,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",160,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",161,0)
+         Q $P(@IDX@(XPATH),"^",1)
+"RTN","GPLXPATH",162,0)
+         ;
+"RTN","GPLXPATH",163,0)
+XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+"RTN","GPLXPATH",164,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",165,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",166,0)
+         Q $P(@IDX@(XPATH),"^",2)
+"RTN","GPLXPATH",167,0)
+         ;
+"RTN","GPLXPATH",168,0)
+START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+"RTN","GPLXPATH",169,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",170,0)
+         ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",171,0)
+         Q $P(ISTR,";",2)
+"RTN","GPLXPATH",172,0)
+         ;
+"RTN","GPLXPATH",173,0)
+FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+"RTN","GPLXPATH",174,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",175,0)
+         Q $P(ISTR,";",3)
+"RTN","GPLXPATH",176,0)
+         ;
+"RTN","GPLXPATH",177,0)
+ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+"RTN","GPLXPATH",178,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",179,0)
+         Q $P(ISTR,";",1)
+"RTN","GPLXPATH",180,0)
+         ;
+"RTN","GPLXPATH",181,0)
+BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+"RTN","GPLXPATH",182,0)
+         ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+"RTN","GPLXPATH",183,0)
+         ; DEST IS CLEARED TO START
+"RTN","GPLXPATH",184,0)
+         ; USES PUSH TO DO THE COPY
+"RTN","GPLXPATH",185,0)
+         N I
+"RTN","GPLXPATH",186,0)
+         K @BDEST
+"RTN","GPLXPATH",187,0)
+         F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
+"RTN","GPLXPATH",188,0)
+         . N J,ATMP
+"RTN","GPLXPATH",189,0)
+         . S ATMP=$$ARRAY(@BLIST@(I))
+"RTN","GPLXPATH",190,0)
+         . I DEBUG W "ATMP=",ATMP,!
+"RTN","GPLXPATH",191,0)
+         . I DEBUG W @BLIST@(I),!
+"RTN","GPLXPATH",192,0)
+         . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
+"RTN","GPLXPATH",193,0)
+         . . ; FOR EACH LINE IN THIS INSTR
+"RTN","GPLXPATH",194,0)
+         . . I DEBUG W "BDEST= ",BDEST,!
+"RTN","GPLXPATH",195,0)
+         . . I DEBUG W "ATMP= ",@ATMP@(J),!
+"RTN","GPLXPATH",196,0)
+         . . D PUSH(BDEST,@ATMP@(J))
+"RTN","GPLXPATH",197,0)
+         Q
+"RTN","GPLXPATH",198,0)
+         ;
+"RTN","GPLXPATH",199,0)
+QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+"RTN","GPLXPATH",200,0)
+         ;
+"RTN","GPLXPATH",201,0)
+         I DEBUG W "QUEUEING ",BLST,!
+"RTN","GPLXPATH",202,0)
+         D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+"RTN","GPLXPATH",203,0)
+         Q
+"RTN","GPLXPATH",204,0)
+         ;
+"RTN","GPLXPATH",205,0)
+CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+"RTN","GPLXPATH",206,0)
+         ; KILLS CPDEST FIRST
+"RTN","GPLXPATH",207,0)
+         N CPINSTR
+"RTN","GPLXPATH",208,0)
+         I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
+"RTN","GPLXPATH",209,0)
+         I @CPSRC@(0)<1 D  ; BAD LENGTH
+"RTN","GPLXPATH",210,0)
+         . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
+"RTN","GPLXPATH",211,0)
+         . Q
+"RTN","GPLXPATH",212,0)
+         ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
+"RTN","GPLXPATH",213,0)
+         D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
+"RTN","GPLXPATH",214,0)
+         D BUILD("CPINSTR",CPDEST)
+"RTN","GPLXPATH",215,0)
+         Q
+"RTN","GPLXPATH",216,0)
+         ;
+"RTN","GPLXPATH",217,0)
+QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+"RTN","GPLXPATH",218,0)
+         ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
+"RTN","GPLXPATH",219,0)
+         ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
+"RTN","GPLXPATH",220,0)
+         ; USED TO INSERT CHILDREN NODES
+"RTN","GPLXPATH",221,0)
+         I @QOXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",222,0)
+         . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
+"RTN","GPLXPATH",223,0)
+         . Q
+"RTN","GPLXPATH",224,0)
+         I DEBUG W "DOING QOPEN",!
+"RTN","GPLXPATH",225,0)
+         N S1,E1,QOT,QOTMP
+"RTN","GPLXPATH",226,0)
+         S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
+"RTN","GPLXPATH",227,0)
+         I $D(QOXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",228,0)
+         . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
+"RTN","GPLXPATH",229,0)
+         . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
+"RTN","GPLXPATH",230,0)
+         I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",231,0)
+         . S E1=@QOXML@(0)-1
+"RTN","GPLXPATH",232,0)
+         D QUEUE(QOBLIST,QOXML,S1,E1)
+"RTN","GPLXPATH",233,0)
+         ; S QOTMP=QOXML_"^"_S1_"^"_E1
+"RTN","GPLXPATH",234,0)
+         ; D PUSH(QOBLIST,QOTMP)
+"RTN","GPLXPATH",235,0)
+         Q
+"RTN","GPLXPATH",236,0)
+         ;
+"RTN","GPLXPATH",237,0)
+QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+"RTN","GPLXPATH",238,0)
+         ; ADDS THE LIST LINE OF QCXML TO QCBLIST
+"RTN","GPLXPATH",239,0)
+         ; USED TO FINISH INSERTING CHILDERN NODES
+"RTN","GPLXPATH",240,0)
+         ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
+"RTN","GPLXPATH",241,0)
+         ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
+"RTN","GPLXPATH",242,0)
+         I @QCXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",243,0)
+         . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
+"RTN","GPLXPATH",244,0)
+         I DEBUG W "GOING TO CLOSE",!
+"RTN","GPLXPATH",245,0)
+         N S1,E1,QCT,QCTMP
+"RTN","GPLXPATH",246,0)
+         S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
+"RTN","GPLXPATH",247,0)
+         I $D(QCXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",248,0)
+         . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
+"RTN","GPLXPATH",249,0)
+         . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
+"RTN","GPLXPATH",250,0)
+         I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",251,0)
+         . S S1=@QCXML@(0)
+"RTN","GPLXPATH",252,0)
+         D QUEUE(QCBLIST,QCXML,S1,E1)
+"RTN","GPLXPATH",253,0)
+         ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+"RTN","GPLXPATH",254,0)
+         Q
+"RTN","GPLXPATH",255,0)
+         ;
+"RTN","GPLXPATH",256,0)
+INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+"RTN","GPLXPATH",257,0)
+         ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
+"RTN","GPLXPATH",258,0)
+         ; OMITTED, INSERTION WILL BE AT THE ROOT
+"RTN","GPLXPATH",259,0)
+         ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
+"RTN","GPLXPATH",260,0)
+         ; XML AT THE END OF THE XPATH POINT
+"RTN","GPLXPATH",261,0)
+         ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
+"RTN","GPLXPATH",262,0)
+         N INSBLD,INSTMP
+"RTN","GPLXPATH",263,0)
+         I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+"RTN","GPLXPATH",264,0)
+         I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+"RTN","GPLXPATH",265,0)
+         I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
+"RTN","GPLXPATH",266,0)
+         . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
+"RTN","GPLXPATH",267,0)
+         I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",268,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",269,0)
+         . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
+"RTN","GPLXPATH",270,0)
+         . . I DEBUG D PARY^GPLXPATH("INSBLD")
+"RTN","GPLXPATH",271,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",272,0)
+         . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
+"RTN","GPLXPATH",273,0)
+         . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
+"RTN","GPLXPATH",274,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",275,0)
+         . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
+"RTN","GPLXPATH",276,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",277,0)
+         . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
+"RTN","GPLXPATH",278,0)
+         . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+"RTN","GPLXPATH",279,0)
+         . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+"RTN","GPLXPATH",280,0)
+         Q
+"RTN","GPLXPATH",281,0)
+         ;
+"RTN","GPLXPATH",282,0)
+INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+"RTN","GPLXPATH",283,0)
+         ; INTO INNXML AT THE INNXPATH XPATH POINT
+"RTN","GPLXPATH",284,0)
+         ;
+"RTN","GPLXPATH",285,0)
+         N INNBLD,UXPATH
+"RTN","GPLXPATH",286,0)
+         N INNTBUF
+"RTN","GPLXPATH",287,0)
+         S INNTBUF=$NA(^TMP($J,"INNTBUF"))
+"RTN","GPLXPATH",288,0)
+         I '$D(INNXPATH) D  ; XPATH NOT PASSED
+"RTN","GPLXPATH",289,0)
+         . S UXPATH="//" ; USE ROOT XPATH
+"RTN","GPLXPATH",290,0)
+         I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
+"RTN","GPLXPATH",291,0)
+         I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
+"RTN","GPLXPATH",292,0)
+         . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
+"RTN","GPLXPATH",293,0)
+         . D BUILD("INNBLD",INNXML)
+"RTN","GPLXPATH",294,0)
+         I @INNXML@(0)>0  D  ; NOT EMPTY
+"RTN","GPLXPATH",295,0)
+         . D QOPEN("INNBLD",INNXML,UXPATH) ;
+"RTN","GPLXPATH",296,0)
+         . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
+"RTN","GPLXPATH",297,0)
+         . D QCLOSE("INNBLD",INNXML,UXPATH)
+"RTN","GPLXPATH",298,0)
+         . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
+"RTN","GPLXPATH",299,0)
+         . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+"RTN","GPLXPATH",300,0)
+         Q
+"RTN","GPLXPATH",301,0)
+         ;
+"RTN","GPLXPATH",302,0)
+INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+"RTN","GPLXPATH",303,0)
+        ; BUT XDEST AN XNEW ARE PASSED BY NAME
+"RTN","GPLXPATH",304,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",305,0)
+        D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
+"RTN","GPLXPATH",306,0)
+        D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
+"RTN","GPLXPATH",307,0)
+        D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
+"RTN","GPLXPATH",308,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",309,0)
+        D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
+"RTN","GPLXPATH",310,0)
+        I DEBUG D PARY("XDEST")
+"RTN","GPLXPATH",311,0)
+        Q
+"RTN","GPLXPATH",312,0)
+        ;
+"RTN","GPLXPATH",313,0)
+REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+"RTN","GPLXPATH",314,0)
+         ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
+"RTN","GPLXPATH",315,0)
+         ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
+"RTN","GPLXPATH",316,0)
+         ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
+"RTN","GPLXPATH",317,0)
+         N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+"RTN","GPLXPATH",318,0)
+         S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+"RTN","GPLXPATH",319,0)
+         D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+"RTN","GPLXPATH",320,0)
+         S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+"RTN","GPLXPATH",321,0)
+         S XFIRST=$P(XNODE,"^",1)
+"RTN","GPLXPATH",322,0)
+         S XLAST=$P(XNODE,"^",2)
+"RTN","GPLXPATH",323,0)
+         I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
+"RTN","GPLXPATH",324,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
+"RTN","GPLXPATH",325,0)
+         . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",326,0)
+         I RENEW'="" D  ; NEW XML IS NOT NULL
+"RTN","GPLXPATH",327,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+"RTN","GPLXPATH",328,0)
+         . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
+"RTN","GPLXPATH",329,0)
+         . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",330,0)
+         I DEBUG W "REPLACE PREBUILD",!
+"RTN","GPLXPATH",331,0)
+         I DEBUG D PARY("REBLD")
+"RTN","GPLXPATH",332,0)
+         D BUILD("REBLD","RTMP")
+"RTN","GPLXPATH",333,0)
+         K @REXML ; KILL WHAT WAS THERE
+"RTN","GPLXPATH",334,0)
+         D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","GPLXPATH",335,0)
+         Q
+"RTN","GPLXPATH",336,0)
+         ;
+"RTN","GPLXPATH",337,0)
+MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+"RTN","GPLXPATH",338,0)
+         ; W "Reporting on the missing",!
+"RTN","GPLXPATH",339,0)
+         ; W OARY
+"RTN","GPLXPATH",340,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
+"RTN","GPLXPATH",341,0)
+         N I
+"RTN","GPLXPATH",342,0)
+         S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
+"RTN","GPLXPATH",343,0)
+         F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",344,0)
+         . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
+"RTN","GPLXPATH",345,0)
+         . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
+"RTN","GPLXPATH",346,0)
+         . . Q
+"RTN","GPLXPATH",347,0)
+         Q
+"RTN","GPLXPATH",348,0)
+         ;
+"RTN","GPLXPATH",349,0)
+MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+"RTN","GPLXPATH",350,0)
+     ; AND PUT THE RESULTS IN OXML
+"RTN","GPLXPATH",351,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
+"RTN","GPLXPATH",352,0)
+         I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
+"RTN","GPLXPATH",353,0)
+         N I,J,TNAM,TVAL,TSTR
+"RTN","GPLXPATH",354,0)
+         S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
+"RTN","GPLXPATH",355,0)
+         F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",356,0)
+         . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
+"RTN","GPLXPATH",357,0)
+         . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
+"RTN","GPLXPATH",358,0)
+         . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+"RTN","GPLXPATH",359,0)
+         . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
+"RTN","GPLXPATH",360,0)
+         . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
+"RTN","GPLXPATH",361,0)
+         . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+"RTN","GPLXPATH",362,0)
+         . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+"RTN","GPLXPATH",363,0)
+         . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
+"RTN","GPLXPATH",364,0)
+         . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+"RTN","GPLXPATH",365,0)
+         . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+"RTN","GPLXPATH",366,0)
+         . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+"RTN","GPLXPATH",367,0)
+         . . I DEBUG W TSTR
+"RTN","GPLXPATH",368,0)
+         W "MAPPED",!
+"RTN","GPLXPATH",369,0)
+         Q
+"RTN","GPLXPATH",370,0)
+         ;
+"RTN","GPLXPATH",371,0)
+TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+"RTN","GPLXPATH",372,0)
+       ; THEXML IS PASSED BY NAME
+"RTN","GPLXPATH",373,0)
+       N I,J,TMPXML,DEL,FOUND,INTXT
+"RTN","GPLXPATH",374,0)
+       S FOUND=0
+"RTN","GPLXPATH",375,0)
+       S INTXT=0
+"RTN","GPLXPATH",376,0)
+       W "DELETING EMPTY ELEMENTS",!
+"RTN","GPLXPATH",377,0)
+       F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
+"RTN","GPLXPATH",378,0)
+       . S J=@THEXML@(I)
+"RTN","GPLXPATH",379,0)
+       . I J["<text>" D
+"RTN","GPLXPATH",380,0)
+       . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
+"RTN","GPLXPATH",381,0)
+       . . W "IN HTML SECTION",!
+"RTN","GPLXPATH",382,0)
+       . N JM,JP,JPX ; JMINUS AND JPLUS
+"RTN","GPLXPATH",383,0)
+       . S JM=@THEXML@(I-1) ; LINE BEFORE
+"RTN","GPLXPATH",384,0)
+       . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
+"RTN","GPLXPATH",385,0)
+       . S JP=@THEXML@(I+1) ; LINE AFTER
+"RTN","GPLXPATH",386,0)
+       . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
+"RTN","GPLXPATH",387,0)
+       . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
+"RTN","GPLXPATH",388,0)
+       . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
+"RTN","GPLXPATH",389,0)
+       . . . W I,J,JP,!
+"RTN","GPLXPATH",390,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",391,0)
+       . . . S DEL(I)="" ; SET LINE TO DELETE
+"RTN","GPLXPATH",392,0)
+       . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
+"RTN","GPLXPATH",393,0)
+       . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
+"RTN","GPLXPATH",394,0)
+       . . . W I,J,!
+"RTN","GPLXPATH",395,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",396,0)
+       . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
+"RTN","GPLXPATH",397,0)
+       . . . I JM=JPX D  ;
+"RTN","GPLXPATH",398,0)
+       . . . . W I,JM_J_JPX,!
+"RTN","GPLXPATH",399,0)
+       . . . . S DEL(I-1)=""
+"RTN","GPLXPATH",400,0)
+       . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
+"RTN","GPLXPATH",401,0)
+       ; . I J'["><" D PUSH("TMPXML",J)
+"RTN","GPLXPATH",402,0)
+       I FOUND D  ; NEED TO DELETE THINGS
+"RTN","GPLXPATH",403,0)
+       . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
+"RTN","GPLXPATH",404,0)
+       . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
+"RTN","GPLXPATH",405,0)
+       . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
+"RTN","GPLXPATH",406,0)
+       . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
+"RTN","GPLXPATH",407,0)
+       Q FOUND
+"RTN","GPLXPATH",408,0)
+       ;
+"RTN","GPLXPATH",409,0)
+UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+"RTN","GPLXPATH",410,0)
+        ; XSEC IS A SECTION PASSED BY NAME
+"RTN","GPLXPATH",411,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",412,0)
+        D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
+"RTN","GPLXPATH",413,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",414,0)
+        D CP("XTMP",XSEC) ; REPLACE PASSED XML
+"RTN","GPLXPATH",415,0)
+        Q
+"RTN","GPLXPATH",416,0)
+        ;
+"RTN","GPLXPATH",417,0)
+PARY(GLO)       ;PRINT AN ARRAY
+"RTN","GPLXPATH",418,0)
+        N I
+"RTN","GPLXPATH",419,0)
+        F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
+"RTN","GPLXPATH",420,0)
+        Q
+"RTN","GPLXPATH",421,0)
+        ;
+"RTN","GPLXPATH",422,0)
+TEST     ; Run all the test cases
+"RTN","GPLXPATH",423,0)
+        D TESTALL^GPLUNIT("GPLXPAT0")
+"RTN","GPLXPATH",424,0)
+        Q
+"RTN","GPLXPATH",425,0)
+        ;
+"RTN","GPLXPATH",426,0)
+ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+"RTN","GPLXPATH",427,0)
+          N ZTMP
+"RTN","GPLXPATH",428,0)
+          S DEBUG=1
+"RTN","GPLXPATH",429,0)
+          D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",430,0)
+          D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLXPATH",431,0)
+          Q
+"RTN","GPLXPATH",432,0)
+          ;
+"RTN","GPLXPATH",433,0)
+TLIST   ; LIST THE TESTS
+"RTN","GPLXPATH",434,0)
+        N ZTMP
+"RTN","GPLXPATH",435,0)
+        D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",436,0)
+        D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLXPATH",437,0)
+        Q
+"RTN","GPLXPATH",438,0)
+        ;
+"VER")
+8.0^22.0
+**END**
+**END**
Index: ccr/tags/CCR_1_0_4/p/CCR_1_0_1_T2_GTM.KID
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCR_1_0_1_T2_GTM.KID	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCR_1_0_1_T2_GTM.KID	(revision 169)
@@ -0,0 +1,8916 @@
+KIDS Distribution saved on Sep 01, 2008@17:43:26
+FIRST CCR DISTRO
+**KIDS**:CCR*1.0*1^
+
+**INSTALL NAME**
+CCR*1.0*1
+"BLD",6955,0)
+CCR*1.0*1^^0^3080901^n
+"BLD",6955,1,0)
+^^22^22^3080901^
+"BLD",6955,1,1,0)
+CCR AND CCD EXPORT TOOLS 
+"BLD",6955,1,2,0)
+ 
+"BLD",6955,1,3,0)
+SINGLE XML EXPORT TO A HOST DIRECTORY AT 
+"BLD",6955,1,4,0)
+ 
+"BLD",6955,1,5,0)
+BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
+"BLD",6955,1,6,0)
+DIRECTORY
+"BLD",6955,1,7,0)
+ 
+"BLD",6955,1,8,0)
+EXPORT^GPLCRR FOR THE CCR
+"BLD",6955,1,9,0)
+EXPORT^GPLCCD FOR THE CCD
+"BLD",6955,1,10,0)
+XPAT^GPLCCR(DFN,"","") 
+"BLD",6955,1,11,0)
+ 
+"BLD",6955,1,12,0)
+BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
+"BLD",6955,1,13,0)
+ 
+"BLD",6955,1,14,0)
+ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
+"BLD",6955,1,15,0)
+RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
+"BLD",6955,1,16,0)
+ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
+"BLD",6955,1,17,0)
+ 
+"BLD",6955,1,18,0)
+CLIST^GPLRIMA TO LIST CATEGORY TOTALS
+"BLD",6955,1,19,0)
+CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
+"BLD",6955,1,20,0)
+XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
+"BLD",6955,1,21,0)
+ 
+"BLD",6955,1,22,0)
+TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
+"BLD",6955,4,0)
+^9.64PA^^
+"BLD",6955,6.3)
+3
+"BLD",6955,"KRN",0)
+^9.67PA^8989.52^19
+"BLD",6955,"KRN",.4,0)
+.4
+"BLD",6955,"KRN",.401,0)
+.401
+"BLD",6955,"KRN",.402,0)
+.402
+"BLD",6955,"KRN",.403,0)
+.403
+"BLD",6955,"KRN",.5,0)
+.5
+"BLD",6955,"KRN",.84,0)
+.84
+"BLD",6955,"KRN",3.6,0)
+3.6
+"BLD",6955,"KRN",3.8,0)
+3.8
+"BLD",6955,"KRN",9.2,0)
+9.2
+"BLD",6955,"KRN",9.8,0)
+9.8
+"BLD",6955,"KRN",9.8,"NM",0)
+^9.68A^19^19
+"BLD",6955,"KRN",9.8,"NM",1,0)
+CCRDPT^^0^B312345713
+"BLD",6955,"KRN",9.8,"NM",2,0)
+CCRDPTT^^0^B4863621
+"BLD",6955,"KRN",9.8,"NM",3,0)
+CCRMEDS^^0^B36357726
+"BLD",6955,"KRN",9.8,"NM",4,0)
+CCRSYS^^0^B1690193
+"BLD",6955,"KRN",9.8,"NM",5,0)
+CCRUNIT^^0^B8574
+"BLD",6955,"KRN",9.8,"NM",6,0)
+CCRUTIL^^0^B17726385
+"BLD",6955,"KRN",9.8,"NM",7,0)
+CCRVA200^^0^B35847405
+"BLD",6955,"KRN",9.8,"NM",8,0)
+GPLACTOR^^0^B58306782
+"BLD",6955,"KRN",9.8,"NM",9,0)
+GPLXPATH^^0^B261673629
+"BLD",6955,"KRN",9.8,"NM",10,0)
+GPLUNIT^^0^B31630479
+"BLD",6955,"KRN",9.8,"NM",11,0)
+GPLPROBS^^0^B24846496
+"BLD",6955,"KRN",9.8,"NM",12,0)
+GPLVITAL^^0^B98509194
+"BLD",6955,"KRN",9.8,"NM",13,0)
+GPLRIMA^^0^B96435476
+"BLD",6955,"KRN",9.8,"NM",14,0)
+GPLCCR^^0^B66792391
+"BLD",6955,"KRN",9.8,"NM",15,0)
+GPLCCR0^^0^B658213703
+"BLD",6955,"KRN",9.8,"NM",16,0)
+GPLCCD^^0^B106978605
+"BLD",6955,"KRN",9.8,"NM",17,0)
+GPLCCD1^^0^B100039732
+"BLD",6955,"KRN",9.8,"NM",18,0)
+GPLMEDS^^0^B27482404
+"BLD",6955,"KRN",9.8,"NM",19,0)
+GPLXPAT0^^0^B44173297
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPT",1)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPTT",2)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS",3)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRSYS",4)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUNIT",5)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUTIL",6)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRVA200",7)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLACTOR",8)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",16)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",17)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",14)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",15)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLMEDS",18)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",11)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",13)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",10)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",12)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",19)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
+
+"BLD",6955,"KRN",19,0)
+19
+"BLD",6955,"KRN",19.1,0)
+19.1
+"BLD",6955,"KRN",101,0)
+101
+"BLD",6955,"KRN",409.61,0)
+409.61
+"BLD",6955,"KRN",771,0)
+771
+"BLD",6955,"KRN",870,0)
+870
+"BLD",6955,"KRN",8989.51,0)
+8989.51
+"BLD",6955,"KRN",8989.52,0)
+8989.52
+"BLD",6955,"KRN",8994,0)
+8994
+"BLD",6955,"KRN","B",.4,.4)
+
+"BLD",6955,"KRN","B",.401,.401)
+
+"BLD",6955,"KRN","B",.402,.402)
+
+"BLD",6955,"KRN","B",.403,.403)
+
+"BLD",6955,"KRN","B",.5,.5)
+
+"BLD",6955,"KRN","B",.84,.84)
+
+"BLD",6955,"KRN","B",3.6,3.6)
+
+"BLD",6955,"KRN","B",3.8,3.8)
+
+"BLD",6955,"KRN","B",9.2,9.2)
+
+"BLD",6955,"KRN","B",9.8,9.8)
+
+"BLD",6955,"KRN","B",19,19)
+
+"BLD",6955,"KRN","B",19.1,19.1)
+
+"BLD",6955,"KRN","B",101,101)
+
+"BLD",6955,"KRN","B",409.61,409.61)
+
+"BLD",6955,"KRN","B",771,771)
+
+"BLD",6955,"KRN","B",870,870)
+
+"BLD",6955,"KRN","B",8989.51,8989.51)
+
+"BLD",6955,"KRN","B",8989.52,8989.52)
+
+"BLD",6955,"KRN","B",8994,8994)
+
+"BLD",6955,"QUES",0)
+^9.62^^
+"BLD",6955,"REQB",0)
+^9.611^^
+"MBREQ")
+0
+"QUES","XPF1",0)
+Y
+"QUES","XPF1","??")
+^D REP^XPDH
+"QUES","XPF1","A")
+Shall I write over your |FLAG| File
+"QUES","XPF1","B")
+YES
+"QUES","XPF1","M")
+D XPF1^XPDIQ
+"QUES","XPF2",0)
+Y
+"QUES","XPF2","??")
+^D DTA^XPDH
+"QUES","XPF2","A")
+Want my data |FLAG| yours
+"QUES","XPF2","B")
+YES
+"QUES","XPF2","M")
+D XPF2^XPDIQ
+"QUES","XPI1",0)
+YO
+"QUES","XPI1","??")
+^D INHIBIT^XPDH
+"QUES","XPI1","A")
+Want KIDS to INHIBIT LOGONs during the install
+"QUES","XPI1","B")
+NO
+"QUES","XPI1","M")
+D XPI1^XPDIQ
+"QUES","XPM1",0)
+PO^VA(200,:EM
+"QUES","XPM1","??")
+^D MG^XPDH
+"QUES","XPM1","A")
+Enter the Coordinator for Mail Group '|FLAG|'
+"QUES","XPM1","B")
+
+"QUES","XPM1","M")
+D XPM1^XPDIQ
+"QUES","XPO1",0)
+Y
+"QUES","XPO1","??")
+^D MENU^XPDH
+"QUES","XPO1","A")
+Want KIDS to Rebuild Menu Trees Upon Completion of Install
+"QUES","XPO1","B")
+NO
+"QUES","XPO1","M")
+D XPO1^XPDIQ
+"QUES","XPZ1",0)
+Y
+"QUES","XPZ1","??")
+^D OPT^XPDH
+"QUES","XPZ1","A")
+Want to DISABLE Scheduled Options, Menu Options, and Protocols
+"QUES","XPZ1","B")
+NO
+"QUES","XPZ1","M")
+D XPZ1^XPDIQ
+"QUES","XPZ2",0)
+Y
+"QUES","XPZ2","??")
+^D RTN^XPDH
+"QUES","XPZ2","A")
+Want to MOVE routines to other CPUs
+"QUES","XPZ2","B")
+NO
+"QUES","XPZ2","M")
+D XPZ2^XPDIQ
+"RTN")
+19
+"RTN","CCRDPT")
+0^1^B312345713
+"RTN","CCRDPT",1,0)
+CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
+"RTN","CCRDPT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 3
+"RTN","CCRDPT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPT",5,0)
+ ;
+"RTN","CCRDPT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPT",9,0)
+ ;(at your option) any later version.
+"RTN","CCRDPT",10,0)
+ ;
+"RTN","CCRDPT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPT",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPT",15,0)
+ ;
+"RTN","CCRDPT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPT",19,0)
+    ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
+"RTN","CCRDPT",20,0)
+    ; DESTROY to clean-up.
+"RTN","CCRDPT",21,0)
+    ; The first line of every routine tests if the global exists.
+"RTN","CCRDPT",22,0)
+    ;
+"RTN","CCRDPT",23,0)
+    ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
+"RTN","CCRDPT",24,0)
+    ; INIT        9 lines  Copy DFN global to a local variable
+"RTN","CCRDPT",25,0)
+    ; DESTROY     6 lines  Kill local variable
+"RTN","CCRDPT",26,0)
+    ; FAMILY      6 lines  Family Name
+"RTN","CCRDPT",27,0)
+    ; GIVEN       6 lines  Given Name
+"RTN","CCRDPT",28,0)
+    ; MIDDLE      6 lines  Middle Name
+"RTN","CCRDPT",29,0)
+    ; SUFFIX      6 lines  Suffix Name
+"RTN","CCRDPT",30,0)
+    ; DISPNAME    5 lines  Display Name
+"RTN","CCRDPT",31,0)
+    ; DOB         6 lines  Date of Birth
+"RTN","CCRDPT",32,0)
+    ; GENDER      4 lines  Get Gender
+"RTN","CCRDPT",33,0)
+    ; SSN         4 lines  Get SSN for ID
+"RTN","CCRDPT",34,0)
+    ; ADDRTYPE    4 lines  Get Home Address
+"RTN","CCRDPT",35,0)
+    ; ADDR1       4 lines  Get Home Address line 1
+"RTN","CCRDPT",36,0)
+    ; ADDR2       5 lines  Get Home Address line 2
+"RTN","CCRDPT",37,0)
+    ; CITY        4 lines  Get City for Home Address
+"RTN","CCRDPT",38,0)
+    ; STATE      11 lines  Get State for Home Address
+"RTN","CCRDPT",39,0)
+    ; ZIP         4 lines  Get Zip code for Home Address
+"RTN","CCRDPT",40,0)
+    ; COUNTY      4 lines  Get County for our Address
+"RTN","CCRDPT",41,0)
+    ; COUNTRY     4 lines  Get Country for our Address
+"RTN","CCRDPT",42,0)
+    ; RESTEL      4 lines  Residential Telephone
+"RTN","CCRDPT",43,0)
+    ; WORKTEL     4 lines  Work Telephone
+"RTN","CCRDPT",44,0)
+    ; EMAIL       4 lines  Email Adddress
+"RTN","CCRDPT",45,0)
+    ; CELLTEL     4 lines  Cell Phone
+"RTN","CCRDPT",46,0)
+    ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
+"RTN","CCRDPT",47,0)
+    ; NOK1GIV     6 lines  NOK1 Given Name
+"RTN","CCRDPT",48,0)
+    ; NOK1MID     6 lines  NOK1 Middle Name
+"RTN","CCRDPT",49,0)
+    ; NOK1SUF     6 lines  NOK1 Suffi Name
+"RTN","CCRDPT",50,0)
+    ; NOK1DISP    5 lines  NOK1 Display Name
+"RTN","CCRDPT",51,0)
+    ; NOK1REL     4 lines  NOK1 Relationship to the patient
+"RTN","CCRDPT",52,0)
+    ; NOK1ADD1    4 lines  NOK1 Address 1
+"RTN","CCRDPT",53,0)
+    ; NOK1ADD2    5 lines  NOK1 Address 2
+"RTN","CCRDPT",54,0)
+    ; NOK1CITY    4 lines  NOK1 City
+"RTN","CCRDPT",55,0)
+    ; NOK1STAT    5 lines  NOK1 State
+"RTN","CCRDPT",56,0)
+    ; NOK1ZIP     4 lines  NOK1 Zip Code
+"RTN","CCRDPT",57,0)
+    ; NOK1HTEL;   4 lines  NOK1 Home Telephone
+"RTN","CCRDPT",58,0)
+    ; NOK1WTEL;   4 lines  NOK1 Work Telephone
+"RTN","CCRDPT",59,0)
+    ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
+"RTN","CCRDPT",60,0)
+    ; NOK2FAM     6 lines  NOK2 Family Name
+"RTN","CCRDPT",61,0)
+    ; NOK2GIV     6 lines  NOK2 Given Name
+"RTN","CCRDPT",62,0)
+    ; NOK2MID     6 lines  NOK2 Middle Name
+"RTN","CCRDPT",63,0)
+    ; NOK2SUF     5 lines  NOK2 Suffi Name
+"RTN","CCRDPT",64,0)
+    ; NOK2DISP    5 lines  NOK2 Display Name
+"RTN","CCRDPT",65,0)
+    ; NOK2REL     4 lines  NOK2 Relationship to the patient
+"RTN","CCRDPT",66,0)
+    ; NOK2ADD1    4 lines  NOK2 Address 1
+"RTN","CCRDPT",67,0)
+    ; NOK2ADD2    5 lines  NOK2 Address 2
+"RTN","CCRDPT",68,0)
+    ; NOK2CITY    4 lines  NOK2 City
+"RTN","CCRDPT",69,0)
+    ; NOK2STAT    5 lines  NOK2 State
+"RTN","CCRDPT",70,0)
+    ; NOK2ZIP     4 lines  NOK2 Zip Code
+"RTN","CCRDPT",71,0)
+    ; NOK2HTEL;   4 lines  NOK2 Home Telephone
+"RTN","CCRDPT",72,0)
+    ; NOK2WTEL;   4 lines  NOK2 Work Telephone
+"RTN","CCRDPT",73,0)
+    ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
+"RTN","CCRDPT",74,0)
+    ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
+"RTN","CCRDPT",75,0)
+    ; EMERGIV     6 lines  EMER Given Name
+"RTN","CCRDPT",76,0)
+    ; EMERMID     6 lines  EMER Middle Name
+"RTN","CCRDPT",77,0)
+    ; EMERSUF     5 lines  EMER Suffi Name
+"RTN","CCRDPT",78,0)
+    ; EMERDISP    5 lines  EMER Display Name
+"RTN","CCRDPT",79,0)
+    ; EMERREL     4 lines  EMER Relationship to the patient
+"RTN","CCRDPT",80,0)
+    ; EMERADD1    4 lines  EMER Address 1
+"RTN","CCRDPT",81,0)
+    ; EMERADD2    5 lines  EMER Address 2
+"RTN","CCRDPT",82,0)
+    ; EMERCITY    4 lines  EMER City
+"RTN","CCRDPT",83,0)
+    ; EMERSTAT    5 lines  EMER State
+"RTN","CCRDPT",84,0)
+    ; EMERZIP     4 lines  EMER Zip Code
+"RTN","CCRDPT",85,0)
+    ; EMERHTEL;   4 lines  EMER Home Telephone
+"RTN","CCRDPT",86,0)
+    ; EMERWTEL;   4 lines  EMER Work Telephone
+"RTN","CCRDPT",87,0)
+    ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
+"RTN","CCRDPT",88,0)
+    ;
+"RTN","CCRDPT",89,0)
+          W "No Entry at top!" Q
+"RTN","CCRDPT",90,0)
+   ; The following is a map of the relevant data in the patient global.
+"RTN","CCRDPT",91,0)
+    ;
+"RTN","CCRDPT",92,0)
+    ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
+"RTN","CCRDPT",93,0)
+    ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
+"RTN","CCRDPT",94,0)
+    ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
+"RTN","CCRDPT",95,0)
+    ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
+"RTN","CCRDPT",96,0)
+    ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
+"RTN","CCRDPT",97,0)
+    ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
+"RTN","CCRDPT",98,0)
+    ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
+"RTN","CCRDPT",99,0)
+    ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
+"RTN","CCRDPT",100,0)
+    ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
+"RTN","CCRDPT",101,0)
+    ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
+"RTN","CCRDPT",102,0)
+    ; ==>[21S] ^
+"RTN","CCRDPT",103,0)
+    ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
+"RTN","CCRDPT",104,0)
+    ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
+"RTN","CCRDPT",105,0)
+    ; ==>COMPONENTS [3P:20] ^
+"RTN","CCRDPT",106,0)
+    ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
+"RTN","CCRDPT",107,0)
+    ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
+"RTN","CCRDPT",108,0)
+    ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
+"RTN","CCRDPT",109,0)
+    ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
+"RTN","CCRDPT",110,0)
+    ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
+"RTN","CCRDPT",111,0)
+    ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
+"RTN","CCRDPT",112,0)
+    ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
+"RTN","CCRDPT",113,0)
+    ; ==>^
+"RTN","CCRDPT",114,0)
+    ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
+"RTN","CCRDPT",115,0)
+    ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
+"RTN","CCRDPT",116,0)
+    ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
+"RTN","CCRDPT",117,0)
+    ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
+"RTN","CCRDPT",118,0)
+    ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
+"RTN","CCRDPT",119,0)
+    ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
+"RTN","CCRDPT",120,0)
+    ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
+"RTN","CCRDPT",121,0)
+    ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
+"RTN","CCRDPT",122,0)
+    ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
+"RTN","CCRDPT",123,0)
+    ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
+"RTN","CCRDPT",124,0)
+    ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
+"RTN","CCRDPT",125,0)
+    ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
+"RTN","CCRDPT",126,0)
+    ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
+"RTN","CCRDPT",127,0)
+    ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
+"RTN","CCRDPT",128,0)
+    ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
+"RTN","CCRDPT",129,0)
+    ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
+"RTN","CCRDPT",130,0)
+    ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
+"RTN","CCRDPT",131,0)
+    ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
+"RTN","CCRDPT",132,0)
+    ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
+"RTN","CCRDPT",133,0)
+    ; ==>SITE [14P:4] ^
+"RTN","CCRDPT",134,0)
+    ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
+"RTN","CCRDPT",135,0)
+    ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
+"RTN","CCRDPT",136,0)
+    ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
+"RTN","CCRDPT",137,0)
+    ; ==>3] [5F] ^
+"RTN","CCRDPT",138,0)
+    ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
+"RTN","CCRDPT",139,0)
+    ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
+"RTN","CCRDPT",140,0)
+    ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
+"RTN","CCRDPT",141,0)
+    ; ==>^
+"RTN","CCRDPT",142,0)
+    ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
+"RTN","CCRDPT",143,0)
+    ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
+"RTN","CCRDPT",144,0)
+    ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
+"RTN","CCRDPT",145,0)
+    ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
+"RTN","CCRDPT",146,0)
+    ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
+"RTN","CCRDPT",147,0)
+    ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
+"RTN","CCRDPT",148,0)
+    ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
+"RTN","CCRDPT",149,0)
+    ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
+"RTN","CCRDPT",150,0)
+    ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
+"RTN","CCRDPT",151,0)
+    ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
+"RTN","CCRDPT",152,0)
+    ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
+"RTN","CCRDPT",153,0)
+    ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
+"RTN","CCRDPT",154,0)
+    ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
+"RTN","CCRDPT",155,0)
+    ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
+"RTN","CCRDPT",156,0)
+    ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
+"RTN","CCRDPT",157,0)
+    ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
+"RTN","CCRDPT",158,0)
+    ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
+"RTN","CCRDPT",159,0)
+    ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
+"RTN","CCRDPT",160,0)
+    ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
+"RTN","CCRDPT",161,0)
+    ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
+"RTN","CCRDPT",162,0)
+    ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
+"RTN","CCRDPT",163,0)
+    ; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
+"RTN","CCRDPT",164,0)
+    ; INPUT: Patient IEN (DFN)
+"RTN","CCRDPT",165,0)
+    ; OUTPUT: PT in the Symbol Table, representing the patient global
+"RTN","CCRDPT",166,0)
+    ; Instead of accessing a global each single read (SLOOOOW)
+"RTN","CCRDPT",167,0)
+    ; read it off a local variable stored in Memory.
+"RTN","CCRDPT",168,0)
+INIT(DFN) ;
+"RTN","CCRDPT",169,0)
+          M PT=^DPT(DFN)
+"RTN","CCRDPT",170,0)
+          Q
+"RTN","CCRDPT",171,0)
+          ;
+"RTN","CCRDPT",172,0)
+DESTROY ; Kill local variable; PUBLIC
+"RTN","CCRDPT",173,0)
+          ; INPUT: None
+"RTN","CCRDPT",174,0)
+          ; OUTPUT: Kill PT from the Symbol Table after you are done
+"RTN","CCRDPT",175,0)
+          K PT
+"RTN","CCRDPT",176,0)
+          Q
+"RTN","CCRDPT",177,0)
+          ;
+"RTN","CCRDPT",178,0)
+FAMILY() ; Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",179,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",180,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",181,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",182,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",183,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",184,0)
+          ;
+"RTN","CCRDPT",185,0)
+GIVEN() ; Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",186,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",187,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",188,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",189,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",190,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",191,0)
+          ;
+"RTN","CCRDPT",192,0)
+MIDDLE() ; Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",193,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",194,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",195,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",196,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",197,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",198,0)
+          ;
+"RTN","CCRDPT",199,0)
+SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",200,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",201,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",202,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",203,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",204,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",205,0)
+          ;
+"RTN","CCRDPT",206,0)
+DISPNAME() ; Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",207,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",208,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",209,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",210,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",211,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",212,0)
+DOB() ; Date of Birth; PUBLIC; Extrinsic
+"RTN","CCRDPT",213,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",214,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",215,0)
+          N DOB S DOB=$P(PT(0),"^",3)
+"RTN","CCRDPT",216,0)
+          ; Date in FM Date Format. Convert to UTC/ISO 8601.
+"RTN","CCRDPT",217,0)
+          Q $$FMDTOUTC^CCRUTIL(DOB,"D")
+"RTN","CCRDPT",218,0)
+          ;
+"RTN","CCRDPT",219,0)
+GENDER() ; Get Gender; PUBLIC; Extrinsic
+"RTN","CCRDPT",220,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",221,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",222,0)
+          Q $P(PT(0),"^",2)
+"RTN","CCRDPT",223,0)
+          ;
+"RTN","CCRDPT",224,0)
+SSN() ; Get SSN for ID; PUBLIC; Extrinsic
+"RTN","CCRDPT",225,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",226,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",227,0)
+          Q $P(PT(0),"^",9)
+"RTN","CCRDPT",228,0)
+          ;
+"RTN","CCRDPT",229,0)
+ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",230,0)
+          ; Vista only stores a home address for the patient.
+"RTN","CCRDPT",231,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",232,0)
+          Q "Home"
+"RTN","CCRDPT",233,0)
+          ;
+"RTN","CCRDPT",234,0)
+ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",235,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",236,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",237,0)
+          Q $P(PT(.11),"^",1)
+"RTN","CCRDPT",238,0)
+          ;
+"RTN","CCRDPT",239,0)
+ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",240,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",241,0)
+          ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
+"RTN","CCRDPT",242,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",243,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",244,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",245,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",246,0)
+          Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
+"RTN","CCRDPT",247,0)
+          Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
+"RTN","CCRDPT",248,0)
+          ;
+"RTN","CCRDPT",249,0)
+CITY() ; Get City for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",250,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",251,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",252,0)
+          Q $P(PT(.11),"^",4)
+"RTN","CCRDPT",253,0)
+          ;
+"RTN","CCRDPT",254,0)
+STATE() ; Get State for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",255,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",256,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",257,0)
+          ; State is stored as a pointer
+"RTN","CCRDPT",258,0)
+          N STATENUM S STATENUM=$P(PT(.11),"^",5)
+"RTN","CCRDPT",259,0)
+          ;
+"RTN","CCRDPT",260,0)
+          ; State File Global is below
+"RTN","CCRDPT",261,0)
+          ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
+"RTN","CCRDPT",262,0)
+          ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
+"RTN","CCRDPT",263,0)
+          ; ==>US STATE OR POSSESSION [6S] ^
+"RTN","CCRDPT",264,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",265,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",266,0)
+          ;
+"RTN","CCRDPT",267,0)
+ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",268,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",269,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",270,0)
+          Q $P(PT(.11),"^",6)
+"RTN","CCRDPT",271,0)
+          ;
+"RTN","CCRDPT",272,0)
+COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",273,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",274,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",275,0)
+          Q $P(PT(.11),"^",7)
+"RTN","CCRDPT",276,0)
+          ;
+"RTN","CCRDPT",277,0)
+COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",278,0)
+          ; Unfortunately, I can't find where that is stored, so the inevitable...
+"RTN","CCRDPT",279,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",280,0)
+          Q "USA"
+"RTN","CCRDPT",281,0)
+          ;
+"RTN","CCRDPT",282,0)
+RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",283,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",284,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",285,0)
+          Q $P(PT(.13),"^",1)
+"RTN","CCRDPT",286,0)
+          ;
+"RTN","CCRDPT",287,0)
+WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",288,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",289,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",290,0)
+          Q $P(PT(.13),"^",2)
+"RTN","CCRDPT",291,0)
+          ;
+"RTN","CCRDPT",292,0)
+EMAIL() ; Email Adddress; PUBLIC; Extrinsic
+"RTN","CCRDPT",293,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",294,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",295,0)
+          Q $P(PT(.13),"^",3)
+"RTN","CCRDPT",296,0)
+          ;
+"RTN","CCRDPT",297,0)
+CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
+"RTN","CCRDPT",298,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",299,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",300,0)
+          Q $P(PT(.13),"^",4)
+"RTN","CCRDPT",301,0)
+          ;
+"RTN","CCRDPT",302,0)
+NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",303,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",304,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",305,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",306,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",307,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",308,0)
+          ;
+"RTN","CCRDPT",309,0)
+NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",310,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",311,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",312,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",313,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",314,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",315,0)
+          ;
+"RTN","CCRDPT",316,0)
+NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",317,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",318,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",319,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",320,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",321,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",322,0)
+          ;
+"RTN","CCRDPT",323,0)
+NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",324,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",325,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",326,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",327,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",328,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",329,0)
+          ;
+"RTN","CCRDPT",330,0)
+NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",331,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",332,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",333,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",334,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",335,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",336,0)
+NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",337,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",338,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",339,0)
+          Q $P(PT(.21),"^",2)
+"RTN","CCRDPT",340,0)
+          ;
+"RTN","CCRDPT",341,0)
+NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",342,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",343,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",344,0)
+          Q $P(PT(.21),"^",3)
+"RTN","CCRDPT",345,0)
+          ;
+"RTN","CCRDPT",346,0)
+NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",347,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",348,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",349,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",350,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",351,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",352,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",353,0)
+          Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
+"RTN","CCRDPT",354,0)
+          Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
+"RTN","CCRDPT",355,0)
+          ;
+"RTN","CCRDPT",356,0)
+NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",357,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",358,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",359,0)
+          Q $P(PT(.21),"^",6)
+"RTN","CCRDPT",360,0)
+          ;
+"RTN","CCRDPT",361,0)
+NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",362,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",363,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",364,0)
+          N STATENUM S STATENUM=$P(PT(.21),"^",7)
+"RTN","CCRDPT",365,0)
+          Q:STATENUM="" ""
+"RTN","CCRDPT",366,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",367,0)
+          ;
+"RTN","CCRDPT",368,0)
+NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",369,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",370,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",371,0)
+          Q $P(PT(.21),"^",8)
+"RTN","CCRDPT",372,0)
+          ;
+"RTN","CCRDPT",373,0)
+NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",374,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",375,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",376,0)
+          Q $P(PT(.21),"^",9)
+"RTN","CCRDPT",377,0)
+          ;
+"RTN","CCRDPT",378,0)
+NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",379,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",380,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",381,0)
+          Q $P(PT(.21),"^",11)
+"RTN","CCRDPT",382,0)
+          ;
+"RTN","CCRDPT",383,0)
+NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",384,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",385,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",386,0)
+          Q $P(PT(.21),"^",10)
+"RTN","CCRDPT",387,0)
+          ;
+"RTN","CCRDPT",388,0)
+NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",389,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",390,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",391,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",392,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",393,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",394,0)
+          ;
+"RTN","CCRDPT",395,0)
+NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
+"RTN","CCRDPT",396,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",397,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",398,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",399,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",400,0)
+          ;
+"RTN","CCRDPT",401,0)
+NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",402,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",403,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",404,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",405,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",406,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",407,0)
+          ;
+"RTN","CCRDPT",408,0)
+NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",409,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",410,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",411,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",412,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",413,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",414,0)
+NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",415,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",416,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",417,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",418,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",419,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",420,0)
+NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",421,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",422,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",423,0)
+          Q $P(PT(.211),"^",2)
+"RTN","CCRDPT",424,0)
+          ;
+"RTN","CCRDPT",425,0)
+NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",426,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",427,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",428,0)
+          Q $P(PT(.211),"^",3)
+"RTN","CCRDPT",429,0)
+          ;
+"RTN","CCRDPT",430,0)
+NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",431,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",432,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",433,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",434,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",435,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",436,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",437,0)
+          Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
+"RTN","CCRDPT",438,0)
+          Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
+"RTN","CCRDPT",439,0)
+          ;
+"RTN","CCRDPT",440,0)
+NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",441,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",442,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",443,0)
+          Q $P(PT(.211),"^",6)
+"RTN","CCRDPT",444,0)
+          ;
+"RTN","CCRDPT",445,0)
+NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",446,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",447,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",448,0)
+          N STATENUM S STATENUM=$P(PT(.211),"^",7)
+"RTN","CCRDPT",449,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",450,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",451,0)
+          ;
+"RTN","CCRDPT",452,0)
+NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",453,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",454,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",455,0)
+          Q $P(PT(.211),"^",8)
+"RTN","CCRDPT",456,0)
+          ;
+"RTN","CCRDPT",457,0)
+NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",458,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",459,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",460,0)
+          Q $P(PT(.211),"^",9)
+"RTN","CCRDPT",461,0)
+          ;
+"RTN","CCRDPT",462,0)
+NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",463,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",464,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",465,0)
+          Q $P(PT(.211),"^",11)
+"RTN","CCRDPT",466,0)
+          ;
+"RTN","CCRDPT",467,0)
+NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",468,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",469,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",470,0)
+          Q $P(PT(.211),"^",10)
+"RTN","CCRDPT",471,0)
+          ;
+"RTN","CCRDPT",472,0)
+EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",473,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",474,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",475,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",476,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",477,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",478,0)
+          ;
+"RTN","CCRDPT",479,0)
+EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",480,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",481,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",482,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",483,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",484,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",485,0)
+          ;
+"RTN","CCRDPT",486,0)
+EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",487,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",488,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",489,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",490,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",491,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",492,0)
+          ;
+"RTN","CCRDPT",493,0)
+EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",494,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",495,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",496,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",497,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",498,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",499,0)
+EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",500,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",501,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",502,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",503,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",504,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",505,0)
+EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",506,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",507,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",508,0)
+          Q $P(PT(.33),"^",2)
+"RTN","CCRDPT",509,0)
+          ;
+"RTN","CCRDPT",510,0)
+EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",511,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",512,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",513,0)
+          Q $P(PT(.33),"^",3)
+"RTN","CCRDPT",514,0)
+          ;
+"RTN","CCRDPT",515,0)
+EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",516,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",517,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",518,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",519,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",520,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",521,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",522,0)
+          Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
+"RTN","CCRDPT",523,0)
+          Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
+"RTN","CCRDPT",524,0)
+          ;
+"RTN","CCRDPT",525,0)
+EMERCITY() ; EMER City; PUBLIC; Extrinsic
+"RTN","CCRDPT",526,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",527,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",528,0)
+          Q $P(PT(.33),"^",6)
+"RTN","CCRDPT",529,0)
+          ;
+"RTN","CCRDPT",530,0)
+EMERSTAT() ; EMER State; PUBLIC; Extrinsic
+"RTN","CCRDPT",531,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",532,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",533,0)
+          N STATENUM S STATENUM=$P(PT(.33),"^",7)
+"RTN","CCRDPT",534,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",535,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",536,0)
+          ;
+"RTN","CCRDPT",537,0)
+EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",538,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",539,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",540,0)
+          Q $P(PT(.33),"^",8)
+"RTN","CCRDPT",541,0)
+          ;
+"RTN","CCRDPT",542,0)
+EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",543,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",544,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",545,0)
+          Q $P(PT(.33),"^",9)
+"RTN","CCRDPT",546,0)
+          ;
+"RTN","CCRDPT",547,0)
+EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",548,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",549,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",550,0)
+          Q $P(PT(.33),"^",11)
+"RTN","CCRDPT",551,0)
+          ;
+"RTN","CCRDPT",552,0)
+EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
+"RTN","CCRDPT",553,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",554,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",555,0)
+          Q $P(PT(.33),"^",10)
+"RTN","CCRDPT",556,0)
+          ;
+"RTN","CCRDPTT")
+0^2^B4863621
+"RTN","CCRDPTT",1,0)
+CCRDPTT ; Unit Tester...
+"RTN","CCRDPTT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 3
+"RTN","CCRDPTT",3,0)
+ ;
+"RTN","CCRDPTT",4,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPTT",5,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPTT",6,0)
+ ;
+"RTN","CCRDPTT",7,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPTT",8,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPTT",9,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPTT",10,0)
+ ;(at your option) any later version.
+"RTN","CCRDPTT",11,0)
+ ;
+"RTN","CCRDPTT",12,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPTT",13,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPTT",14,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPTT",15,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPTT",16,0)
+ ;
+"RTN","CCRDPTT",17,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPTT",18,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPTT",19,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPTT",20,0)
+          ; Get the functions in the routine using Rick's routine
+"RTN","CCRDPTT",21,0)
+          ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
+"RTN","CCRDPTT",22,0)
+          ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
+"RTN","CCRDPTT",23,0)
+          ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
+"RTN","CCRDPTT",24,0)
+          ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
+"RTN","CCRDPTT",25,0)
+          ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
+"RTN","CCRDPTT",26,0)
+          ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",27,0)
+          ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",28,0)
+          ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
+"RTN","CCRDPTT",29,0)
+          ; etc.
+"RTN","CCRDPTT",30,0)
+          ;
+"RTN","CCRDPTT",31,0)
+          ; Load Routine Entry points; We get a sweeeeeet array
+"RTN","CCRDPTT",32,0)
+          D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
+"RTN","CCRDPTT",33,0)
+          N X,Y
+"RTN","CCRDPTT",34,0)
+          ; Select Patient
+"RTN","CCRDPTT",35,0)
+          S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","CCRDPTT",36,0)
+          ;
+"RTN","CCRDPTT",37,0)
+          W "You have selected patient "_Y,!!
+"RTN","CCRDPTT",38,0)
+          D INIT^CCRDPT($P(Y,"^"))
+"RTN","CCRDPTT",39,0)
+          ; ZWR PT
+"RTN","CCRDPTT",40,0)
+          N I S I=165 F  S I=$O(OUT(I)) Q:I=""  D
+"RTN","CCRDPTT",41,0)
+          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
+"RTN","CCRDPTT",42,0)
+          . W "valued at "
+"RTN","CCRDPTT",43,0)
+          . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
+"RTN","CCRDPTT",44,0)
+          . W !
+"RTN","CCRDPTT",45,0)
+          Q
+"RTN","CCRMEDS")
+0^3^B36357726
+"RTN","CCRMEDS",1,0)
+CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
+"RTN","CCRMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 3
+"RTN","CCRMEDS",3,0)
+   ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRMEDS",4,0)
+   ; General Public License See attached copy of the License.
+"RTN","CCRMEDS",5,0)
+   ; 
+"RTN","CCRMEDS",6,0)
+   ; This program is free software; you can redistribute it and/or modify
+"RTN","CCRMEDS",7,0)
+   ; it under the terms of the GNU General Public License as published by
+"RTN","CCRMEDS",8,0)
+   ; the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRMEDS",9,0)
+   ; (at your option) any later version.
+"RTN","CCRMEDS",10,0)
+   ; 
+"RTN","CCRMEDS",11,0)
+   ; This program is distributed in the hope that it will be useful,
+"RTN","CCRMEDS",12,0)
+   ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRMEDS",13,0)
+   ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRMEDS",14,0)
+   ; GNU General Public License for more details.
+"RTN","CCRMEDS",15,0)
+   ; 
+"RTN","CCRMEDS",16,0)
+   ; You should have received a copy of the GNU General Public License along
+"RTN","CCRMEDS",17,0)
+   ; with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRMEDS",18,0)
+   ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRMEDS",19,0)
+   ;
+"RTN","CCRMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","CCRMEDS",21,0)
+   Q
+"RTN","CCRMEDS",22,0)
+   ;
+"RTN","CCRMEDS",23,0)
+EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","CCRMEDS",24,0)
+   ;
+"RTN","CCRMEDS",25,0)
+   ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","CCRMEDS",26,0)
+   ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","CCRMEDS",27,0)
+   ; 
+"RTN","CCRMEDS",28,0)
+   ; MEDS is return array from RPC.
+"RTN","CCRMEDS",29,0)
+   ; MAP is a mapping variable map (store result) for each med
+"RTN","CCRMEDS",30,0)
+   ; MED is holds each array element from MEDS(J), one medicine
+"RTN","CCRMEDS",31,0)
+   ; J is a counter.
+"RTN","CCRMEDS",32,0)
+   ;
+"RTN","CCRMEDS",33,0)
+   ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+"RTN","CCRMEDS",34,0)
+   ; med data available.
+"RTN","CCRMEDS",35,0)
+   ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+"RTN","CCRMEDS",36,0)
+   ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+"RTN","CCRMEDS",37,0)
+ 
+"RTN","CCRMEDS",38,0)
+   N MEDS,MAP
+"RTN","CCRMEDS",39,0)
+   K ^TMP($J)
+"RTN","CCRMEDS",40,0)
+   D RX^PSO52API(DFN,"CCDCCR")
+"RTN","CCRMEDS",41,0)
+   M MEDS=^TMP($J,"CCDCCR",DFN)
+"RTN","CCRMEDS",42,0)
+   ; @(0) contains the number of meds or -1^NO DATA FOUND
+"RTN","CCRMEDS",43,0)
+   ; If it is -1, we quit.
+"RTN","CCRMEDS",44,0)
+   I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT  
+"RTN","CCRMEDS",45,0)
+   I DEBUG ZWR MEDS
+"RTN","CCRMEDS",46,0)
+   N RXIEN S RXIEN=0
+"RTN","CCRMEDS",47,0)
+   F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+"RTN","CCRMEDS",48,0)
+   . I DEBUG W "RXIEN IS ",RXIEN,!
+"RTN","CCRMEDS",49,0)
+   . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J))
+"RTN","CCRMEDS",50,0)
+   . K @MAP
+"RTN","CCRMEDS",51,0)
+   . I DEBUG W "MAP= ",MAP,!
+"RTN","CCRMEDS",52,0)
+   . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+"RTN","CCRMEDS",53,0)
+   . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+"RTN","CCRMEDS",54,0)
+   . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+"RTN","CCRMEDS",55,0)
+   . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
+"RTN","CCRMEDS",56,0)
+   . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+"RTN","CCRMEDS",57,0)
+   . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
+"RTN","CCRMEDS",58,0)
+   . S @MAP@("MEDRXNOTXT")="Prescription Number"
+"RTN","CCRMEDS",59,0)
+   . S @MAP@("MEDRXNO")=MED(.01)
+"RTN","CCRMEDS",60,0)
+   . S @MAP@("MEDTYPETEXT")="Medication"
+"RTN","CCRMEDS",61,0)
+   . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+"RTN","CCRMEDS",62,0)
+   . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+"RTN","CCRMEDS",63,0)
+   . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+"RTN","CCRMEDS",64,0)
+   . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+"RTN","CCRMEDS",65,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
+"RTN","CCRMEDS",66,0)
+   . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+"RTN","CCRMEDS",67,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
+"RTN","CCRMEDS",68,0)
+   . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+"RTN","CCRMEDS",69,0)
+   . N MEDIEN S MEDIEN=$P(MED(6),U)
+"RTN","CCRMEDS",70,0)
+   . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","CCRMEDS",71,0)
+   . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","CCRMEDS",72,0)
+   . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","CCRMEDS",73,0)
+   . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","CCRMEDS",74,0)
+   . ; Units, concentration, etc, come from another call
+"RTN","CCRMEDS",75,0)
+   . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","CCRMEDS",76,0)
+   . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","CCRMEDS",77,0)
+   . ; NDF Entry IEN, and VA Product Name
+"RTN","CCRMEDS",78,0)
+   . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",79,0)
+   . ; Documented in the same manual.
+"RTN","CCRMEDS",80,0)
+   . N IEN S IEN=^PSDRUG($P(MED(6),U))
+"RTN","CCRMEDS",81,0)
+   . D NDF^PSS50(IEN,,,,,"CONC")
+"RTN","CCRMEDS",82,0)
+   . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN)
+"RTN","CCRMEDS",83,0)
+   . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","CCRMEDS",84,0)
+   . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","CCRMEDS",85,0)
+   . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","CCRMEDS",86,0)
+   . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","CCRMEDS",87,0)
+   . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","CCRMEDS",88,0)
+   . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","CCRMEDS",89,0)
+   . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
+"RTN","CCRMEDS",90,0)
+   . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+"RTN","CCRMEDS",91,0)
+   . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","CCRMEDS",92,0)
+   . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","CCRMEDS",93,0)
+   . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",94,0)
+   . ; Node 14.5 is the Dispense Unit
+"RTN","CCRMEDS",95,0)
+   . D DATA^PSS50(IEN,,,,,"QTY")
+"RTN","CCRMEDS",96,0)
+   . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN)
+"RTN","CCRMEDS",97,0)
+   . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","CCRMEDS",98,0)
+   . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""
+"RTN","CCRMEDS",99,0)
+   . S @MAP@("MEDDOSEINDICATOR")
+"RTN","CCRMEDS",100,0)
+   . S @MAP@("MEDDELIVERYMETHOD")
+"RTN","CCRMEDS",101,0)
+   . S @MAP@("MEDDOSEVALUE")
+"RTN","CCRMEDS",102,0)
+   . S @MAP@("MEDDOSEUNIT")
+"RTN","CCRMEDS",103,0)
+   . S @MAP@("MEDRATEVALUE")
+"RTN","CCRMEDS",104,0)
+   . S @MAP@("MEDRATEUNIT")
+"RTN","CCRMEDS",105,0)
+   . S @MAP@("MEDVEHICLETEXT")
+"RTN","CCRMEDS",106,0)
+   . S @MAP@("MEDDIRECTIONROUTETEXT")
+"RTN","CCRMEDS",107,0)
+   . S @MAP@("MEDFREQUENCYVALUE")
+"RTN","CCRMEDS",108,0)
+   . S @MAP@("MEDFREQUENCYUNIT")
+"RTN","CCRMEDS",109,0)
+   . S @MAP@("MEDINTERVALVALUE")
+"RTN","CCRMEDS",110,0)
+   . S @MAP@("MEDINTERVALUNIT")
+"RTN","CCRMEDS",111,0)
+   . S @MAP@("MEDDURATIONVALUE")
+"RTN","CCRMEDS",112,0)
+   . S @MAP@("MEDDURATIONUNIT")
+"RTN","CCRMEDS",113,0)
+   . S @MAP@("MEDPRNFLAG")
+"RTN","CCRMEDS",114,0)
+   . S @MAP@("MEDPROBLEMOBJECTID")=""
+"RTN","CCRMEDS",115,0)
+   . S @MAP@("MEDPROBLEMDESCRIPTION")=""
+"RTN","CCRMEDS",116,0)
+   . S @MAP@("MEDPROBLEMCODEVALUE")=""
+"RTN","CCRMEDS",117,0)
+   . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
+"RTN","CCRMEDS",118,0)
+   . S @MAP@("MEDPROBLEMCODINGVERSION")=""
+"RTN","CCRMEDS",119,0)
+   . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
+"RTN","CCRMEDS",120,0)
+   . S @MAP@("MEDSTOPINDICATOR")
+"RTN","CCRMEDS",121,0)
+   . S @MAP@("MEDDIRSEQ")
+"RTN","CCRMEDS",122,0)
+   . S @MAP@("MEDMULDIRMOD")
+"RTN","CCRMEDS",123,0)
+   . S @MAP@("MEDPTINSTRUCTIONS")
+"RTN","CCRMEDS",124,0)
+   . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")
+"RTN","CCRMEDS",125,0)
+   . S @MAP@("MEDRFNO")=MED(9)
+"RTN","CCRMEDS",126,0)
+   . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J))
+"RTN","CCRMEDS",127,0)
+   . K @RESULT
+"RTN","CCRMEDS",128,0)
+   . D MAP^GPLXPATH(INXML,MAP,RESULT)
+"RTN","CCRMEDS",129,0)
+   . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+"RTN","CCRMEDS",130,0)
+   . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+"RTN","CCRMEDS",131,0)
+   N MEDTMP,MEDI
+"RTN","CCRMEDS",132,0)
+   D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","CCRMEDS",133,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","CCRMEDS",134,0)
+   . W "MEDICATION MISSING ",!
+"RTN","CCRMEDS",135,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","CCRMEDS",136,0)
+   Q
+"RTN","CCRMEDS",137,0)
+   ;
+"RTN","CCRSYS")
+0^4^B1690193
+"RTN","CCRSYS",1,0)
+CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
+"RTN","CCRSYS",2,0)
+        ;;0.1;CCDCCR;;;Build 3
+"RTN","CCRSYS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRSYS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRSYS",5,0)
+ ;
+"RTN","CCRSYS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRSYS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRSYS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRSYS",9,0)
+ ;(at your option) any later version.
+"RTN","CCRSYS",10,0)
+ ;
+"RTN","CCRSYS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRSYS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRSYS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRSYS",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRSYS",15,0)
+ ;
+"RTN","CCRSYS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRSYS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRSYS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRSYS",19,0)
+    ;
+"RTN","CCRSYS",20,0)
+        W "Enter at appropriate points." Q
+"RTN","CCRSYS",21,0)
+        ;
+"RTN","CCRSYS",22,0)
+        ; Originally, I was going to use VEPERVER, but VEPERVER
+"RTN","CCRSYS",23,0)
+        ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
+"RTN","CCRSYS",24,0)
+        ; manner (press any key to continue),
+"RTN","CCRSYS",25,0)
+        ; and is really a very half finished routine
+"RTN","CCRSYS",26,0)
+        ;
+"RTN","CCRSYS",27,0)
+        ; So for now, I am hard-coding the values.
+"RTN","CCRSYS",28,0)
+        ;
+"RTN","CCRSYS",29,0)
+SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
+"RTN","CCRSYS",30,0)
+        Q "WorldVistA EHR/VOE"
+"RTN","CCRSYS",31,0)
+        ;
+"RTN","CCRSYS",32,0)
+SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
+"RTN","CCRSYS",33,0)
+        Q "1.0"
+"RTN","CCRSYS",34,0)
+        ;
+"RTN","CCRUNIT")
+0^5^B8574
+"RTN","CCRUNIT",1,0)
+CCRUNIT ; A routine that tests some crap
+"RTN","CCRUNIT",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 3
+"RTN","CCRUNIT",3,0)
+        Q
+"RTN","CCRUNIT",4,0)
+        ;
+"RTN","CCRUNIT",5,0)
+MEDS
+"RTN","CCRUNIT",6,0)
+        N DEBUG S DEBUG=0
+"RTN","CCRUNIT",7,0)
+        N DFN S DFN=1
+"RTN","CCRUNIT",8,0)
+        K ^TMP($J)
+"RTN","CCRUNIT",9,0)
+        W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+"RTN","CCRUNIT",10,0)
+        N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
+"RTN","CCRUNIT",11,0)
+        B
+"RTN","CCRUNIT",12,0)
+        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+"RTN","CCRUNIT",13,0)
+        W "XPATH is: "_XPATH,!
+"RTN","CCRUNIT",14,0)
+        W "Getting Med Template into INXML using",!
+"RTN","CCRUNIT",15,0)
+        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+"RTN","CCRUNIT",16,0)
+        N INXML
+"RTN","CCRUNIT",17,0)
+        D QUERY^GPLXPATH(T,XPATH,"INXML")
+"RTN","CCRUNIT",18,0)
+        B
+"RTN","CCRUNIT",19,0)
+        W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
+"RTN","CCRUNIT",20,0)
+        W "OUTXML will be ^TMP($J,""OUT"")",!
+"RTN","CCRUNIT",21,0)
+        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+"RTN","CCRUNIT",22,0)
+        D EXTRACT^GPLMEDS("INXML",DFN,OUTXML)
+"RTN","CCRUNIT",23,0)
+        Q
+"RTN","CCRUTIL")
+0^6^B17726385
+"RTN","CCRUTIL",1,0)
+CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
+"RTN","CCRUTIL",2,0)
+          ;;0.1;CCRCCD;;Jun 15, 2008;Build 3
+"RTN","CCRUTIL",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRUTIL",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRUTIL",5,0)
+ ;
+"RTN","CCRUTIL",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRUTIL",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRUTIL",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRUTIL",9,0)
+ ;(at your option) any later version.
+"RTN","CCRUTIL",10,0)
+ ;
+"RTN","CCRUTIL",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRUTIL",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRUTIL",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRUTIL",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRUTIL",15,0)
+ ;
+"RTN","CCRUTIL",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRUTIL",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRUTIL",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRUTIL",19,0)
+    ;
+"RTN","CCRUTIL",20,0)
+          W "No Entry at Top!"
+"RTN","CCRUTIL",21,0)
+          Q
+"RTN","CCRUTIL",22,0)
+          ;
+"RTN","CCRUTIL",23,0)
+FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
+"RTN","CCRUTIL",24,0)
+          ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+"RTN","CCRUTIL",25,0)
+          ; If not passed, or passed incorrectly, it's assumed that it is D.
+"RTN","CCRUTIL",26,0)
+          ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+"RTN","CCRUTIL",27,0)
+          ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+"RTN","CCRUTIL",28,0)
+          ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+"RTN","CCRUTIL",29,0)
+          N UTC,Y,M,D,H,MM,S,OFF
+"RTN","CCRUTIL",30,0)
+          S Y=1700+$E(DATE,1,3)
+"RTN","CCRUTIL",31,0)
+          S M=$E(DATE,4,5)
+"RTN","CCRUTIL",32,0)
+          S D=$E(DATE,6,7)
+"RTN","CCRUTIL",33,0)
+          S H=$E(DATE,9,10)
+"RTN","CCRUTIL",34,0)
+          I $L(H)=1 S H="0"_H
+"RTN","CCRUTIL",35,0)
+          S MM=$E(DATE,11,12)
+"RTN","CCRUTIL",36,0)
+          I $L(MM)=1 S MM="0"_MM
+"RTN","CCRUTIL",37,0)
+          S S=$E(DATE,13,14)
+"RTN","CCRUTIL",38,0)
+          I $L(S)=1 S S="0"_S
+"RTN","CCRUTIL",39,0)
+          S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+"RTN","CCRUTIL",40,0)
+          ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+"RTN","CCRUTIL",41,0)
+          ; In this case, set H, MM and S to "00"
+"RTN","CCRUTIL",42,0)
+          ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
+"RTN","CCRUTIL",43,0)
+          S:'$L(H) H="00"
+"RTN","CCRUTIL",44,0)
+          S:'$L(MM) MM="00"
+"RTN","CCRUTIL",45,0)
+          S:'$L(S) S="00"
+"RTN","CCRUTIL",46,0)
+          S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+"RTN","CCRUTIL",47,0)
+          I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+"RTN","CCRUTIL",48,0)
+          E  Q $P(UTC,"T")
+"RTN","CCRUTIL",49,0)
+          ;
+"RTN","CCRUTIL",50,0)
+SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+"RTN","CCRUTIL",51,0)
+               ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+"RTN","CCRUTIL",52,0)
+               ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+"RTN","CCRUTIL",53,0)
+               ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+"RTN","CCRUTIL",54,0)
+               ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+"RTN","CCRUTIL",55,0)
+               ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+"RTN","CCRUTIL",56,0)
+               ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+"RTN","CCRUTIL",57,0)
+               ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+"RTN","CCRUTIL",58,0)
+          N VSRT ; TEMP FOR HASHING DATES
+"RTN","CCRUTIL",59,0)
+          N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+"RTN","CCRUTIL",60,0)
+          S ZCNT=0 ; COUNTING NUMBER OF DATES
+"RTN","CCRUTIL",61,0)
+          S ZTMP="" ;
+"RTN","CCRUTIL",62,0)
+          F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
+"RTN","CCRUTIL",63,0)
+          . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","CCRUTIL",64,0)
+          . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
+"RTN","CCRUTIL",65,0)
+          . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
+"RTN","CCRUTIL",66,0)
+          . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
+"RTN","CCRUTIL",67,0)
+          . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
+"RTN","CCRUTIL",68,0)
+          . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
+"RTN","CCRUTIL",69,0)
+          . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
+"RTN","CCRUTIL",70,0)
+          . I DEBUG W "ZTMP=",ZTMP," "
+"RTN","CCRUTIL",71,0)
+          S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
+"RTN","CCRUTIL",72,0)
+          ; I DEBUG ZWR V2
+"RTN","CCRUTIL",73,0)
+          ; I DEBUG ZWR VSRT
+"RTN","CCRUTIL",74,0)
+          N ZD,ZT ; DATA AND TIME ITERATORS
+"RTN","CCRUTIL",75,0)
+          N ZDONE ; DONE FLAG
+"RTN","CCRUTIL",76,0)
+          S (ZD,ZT)=""
+"RTN","CCRUTIL",77,0)
+          S ZDONE=0
+"RTN","CCRUTIL",78,0)
+          N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
+"RTN","CCRUTIL",79,0)
+          S UORDR=ORDR ; DIRECTION TO SORT
+"RTN","CCRUTIL",80,0)
+          I ORDR="" S UORDR=1
+"RTN","CCRUTIL",81,0)
+          N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
+"RTN","CCRUTIL",82,0)
+          F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
+"RTN","CCRUTIL",83,0)
+          . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE
+"RTN","CCRUTIL",84,0)
+          . I ZD="" S ZDONE=1
+"RTN","CCRUTIL",85,0)
+          . I 'ZDONE D  ; MORE DATES
+"RTN","CCRUTIL",86,0)
+          . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
+"RTN","CCRUTIL",87,0)
+          . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
+"RTN","CCRUTIL",88,0)
+          . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
+"RTN","CCRUTIL",89,0)
+          . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
+"RTN","CCRUTIL",90,0)
+          . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
+"RTN","CCRUTIL",91,0)
+          Q ZCNT
+"RTN","CCRUTIL",92,0)
+          ;
+"RTN","CCRVA200")
+0^7^B35847405
+"RTN","CCRVA200",1,0)
+CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
+"RTN","CCRVA200",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 3
+"RTN","CCRVA200",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRVA200",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRVA200",5,0)
+ ;
+"RTN","CCRVA200",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRVA200",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRVA200",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRVA200",9,0)
+ ;(at your option) any later version.
+"RTN","CCRVA200",10,0)
+ ;
+"RTN","CCRVA200",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRVA200",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRVA200",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRVA200",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRVA200",15,0)
+ ;
+"RTN","CCRVA200",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRVA200",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRVA200",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRVA200",19,0)
+        Q
+"RTN","CCRVA200",20,0)
+        ; This routine uses Kernel APIs and Direct Global Access to get
+"RTN","CCRVA200",21,0)
+        ; Proivder Data from File 200.
+"RTN","CCRVA200",22,0)
+        ;
+"RTN","CCRVA200",23,0)
+        ; The Global is VA(200,*)
+"RTN","CCRVA200",24,0)
+        ;
+"RTN","CCRVA200",25,0)
+FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",26,0)
+        ; INPUT: DUZ (i.e. File 200 IEN) ByVal
+"RTN","CCRVA200",27,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",28,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",29,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",30,0)
+        Q NAME("FAMILY")
+"RTN","CCRVA200",31,0)
+        ;
+"RTN","CCRVA200",32,0)
+GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",33,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",34,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",35,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",36,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",37,0)
+        Q NAME("GIVEN")
+"RTN","CCRVA200",38,0)
+        ;
+"RTN","CCRVA200",39,0)
+MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",40,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",41,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",42,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",43,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",44,0)
+        Q NAME("MIDDLE")
+"RTN","CCRVA200",45,0)
+        ;
+"RTN","CCRVA200",46,0)
+SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",47,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",48,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",49,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",50,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",51,0)
+        Q NAME("SUFFIX")
+"RTN","CCRVA200",52,0)
+        ;
+"RTN","CCRVA200",53,0)
+TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",54,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",55,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",56,0)
+        ; Gets External Value of Title field in New Person File.
+"RTN","CCRVA200",57,0)
+        ; It's actually a pointer to file 3.1
+"RTN","CCRVA200",58,0)
+        ; 200=New Person File; 8 is Title Field
+"RTN","CCRVA200",59,0)
+        Q $$GET1^DIQ(200,DUZ_",",8)
+"RTN","CCRVA200",60,0)
+        ;
+"RTN","CCRVA200",61,0)
+NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",62,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",63,0)
+        ; OUTPUT: Delimited String in format:
+"RTN","CCRVA200",64,0)
+        ;       IDType^ID^IDDescription
+"RTN","CCRVA200",65,0)
+        ; If the NPI doesn't exist, "" is returned.
+"RTN","CCRVA200",66,0)
+        ; This routine uses a call documented in the Kernel dev guide
+"RTN","CCRVA200",67,0)
+        ; This call returns as "NPI^TimeEntered^ActiveInactive"
+"RTN","CCRVA200",68,0)
+        ; It returns -1 for NPI if NPI doesn't exist.
+"RTN","CCRVA200",69,0)
+        N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+"RTN","CCRVA200",70,0)
+        Q:NPI=-1 ""
+"RTN","CCRVA200",71,0)
+        Q "NPI^"_NPI_"^HHS"
+"RTN","CCRVA200",72,0)
+        ;
+"RTN","CCRVA200",73,0)
+SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",74,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",75,0)
+        ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
+"RTN","CCRVA200",76,0)
+        ; Uses a Kernel API. Returns -1 if a specialty is not specified
+"RTN","CCRVA200",77,0)
+        ;       in file 200.
+"RTN","CCRVA200",78,0)
+        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
+"RTN","CCRVA200",79,0)
+        N STR S STR=$$GET^XUA4A72(DUZ)
+"RTN","CCRVA200",80,0)
+        Q:+STR<0 ""
+"RTN","CCRVA200",81,0)
+        ; Sometimes we have 3 pieces, or 2. Deal with that.
+"RTN","CCRVA200",82,0)
+        Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+"RTN","CCRVA200",83,0)
+        Q $P(STR,U,2)_"-"_$P(STR,U,3)
+"RTN","CCRVA200",84,0)
+        ;
+"RTN","CCRVA200",85,0)
+ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",86,0)
+        ; INPUT: DUZ, but not needed really... here for future expansion
+"RTN","CCRVA200",87,0)
+        ; OUTPUT: At this point "Work"
+"RTN","CCRVA200",88,0)
+        Q "Work"
+"RTN","CCRVA200",89,0)
+        ;
+"RTN","CCRVA200",90,0)
+ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",91,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",92,0)
+        ; Output: String.
+"RTN","CCRVA200",93,0)
+        ;
+"RTN","CCRVA200",94,0)
+        ; First, get site number from the institution file.
+"RTN","CCRVA200",95,0)
+        ; 1st piece returned by $$SITE^VASITE, which gets the system institution
+"RTN","CCRVA200",96,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",97,0)
+        ;
+"RTN","CCRVA200",98,0)
+        ; Second, get mailing address
+"RTN","CCRVA200",99,0)
+        ; There are two APIs to get the address, one for physical and one for
+"RTN","CCRVA200",100,0)
+        ; mailing. We will check if mailing exists first, since that's the
+"RTN","CCRVA200",101,0)
+        ; one we want to use; then check for physical. If neither exists,
+"RTN","CCRVA200",102,0)
+        ; then we return nothing. We check for the existence of an address
+"RTN","CCRVA200",103,0)
+        ; by the length of the returned string.
+"RTN","CCRVA200",104,0)
+        ; NOTE: API doesn't support Address 2, so I won't even include it
+"RTN","CCRVA200",105,0)
+        ; in the template.
+"RTN","CCRVA200",106,0)
+        N ADD
+"RTN","CCRVA200",107,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",108,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",109,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",110,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",111,0)
+        Q ""
+"RTN","CCRVA200",112,0)
+        ;
+"RTN","CCRVA200",113,0)
+CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",114,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",115,0)
+        ; Output: String.
+"RTN","CCRVA200",116,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",117,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",118,0)
+        N ADD
+"RTN","CCRVA200",119,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",120,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",121,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",122,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",123,0)
+        Q ""
+"RTN","CCRVA200",124,0)
+        ;
+"RTN","CCRVA200",125,0)
+STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",126,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",127,0)
+        ; Output: String.
+"RTN","CCRVA200",128,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",129,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",130,0)
+        N ADD
+"RTN","CCRVA200",131,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",132,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",133,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",134,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",135,0)
+        Q ""
+"RTN","CCRVA200",136,0)
+        ;
+"RTN","CCRVA200",137,0)
+POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",138,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",139,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",140,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",141,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",142,0)
+        N ADD
+"RTN","CCRVA200",143,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",144,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",145,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",146,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",147,0)
+        Q ""
+"RTN","CCRVA200",148,0)
+        ;
+"RTN","CCRVA200",149,0)
+TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",150,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",151,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",152,0)
+        ; Direct global access
+"RTN","CCRVA200",153,0)
+        N TEL S TEL=$G(^VA(200,DUZ,.13))
+"RTN","CCRVA200",154,0)
+        Q $P(TEL,U,2)
+"RTN","CCRVA200",155,0)
+        ;
+"RTN","CCRVA200",156,0)
+TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",157,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",158,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",159,0)
+        Q "Office"
+"RTN","CCRVA200",160,0)
+        ;
+"RTN","CCRVA200",161,0)
+EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",162,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",163,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",164,0)
+        ; Direct global access
+"RTN","CCRVA200",165,0)
+        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+"RTN","CCRVA200",166,0)
+        Q $P(EMAIL,U)
+"RTN","CCRVA200",167,0)
+        ;
+"RTN","GPLACTOR")
+0^8^B58306782
+"RTN","GPLACTOR",1,0)
+GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+"RTN","GPLACTOR",2,0)
+ ;;0.3;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLACTOR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLACTOR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLACTOR",5,0)
+ ;
+"RTN","GPLACTOR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLACTOR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLACTOR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLACTOR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLACTOR",10,0)
+ ;
+"RTN","GPLACTOR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLACTOR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLACTOR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLACTOR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLACTOR",15,0)
+ ;
+"RTN","GPLACTOR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLACTOR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLACTOR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLACTOR",19,0)
+    ;
+"RTN","GPLACTOR",20,0)
+    ;  PROCESS THE ACTORS SECTION OF THE CCR
+"RTN","GPLACTOR",21,0)
+    ;
+"RTN","GPLACTOR",22,0)
+    ; ===Revision History===
+"RTN","GPLACTOR",23,0)
+    ; 0.1 Initial Writing of Skeleton--GPL
+"RTN","GPLACTOR",24,0)
+    ; 0.2 Patient Data Extraction--SMH
+"RTN","GPLACTOR",25,0)
+    ; 0.3 Information System Info Extraction--SMH
+"RTN","GPLACTOR",26,0)
+    ;
+"RTN","GPLACTOR",27,0)
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+"RTN","GPLACTOR",28,0)
+  ; IPXML is the Input Actor Template into which we  substitute values
+"RTN","GPLACTOR",29,0)
+  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+"RTN","GPLACTOR",30,0)
+  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
+"RTN","GPLACTOR",31,0)
+  ; ^TMP(7542,1,"ACTORS",0)=Count
+"RTN","GPLACTOR",32,0)
+  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+"RTN","GPLACTOR",33,0)
+  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+"RTN","GPLACTOR",34,0)
+  ; AXML is the output arrary, to contain XML.
+"RTN","GPLACTOR",35,0)
+  ;
+"RTN","GPLACTOR",36,0)
+           N I,J,AMAP,AOID,ATYP,AIEN
+"RTN","GPLACTOR",37,0)
+           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+"RTN","GPLACTOR",38,0)
+           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+"RTN","GPLACTOR",39,0)
+           W "PROCESSING ACTORS ",!
+"RTN","GPLACTOR",40,0)
+           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+"RTN","GPLACTOR",41,0)
+           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",42,0)
+           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+"RTN","GPLACTOR",43,0)
+           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+"RTN","GPLACTOR",44,0)
+           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+"RTN","GPLACTOR",45,0)
+           . I ATYP="" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",46,0)
+           . ;
+"RTN","GPLACTOR",47,0)
+           . W AOID_" "_ATYP_" "_AIEN,!
+"RTN","GPLACTOR",48,0)
+           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+"RTN","GPLACTOR",49,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+"RTN","GPLACTOR",50,0)
+           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",51,0)
+           . ;
+"RTN","GPLACTOR",52,0)
+           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+"RTN","GPLACTOR",53,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+"RTN","GPLACTOR",54,0)
+           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",55,0)
+           . ;
+"RTN","GPLACTOR",56,0)
+           . I ATYP="NOK" D  ; NOK ACTOR TYPE
+"RTN","GPLACTOR",57,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+"RTN","GPLACTOR",58,0)
+           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",59,0)
+           . ;
+"RTN","GPLACTOR",60,0)
+           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",61,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+"RTN","GPLACTOR",62,0)
+           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",63,0)
+           . ;
+"RTN","GPLACTOR",64,0)
+           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",65,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+"RTN","GPLACTOR",66,0)
+           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",67,0)
+           . ;
+"RTN","GPLACTOR",68,0)
+           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+"RTN","GPLACTOR",69,0)
+           ;
+"RTN","GPLACTOR",70,0)
+           N ACTTMP
+"RTN","GPLACTOR",71,0)
+           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLACTOR",72,0)
+           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLACTOR",73,0)
+           . ; STRINGS MARKED AS @@X@@
+"RTN","GPLACTOR",74,0)
+           . W "ACTORS Missing list: ",!
+"RTN","GPLACTOR",75,0)
+           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+"RTN","GPLACTOR",76,0)
+           Q
+"RTN","GPLACTOR",77,0)
+           ;
+"RTN","GPLACTOR",78,0)
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+"RTN","GPLACTOR",79,0)
+     ;
+"RTN","GPLACTOR",80,0)
+     W "PROCESSING ACTOR PATIENT ",AIEN,!
+"RTN","GPLACTOR",81,0)
+     N AMAP,ZX
+"RTN","GPLACTOR",82,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",83,0)
+     K @AMAP
+"RTN","GPLACTOR",84,0)
+     D INIT^CCRDPT(AIEN)
+"RTN","GPLACTOR",85,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",86,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
+"RTN","GPLACTOR",87,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
+"RTN","GPLACTOR",88,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
+"RTN","GPLACTOR",89,0)
+     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
+"RTN","GPLACTOR",90,0)
+     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
+"RTN","GPLACTOR",91,0)
+     S @AMAP@("ACTORSSN")=""
+"RTN","GPLACTOR",92,0)
+     S @AMAP@("ACTORSSNTEXT")=""
+"RTN","GPLACTOR",93,0)
+     S @AMAP@("ACTORSSNSOURCEID")=""
+"RTN","GPLACTOR",94,0)
+     S ZX=$$SSN^CCRDPT
+"RTN","GPLACTOR",95,0)
+     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+"RTN","GPLACTOR",96,0)
+     . S @AMAP@("ACTORSSN")=ZX
+"RTN","GPLACTOR",97,0)
+     . S @AMAP@("ACTORSSNTEXT")="SSN"
+"RTN","GPLACTOR",98,0)
+     . S @AMAP@("ACTORSSNSOURCEID")=AOID
+"RTN","GPLACTOR",99,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
+"RTN","GPLACTOR",100,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
+"RTN","GPLACTOR",101,0)
+     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
+"RTN","GPLACTOR",102,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
+"RTN","GPLACTOR",103,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
+"RTN","GPLACTOR",104,0)
+     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
+"RTN","GPLACTOR",105,0)
+     S @AMAP@("ACTORRESTEL")=""
+"RTN","GPLACTOR",106,0)
+     S @AMAP@("ACTORRESTELTEXT")=""
+"RTN","GPLACTOR",107,0)
+     S ZX=$$RESTEL^CCRDPT
+"RTN","GPLACTOR",108,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",109,0)
+     . S @AMAP@("ACTORRESTEL")=ZX
+"RTN","GPLACTOR",110,0)
+     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+"RTN","GPLACTOR",111,0)
+     S @AMAP@("ACTORWORKTEL")=""
+"RTN","GPLACTOR",112,0)
+     S @AMAP@("ACTORWORKTELTEXT")=""
+"RTN","GPLACTOR",113,0)
+     S ZX=$$WORKTEL^CCRDPT
+"RTN","GPLACTOR",114,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",115,0)
+     . S @AMAP@("ACTORWORKTEL")=ZX
+"RTN","GPLACTOR",116,0)
+     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+"RTN","GPLACTOR",117,0)
+     S @AMAP@("ACTORCELLTEL")=""
+"RTN","GPLACTOR",118,0)
+     S @AMAP@("ACTORCELLTELTEXT")=""
+"RTN","GPLACTOR",119,0)
+     S ZX=$$CELLTEL^CCRDPT
+"RTN","GPLACTOR",120,0)
+     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+"RTN","GPLACTOR",121,0)
+     . S @AMAP@("ACTORCELLTEL")=ZX
+"RTN","GPLACTOR",122,0)
+     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+"RTN","GPLACTOR",123,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
+"RTN","GPLACTOR",124,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+"RTN","GPLACTOR",125,0)
+     S @AMAP@("ACTORIEN")=AIEN
+"RTN","GPLACTOR",126,0)
+     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+"RTN","GPLACTOR",127,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",128,0)
+         D DESTROY^CCRDPT
+"RTN","GPLACTOR",129,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",130,0)
+     Q
+"RTN","GPLACTOR",131,0)
+     ;
+"RTN","GPLACTOR",132,0)
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+"RTN","GPLACTOR",133,0)
+     ;
+"RTN","GPLACTOR",134,0)
+     ; N AMAP
+"RTN","GPLACTOR",135,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",136,0)
+     K @AMAP
+"RTN","GPLACTOR",137,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",138,0)
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
+"RTN","GPLACTOR",139,0)
+         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
+"RTN","GPLACTOR",140,0)
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+"RTN","GPLACTOR",141,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",142,0)
+     Q
+"RTN","GPLACTOR",143,0)
+     ;
+"RTN","GPLACTOR",144,0)
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+"RTN","GPLACTOR",145,0)
+     ;
+"RTN","GPLACTOR",146,0)
+     ; N AMAP
+"RTN","GPLACTOR",147,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",148,0)
+     K @AMAP
+"RTN","GPLACTOR",149,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",150,0)
+     S @AMAP@("ACTORDISPLAYNAME")=""
+"RTN","GPLACTOR",151,0)
+     S @AMAP@("ACTORRELATION")=""
+"RTN","GPLACTOR",152,0)
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+"RTN","GPLACTOR",153,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",154,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",155,0)
+     Q
+"RTN","GPLACTOR",156,0)
+     ;
+"RTN","GPLACTOR",157,0)
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+"RTN","GPLACTOR",158,0)
+     ;
+"RTN","GPLACTOR",159,0)
+     ; N AMAP
+"RTN","GPLACTOR",160,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",161,0)
+     K @AMAP
+"RTN","GPLACTOR",162,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",163,0)
+     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
+"RTN","GPLACTOR",164,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",165,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",166,0)
+     Q
+"RTN","GPLACTOR",167,0)
+     ;
+"RTN","GPLACTOR",168,0)
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+"RTN","GPLACTOR",169,0)
+     ;
+"RTN","GPLACTOR",170,0)
+     ; N AMAP
+"RTN","GPLACTOR",171,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",172,0)
+     K @AMAP
+"RTN","GPLACTOR",173,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",174,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
+"RTN","GPLACTOR",175,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",176,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
+"RTN","GPLACTOR",177,0)
+         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",178,0)
+         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
+"RTN","GPLACTOR",179,0)
+         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
+"RTN","GPLACTOR",180,0)
+         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
+"RTN","GPLACTOR",181,0)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
+"RTN","GPLACTOR",182,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",183,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
+"RTN","GPLACTOR",184,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
+"RTN","GPLACTOR",185,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
+"RTN","GPLACTOR",186,0)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
+"RTN","GPLACTOR",187,0)
+     S @AMAP@("ACTORTELEPHONE")=""
+"RTN","GPLACTOR",188,0)
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+"RTN","GPLACTOR",189,0)
+     S ZX=$$TEL^CCRVA200(AIEN)
+"RTN","GPLACTOR",190,0)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+"RTN","GPLACTOR",191,0)
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+"RTN","GPLACTOR",192,0)
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",193,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
+"RTN","GPLACTOR",194,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",195,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",196,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",197,0)
+     Q
+"RTN","GPLACTOR",198,0)
+     ;
+"RTN","GPLCCD")
+0^16^B106978605
+"RTN","GPLCCD",1,0)
+GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
+"RTN","GPLCCD",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCD",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD",5,0)
+ ;
+"RTN","GPLCCD",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD",10,0)
+ ;
+"RTN","GPLCCD",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD",15,0)
+ ;
+"RTN","GPLCCD",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD",19,0)
+ ;
+"RTN","GPLCCD",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCD",21,0)
+ ;
+"RTN","GPLCCD",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCD",23,0)
+       ; Select a patient.
+"RTN","GPLCCD",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCD",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCD",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCD",27,0)
+       ; N CCDGLO
+"RTN","GPLCCD",28,0)
+       D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+"RTN","GPLCCD",29,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
+"RTN","GPLCCD",30,0)
+       S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+"RTN","GPLCCD",31,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCD",32,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCD",33,0)
+       . S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCD",34,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCD",35,0)
+       . ;S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCD",36,0)
+       S ODIR=@ODIRGLB
+"RTN","GPLCCD",37,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCD",38,0)
+       Q
+"RTN","GPLCCD",39,0)
+       ;
+"RTN","GPLCCD",40,0)
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCD",41,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCD",42,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCD",43,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCD",44,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCD",45,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCD",46,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCD",47,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCD",48,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCD",49,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCD",50,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+"RTN","GPLCCD",51,0)
+    S DEBUG=0
+"RTN","GPLCCD",52,0)
+    N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+"RTN","GPLCCD",53,0)
+    I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+"RTN","GPLCCD",54,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCD",55,0)
+    I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+"RTN","GPLCCD",56,0)
+    E  S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCD",57,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCD",58,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCD",59,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCD",60,0)
+    I CCD D LOAD^GPLCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",61,0)
+    E  D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",62,0)
+    D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCD",63,0)
+    N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+"RTN","GPLCCD",64,0)
+    S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+"RTN","GPLCCD",65,0)
+    S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+"RTN","GPLCCD",66,0)
+    S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+"RTN","GPLCCD",67,0)
+    S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+"RTN","GPLCCD",68,0)
+    S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+"RTN","GPLCCD",69,0)
+    S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+"RTN","GPLCCD",70,0)
+    ;
+"RTN","GPLCCD",71,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCD",72,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCD",73,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",74,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",75,0)
+    I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCD",76,0)
+    I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+"RTN","GPLCCD",77,0)
+    ;
+"RTN","GPLCCD",78,0)
+    I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCD",79,0)
+    ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+"RTN","GPLCCD",80,0)
+    S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+"RTN","GPLCCD",81,0)
+    D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
+"RTN","GPLCCD",82,0)
+    D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+"RTN","GPLCCD",83,0)
+    I DEBUG D PARY^GPLXPATH("ACTT2")
+"RTN","GPLCCD",84,0)
+    D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
+"RTN","GPLCCD",85,0)
+    I DEBUG D PARY^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",86,0)
+    K ACTT1 K ACCT2
+"RTN","GPLCCD",87,0)
+    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+"RTN","GPLCCD",88,0)
+    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+"RTN","GPLCCD",89,0)
+    D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+"RTN","GPLCCD",90,0)
+    D CP^GPLXPATH("ACTT2",CCDGLO)
+"RTN","GPLCCD",91,0)
+    ;
+"RTN","GPLCCD",92,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCD",93,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCD",94,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCD",95,0)
+    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCD",96,0)
+    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCD",97,0)
+    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCD",98,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCD",99,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCD",100,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCD",101,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCD",102,0)
+    . S IXML="INXML"
+"RTN","GPLCCD",103,0)
+    . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+"RTN","GPLCCD",104,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCD",105,0)
+    . ; W OXML,!
+"RTN","GPLCCD",106,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCD",107,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCD",108,0)
+    . X CALL
+"RTN","GPLCCD",109,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCD",110,0)
+    . . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+"RTN","GPLCCD",111,0)
+    . . I CCD D UNSHAVE("ITMP",OXML)
+"RTN","GPLCCD",112,0)
+    . . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+"RTN","GPLCCD",113,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCD",114,0)
+    . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",115,0)
+    . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCD",116,0)
+    ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+"RTN","GPLCCD",117,0)
+    ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCD",118,0)
+    ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCD",119,0)
+    ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCD",120,0)
+    ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",121,0)
+    N I,J,DONE S DONE=0
+"RTN","GPLCCD",122,0)
+    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCD",123,0)
+    . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCD",124,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCD",125,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCD",126,0)
+    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+"RTN","GPLCCD",127,0)
+    . N I
+"RTN","GPLCCD",128,0)
+    . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+"RTN","GPLCCD",129,0)
+    . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",130,0)
+    . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+"RTN","GPLCCD",131,0)
+    . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",132,0)
+    . . . S @CCDGLO@(I)="</structuredBody></component>"
+"RTN","GPLCCD",133,0)
+    S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+"RTN","GPLCCD",134,0)
+    S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+"RTN","GPLCCD",135,0)
+    Q
+"RTN","GPLCCD",136,0)
+    ;
+"RTN","GPLCCD",137,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCD",138,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCD",139,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCD",140,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCD",141,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCD",142,0)
+    ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCD",143,0)
+    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCD",144,0)
+    Q
+"RTN","GPLCCD",145,0)
+    ;
+"RTN","GPLCCD",146,0)
+SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+"RTN","GPLCCD",147,0)
+    ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+"RTN","GPLCCD",148,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",149,0)
+    W SHXML,!
+"RTN","GPLCCD",150,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",151,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+"RTN","GPLCCD",152,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+"RTN","GPLCCD",153,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+"RTN","GPLCCD",154,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",155,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",156,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",157,0)
+    Q
+"RTN","GPLCCD",158,0)
+    ;
+"RTN","GPLCCD",159,0)
+UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+"RTN","GPLCCD",160,0)
+    ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+"RTN","GPLCCD",161,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",162,0)
+    W SHXML,!
+"RTN","GPLCCD",163,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",164,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+"RTN","GPLCCD",165,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+"RTN","GPLCCD",166,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+"RTN","GPLCCD",167,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",168,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",169,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",170,0)
+    Q
+"RTN","GPLCCD",171,0)
+    ;
+"RTN","GPLCCD",172,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCD",173,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCD",174,0)
+    ; K @VMAP
+"RTN","GPLCCD",175,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCD",176,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCD",177,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCD",178,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCD",179,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCD",180,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCD",181,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",182,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",183,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCD",184,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCD",185,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCD",186,0)
+    N CTMP
+"RTN","GPLCCD",187,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCD",188,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCD",189,0)
+    Q
+"RTN","GPLCCD",190,0)
+    ;
+"RTN","GPLCCD",191,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCD",192,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCD",193,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCD",194,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCD",195,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCD",196,0)
+    ;OR INSTITUTION
+"RTN","GPLCCD",197,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCD",198,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCD",199,0)
+    N I,J,K,L
+"RTN","GPLCCD",200,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCD",201,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCD",202,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCD",203,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCD",204,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCD",205,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCD",206,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCD",207,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCD",208,0)
+    F J=0:0 D  Q:$O(K(I))=""  ;
+"RTN","GPLCCD",209,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCD",210,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCD",211,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCD",212,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCD",213,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCD",214,0)
+    Q
+"RTN","GPLCCD",215,0)
+    ;
+"RTN","GPLCCD",216,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCD",217,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCD",218,0)
+  Q
+"RTN","GPLCCD",219,0)
+  ;
+"RTN","GPLCCD",220,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCD",221,0)
+  N ZTMP
+"RTN","GPLCCD",222,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",223,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCD",224,0)
+  Q
+"RTN","GPLCCD",225,0)
+  ;
+"RTN","GPLCCD",226,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCD",227,0)
+  N ZTMP
+"RTN","GPLCCD",228,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",229,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCD",230,0)
+  Q
+"RTN","GPLCCD",231,0)
+  ;
+"RTN","GPLCCD",232,0)
+ ;;><TEST>
+"RTN","GPLCCD",233,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCD",234,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",235,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCD",236,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCD",237,0)
+ ;;><VITALS>
+"RTN","GPLCCD",238,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",239,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCD",240,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCD",241,0)
+ ;;><CCR>
+"RTN","GPLCCD",242,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",243,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",244,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",245,0)
+ ;;><ACTLST>
+"RTN","GPLCCD",246,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",247,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",248,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCD",249,0)
+ ;;><ACTORS>
+"RTN","GPLCCD",250,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCD",251,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCD",252,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCD",253,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCD",254,0)
+ ;;><TRIM>
+"RTN","GPLCCD",255,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCD",256,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",257,0)
+ ;;><CCD>
+"RTN","GPLCCD",258,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",259,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
+"RTN","GPLCCD",260,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",261,0)
+ ;;></TEST>
+"RTN","GPLCCD1")
+0^17^B100039732
+"RTN","GPLCCD1",1,0)
+GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
+"RTN","GPLCCD1",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCD1",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD1",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD1",5,0)
+ ;
+"RTN","GPLCCD1",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD1",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD1",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD1",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD1",10,0)
+ ;
+"RTN","GPLCCD1",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD1",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD1",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD1",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD1",15,0)
+ ;
+"RTN","GPLCCD1",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD1",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD1",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD1",19,0)
+ ;
+"RTN","GPLCCD1",20,0)
+          W "This is a CCD TEMPLATE with processing routines",!
+"RTN","GPLCCD1",21,0)
+          W !
+"RTN","GPLCCD1",22,0)
+          Q
+"RTN","GPLCCD1",23,0)
+          ;
+"RTN","GPLCCD1",24,0)
+ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
+"RTN","GPLCCD1",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCD1",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCD1",28,0)
+          ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
+"RTN","GPLCCD1",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCD1",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCD1",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCD1",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCD1",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCD1",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCD1",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCD1",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCD1",37,0)
+          Q
+"RTN","GPLCCD1",38,0)
+          ;
+"RTN","GPLCCD1",39,0)
+ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+"RTN","GPLCCD1",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCD1",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCD1",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCD1",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCD1",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCD1",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCD1",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCD1",48,0)
+          ;
+"RTN","GPLCCD1",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCD1",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCD1",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCD1",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCD1",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCD1",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCD1",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCD1",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCD1",57,0)
+          Q
+"RTN","GPLCCD1",58,0)
+          ;
+"RTN","GPLCCD1",59,0)
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCD1",60,0)
+          D ZLOAD(ARY,"GPLCCD1")
+"RTN","GPLCCD1",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCD1",62,0)
+          Q
+"RTN","GPLCCD1",63,0)
+          ;
+"RTN","GPLCCD1",64,0)
+TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+"RTN","GPLCCD1",65,0)
+          Q
+"RTN","GPLCCD1",66,0)
+MARKUP ;<MARKUP>
+"RTN","GPLCCD1",67,0)
+ ;;<Body>
+"RTN","GPLCCD1",68,0)
+ ;;<Problems>
+"RTN","GPLCCD1",69,0)
+ ;;</Problems>
+"RTN","GPLCCD1",70,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",71,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",72,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",73,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",74,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",75,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",76,0)
+ ;;<Medications>
+"RTN","GPLCCD1",77,0)
+ ;;</Medications>
+"RTN","GPLCCD1",78,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",79,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",80,0)
+ ;;<Results>
+"RTN","GPLCCD1",81,0)
+ ;;</Results>
+"RTN","GPLCCD1",82,0)
+ ;;</Body>
+"RTN","GPLCCD1",83,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCD1",84,0)
+ ;</MARKUP>
+"RTN","GPLCCD1",85,0)
+ ;;<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">
+"RTN","GPLCCD1",86,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",87,0)
+ Q
+"RTN","GPLCCD1",88,0)
+ ;
+"RTN","GPLCCD1",89,0)
+ ;<TEMPLATE>
+"RTN","GPLCCD1",90,0)
+ ;;<?xml version="1.0"?>
+"RTN","GPLCCD1",91,0)
+ ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
+"RTN","GPLCCD1",92,0)
+ ;;<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">
+"RTN","GPLCCD1",93,0)
+ ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
+"RTN","GPLCCD1",94,0)
+ ;;<templateId root="2.16.840.1.113883.10.20.1"/>
+"RTN","GPLCCD1",95,0)
+ ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
+"RTN","GPLCCD1",96,0)
+ ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
+"RTN","GPLCCD1",97,0)
+ ;;<title>Continuity of Care Document</title>
+"RTN","GPLCCD1",98,0)
+ ;;<effectiveTime value="20000407130000+0500"/>
+"RTN","GPLCCD1",99,0)
+ ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+"RTN","GPLCCD1",100,0)
+ ;;<languageCode code="en-US"/>
+"RTN","GPLCCD1",101,0)
+ ;;<recordTarget>
+"RTN","GPLCCD1",102,0)
+ ;;<patientRole>
+"RTN","GPLCCD1",103,0)
+ ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",104,0)
+ ;;<patient>
+"RTN","GPLCCD1",105,0)
+ ;;<name>
+"RTN","GPLCCD1",106,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",107,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",108,0)
+ ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
+"RTN","GPLCCD1",109,0)
+ ;;</name>
+"RTN","GPLCCD1",110,0)
+ ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
+"RTN","GPLCCD1",111,0)
+ ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
+"RTN","GPLCCD1",112,0)
+ ;;</patient>
+"RTN","GPLCCD1",113,0)
+ ;;<providerOrganization>
+"RTN","GPLCCD1",114,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",115,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",116,0)
+ ;;</providerOrganization>
+"RTN","GPLCCD1",117,0)
+ ;;</patientRole>
+"RTN","GPLCCD1",118,0)
+ ;;</recordTarget>
+"RTN","GPLCCD1",119,0)
+ ;;<author>
+"RTN","GPLCCD1",120,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",121,0)
+ ;;<assignedAuthor>
+"RTN","GPLCCD1",122,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",123,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",124,0)
+ ;;<name>
+"RTN","GPLCCD1",125,0)
+ ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
+"RTN","GPLCCD1",126,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",127,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",128,0)
+ ;;</name>
+"RTN","GPLCCD1",129,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",130,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",131,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",132,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",133,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",134,0)
+ ;;</assignedAuthor>
+"RTN","GPLCCD1",135,0)
+ ;;</author>
+"RTN","GPLCCD1",136,0)
+ ;;<informant>
+"RTN","GPLCCD1",137,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",138,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",139,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",140,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",141,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",142,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",143,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",144,0)
+ ;;</informant>
+"RTN","GPLCCD1",145,0)
+ ;;<custodian>
+"RTN","GPLCCD1",146,0)
+ ;;<assignedCustodian>
+"RTN","GPLCCD1",147,0)
+ ;;<representedCustodianOrganization>
+"RTN","GPLCCD1",148,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",149,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",150,0)
+ ;;</representedCustodianOrganization>
+"RTN","GPLCCD1",151,0)
+ ;;</assignedCustodian>
+"RTN","GPLCCD1",152,0)
+ ;;</custodian>
+"RTN","GPLCCD1",153,0)
+ ;;<legalAuthenticator>
+"RTN","GPLCCD1",154,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",155,0)
+ ;;<signatureCode code="S"/>
+"RTN","GPLCCD1",156,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",157,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",158,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",159,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",160,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",161,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",162,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",163,0)
+ ;;</legalAuthenticator>
+"RTN","GPLCCD1",164,0)
+ ;;<Actors>
+"RTN","GPLCCD1",165,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCD1",166,0)
+ ;;<participant typeCode="IND">
+"RTN","GPLCCD1",167,0)
+ ;;<associatedEntity classCode="NOK">
+"RTN","GPLCCD1",168,0)
+ ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
+"RTN","GPLCCD1",169,0)
+ ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
+"RTN","GPLCCD1",170,0)
+ ;;<telecom value="tel:(999)555-1212"/>
+"RTN","GPLCCD1",171,0)
+ ;;<associatedPerson>
+"RTN","GPLCCD1",172,0)
+ ;;<name>
+"RTN","GPLCCD1",173,0)
+ ;;<given>Henrietta</given>
+"RTN","GPLCCD1",174,0)
+ ;;<family>Levin</family>
+"RTN","GPLCCD1",175,0)
+ ;;</name>
+"RTN","GPLCCD1",176,0)
+ ;;</associatedPerson>
+"RTN","GPLCCD1",177,0)
+ ;;</associatedEntity>
+"RTN","GPLCCD1",178,0)
+ ;;</participant>
+"RTN","GPLCCD1",179,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCD1",180,0)
+ ;;</Actors>
+"RTN","GPLCCD1",181,0)
+ ;;<documentationOf>
+"RTN","GPLCCD1",182,0)
+ ;;<serviceEvent classCode="PCPR">
+"RTN","GPLCCD1",183,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",184,0)
+ ;;<high value="@@DATETIME@@"/>
+"RTN","GPLCCD1",185,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",186,0)
+ ;;<performer typeCode="PRF">
+"RTN","GPLCCD1",187,0)
+ ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+"RTN","GPLCCD1",188,0)
+ ;;<time>
+"RTN","GPLCCD1",189,0)
+ ;;<low value="1990"/>
+"RTN","GPLCCD1",190,0)
+ ;;<high value='20000407'/>
+"RTN","GPLCCD1",191,0)
+ ;;</time>
+"RTN","GPLCCD1",192,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",193,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",194,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",195,0)
+ ;;<name>
+"RTN","GPLCCD1",196,0)
+ ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
+"RTN","GPLCCD1",197,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",198,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",199,0)
+ ;;</name>
+"RTN","GPLCCD1",200,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",201,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",202,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",203,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",204,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",205,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",206,0)
+ ;;</performer>
+"RTN","GPLCCD1",207,0)
+ ;;</serviceEvent>
+"RTN","GPLCCD1",208,0)
+ ;;</documentationOf>
+"RTN","GPLCCD1",209,0)
+ ;;<Body>
+"RTN","GPLCCD1",210,0)
+ ;;<PROBLEMS-HTML>
+"RTN","GPLCCD1",211,0)
+ ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
+"RTN","GPLCCD1",212,0)
+ ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
+"RTN","GPLCCD1",213,0)
+ ;;<td>@@PROBLEMDATEOFONSET@@</td>
+"RTN","GPLCCD1",214,0)
+ ;;<td>Active</td></tr>
+"RTN","GPLCCD1",215,0)
+ ;;</tbody></table></text>
+"RTN","GPLCCD1",216,0)
+ ;;</PROBLEMS-HTML>
+"RTN","GPLCCD1",217,0)
+ ;;<Problems>
+"RTN","GPLCCD1",218,0)
+ ;;<component>
+"RTN","GPLCCD1",219,0)
+ ;;<section>
+"RTN","GPLCCD1",220,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
+"RTN","GPLCCD1",221,0)
+ ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
+"RTN","GPLCCD1",222,0)
+ ;;<title>Problems</title>
+"RTN","GPLCCD1",223,0)
+ ;;<entry typeCode="DRIV">
+"RTN","GPLCCD1",224,0)
+ ;;<act classCode="ACT" moodCode="EVN">
+"RTN","GPLCCD1",225,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
+"RTN","GPLCCD1",226,0)
+ ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
+"RTN","GPLCCD1",227,0)
+ ;;<code nullFlavor="NA"/>
+"RTN","GPLCCD1",228,0)
+ ;;<entryRelationship typeCode="SUBJ">
+"RTN","GPLCCD1",229,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",230,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
+"RTN","GPLCCD1",231,0)
+ ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
+"RTN","GPLCCD1",232,0)
+ ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
+"RTN","GPLCCD1",233,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",234,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",235,0)
+ ;;<low value="@@PROBLEMDATEOFONSET@@"/>
+"RTN","GPLCCD1",236,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",237,0)
+ ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
+"RTN","GPLCCD1",238,0)
+ ;;<entryRelationship typeCode="REFR">
+"RTN","GPLCCD1",239,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",240,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
+"RTN","GPLCCD1",241,0)
+ ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+"RTN","GPLCCD1",242,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",243,0)
+ ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
+"RTN","GPLCCD1",244,0)
+ ;;</observation>
+"RTN","GPLCCD1",245,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",246,0)
+ ;;</observation>
+"RTN","GPLCCD1",247,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",248,0)
+ ;;</act>
+"RTN","GPLCCD1",249,0)
+ ;;</entry>
+"RTN","GPLCCD1",250,0)
+ ;;</section>
+"RTN","GPLCCD1",251,0)
+ ;;</component>
+"RTN","GPLCCD1",252,0)
+ ;;</Problems>
+"RTN","GPLCCD1",253,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",254,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",255,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",256,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",257,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",258,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",259,0)
+ ;;<Medications>
+"RTN","GPLCCD1",260,0)
+ ;;</Medications>
+"RTN","GPLCCD1",261,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",262,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",263,0)
+ ;;<Results>
+"RTN","GPLCCD1",264,0)
+ ;;</Results>
+"RTN","GPLCCD1",265,0)
+ ;;</Body>
+"RTN","GPLCCD1",266,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",267,0)
+ ;</TEMPLATE>
+"RTN","GPLCCR")
+0^14^B66792391
+"RTN","GPLCCR",1,0)
+GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
+"RTN","GPLCCR",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR",5,0)
+ ;
+"RTN","GPLCCR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR",10,0)
+ ;
+"RTN","GPLCCR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR",15,0)
+ ;
+"RTN","GPLCCR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR",19,0)
+ ;
+"RTN","GPLCCR",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCR",21,0)
+ ;
+"RTN","GPLCCR",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCR",23,0)
+       ; Select a patient.
+"RTN","GPLCCR",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCR",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCR",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCR",27,0)
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+"RTN","GPLCCR",28,0)
+       Q
+"RTN","GPLCCR",29,0)
+       ;
+"RTN","GPLCCR",30,0)
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","GPLCCR",31,0)
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+"RTN","GPLCCR",32,0)
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+"RTN","GPLCCR",33,0)
+       N CCRGLO
+"RTN","GPLCCR",34,0)
+       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
+"RTN","GPLCCR",35,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
+"RTN","GPLCCR",36,0)
+       S ONAM=FN
+"RTN","GPLCCR",37,0)
+       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
+"RTN","GPLCCR",38,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCR",39,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCR",40,0)
+       . ;S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCR",41,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCR",42,0)
+       . S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCR",43,0)
+       S ODIR=DIR
+"RTN","GPLCCR",44,0)
+       I DIR="" S ODIR=@ODIRGLB
+"RTN","GPLCCR",45,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCR",46,0)
+       Q
+"RTN","GPLCCR",47,0)
+       ;
+"RTN","GPLCCR",48,0)
+CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCR",49,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCR",50,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCR",51,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCR",52,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCR",53,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCR",54,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCR",55,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCR",56,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCR",57,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCR",58,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
+"RTN","GPLCCR",59,0)
+    I '$D(DEBUG) S DEBUG=0
+"RTN","GPLCCR",60,0)
+    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
+"RTN","GPLCCR",61,0)
+    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
+"RTN","GPLCCR",62,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCR",63,0)
+    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCR",64,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCR",65,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCR",66,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCR",67,0)
+    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCR",68,0)
+    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCR",69,0)
+    ;
+"RTN","GPLCCR",70,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCR",71,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCR",72,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",73,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",74,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCR",75,0)
+    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+"RTN","GPLCCR",76,0)
+    ;
+"RTN","GPLCCR",77,0)
+    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCR",78,0)
+    ;
+"RTN","GPLCCR",79,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCR",80,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCR",81,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCR",82,0)
+    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCR",83,0)
+    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCR",84,0)
+    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCR",85,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCR",86,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCR",87,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCR",88,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCR",89,0)
+    . S IXML="INXML"
+"RTN","GPLCCR",90,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCR",91,0)
+    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
+"RTN","GPLCCR",92,0)
+    . ; W OXML,!
+"RTN","GPLCCR",93,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCR",94,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCR",95,0)
+    . X CALL
+"RTN","GPLCCR",96,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCR",97,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCR",98,0)
+    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",99,0)
+    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCR",100,0)
+    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCR",101,0)
+    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCR",102,0)
+    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCR",103,0)
+    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",104,0)
+    N TRIMI,J,DONE S DONE=0
+"RTN","GPLCCR",105,0)
+    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCR",106,0)
+    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCR",107,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCR",108,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCR",109,0)
+    Q
+"RTN","GPLCCR",110,0)
+    ;
+"RTN","GPLCCR",111,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCR",112,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCR",113,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCR",114,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCR",115,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCR",116,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCR",117,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCR",118,0)
+    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
+"RTN","GPLCCR",119,0)
+    Q
+"RTN","GPLCCR",120,0)
+    ;
+"RTN","GPLCCR",121,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCR",122,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCR",123,0)
+    ; K @VMAP
+"RTN","GPLCCR",124,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCR",125,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCR",126,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCR",127,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCR",128,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCR",129,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCR",130,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",131,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",132,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCR",133,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCR",134,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCR",135,0)
+    N CTMP
+"RTN","GPLCCR",136,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCR",137,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCR",138,0)
+    Q
+"RTN","GPLCCR",139,0)
+    ;
+"RTN","GPLCCR",140,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCR",141,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCR",142,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCR",143,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCR",144,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCR",145,0)
+    ;OR INSTITUTION
+"RTN","GPLCCR",146,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCR",147,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCR",148,0)
+    N I,J,K,L
+"RTN","GPLCCR",149,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCR",150,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCR",151,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCR",152,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCR",153,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCR",154,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCR",155,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCR",156,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCR",157,0)
+    F J=0:0 D  Q:$O(K(I))=""
+"RTN","GPLCCR",158,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCR",159,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCR",160,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCR",161,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCR",162,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCR",163,0)
+    Q
+"RTN","GPLCCR",164,0)
+    ;
+"RTN","GPLCCR",165,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCR",166,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCR",167,0)
+  Q
+"RTN","GPLCCR",168,0)
+  ;
+"RTN","GPLCCR",169,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCR",170,0)
+  N ZTMP
+"RTN","GPLCCR",171,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",172,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCR",173,0)
+  Q
+"RTN","GPLCCR",174,0)
+  ;
+"RTN","GPLCCR",175,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCR",176,0)
+  N ZTMP
+"RTN","GPLCCR",177,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",178,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCR",179,0)
+  Q
+"RTN","GPLCCR",180,0)
+  ;
+"RTN","GPLCCR",181,0)
+ ;;><TEST>
+"RTN","GPLCCR",182,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCR",183,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",184,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCR",185,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCR",186,0)
+ ;;><VITALS>
+"RTN","GPLCCR",187,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",188,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCR",189,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCR",190,0)
+ ;;><CCR>
+"RTN","GPLCCR",191,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",192,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",193,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCR",194,0)
+ ;;><ACTLST>
+"RTN","GPLCCR",195,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",196,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",197,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCR",198,0)
+ ;;><ACTORS>
+"RTN","GPLCCR",199,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCR",200,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCR",201,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCR",202,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCR",203,0)
+ ;;><TRIM>
+"RTN","GPLCCR",204,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCR",205,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
+"RTN","GPLCCR0")
+0^15^B658213703
+"RTN","GPLCCR0",1,0)
+GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+"RTN","GPLCCR0",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLCCR0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR0",5,0)
+ ;
+"RTN","GPLCCR0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR0",10,0)
+ ;
+"RTN","GPLCCR0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR0",15,0)
+ ;
+"RTN","GPLCCR0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR0",19,0)
+ ;
+"RTN","GPLCCR0",20,0)
+          W "This is a CCR TEMPLATE with processing routines",!
+"RTN","GPLCCR0",21,0)
+          W !
+"RTN","GPLCCR0",22,0)
+          Q
+"RTN","GPLCCR0",23,0)
+          ;
+"RTN","GPLCCR0",24,0)
+ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
+"RTN","GPLCCR0",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCR0",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCR0",28,0)
+          ; I '$G(@ZARY) D  ;
+"RTN","GPLCCR0",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCR0",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCR0",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCR0",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCR0",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCR0",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCR0",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCR0",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCR0",37,0)
+          Q
+"RTN","GPLCCR0",38,0)
+          ;
+"RTN","GPLCCR0",39,0)
+ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
+"RTN","GPLCCR0",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCR0",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCR0",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCR0",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCR0",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCR0",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCR0",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCR0",48,0)
+          ;
+"RTN","GPLCCR0",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCR0",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCR0",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCR0",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCR0",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCR0",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCR0",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCR0",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCR0",57,0)
+          Q
+"RTN","GPLCCR0",58,0)
+          ;
+"RTN","GPLCCR0",59,0)
+LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCR0",60,0)
+          D ZLOAD(ARY,"GPLCCR0")
+"RTN","GPLCCR0",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCR0",62,0)
+          Q
+"RTN","GPLCCR0",63,0)
+          ;
+"RTN","GPLCCR0",64,0)
+ ;<TEMPLATE>
+"RTN","GPLCCR0",65,0)
+ ;;<?xml version="1.0" encoding="UTF-8"?>
+"RTN","GPLCCR0",66,0)
+ ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
+"RTN","GPLCCR0",67,0)
+ ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
+"RTN","GPLCCR0",68,0)
+ ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
+"RTN","GPLCCR0",69,0)
+ ;;<Language>
+"RTN","GPLCCR0",70,0)
+ ;;<Text>English</Text>
+"RTN","GPLCCR0",71,0)
+ ;;</Language>
+"RTN","GPLCCR0",72,0)
+ ;;<Version>V1.0</Version>
+"RTN","GPLCCR0",73,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",74,0)
+ ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",75,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",76,0)
+ ;;<Patient>
+"RTN","GPLCCR0",77,0)
+ ;;<ActorID>@@ACTORPATIENT@@</ActorID>
+"RTN","GPLCCR0",78,0)
+ ;;</Patient>
+"RTN","GPLCCR0",79,0)
+ ;;<From>
+"RTN","GPLCCR0",80,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",81,0)
+ ;;<ActorID>@@ACTORFROM@@</ActorID>
+"RTN","GPLCCR0",82,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",83,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",84,0)
+ ;;<ActorID>@@ACTORFROM2@@</ActorID>
+"RTN","GPLCCR0",85,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",86,0)
+ ;;</From>
+"RTN","GPLCCR0",87,0)
+ ;;<To>
+"RTN","GPLCCR0",88,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",89,0)
+ ;;<ActorID>@@ACTORTO@@</ActorID>
+"RTN","GPLCCR0",90,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",91,0)
+ ;;<Text>@@ACTORTOTEXT@@</Text>
+"RTN","GPLCCR0",92,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",93,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",94,0)
+ ;;</To>
+"RTN","GPLCCR0",95,0)
+ ;;<Purpose>
+"RTN","GPLCCR0",96,0)
+ ;;<Description>
+"RTN","GPLCCR0",97,0)
+ ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
+"RTN","GPLCCR0",98,0)
+ ;;</Description>
+"RTN","GPLCCR0",99,0)
+ ;;</Purpose>
+"RTN","GPLCCR0",100,0)
+ ;;<Body>
+"RTN","GPLCCR0",101,0)
+ ;;<Problems>
+"RTN","GPLCCR0",102,0)
+ ;;<Problem>
+"RTN","GPLCCR0",103,0)
+ ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",104,0)
+ ;;<Type>
+"RTN","GPLCCR0",105,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",106,0)
+ ;;</Type>
+"RTN","GPLCCR0",107,0)
+ ;;<Description>
+"RTN","GPLCCR0",108,0)
+ ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",109,0)
+ ;;<Code>
+"RTN","GPLCCR0",110,0)
+ ;;<Value>@@PROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",111,0)
+ ;;<CodingSystem>ICD9CM</CodingSystem>
+"RTN","GPLCCR0",112,0)
+ ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",113,0)
+ ;;</Code>
+"RTN","GPLCCR0",114,0)
+ ;;</Description>
+"RTN","GPLCCR0",115,0)
+ ;;<Source>
+"RTN","GPLCCR0",116,0)
+ ;;<Actor>
+"RTN","GPLCCR0",117,0)
+ ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",118,0)
+ ;;</Actor>
+"RTN","GPLCCR0",119,0)
+ ;;</Source>
+"RTN","GPLCCR0",120,0)
+ ;;</Problem>
+"RTN","GPLCCR0",121,0)
+ ;;</Problems>
+"RTN","GPLCCR0",122,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCR0",123,0)
+ ;;<FamilyProblemHistory>
+"RTN","GPLCCR0",124,0)
+ ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",125,0)
+ ;;<Source>
+"RTN","GPLCCR0",126,0)
+ ;;<Actor>
+"RTN","GPLCCR0",127,0)
+ ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
+"RTN","GPLCCR0",128,0)
+ ;;</Actor>
+"RTN","GPLCCR0",129,0)
+ ;;</Source>
+"RTN","GPLCCR0",130,0)
+ ;;<FamilyMember>
+"RTN","GPLCCR0",131,0)
+ ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
+"RTN","GPLCCR0",132,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",133,0)
+ ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
+"RTN","GPLCCR0",134,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",135,0)
+ ;;<Source>
+"RTN","GPLCCR0",136,0)
+ ;;<Actor>
+"RTN","GPLCCR0",137,0)
+ ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",138,0)
+ ;;</Actor>
+"RTN","GPLCCR0",139,0)
+ ;;</Source>
+"RTN","GPLCCR0",140,0)
+ ;;</FamilyMember>
+"RTN","GPLCCR0",141,0)
+ ;;<Problem>
+"RTN","GPLCCR0",142,0)
+ ;;<Type>
+"RTN","GPLCCR0",143,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",144,0)
+ ;;</Type>
+"RTN","GPLCCR0",145,0)
+ ;;<Description>
+"RTN","GPLCCR0",146,0)
+ ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",147,0)
+ ;;<Code>
+"RTN","GPLCCR0",148,0)
+ ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
+"RTN","GPLCCR0",149,0)
+ ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",150,0)
+ ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
+"RTN","GPLCCR0",151,0)
+ ;;</Code>
+"RTN","GPLCCR0",152,0)
+ ;;</Description>
+"RTN","GPLCCR0",153,0)
+ ;;<Source>
+"RTN","GPLCCR0",154,0)
+ ;;<Actor>
+"RTN","GPLCCR0",155,0)
+ ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
+"RTN","GPLCCR0",156,0)
+ ;;</Actor>
+"RTN","GPLCCR0",157,0)
+ ;;</Source>
+"RTN","GPLCCR0",158,0)
+ ;;</Problem>
+"RTN","GPLCCR0",159,0)
+ ;;</FamilyProblemHistory>
+"RTN","GPLCCR0",160,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCR0",161,0)
+ ;;<SocialHistory>
+"RTN","GPLCCR0",162,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",163,0)
+ ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",164,0)
+ ;;<Type>
+"RTN","GPLCCR0",165,0)
+ ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
+"RTN","GPLCCR0",166,0)
+ ;;</Type>
+"RTN","GPLCCR0",167,0)
+ ;;<Description>
+"RTN","GPLCCR0",168,0)
+ ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",169,0)
+ ;;</Description>
+"RTN","GPLCCR0",170,0)
+ ;;<Source>
+"RTN","GPLCCR0",171,0)
+ ;;<Actor>
+"RTN","GPLCCR0",172,0)
+ ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",173,0)
+ ;;</Actor>
+"RTN","GPLCCR0",174,0)
+ ;;</Source>
+"RTN","GPLCCR0",175,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",176,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",177,0)
+ ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
+"RTN","GPLCCR0",178,0)
+ ;;<Type>
+"RTN","GPLCCR0",179,0)
+ ;;<Text>Ethnic Origin</Text>
+"RTN","GPLCCR0",180,0)
+ ;;</Type>
+"RTN","GPLCCR0",181,0)
+ ;;<Description>
+"RTN","GPLCCR0",182,0)
+ ;;<Text>Not Hispanic or Latino</Text>
+"RTN","GPLCCR0",183,0)
+ ;;</Description>
+"RTN","GPLCCR0",184,0)
+ ;;<Source>
+"RTN","GPLCCR0",185,0)
+ ;;<Actor>
+"RTN","GPLCCR0",186,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",187,0)
+ ;;</Actor>
+"RTN","GPLCCR0",188,0)
+ ;;</Source>
+"RTN","GPLCCR0",189,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",190,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",191,0)
+ ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
+"RTN","GPLCCR0",192,0)
+ ;;<Type>
+"RTN","GPLCCR0",193,0)
+ ;;<Text>Race</Text>
+"RTN","GPLCCR0",194,0)
+ ;;</Type>
+"RTN","GPLCCR0",195,0)
+ ;;<Description>
+"RTN","GPLCCR0",196,0)
+ ;;<Text>White</Text>
+"RTN","GPLCCR0",197,0)
+ ;;</Description>
+"RTN","GPLCCR0",198,0)
+ ;;<Source>
+"RTN","GPLCCR0",199,0)
+ ;;<Actor>
+"RTN","GPLCCR0",200,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",201,0)
+ ;;</Actor>
+"RTN","GPLCCR0",202,0)
+ ;;</Source>
+"RTN","GPLCCR0",203,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",204,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",205,0)
+ ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
+"RTN","GPLCCR0",206,0)
+ ;;<Type>
+"RTN","GPLCCR0",207,0)
+ ;;<Text>Occupation</Text>
+"RTN","GPLCCR0",208,0)
+ ;;</Type>
+"RTN","GPLCCR0",209,0)
+ ;;<Description>
+"RTN","GPLCCR0",210,0)
+ ;;<Text>Physician</Text>
+"RTN","GPLCCR0",211,0)
+ ;;</Description>
+"RTN","GPLCCR0",212,0)
+ ;;<Source>
+"RTN","GPLCCR0",213,0)
+ ;;<Actor>
+"RTN","GPLCCR0",214,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",215,0)
+ ;;</Actor>
+"RTN","GPLCCR0",216,0)
+ ;;</Source>
+"RTN","GPLCCR0",217,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",218,0)
+ ;;</SocialHistory>
+"RTN","GPLCCR0",219,0)
+ ;;<Alerts>
+"RTN","GPLCCR0",220,0)
+ ;;<Alert>
+"RTN","GPLCCR0",221,0)
+ ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",222,0)
+ ;;<Description>
+"RTN","GPLCCR0",223,0)
+ ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",224,0)
+ ;;<Code>
+"RTN","GPLCCR0",225,0)
+ ;;<Value>@@ALERTCODEVALUE@@</Value>
+"RTN","GPLCCR0",226,0)
+ ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",227,0)
+ ;;</Code>
+"RTN","GPLCCR0",228,0)
+ ;;</Description>
+"RTN","GPLCCR0",229,0)
+ ;;<Status>
+"RTN","GPLCCR0",230,0)
+ ;;<Text>@@ALERTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",231,0)
+ ;;</Status>
+"RTN","GPLCCR0",232,0)
+ ;;<Source>
+"RTN","GPLCCR0",233,0)
+ ;;<Actor>
+"RTN","GPLCCR0",234,0)
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",235,0)
+ ;;</Actor>
+"RTN","GPLCCR0",236,0)
+ ;;</Source>
+"RTN","GPLCCR0",237,0)
+ ;;<Agent>
+"RTN","GPLCCR0",238,0)
+ ;;<Products>
+"RTN","GPLCCR0",239,0)
+ ;;<Product>
+"RTN","GPLCCR0",240,0)
+ ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",241,0)
+ ;;<Source>
+"RTN","GPLCCR0",242,0)
+ ;;<Actor>
+"RTN","GPLCCR0",243,0)
+ ;;<ActorID>@@ALERTAGENTPRODUCTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",244,0)
+ ;;</Actor>
+"RTN","GPLCCR0",245,0)
+ ;;</Source>
+"RTN","GPLCCR0",246,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",247,0)
+ ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",248,0)
+ ;;<Code>
+"RTN","GPLCCR0",249,0)
+ ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
+"RTN","GPLCCR0",250,0)
+ ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",251,0)
+ ;;</Code>
+"RTN","GPLCCR0",252,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",253,0)
+ ;;</Product>
+"RTN","GPLCCR0",254,0)
+ ;;</Products>
+"RTN","GPLCCR0",255,0)
+ ;;</Agent>
+"RTN","GPLCCR0",256,0)
+ ;;<Reaction>
+"RTN","GPLCCR0",257,0)
+ ;;<Description>
+"RTN","GPLCCR0",258,0)
+ ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",259,0)
+ ;;<Code>
+"RTN","GPLCCR0",260,0)
+ ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",261,0)
+ ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",262,0)
+ ;;</Code>
+"RTN","GPLCCR0",263,0)
+ ;;</Description>
+"RTN","GPLCCR0",264,0)
+ ;;</Reaction>
+"RTN","GPLCCR0",265,0)
+ ;;</Alert>
+"RTN","GPLCCR0",266,0)
+ ;;</Alerts>
+"RTN","GPLCCR0",267,0)
+ ;;<Medications>
+"RTN","GPLCCR0",268,0)
+ ;;<Medication>
+"RTN","GPLCCR0",269,0)
+ ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",270,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",271,0)
+ ;;<Type>
+"RTN","GPLCCR0",272,0)
+ ;;<Text>@@MEDISSUEDATETXT@@</Text>
+"RTN","GPLCCR0",273,0)
+ ;;</Type>
+"RTN","GPLCCR0",274,0)
+ ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
+"RTN","GPLCCR0",275,0)
+ ;;<Type>
+"RTN","GPLCCR0",276,0)
+ ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
+"RTN","GPLCCR0",277,0)
+ ;;</Type>
+"RTN","GPLCCR0",278,0)
+ ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
+"RTN","GPLCCR0",279,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",280,0)
+ ;;<IDs>
+"RTN","GPLCCR0",281,0)
+ ;;<Type>
+"RTN","GPLCCR0",282,0)
+ ;;<Text>@@MEDRXNOTXT@@</Text>
+"RTN","GPLCCR0",283,0)
+ ;;</Type>
+"RTN","GPLCCR0",284,0)
+ ;;<ID>@@MEDRXNO@@</ID>
+"RTN","GPLCCR0",285,0)
+ ;;</IDs>
+"RTN","GPLCCR0",286,0)
+ ;;<Type>
+"RTN","GPLCCR0",287,0)
+ ;;<Text>@@MEDTYPETEXT@@</Text>
+"RTN","GPLCCR0",288,0)
+ ;;</Type>
+"RTN","GPLCCR0",289,0)
+ ;;<Description>
+"RTN","GPLCCR0",290,0)
+ ;;<Text>@@MEDDETAILUNADORNED@@</Text>
+"RTN","GPLCCR0",291,0)
+ ;;</Description>
+"RTN","GPLCCR0",292,0)
+ ;;<Status>
+"RTN","GPLCCR0",293,0)
+ ;;<Text>@@MEDSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",294,0)
+ ;;</Status>
+"RTN","GPLCCR0",295,0)
+ ;;<Source>
+"RTN","GPLCCR0",296,0)
+ ;;<Actor>
+"RTN","GPLCCR0",297,0)
+ ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",298,0)
+ ;;</Actor>
+"RTN","GPLCCR0",299,0)
+ ;;</Source>
+"RTN","GPLCCR0",300,0)
+ ;;<Product>
+"RTN","GPLCCR0",301,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",302,0)
+ ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",303,0)
+ ;;<Code>
+"RTN","GPLCCR0",304,0)
+ ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
+"RTN","GPLCCR0",305,0)
+ ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",306,0)
+ ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
+"RTN","GPLCCR0",307,0)
+ ;;</Code>
+"RTN","GPLCCR0",308,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",309,0)
+ ;;<BrandName>
+"RTN","GPLCCR0",310,0)
+ ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
+"RTN","GPLCCR0",311,0)
+ ;;</BrandName>
+"RTN","GPLCCR0",312,0)
+ ;;<Strength>
+"RTN","GPLCCR0",313,0)
+ ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
+"RTN","GPLCCR0",314,0)
+ ;;<Units>
+"RTN","GPLCCR0",315,0)
+ ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
+"RTN","GPLCCR0",316,0)
+ ;;</Units>
+"RTN","GPLCCR0",317,0)
+ ;;</Strength>
+"RTN","GPLCCR0",318,0)
+ ;;<Form>
+"RTN","GPLCCR0",319,0)
+ ;;<Text>@@MEDFORMTEXT@@</Text>
+"RTN","GPLCCR0",320,0)
+ ;;</Form>
+"RTN","GPLCCR0",321,0)
+ ;;<Concentration>
+"RTN","GPLCCR0",322,0)
+ ;;<Value>@@MEDCONCVALUE@@</Value>
+"RTN","GPLCCR0",323,0)
+ ;;<Units>
+"RTN","GPLCCR0",324,0)
+ ;;<Unit>@@MEDCONCUNIT@@</Unit>
+"RTN","GPLCCR0",325,0)
+ ;;</Units>
+"RTN","GPLCCR0",326,0)
+ ;;</Concentration>
+"RTN","GPLCCR0",327,0)
+ ;;<Size>
+"RTN","GPLCCR0",328,0)
+ ;;<Text>@@MEDSIZETEXT@@</Text>
+"RTN","GPLCCR0",329,0)
+ ;;</Size>
+"RTN","GPLCCR0",330,0)
+ ;;</Product>
+"RTN","GPLCCR0",331,0)
+ ;;<Quantity>
+"RTN","GPLCCR0",332,0)
+ ;;<Value>@@MEDQUANTITYVALUE@@</Value>
+"RTN","GPLCCR0",333,0)
+ ;;<Units>
+"RTN","GPLCCR0",334,0)
+ ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
+"RTN","GPLCCR0",335,0)
+ ;;</Units>
+"RTN","GPLCCR0",336,0)
+ ;;</Quantity>
+"RTN","GPLCCR0",337,0)
+ ;;<Directions>
+"RTN","GPLCCR0",338,0)
+ ;;<Direction>
+"RTN","GPLCCR0",339,0)
+ ;;<Description>
+"RTN","GPLCCR0",340,0)
+ ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",341,0)
+ ;;</Description>
+"RTN","GPLCCR0",342,0)
+ ;;<DoseIndicator>
+"RTN","GPLCCR0",343,0)
+ ;;<Text>@@MEDDOSEINDICATOR@@</Text>
+"RTN","GPLCCR0",344,0)
+ ;;</DoseIndicator>
+"RTN","GPLCCR0",345,0)
+ ;;<DeliveryMethod>
+"RTN","GPLCCR0",346,0)
+ ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
+"RTN","GPLCCR0",347,0)
+ ;;</DeliveryMethod>
+"RTN","GPLCCR0",348,0)
+ ;;<Dose>
+"RTN","GPLCCR0",349,0)
+ ;;<Value>@@MEDDOSEVALUE@@</Value>
+"RTN","GPLCCR0",350,0)
+ ;;<Units>
+"RTN","GPLCCR0",351,0)
+ ;;<Unit>@@MEDDOSEUNIT@@</Unit>
+"RTN","GPLCCR0",352,0)
+ ;;</Units>
+"RTN","GPLCCR0",353,0)
+ ;;<Rate>
+"RTN","GPLCCR0",354,0)
+ ;;<Value>@@MEDRATEVALUE@@</Value>
+"RTN","GPLCCR0",355,0)
+ ;;<Units>
+"RTN","GPLCCR0",356,0)
+ ;;<Unit>@@MEDRATEUNIT@@</Unit>
+"RTN","GPLCCR0",357,0)
+ ;;</Units>
+"RTN","GPLCCR0",358,0)
+ ;;</Rate>
+"RTN","GPLCCR0",359,0)
+ ;;</Dose>
+"RTN","GPLCCR0",360,0)
+ ;;<Vehicle>
+"RTN","GPLCCR0",361,0)
+ ;;<Text>@@MEDVEHICLETEXT@@</Text>
+"RTN","GPLCCR0",362,0)
+ ;;</Vehicle>
+"RTN","GPLCCR0",363,0)
+ ;;<Route>
+"RTN","GPLCCR0",364,0)
+ ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
+"RTN","GPLCCR0",365,0)
+ ;;</Route>
+"RTN","GPLCCR0",366,0)
+ ;;<Frequency>
+"RTN","GPLCCR0",367,0)
+ ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
+"RTN","GPLCCR0",368,0)
+ ;;<Units>
+"RTN","GPLCCR0",369,0)
+ ;;<Unit>@@MEDFREQUENCYUNIT@@</Unit>
+"RTN","GPLCCR0",370,0)
+ ;;</Units>
+"RTN","GPLCCR0",371,0)
+ ;;</Frequency>
+"RTN","GPLCCR0",372,0)
+ ;;<Interval>
+"RTN","GPLCCR0",373,0)
+ ;;<Value>@@MEDINTERVALVALUE@@</Value>
+"RTN","GPLCCR0",374,0)
+ ;;<Units>
+"RTN","GPLCCR0",375,0)
+ ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
+"RTN","GPLCCR0",376,0)
+ ;;</Units>
+"RTN","GPLCCR0",377,0)
+ ;;</Interval>
+"RTN","GPLCCR0",378,0)
+ ;;<Duration>
+"RTN","GPLCCR0",379,0)
+ ;;<Value>@@MEDDURATIONVALUE@@</Value>
+"RTN","GPLCCR0",380,0)
+ ;;<Units>
+"RTN","GPLCCR0",381,0)
+ ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
+"RTN","GPLCCR0",382,0)
+ ;;</Units>
+"RTN","GPLCCR0",383,0)
+ ;;</Duration>
+"RTN","GPLCCR0",384,0)
+ ;;<Indication>
+"RTN","GPLCCR0",385,0)
+ ;;<PRNFlag>
+"RTN","GPLCCR0",386,0)
+ ;;<Text>@@MEDPRNFLAG@@</Text>
+"RTN","GPLCCR0",387,0)
+ ;;</PRNFlag>
+"RTN","GPLCCR0",388,0)
+ ;;<Problem>
+"RTN","GPLCCR0",389,0)
+ ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",390,0)
+ ;;<Type>
+"RTN","GPLCCR0",391,0)
+ ;;<Text>@@PROBLEM@@</Text>
+"RTN","GPLCCR0",392,0)
+ ;;</Type>
+"RTN","GPLCCR0",393,0)
+ ;;<Description>
+"RTN","GPLCCR0",394,0)
+ ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",395,0)
+ ;;<Code>
+"RTN","GPLCCR0",396,0)
+ ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",397,0)
+ ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",398,0)
+ ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",399,0)
+ ;;</Code>
+"RTN","GPLCCR0",400,0)
+ ;;</Description>
+"RTN","GPLCCR0",401,0)
+ ;;<Source>
+"RTN","GPLCCR0",402,0)
+ ;;<Actor>
+"RTN","GPLCCR0",403,0)
+ ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",404,0)
+ ;;</Actor>
+"RTN","GPLCCR0",405,0)
+ ;;</Source>
+"RTN","GPLCCR0",406,0)
+ ;;</Problem>
+"RTN","GPLCCR0",407,0)
+ ;;</Indication>
+"RTN","GPLCCR0",408,0)
+ ;;<StopIndicator>
+"RTN","GPLCCR0",409,0)
+ ;;<Text>@@MEDSTOPINDICATOR@@</Text>
+"RTN","GPLCCR0",410,0)
+ ;;</StopIndicator>
+"RTN","GPLCCR0",411,0)
+ ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
+"RTN","GPLCCR0",412,0)
+ ;;<MultipleDirectionModifier>
+"RTN","GPLCCR0",413,0)
+ ;;<Text>@@MEDMULDIRMOD@@</Text>
+"RTN","GPLCCR0",414,0)
+ ;;</MultipleDirectionModifier>
+"RTN","GPLCCR0",415,0)
+ ;;</Direction>
+"RTN","GPLCCR0",416,0)
+ ;;</Directions>
+"RTN","GPLCCR0",417,0)
+ ;;<PatientInstructions>
+"RTN","GPLCCR0",418,0)
+ ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",419,0)
+ ;;</PatientInstructions>
+"RTN","GPLCCR0",420,0)
+ ;;<FullfillmentInstructions>
+"RTN","GPLCCR0",421,0)
+ ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",422,0)
+ ;;</FullfillmentInstructions>
+"RTN","GPLCCR0",423,0)
+ ;;<Refills>
+"RTN","GPLCCR0",424,0)
+ ;;<Refill>
+"RTN","GPLCCR0",425,0)
+ ;;<Number>@@MEDRFNO@@</Number>
+"RTN","GPLCCR0",426,0)
+ ;;</Refill>
+"RTN","GPLCCR0",427,0)
+ ;;</Refills>
+"RTN","GPLCCR0",428,0)
+ ;;</Medication>
+"RTN","GPLCCR0",429,0)
+ ;;</Medications>
+"RTN","GPLCCR0",430,0)
+ ;;<VitalSigns>
+"RTN","GPLCCR0",431,0)
+ ;;<Result>
+"RTN","GPLCCR0",432,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",433,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",434,0)
+ ;;<Type>
+"RTN","GPLCCR0",435,0)
+ ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
+"RTN","GPLCCR0",436,0)
+ ;;</Type>
+"RTN","GPLCCR0",437,0)
+ ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",438,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",439,0)
+ ;;<Description>
+"RTN","GPLCCR0",440,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",441,0)
+ ;;</Description>
+"RTN","GPLCCR0",442,0)
+ ;;<Source>
+"RTN","GPLCCR0",443,0)
+ ;;<Actor>
+"RTN","GPLCCR0",444,0)
+ ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",445,0)
+ ;;</Actor>
+"RTN","GPLCCR0",446,0)
+ ;;</Source>
+"RTN","GPLCCR0",447,0)
+ ;;<Test>
+"RTN","GPLCCR0",448,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",449,0)
+ ;;<Type>
+"RTN","GPLCCR0",450,0)
+ ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
+"RTN","GPLCCR0",451,0)
+ ;;</Type>
+"RTN","GPLCCR0",452,0)
+ ;;<Description>
+"RTN","GPLCCR0",453,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",454,0)
+ ;;<Code>
+"RTN","GPLCCR0",455,0)
+ ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",456,0)
+ ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",457,0)
+ ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
+"RTN","GPLCCR0",458,0)
+ ;;</Code>
+"RTN","GPLCCR0",459,0)
+ ;;</Description>
+"RTN","GPLCCR0",460,0)
+ ;;<Source>
+"RTN","GPLCCR0",461,0)
+ ;;<Actor>
+"RTN","GPLCCR0",462,0)
+ ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",463,0)
+ ;;</Actor>
+"RTN","GPLCCR0",464,0)
+ ;;</Source>
+"RTN","GPLCCR0",465,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",466,0)
+ ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
+"RTN","GPLCCR0",467,0)
+ ;;<Units>
+"RTN","GPLCCR0",468,0)
+ ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
+"RTN","GPLCCR0",469,0)
+ ;;</Units>
+"RTN","GPLCCR0",470,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",471,0)
+ ;;</Test>
+"RTN","GPLCCR0",472,0)
+ ;;</Result>
+"RTN","GPLCCR0",473,0)
+ ;;</VitalSigns>
+"RTN","GPLCCR0",474,0)
+ ;;<Results>
+"RTN","GPLCCR0",475,0)
+ ;;<Result>
+"RTN","GPLCCR0",476,0)
+ ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",477,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",478,0)
+ ;;<Type>
+"RTN","GPLCCR0",479,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",480,0)
+ ;;</Type>
+"RTN","GPLCCR0",481,0)
+ ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",482,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",483,0)
+ ;;<Description>
+"RTN","GPLCCR0",484,0)
+ ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",485,0)
+ ;;<Code>
+"RTN","GPLCCR0",486,0)
+ ;;<Value>@@RESULTCODE@@</Value>
+"RTN","GPLCCR0",487,0)
+ ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",488,0)
+ ;;</Code>
+"RTN","GPLCCR0",489,0)
+ ;;</Description>
+"RTN","GPLCCR0",490,0)
+ ;;<Status>
+"RTN","GPLCCR0",491,0)
+ ;;<Text>@@RESULTSTATUS@@</Text>
+"RTN","GPLCCR0",492,0)
+ ;;</Status>
+"RTN","GPLCCR0",493,0)
+ ;;<Source>
+"RTN","GPLCCR0",494,0)
+ ;;<Actor>
+"RTN","GPLCCR0",495,0)
+ ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",496,0)
+ ;;</Actor>
+"RTN","GPLCCR0",497,0)
+ ;;</Source>
+"RTN","GPLCCR0",498,0)
+ ;;<TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",499,0)
+ ;;<Test>
+"RTN","GPLCCR0",500,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",501,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",502,0)
+ ;;<Type>
+"RTN","GPLCCR0",503,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",504,0)
+ ;;</Type>
+"RTN","GPLCCR0",505,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",506,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",507,0)
+ ;;<Description>
+"RTN","GPLCCR0",508,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",509,0)
+ ;;<Code>
+"RTN","GPLCCR0",510,0)
+ ;;<Value>@@RESULTTESTCODE@@</Value>
+"RTN","GPLCCR0",511,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",512,0)
+ ;;</Code>
+"RTN","GPLCCR0",513,0)
+ ;;</Description>
+"RTN","GPLCCR0",514,0)
+ ;;<Status>
+"RTN","GPLCCR0",515,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",516,0)
+ ;;</Status>
+"RTN","GPLCCR0",517,0)
+ ;;<Source>
+"RTN","GPLCCR0",518,0)
+ ;;<Actor>
+"RTN","GPLCCR0",519,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",520,0)
+ ;;</Actor>
+"RTN","GPLCCR0",521,0)
+ ;;</Source>
+"RTN","GPLCCR0",522,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",523,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",524,0)
+ ;;<Units>
+"RTN","GPLCCR0",525,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",526,0)
+ ;;</Units>
+"RTN","GPLCCR0",527,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",528,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",529,0)
+ ;;<Normal>
+"RTN","GPLCCR0",530,0)
+ ;;<Description>
+"RTN","GPLCCR0",531,0)
+ ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",532,0)
+ ;;</Description>
+"RTN","GPLCCR0",533,0)
+ ;;<Source>
+"RTN","GPLCCR0",534,0)
+ ;;<Actor>
+"RTN","GPLCCR0",535,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",536,0)
+ ;;</Actor>
+"RTN","GPLCCR0",537,0)
+ ;;</Source>
+"RTN","GPLCCR0",538,0)
+ ;;</Normal>
+"RTN","GPLCCR0",539,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",540,0)
+ ;;<Flag>
+"RTN","GPLCCR0",541,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",542,0)
+ ;;</Flag>
+"RTN","GPLCCR0",543,0)
+ ;;</Test>
+"RTN","GPLCCR0",544,0)
+ ;;</TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",545,0)
+ ;;<TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",546,0)
+ ;;<Test>
+"RTN","GPLCCR0",547,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",548,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",549,0)
+ ;;<Type>
+"RTN","GPLCCR0",550,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",551,0)
+ ;;</Type>
+"RTN","GPLCCR0",552,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",553,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",554,0)
+ ;;<Description>
+"RTN","GPLCCR0",555,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",556,0)
+ ;;<Code>
+"RTN","GPLCCR0",557,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",558,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",559,0)
+ ;;</Code>
+"RTN","GPLCCR0",560,0)
+ ;;</Description>
+"RTN","GPLCCR0",561,0)
+ ;;<Status>
+"RTN","GPLCCR0",562,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",563,0)
+ ;;</Status>
+"RTN","GPLCCR0",564,0)
+ ;;<Source>
+"RTN","GPLCCR0",565,0)
+ ;;<Actor>
+"RTN","GPLCCR0",566,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",567,0)
+ ;;</Actor>
+"RTN","GPLCCR0",568,0)
+ ;;</Source>
+"RTN","GPLCCR0",569,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",570,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",571,0)
+ ;;<Units>
+"RTN","GPLCCR0",572,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",573,0)
+ ;;</Units>
+"RTN","GPLCCR0",574,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",575,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",576,0)
+ ;;<Normal>
+"RTN","GPLCCR0",577,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
+"RTN","GPLCCR0",578,0)
+ ;;<Units>
+"RTN","GPLCCR0",579,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
+"RTN","GPLCCR0",580,0)
+ ;;</Units>
+"RTN","GPLCCR0",581,0)
+ ;;<ValueSequencePosition>1</ValueSequencePosition>
+"RTN","GPLCCR0",582,0)
+ ;;<Source>
+"RTN","GPLCCR0",583,0)
+ ;;<Actor>
+"RTN","GPLCCR0",584,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",585,0)
+ ;;</Actor>
+"RTN","GPLCCR0",586,0)
+ ;;</Source>
+"RTN","GPLCCR0",587,0)
+ ;;</Normal>
+"RTN","GPLCCR0",588,0)
+ ;;<Normal>
+"RTN","GPLCCR0",589,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
+"RTN","GPLCCR0",590,0)
+ ;;<Units>
+"RTN","GPLCCR0",591,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
+"RTN","GPLCCR0",592,0)
+ ;;</Units>
+"RTN","GPLCCR0",593,0)
+ ;;<ValueSequencePosition>2</ValueSequencePosition>
+"RTN","GPLCCR0",594,0)
+ ;;<VariableNomalModifier>
+"RTN","GPLCCR0",595,0)
+ ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
+"RTN","GPLCCR0",596,0)
+ ;;</VariableNomalModifier>
+"RTN","GPLCCR0",597,0)
+ ;;<Source>
+"RTN","GPLCCR0",598,0)
+ ;;<Actor>
+"RTN","GPLCCR0",599,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",600,0)
+ ;;</Actor>
+"RTN","GPLCCR0",601,0)
+ ;;</Source>
+"RTN","GPLCCR0",602,0)
+ ;;</Normal>
+"RTN","GPLCCR0",603,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",604,0)
+ ;;<Flag>
+"RTN","GPLCCR0",605,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",606,0)
+ ;;</Flag>
+"RTN","GPLCCR0",607,0)
+ ;;</Test>
+"RTN","GPLCCR0",608,0)
+ ;;</TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",609,0)
+ ;;</Result>
+"RTN","GPLCCR0",610,0)
+ ;;</Results>
+"RTN","GPLCCR0",611,0)
+ ;;<HealthCareProviders>
+"RTN","GPLCCR0",612,0)
+ ;;<Provider>
+"RTN","GPLCCR0",613,0)
+ ;;<ActorID>AA0005</ActorID>
+"RTN","GPLCCR0",614,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",615,0)
+ ;;<Text>Primary Provider</Text>
+"RTN","GPLCCR0",616,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",617,0)
+ ;;</Provider>
+"RTN","GPLCCR0",618,0)
+ ;;</HealthCareProviders>
+"RTN","GPLCCR0",619,0)
+ ;;</Body>
+"RTN","GPLCCR0",620,0)
+ ;;<Actors>
+"RTN","GPLCCR0",621,0)
+ ;;<ACTOR-PATIENT>
+"RTN","GPLCCR0",622,0)
+ ;;<Actor>
+"RTN","GPLCCR0",623,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",624,0)
+ ;;<Person>
+"RTN","GPLCCR0",625,0)
+ ;;<Name>
+"RTN","GPLCCR0",626,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",627,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",628,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",629,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",630,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",631,0)
+ ;;</Name>
+"RTN","GPLCCR0",632,0)
+ ;;<DateOfBirth>
+"RTN","GPLCCR0",633,0)
+ ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
+"RTN","GPLCCR0",634,0)
+ ;;</DateOfBirth>
+"RTN","GPLCCR0",635,0)
+ ;;<Gender>
+"RTN","GPLCCR0",636,0)
+ ;;<Text>@@ACTORGENDER@@</Text>
+"RTN","GPLCCR0",637,0)
+ ;;<Code>
+"RTN","GPLCCR0",638,0)
+ ;;<Value>@@ACTORGENDER@@</Value>
+"RTN","GPLCCR0",639,0)
+ ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
+"RTN","GPLCCR0",640,0)
+ ;;</Code>
+"RTN","GPLCCR0",641,0)
+ ;;</Gender>
+"RTN","GPLCCR0",642,0)
+ ;;</Person>
+"RTN","GPLCCR0",643,0)
+ ;;<IDs>
+"RTN","GPLCCR0",644,0)
+ ;;<Type>
+"RTN","GPLCCR0",645,0)
+ ;;<Text>@@ACTORSSNTEXT@@</Text>
+"RTN","GPLCCR0",646,0)
+ ;;</Type>
+"RTN","GPLCCR0",647,0)
+ ;;<ID>@@ACTORSSN@@</ID>
+"RTN","GPLCCR0",648,0)
+ ;;<Source>
+"RTN","GPLCCR0",649,0)
+ ;;<Actor>
+"RTN","GPLCCR0",650,0)
+ ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
+"RTN","GPLCCR0",651,0)
+ ;;</Actor>
+"RTN","GPLCCR0",652,0)
+ ;;</Source>
+"RTN","GPLCCR0",653,0)
+ ;;</IDs>
+"RTN","GPLCCR0",654,0)
+ ;;<Address>
+"RTN","GPLCCR0",655,0)
+ ;;<Type>
+"RTN","GPLCCR0",656,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",657,0)
+ ;;</Type>
+"RTN","GPLCCR0",658,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",659,0)
+ ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
+"RTN","GPLCCR0",660,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",661,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",662,0)
+ ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
+"RTN","GPLCCR0",663,0)
+ ;;</Address>
+"RTN","GPLCCR0",664,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",665,0)
+ ;;<Value>@@ACTORRESTEL@@</Value>
+"RTN","GPLCCR0",666,0)
+ ;;<Type>
+"RTN","GPLCCR0",667,0)
+ ;;<Text>@@ACTORRESTELTEXT@@</Text>
+"RTN","GPLCCR0",668,0)
+ ;;</Type>
+"RTN","GPLCCR0",669,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",670,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",671,0)
+ ;;<Value>@@ACTORWORKTEL@@</Value>
+"RTN","GPLCCR0",672,0)
+ ;;<Type>
+"RTN","GPLCCR0",673,0)
+ ;;<Text>@@ACTORWORKTELTEXT@@</Text>
+"RTN","GPLCCR0",674,0)
+ ;;</Type>
+"RTN","GPLCCR0",675,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",676,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",677,0)
+ ;;<Value>@@ACTORCELLTEL@@</Value>
+"RTN","GPLCCR0",678,0)
+ ;;<Type>
+"RTN","GPLCCR0",679,0)
+ ;;<Text>@@ACTORCELLTELTEXT@@</Text>
+"RTN","GPLCCR0",680,0)
+ ;;</Type>
+"RTN","GPLCCR0",681,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",682,0)
+ ;;<EMail>
+"RTN","GPLCCR0",683,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",684,0)
+ ;;</EMail>
+"RTN","GPLCCR0",685,0)
+ ;;<Source>
+"RTN","GPLCCR0",686,0)
+ ;;<Actor>
+"RTN","GPLCCR0",687,0)
+ ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",688,0)
+ ;;</Actor>
+"RTN","GPLCCR0",689,0)
+ ;;</Source>
+"RTN","GPLCCR0",690,0)
+ ;;</Actor>
+"RTN","GPLCCR0",691,0)
+ ;;</ACTOR-PATIENT>
+"RTN","GPLCCR0",692,0)
+ ;;<ACTOR-SYSTEM>
+"RTN","GPLCCR0",693,0)
+ ;;<Actor>
+"RTN","GPLCCR0",694,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",695,0)
+ ;;<InformationSystem>
+"RTN","GPLCCR0",696,0)
+ ;;<Name>@@ACTORINFOSYSNAME@@</Name>
+"RTN","GPLCCR0",697,0)
+ ;;<Version>@@ACTORINFOSYSVER@@</Version>
+"RTN","GPLCCR0",698,0)
+ ;;</InformationSystem>
+"RTN","GPLCCR0",699,0)
+ ;;<Source>
+"RTN","GPLCCR0",700,0)
+ ;;<Actor>
+"RTN","GPLCCR0",701,0)
+ ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",702,0)
+ ;;</Actor>
+"RTN","GPLCCR0",703,0)
+ ;;</Source>
+"RTN","GPLCCR0",704,0)
+ ;;</Actor>
+"RTN","GPLCCR0",705,0)
+ ;;</ACTOR-SYSTEM>
+"RTN","GPLCCR0",706,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCR0",707,0)
+ ;;<Actor>
+"RTN","GPLCCR0",708,0)
+ ;;<ActorObjectID>AA0003</ActorObjectID>
+"RTN","GPLCCR0",709,0)
+ ;;<Person>
+"RTN","GPLCCR0",710,0)
+ ;;<Name>
+"RTN","GPLCCR0",711,0)
+ ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
+"RTN","GPLCCR0",712,0)
+ ;;</Name>
+"RTN","GPLCCR0",713,0)
+ ;;</Person>
+"RTN","GPLCCR0",714,0)
+ ;;<Relation>
+"RTN","GPLCCR0",715,0)
+ ;;<Text>@@ACTORRELATION@@</Text>
+"RTN","GPLCCR0",716,0)
+ ;;</Relation>
+"RTN","GPLCCR0",717,0)
+ ;;<Source>
+"RTN","GPLCCR0",718,0)
+ ;;<Actor>
+"RTN","GPLCCR0",719,0)
+ ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
+"RTN","GPLCCR0",720,0)
+ ;;</Actor>
+"RTN","GPLCCR0",721,0)
+ ;;</Source>
+"RTN","GPLCCR0",722,0)
+ ;;</Actor>
+"RTN","GPLCCR0",723,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCR0",724,0)
+ ;;<ACTOR-PROVIDER>
+"RTN","GPLCCR0",725,0)
+ ;;<Actor>
+"RTN","GPLCCR0",726,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",727,0)
+ ;;<Person>
+"RTN","GPLCCR0",728,0)
+ ;;<Name>
+"RTN","GPLCCR0",729,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",730,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",731,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",732,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",733,0)
+ ;;<Title>@@ACTORTITLE@@</Title>
+"RTN","GPLCCR0",734,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",735,0)
+ ;;</Name>
+"RTN","GPLCCR0",736,0)
+ ;;</Person>
+"RTN","GPLCCR0",737,0)
+ ;;<IDs>
+"RTN","GPLCCR0",738,0)
+ ;;<Type>
+"RTN","GPLCCR0",739,0)
+ ;;<Text>@@IDTYPE@@</Text>
+"RTN","GPLCCR0",740,0)
+ ;;</Type>
+"RTN","GPLCCR0",741,0)
+ ;;<ID>@@ID@@</ID>
+"RTN","GPLCCR0",742,0)
+ ;;<IssuedBy>
+"RTN","GPLCCR0",743,0)
+ ;;<Description>
+"RTN","GPLCCR0",744,0)
+ ;;<Text>@@IDDESC@@</Text>
+"RTN","GPLCCR0",745,0)
+ ;;</Description>
+"RTN","GPLCCR0",746,0)
+ ;;</IssuedBy>
+"RTN","GPLCCR0",747,0)
+ ;;</IDs>
+"RTN","GPLCCR0",748,0)
+ ;;<Specialty>
+"RTN","GPLCCR0",749,0)
+ ;;<Text>@@ACTORSPECIALITY@@</Text>
+"RTN","GPLCCR0",750,0)
+ ;;</Specialty>
+"RTN","GPLCCR0",751,0)
+ ;;<Address>
+"RTN","GPLCCR0",752,0)
+ ;;<Type>
+"RTN","GPLCCR0",753,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",754,0)
+ ;;</Type>
+"RTN","GPLCCR0",755,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",756,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",757,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",758,0)
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+"RTN","GPLCCR0",759,0)
+ ;;</Address>
+"RTN","GPLCCR0",760,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",761,0)
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+"RTN","GPLCCR0",762,0)
+ ;;<Type>
+"RTN","GPLCCR0",763,0)
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+"RTN","GPLCCR0",764,0)
+ ;;</Type>
+"RTN","GPLCCR0",765,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",766,0)
+ ;;<Email>
+"RTN","GPLCCR0",767,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",768,0)
+ ;;</Email>
+"RTN","GPLCCR0",769,0)
+ ;;<Source>
+"RTN","GPLCCR0",770,0)
+ ;;<Actor>
+"RTN","GPLCCR0",771,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",772,0)
+ ;;</Actor>
+"RTN","GPLCCR0",773,0)
+ ;;</Source>
+"RTN","GPLCCR0",774,0)
+ ;;</Actor>
+"RTN","GPLCCR0",775,0)
+ ;;</ACTOR-PROVIDER>
+"RTN","GPLCCR0",776,0)
+ ;;<ACTOR-ORG>
+"RTN","GPLCCR0",777,0)
+ ;;<Actor>
+"RTN","GPLCCR0",778,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",779,0)
+ ;;<Organization>
+"RTN","GPLCCR0",780,0)
+ ;;<Name>@@ORGANIZATIONNAME@@</Name>
+"RTN","GPLCCR0",781,0)
+ ;;</Organization>
+"RTN","GPLCCR0",782,0)
+ ;;<Source>
+"RTN","GPLCCR0",783,0)
+ ;;<Actor>
+"RTN","GPLCCR0",784,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",785,0)
+ ;;</Actor>
+"RTN","GPLCCR0",786,0)
+ ;;</Source>
+"RTN","GPLCCR0",787,0)
+ ;;</Actor>
+"RTN","GPLCCR0",788,0)
+ ;;</ACTOR-ORG>
+"RTN","GPLCCR0",789,0)
+ ;;</Actors>
+"RTN","GPLCCR0",790,0)
+ ;;<Signatures>
+"RTN","GPLCCR0",791,0)
+ ;;<CCRSignature>
+"RTN","GPLCCR0",792,0)
+ ;;<SignatureObjectID>S0001</SignatureObjectID>
+"RTN","GPLCCR0",793,0)
+ ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
+"RTN","GPLCCR0",794,0)
+ ;;<Source>
+"RTN","GPLCCR0",795,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",796,0)
+ ;;</Source>
+"RTN","GPLCCR0",797,0)
+ ;;<Signature>
+"RTN","GPLCCR0",798,0)
+ ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
+"RTN","GPLCCR0",799,0)
+ ;;<SignedInfo>
+"RTN","GPLCCR0",800,0)
+ ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
+"RTN","GPLCCR0",801,0)
+ ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
+"RTN","GPLCCR0",802,0)
+ ;;<Reference URI="">
+"RTN","GPLCCR0",803,0)
+ ;;<Transforms>
+"RTN","GPLCCR0",804,0)
+ ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
+"RTN","GPLCCR0",805,0)
+ ;;</Transforms>
+"RTN","GPLCCR0",806,0)
+ ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
+"RTN","GPLCCR0",807,0)
+ ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
+"RTN","GPLCCR0",808,0)
+ ;;</Reference>
+"RTN","GPLCCR0",809,0)
+ ;;</SignedInfo>
+"RTN","GPLCCR0",810,0)
+ ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
+"RTN","GPLCCR0",811,0)
+ ;;<KeyInfo>
+"RTN","GPLCCR0",812,0)
+ ;;<KeyValue>
+"RTN","GPLCCR0",813,0)
+ ;;<RSAKeyValue>
+"RTN","GPLCCR0",814,0)
+ ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
+"RTN","GPLCCR0",815,0)
+ ;;<Exponent>AQAB</Exponent>
+"RTN","GPLCCR0",816,0)
+ ;;</RSAKeyValue>
+"RTN","GPLCCR0",817,0)
+ ;;</KeyValue>
+"RTN","GPLCCR0",818,0)
+ ;;</KeyInfo>
+"RTN","GPLCCR0",819,0)
+ ;;</Signature>
+"RTN","GPLCCR0",820,0)
+ ;;</Signature>
+"RTN","GPLCCR0",821,0)
+ ;;</CCRSignature>
+"RTN","GPLCCR0",822,0)
+ ;;</Signatures>
+"RTN","GPLCCR0",823,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCR0",824,0)
+ ;</TEMPLATE>
+"RTN","GPLMEDS")
+0^18^B27482404
+"RTN","GPLMEDS",1,0)
+GPLMEDS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
+"RTN","GPLMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 3
+"RTN","GPLMEDS",3,0)
+   ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLMEDS",4,0)
+   ;General Public License See attached copy of the License.
+"RTN","GPLMEDS",5,0)
+   ;
+"RTN","GPLMEDS",6,0)
+   ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLMEDS",7,0)
+   ;it under the terms of the GNU General Public License as published by
+"RTN","GPLMEDS",8,0)
+   ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLMEDS",9,0)
+   ;(at your option) any later version.
+"RTN","GPLMEDS",10,0)
+   ;
+"RTN","GPLMEDS",11,0)
+   ;This program is distributed in the hope that it will be useful,
+"RTN","GPLMEDS",12,0)
+   ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLMEDS",13,0)
+   ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLMEDS",14,0)
+   ;GNU General Public License for more details.
+"RTN","GPLMEDS",15,0)
+   ;
+"RTN","GPLMEDS",16,0)
+   ;You should have received a copy of the GNU General Public License along
+"RTN","GPLMEDS",17,0)
+   ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLMEDS",18,0)
+   ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLMEDS",19,0)
+   ;
+"RTN","GPLMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","GPLMEDS",21,0)
+   Q
+"RTN","GPLMEDS",22,0)
+   ;
+"RTN","GPLMEDS",23,0)
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","GPLMEDS",24,0)
+   ;
+"RTN","GPLMEDS",25,0)
+   ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLMEDS",26,0)
+   ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLMEDS",27,0)
+   ;
+"RTN","GPLMEDS",28,0)
+   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+"RTN","GPLMEDS",29,0)
+   D ACTIVE^ORWPS(.MEDRSLT,DFN)
+"RTN","GPLMEDS",30,0)
+   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+"RTN","GPLMEDS",31,0)
+   . W "ERROR RUNNINIG MEDICATIONS RPC",!
+"RTN","GPLMEDS",32,0)
+   . S @MEDOUTXML@(0)=0
+"RTN","GPLMEDS",33,0)
+   . Q
+"RTN","GPLMEDS",34,0)
+   ; I DEBUG ZWR MEDRSLT
+"RTN","GPLMEDS",35,0)
+   M GPLMEDS=MEDRSLT
+"RTN","GPLMEDS",36,0)
+   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
+"RTN","GPLMEDS",37,0)
+   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+"RTN","GPLMEDS",38,0)
+   K @MEDTVMAP,@MEDTARYTMP
+"RTN","GPLMEDS",39,0)
+   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
+"RTN","GPLMEDS",40,0)
+   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
+"RTN","GPLMEDS",41,0)
+   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
+"RTN","GPLMEDS",42,0)
+   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
+"RTN","GPLMEDS",43,0)
+   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
+"RTN","GPLMEDS",44,0)
+   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
+"RTN","GPLMEDS",45,0)
+   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
+"RTN","GPLMEDS",46,0)
+   . . S ZI=ZI+1 ; INCREMENT MED COUNT
+"RTN","GPLMEDS",47,0)
+   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
+"RTN","GPLMEDS",48,0)
+   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
+"RTN","GPLMEDS",49,0)
+   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
+"RTN","GPLMEDS",50,0)
+   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
+"RTN","GPLMEDS",51,0)
+   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
+"RTN","GPLMEDS",52,0)
+   ZWR ZA
+"RTN","GPLMEDS",53,0)
+   F ZI=1:1:ZA(0) D  ; FOR EACH MED
+"RTN","GPLMEDS",54,0)
+   . I DEBUG W "ZI IS ",ZI,!
+"RTN","GPLMEDS",55,0)
+   . S MEDVMAP=$NA(@MEDTVMAP@(ZI))
+"RTN","GPLMEDS",56,0)
+   . K @MEDVMAP
+"RTN","GPLMEDS",57,0)
+   . I DEBUG W "VMAP= ",MEDVMAP,!
+"RTN","GPLMEDS",58,0)
+   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
+"RTN","GPLMEDS",59,0)
+   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
+"RTN","GPLMEDS",60,0)
+   . S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS
+"RTN","GPLMEDS",61,0)
+   . S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+"RTN","GPLMEDS",62,0)
+   . S @MEDVMAP@("MEDDATETIMEAGE")=""
+"RTN","GPLMEDS",63,0)
+   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
+"RTN","GPLMEDS",64,0)
+   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
+"RTN","GPLMEDS",65,0)
+   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+"RTN","GPLMEDS",66,0)
+   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLMEDS",67,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+"RTN","GPLMEDS",68,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=""
+"RTN","GPLMEDS",69,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+"RTN","GPLMEDS",70,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
+"RTN","GPLMEDS",71,0)
+   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
+"RTN","GPLMEDS",72,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
+"RTN","GPLMEDS",73,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
+"RTN","GPLMEDS",74,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
+"RTN","GPLMEDS",75,0)
+   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
+"RTN","GPLMEDS",76,0)
+   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
+"RTN","GPLMEDS",77,0)
+   . S @MEDVMAP@("MEDFORMTEXT")=""
+"RTN","GPLMEDS",78,0)
+   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
+"RTN","GPLMEDS",79,0)
+   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
+"RTN","GPLMEDS",80,0)
+   . S @MEDVMAP@("MEDRFNO")=""
+"RTN","GPLMEDS",81,0)
+   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
+"RTN","GPLMEDS",82,0)
+   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
+"RTN","GPLMEDS",83,0)
+   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
+"RTN","GPLMEDS",84,0)
+   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
+"RTN","GPLMEDS",85,0)
+   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
+"RTN","GPLMEDS",86,0)
+   . . S ZN=0 ; DON'T KNOW WHY
+"RTN","GPLMEDS",87,0)
+   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
+"RTN","GPLMEDS",88,0)
+   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
+"RTN","GPLMEDS",89,0)
+   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
+"RTN","GPLMEDS",90,0)
+   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
+"RTN","GPLMEDS",91,0)
+   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
+"RTN","GPLMEDS",92,0)
+   . S @MEDVMAP@("MEDDOSEVALUE")=""
+"RTN","GPLMEDS",93,0)
+   . S @MEDVMAP@("MEDDOSEUNIT")=""
+"RTN","GPLMEDS",94,0)
+   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
+"RTN","GPLMEDS",95,0)
+   . S @MEDVMAP@("MEDDURATIONVALUE")=""
+"RTN","GPLMEDS",96,0)
+   . S @MEDVMAP@("MEDDURATIONUNIT")=""
+"RTN","GPLMEDS",97,0)
+   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
+"RTN","GPLMEDS",98,0)
+   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
+"RTN","GPLMEDS",99,0)
+   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
+"RTN","GPLMEDS",100,0)
+   . K @MEDARYTMP
+"RTN","GPLMEDS",101,0)
+   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+"RTN","GPLMEDS",102,0)
+   . I ZI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLMEDS",103,0)
+   . . ; W "FIRST ONE",!
+"RTN","GPLMEDS",104,0)
+   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
+"RTN","GPLMEDS",105,0)
+   . I ZI>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLMEDS",106,0)
+   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+"RTN","GPLMEDS",107,0)
+   N MEDTMP,MEDI
+"RTN","GPLMEDS",108,0)
+   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLMEDS",109,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLMEDS",110,0)
+   . W "MEDICATION MISSING ",!
+"RTN","GPLMEDS",111,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","GPLMEDS",112,0)
+   Q
+"RTN","GPLMEDS",113,0)
+   ;
+"RTN","GPLPROBS")
+0^11^B24846496
+"RTN","GPLPROBS",1,0)
+GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
+"RTN","GPLPROBS",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLPROBS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLPROBS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLPROBS",5,0)
+ ;
+"RTN","GPLPROBS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLPROBS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLPROBS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLPROBS",9,0)
+ ;(at your option) any later version.
+"RTN","GPLPROBS",10,0)
+ ;
+"RTN","GPLPROBS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLPROBS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLPROBS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLPROBS",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLPROBS",15,0)
+ ;
+"RTN","GPLPROBS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLPROBS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLPROBS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLPROBS",19,0)
+ ;
+"RTN","GPLPROBS",20,0)
+           ;
+"RTN","GPLPROBS",21,0)
+           ;  PROCESS THE PROBLEMS SECTION OF THE CCR
+"RTN","GPLPROBS",22,0)
+           ;
+"RTN","GPLPROBS",23,0)
+EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+"RTN","GPLPROBS",24,0)
+          ;
+"RTN","GPLPROBS",25,0)
+          ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLPROBS",26,0)
+          ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLPROBS",27,0)
+          ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+"RTN","GPLPROBS",28,0)
+          ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+"RTN","GPLPROBS",29,0)
+          ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+"RTN","GPLPROBS",30,0)
+          ;
+"RTN","GPLPROBS",31,0)
+          N RPCRSLT,J,K,PTMP,X,VMAP,TBU
+"RTN","GPLPROBS",32,0)
+          S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
+"RTN","GPLPROBS",33,0)
+          S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
+"RTN","GPLPROBS",34,0)
+          K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLPROBS",35,0)
+          D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+"RTN","GPLPROBS",36,0)
+          I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
+"RTN","GPLPROBS",37,0)
+          . W "NULL RESULT FROM LIST^ORQQPL3 ",!
+"RTN","GPLPROBS",38,0)
+          . S @OUTXML@(0)=0
+"RTN","GPLPROBS",39,0)
+          . ; Q
+"RTN","GPLPROBS",40,0)
+          ; I DEBUG ZWR RPCRSLT
+"RTN","GPLPROBS",41,0)
+          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
+"RTN","GPLPROBS",42,0)
+          . S VMAP=$NA(@TVMAP@(J))
+"RTN","GPLPROBS",43,0)
+          . K @VMAP
+"RTN","GPLPROBS",44,0)
+          . W "VMAP= ",VMAP,!
+"RTN","GPLPROBS",45,0)
+          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+"RTN","GPLPROBS",46,0)
+          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
+"RTN","GPLPROBS",47,0)
+          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
+"RTN","GPLPROBS",48,0)
+          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
+"RTN","GPLPROBS",49,0)
+          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+"RTN","GPLPROBS",50,0)
+          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+"RTN","GPLPROBS",51,0)
+          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
+"RTN","GPLPROBS",52,0)
+          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
+"RTN","GPLPROBS",53,0)
+          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
+"RTN","GPLPROBS",54,0)
+          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
+"RTN","GPLPROBS",55,0)
+          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
+"RTN","GPLPROBS",56,0)
+          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
+"RTN","GPLPROBS",57,0)
+          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
+"RTN","GPLPROBS",58,0)
+          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
+"RTN","GPLPROBS",59,0)
+          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+"RTN","GPLPROBS",60,0)
+          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
+"RTN","GPLPROBS",61,0)
+          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
+"RTN","GPLPROBS",62,0)
+          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
+"RTN","GPLPROBS",63,0)
+          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
+"RTN","GPLPROBS",64,0)
+          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
+"RTN","GPLPROBS",65,0)
+          . S ARYTMP=$NA(@TARYTMP@(J))
+"RTN","GPLPROBS",66,0)
+          . ; W "ARYTMP= ",ARYTMP,!
+"RTN","GPLPROBS",67,0)
+          . K @ARYTMP
+"RTN","GPLPROBS",68,0)
+          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
+"RTN","GPLPROBS",69,0)
+          . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",70,0)
+          . . ; W "FIRST ONE",!
+"RTN","GPLPROBS",71,0)
+          . . D CP^GPLXPATH(ARYTMP,OUTXML)
+"RTN","GPLPROBS",72,0)
+          . . ; W "OUTXML ",OUTXML,!
+"RTN","GPLPROBS",73,0)
+          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLPROBS",74,0)
+          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
+"RTN","GPLPROBS",75,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
+"RTN","GPLPROBS",76,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLPROBS",77,0)
+          ; ZWR @OUTXML
+"RTN","GPLPROBS",78,0)
+          ; $$HTML^DILF(
+"RTN","GPLPROBS",79,0)
+          ; GENERATE THE NARITIVE HTML FOR THE CCD
+"RTN","GPLPROBS",80,0)
+          I CCD D  ; IF THIS IS FOR A CCD
+"RTN","GPLPROBS",81,0)
+          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
+"RTN","GPLPROBS",82,0)
+          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
+"RTN","GPLPROBS",83,0)
+          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
+"RTN","GPLPROBS",84,0)
+          . . W "VMAP =",VMAP,!
+"RTN","GPLPROBS",85,0)
+          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
+"RTN","GPLPROBS",86,0)
+          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
+"RTN","GPLPROBS",87,0)
+          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
+"RTN","GPLPROBS",88,0)
+          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
+"RTN","GPLPROBS",89,0)
+          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
+"RTN","GPLPROBS",90,0)
+          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",91,0)
+          . . . D CP^GPLXPATH("HOUT","HTMLO")
+"RTN","GPLPROBS",92,0)
+          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
+"RTN","GPLPROBS",93,0)
+          . . . W "DOING INNER",!
+"RTN","GPLPROBS",94,0)
+          . . . N HTMLBLD,HTMLTMP
+"RTN","GPLPROBS",95,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
+"RTN","GPLPROBS",96,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
+"RTN","GPLPROBS",97,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
+"RTN","GPLPROBS",98,0)
+          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
+"RTN","GPLPROBS",99,0)
+          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
+"RTN","GPLPROBS",100,0)
+          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
+"RTN","GPLPROBS",101,0)
+          . I DEBUG D PARY^GPLXPATH("HTMLO")
+"RTN","GPLPROBS",102,0)
+          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+"RTN","GPLPROBS",103,0)
+          N PROBSTMP,I
+"RTN","GPLPROBS",104,0)
+          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLPROBS",105,0)
+          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLPROBS",106,0)
+          . ; STRINGS MARKED AS @@X@@
+"RTN","GPLPROBS",107,0)
+          . W "PROBLEMS Missing list: ",!
+"RTN","GPLPROBS",108,0)
+          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
+"RTN","GPLPROBS",109,0)
+          Q
+"RTN","GPLPROBS",110,0)
+          ;
+"RTN","GPLRIMA")
+0^13^B96435476
+"RTN","GPLRIMA",1,0)
+GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+"RTN","GPLRIMA",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLRIMA",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLRIMA",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLRIMA",5,0)
+ ;
+"RTN","GPLRIMA",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLRIMA",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLRIMA",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLRIMA",9,0)
+ ;(at your option) any later version.
+"RTN","GPLRIMA",10,0)
+ ;
+"RTN","GPLRIMA",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLRIMA",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLRIMA",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLRIMA",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLRIMA",15,0)
+ ;
+"RTN","GPLRIMA",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLRIMA",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLRIMA",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLRIMA",19,0)
+ ;
+"RTN","GPLRIMA",20,0)
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+"RTN","GPLRIMA",21,0)
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+"RTN","GPLRIMA",22,0)
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+"RTN","GPLRIMA",23,0)
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+"RTN","GPLRIMA",24,0)
+ ; CONVEYED VIA THE CCR OR CCD.
+"RTN","GPLRIMA",25,0)
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+"RTN","GPLRIMA",26,0)
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+"RTN","GPLRIMA",27,0)
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+"RTN","GPLRIMA",28,0)
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+"RTN","GPLRIMA",29,0)
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+"RTN","GPLRIMA",30,0)
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+"RTN","GPLRIMA",31,0)
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+"RTN","GPLRIMA",32,0)
+ ;
+"RTN","GPLRIMA",33,0)
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+"RTN","GPLRIMA",34,0)
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+"RTN","GPLRIMA",35,0)
+ ;    CONVEYANCE TO THE RIM APPLICATION.
+"RTN","GPLRIMA",36,0)
+ ;
+"RTN","GPLRIMA",37,0)
+ ;
+"RTN","GPLRIMA",38,0)
+ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
+"RTN","GPLRIMA",39,0)
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+"RTN","GPLRIMA",40,0)
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+"RTN","GPLRIMA",41,0)
+    ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
+"RTN","GPLRIMA",42,0)
+    ;
+"RTN","GPLRIMA",43,0)
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+"RTN","GPLRIMA",44,0)
+    N CCRGLO
+"RTN","GPLRIMA",45,0)
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
+"RTN","GPLRIMA",46,0)
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+"RTN","GPLRIMA",47,0)
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+"RTN","GPLRIMA",48,0)
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+"RTN","GPLRIMA",49,0)
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+"RTN","GPLRIMA",50,0)
+    I RIMDFN="" S RIMDFN=RESUME
+"RTN","GPLRIMA",51,0)
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+"RTN","GPLRIMA",52,0)
+    . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
+"RTN","GPLRIMA",53,0)
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+"RTN","GPLRIMA",54,0)
+    . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
+"RTN","GPLRIMA",55,0)
+    . W RIMDFN,!
+"RTN","GPLRIMA",56,0)
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+"RTN","GPLRIMA",57,0)
+    . ;
+"RTN","GPLRIMA",58,0)
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
+"RTN","GPLRIMA",59,0)
+    . ;
+"RTN","GPLRIMA",60,0)
+    . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+"RTN","GPLRIMA",61,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
+"RTN","GPLRIMA",62,0)
+    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+"RTN","GPLRIMA",63,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
+"RTN","GPLRIMA",64,0)
+    . I $D(^TMP("GPLCCR",$J,"MEDICATIONS",1)) D  ; MEDS VARS EXISTS
+"RTN","GPLRIMA",65,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDICATIONS")
+"RTN","GPLRIMA",66,0)
+    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+"RTN","GPLRIMA",67,0)
+    . ;
+"RTN","GPLRIMA",68,0)
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+"RTN","GPLRIMA",69,0)
+    . ;
+"RTN","GPLRIMA",70,0)
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+"RTN","GPLRIMA",71,0)
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+"RTN","GPLRIMA",72,0)
+    . ;
+"RTN","GPLRIMA",73,0)
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
+"RTN","GPLRIMA",74,0)
+    . ;
+"RTN","GPLRIMA",75,0)
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+"RTN","GPLRIMA",76,0)
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+"RTN","GPLRIMA",77,0)
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+"RTN","GPLRIMA",78,0)
+    . ;
+"RTN","GPLRIMA",79,0)
+    . N CATNAME,CATTBL
+"RTN","GPLRIMA",80,0)
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+"RTN","GPLRIMA",81,0)
+    . S CATNAME=""
+"RTN","GPLRIMA",82,0)
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+"RTN","GPLRIMA",83,0)
+    . W "CATEGORY NAME: ",CATNAME,!
+"RTN","GPLRIMA",84,0)
+    . ;
+"RTN","GPLRIMA",85,0)
+    . S RIMDFN=$O(^DPT(RIMDFN)) ; NEXT PATIENT
+"RTN","GPLRIMA",86,0)
+    S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+"RTN","GPLRIMA",87,0)
+    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
+"RTN","GPLRIMA",88,0)
+    Q
+"RTN","GPLRIMA",89,0)
+    ;
+"RTN","GPLRIMA",90,0)
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+"RTN","GPLRIMA",91,0)
+    N SBASE,SATTR
+"RTN","GPLRIMA",92,0)
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+"RTN","GPLRIMA",93,0)
+    D APOST("SATTR","RIMTBL","HEADER")
+"RTN","GPLRIMA",94,0)
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+"RTN","GPLRIMA",95,0)
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+"RTN","GPLRIMA",96,0)
+    . W "POSTING PROBLEMS",!
+"RTN","GPLRIMA",97,0)
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+"RTN","GPLRIMA",98,0)
+    I $D(@SBASE@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS")
+"RTN","GPLRIMA",99,0)
+    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+"RTN","GPLRIMA",100,0)
+    W "ATTRIBUTES: ",SATTR,!
+"RTN","GPLRIMA",101,0)
+    Q SATTR
+"RTN","GPLRIMA",102,0)
+    ;
+"RTN","GPLRIMA",103,0)
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+"RTN","GPLRIMA",104,0)
+    K ^TMP("GPLRIM","RESUME")
+"RTN","GPLRIMA",105,0)
+    K ^TMP("GPLRIM")
+"RTN","GPLRIMA",106,0)
+    Q
+"RTN","GPLRIMA",107,0)
+    ;
+"RTN","GPLRIMA",108,0)
+CLIST ; LIST THE CATEGORIES
+"RTN","GPLRIMA",109,0)
+    ;
+"RTN","GPLRIMA",110,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",111,0)
+    N CLBASE,CLNUM,ZI,CLIDX
+"RTN","GPLRIMA",112,0)
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+"RTN","GPLRIMA",113,0)
+    S CLNUM=@CLBASE@(0)
+"RTN","GPLRIMA",114,0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+"RTN","GPLRIMA",115,0)
+    . S CLIDX=@CLBASE@(ZI)
+"RTN","GPLRIMA",116,0)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+"RTN","GPLRIMA",117,0)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+"RTN","GPLRIMA",118,0)
+    . W CLIDX,!
+"RTN","GPLRIMA",119,0)
+    ; D PARY^GPLXPATH(CLBASE)
+"RTN","GPLRIMA",120,0)
+    Q
+"RTN","GPLRIMA",121,0)
+    ;
+"RTN","GPLRIMA",122,0)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+"RTN","GPLRIMA",123,0)
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+"RTN","GPLRIMA",124,0)
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+"RTN","GPLRIMA",125,0)
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+"RTN","GPLRIMA",126,0)
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+"RTN","GPLRIMA",127,0)
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+"RTN","GPLRIMA",128,0)
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+"RTN","GPLRIMA",129,0)
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+"RTN","GPLRIMA",130,0)
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+"RTN","GPLRIMA",131,0)
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+"RTN","GPLRIMA",132,0)
+    ; NUMBER IE CTBL_X(CDFN)=""
+"RTN","GPLRIMA",133,0)
+    ;
+"RTN","GPLRIMA",134,0)
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+"RTN","GPLRIMA",135,0)
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+"RTN","GPLRIMA",136,0)
+    W "CBASE: ",CCTBL,!
+"RTN","GPLRIMA",137,0)
+    ;
+"RTN","GPLRIMA",138,0)
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+"RTN","GPLRIMA",139,0)
+    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+"RTN","GPLRIMA",140,0)
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+"RTN","GPLRIMA",141,0)
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+"RTN","GPLRIMA",142,0)
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+"RTN","GPLRIMA",143,0)
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+"RTN","GPLRIMA",144,0)
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+"RTN","GPLRIMA",145,0)
+    ;
+"RTN","GPLRIMA",146,0)
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+"RTN","GPLRIMA",147,0)
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",148,0)
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+"RTN","GPLRIMA",149,0)
+    ;
+"RTN","GPLRIMA",150,0)
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+"RTN","GPLRIMA",151,0)
+    ;
+"RTN","GPLRIMA",152,0)
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+"RTN","GPLRIMA",153,0)
+    W "PATS BASE: ",CPATLIST,!
+"RTN","GPLRIMA",154,0)
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+"RTN","GPLRIMA",155,0)
+    ;
+"RTN","GPLRIMA",156,0)
+    Q
+"RTN","GPLRIMA",157,0)
+    ;
+"RTN","GPLRIMA",158,0)
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+"RTN","GPLRIMA",159,0)
+    ;
+"RTN","GPLRIMA",160,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",161,0)
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+"RTN","GPLRIMA",162,0)
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+"RTN","GPLRIMA",163,0)
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+"RTN","GPLRIMA",164,0)
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+"RTN","GPLRIMA",165,0)
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+"RTN","GPLRIMA",166,0)
+    . S ZCNT=0
+"RTN","GPLRIMA",167,0)
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+"RTN","GPLRIMA",168,0)
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+"RTN","GPLRIMA",169,0)
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+"RTN","GPLRIMA",170,0)
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+"RTN","GPLRIMA",171,0)
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",172,0)
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+"RTN","GPLRIMA",173,0)
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+"RTN","GPLRIMA",174,0)
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+"RTN","GPLRIMA",175,0)
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+"RTN","GPLRIMA",176,0)
+    . S ZTOT=ZTOT+ZCNT
+"RTN","GPLRIMA",177,0)
+    W "TOTAL: ",ZTOT,!
+"RTN","GPLRIMA",178,0)
+    Q
+"RTN","GPLRIMA",179,0)
+    ;
+"RTN","GPLRIMA",180,0)
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+"RTN","GPLRIMA",181,0)
+    ; INLST IS PASSED BY NAME
+"RTN","GPLRIMA",182,0)
+    N ZI,ZDX,ZCOUNT
+"RTN","GPLRIMA",183,0)
+    W INLST,!
+"RTN","GPLRIMA",184,0)
+    S ZCOUNT=0
+"RTN","GPLRIMA",185,0)
+    S ZDX=""
+"RTN","GPLRIMA",186,0)
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+"RTN","GPLRIMA",187,0)
+    . S ZCOUNT=ZCOUNT+1
+"RTN","GPLRIMA",188,0)
+    . S ZDX=$O(@INLST@(ZDX))
+"RTN","GPLRIMA",189,0)
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+"RTN","GPLRIMA",190,0)
+    Q ZCOUNT
+"RTN","GPLRIMA",191,0)
+    ;
+"RTN","GPLRIMA",192,0)
+XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+"RTN","GPLRIMA",193,0)
+    ;
+"RTN","GPLRIMA",194,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",195,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",196,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",197,0)
+    S ZI=""
+"RTN","GPLRIMA",198,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",199,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",200,0)
+    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
+"RTN","GPLRIMA",201,0)
+    Q
+"RTN","GPLRIMA",202,0)
+    ;
+"RTN","GPLRIMA",203,0)
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+"RTN","GPLRIMA",204,0)
+    ;
+"RTN","GPLRIMA",205,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",206,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",207,0)
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+"RTN","GPLRIMA",208,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",209,0)
+    S ZI=""
+"RTN","GPLRIMA",210,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",211,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",212,0)
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+"RTN","GPLRIMA",213,0)
+    . W ZI," "
+"RTN","GPLRIMA",214,0)
+    . I ZC=10 D  ; NEW LINE
+"RTN","GPLRIMA",215,0)
+    . . S ZC=0
+"RTN","GPLRIMA",216,0)
+    . . W !
+"RTN","GPLRIMA",217,0)
+    Q
+"RTN","GPLRIMA",218,0)
+    ;
+"RTN","GPLRIMA",219,0)
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+"RTN","GPLRIMA",220,0)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+"RTN","GPLRIMA",221,0)
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+"RTN","GPLRIMA",222,0)
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+"RTN","GPLRIMA",223,0)
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+"RTN","GPLRIMA",224,0)
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+"RTN","GPLRIMA",225,0)
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+"RTN","GPLRIMA",226,0)
+    ;
+"RTN","GPLRIMA",227,0)
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+"RTN","GPLRIMA",228,0)
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+"RTN","GPLRIMA",229,0)
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+"RTN","GPLRIMA",230,0)
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+"RTN","GPLRIMA",231,0)
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+"RTN","GPLRIMA",232,0)
+    Q
+"RTN","GPLRIMA",233,0)
+    ;
+"RTN","GPLRIMA",234,0)
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+"RTN","GPLRIMA",235,0)
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
+"RTN","GPLRIMA",236,0)
+      I '$D(@RIMBASE) S @RIMBASE=""
+"RTN","GPLRIMA",237,0)
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
+"RTN","GPLRIMA",238,0)
+      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+"RTN","GPLRIMA",239,0)
+      Q
+"RTN","GPLRIMA",240,0)
+      ;
+"RTN","GPLRIMA",241,0)
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+"RTN","GPLRIMA",242,0)
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",243,0)
+      K @RIMTBL
+"RTN","GPLRIMA",244,0)
+      D APUSH(RIMTBL,"EXTRACTED")
+"RTN","GPLRIMA",245,0)
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+"RTN","GPLRIMA",246,0)
+      D APUSH(RIMTBL,"HEADER")
+"RTN","GPLRIMA",247,0)
+      D APUSH(RIMTBL,"NOPCP")
+"RTN","GPLRIMA",248,0)
+      D APUSH(RIMTBL,"PCP")
+"RTN","GPLRIMA",249,0)
+      D APUSH(RIMTBL,"PROBLEMS")
+"RTN","GPLRIMA",250,0)
+      D APUSH(RIMTBL,"PROBCODE")
+"RTN","GPLRIMA",251,0)
+      D APUSH(RIMTBL,"PROBNOCODE")
+"RTN","GPLRIMA",252,0)
+      D APUSH(RIMTBL,"PROBDATE")
+"RTN","GPLRIMA",253,0)
+      D APUSH(RIMTBL,"PROBNODATE")
+"RTN","GPLRIMA",254,0)
+      D APUSH(RIMTBL,"VITALS")
+"RTN","GPLRIMA",255,0)
+      D APUSH(RIMTBL,"VITALSCODE")
+"RTN","GPLRIMA",256,0)
+      D APUSH(RIMTBL,"VITALSNOCODE")
+"RTN","GPLRIMA",257,0)
+      D APUSH(RIMTBL,"VITALSDATE")
+"RTN","GPLRIMA",258,0)
+      D APUSH(RIMTBL,"VITALSNODATE")
+"RTN","GPLRIMA",259,0)
+      D APUSH(RIMTBL,"MEDS")
+"RTN","GPLRIMA",260,0)
+      D APUSH(RIMTBL,"MEDSCODE")
+"RTN","GPLRIMA",261,0)
+      D APUSH(RIMTBL,"MEDSNOCODE")
+"RTN","GPLRIMA",262,0)
+      D APUSH(RIMTBL,"MEDSDATE")
+"RTN","GPLRIMA",263,0)
+      D APUSH(RIMTBL,"MEDSNODATE")
+"RTN","GPLRIMA",264,0)
+      Q
+"RTN","GPLRIMA",265,0)
+      ;
+"RTN","GPLRIMA",266,0)
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+"RTN","GPLRIMA",267,0)
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+"RTN","GPLRIMA",268,0)
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+"RTN","GPLRIMA",269,0)
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+"RTN","GPLRIMA",270,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+"RTN","GPLRIMA",271,0)
+    N USETBL
+"RTN","GPLRIMA",272,0)
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+"RTN","GPLRIMA",273,0)
+    . W "ERROR NO SUCH TABLE",!
+"RTN","GPLRIMA",274,0)
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+"RTN","GPLRIMA",275,0)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+"RTN","GPLRIMA",276,0)
+    Q
+"RTN","GPLUNIT")
+0^10^B31630479
+"RTN","GPLUNIT",1,0)
+GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
+"RTN","GPLUNIT",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLUNIT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLUNIT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLUNIT",5,0)
+ ;
+"RTN","GPLUNIT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLUNIT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLUNIT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLUNIT",9,0)
+ ;(at your option) any later version.
+"RTN","GPLUNIT",10,0)
+ ;
+"RTN","GPLUNIT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLUNIT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLUNIT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLUNIT",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLUNIT",15,0)
+ ;
+"RTN","GPLUNIT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLUNIT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLUNIT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLUNIT",19,0)
+ ;
+"RTN","GPLUNIT",20,0)
+          W "This is a unit testing library",!
+"RTN","GPLUNIT",21,0)
+          W !
+"RTN","GPLUNIT",22,0)
+          Q
+"RTN","GPLUNIT",23,0)
+          ;
+"RTN","GPLUNIT",24,0)
+ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
+"RTN","GPLUNIT",25,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",26,0)
+          ; BAT is a string identifying the test battery
+"RTN","GPLUNIT",27,0)
+          ; TST is a test which will evaluate to true or false
+"RTN","GPLUNIT",28,0)
+          ; I '$G(ZARY) D
+"RTN","GPLUNIT",29,0)
+          ; . S ZARY(0)=0 ; initially there are no elements
+"RTN","GPLUNIT",30,0)
+          ; W "GOT HERE LOADING "_TST,!
+"RTN","GPLUNIT",31,0)
+          N CNT ; count of array elements
+"RTN","GPLUNIT",32,0)
+          S CNT=ZARY(0) ; contains array count
+"RTN","GPLUNIT",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLUNIT",34,0)
+          S ZARY(CNT)=TST ; put the test in the array
+"RTN","GPLUNIT",35,0)
+          I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
+"RTN","GPLUNIT",36,0)
+          . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+"RTN","GPLUNIT",37,0)
+          . S II=$P(ZARY(BAT),"^",2)
+"RTN","GPLUNIT",38,0)
+          . S $P(ZARY(BAT),"^",2)=II+1
+"RTN","GPLUNIT",39,0)
+          I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
+"RTN","GPLUNIT",40,0)
+          . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+"RTN","GPLUNIT",41,0)
+          . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+"RTN","GPLUNIT",42,0)
+          . ; S TN=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",43,0)
+          . ; D PUSH^GPLXPATH(TN,BAT)
+"RTN","GPLUNIT",44,0)
+          S ZARY(0)=CNT ; update the array counter
+"RTN","GPLUNIT",45,0)
+          Q
+"RTN","GPLUNIT",46,0)
+          ;
+"RTN","GPLUNIT",47,0)
+ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
+"RTN","GPLUNIT",48,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLUNIT",49,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLUNIT",50,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLUNIT",51,0)
+          K @ZARY
+"RTN","GPLUNIT",52,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLUNIT",53,0)
+          N LINE,LABEL,BODY
+"RTN","GPLUNIT",54,0)
+          N INTEST S INTEST=0 ; switch for in the test case section
+"RTN","GPLUNIT",55,0)
+          N SECTION S SECTION="[anonymous]" ; test case section
+"RTN","GPLUNIT",56,0)
+          ;
+"RTN","GPLUNIT",57,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLUNIT",58,0)
+          . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
+"RTN","GPLUNIT",59,0)
+          . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+"RTN","GPLUNIT",60,0)
+          . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+"RTN","GPLUNIT",61,0)
+          . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
+"RTN","GPLUNIT",62,0)
+          . I INTEST  D  ; within the testing section
+"RTN","GPLUNIT",63,0)
+          . . I LINE?." "1";;><".E  D  ; section name found
+"RTN","GPLUNIT",64,0)
+          . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+"RTN","GPLUNIT",65,0)
+          . . I LINE?." "1";;>>".E  D  ; test case found
+"RTN","GPLUNIT",66,0)
+          . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+"RTN","GPLUNIT",67,0)
+          S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+"RTN","GPLUNIT",68,0)
+          Q
+"RTN","GPLUNIT",69,0)
+          ;
+"RTN","GPLUNIT",70,0)
+ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+"RTN","GPLUNIT",71,0)
+          N ZI,ZX,ZR,ZP
+"RTN","GPLUNIT",72,0)
+          S DEBUG=0
+"RTN","GPLUNIT",73,0)
+          ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+"RTN","GPLUNIT",74,0)
+          ; . W "DOING ALL",!
+"RTN","GPLUNIT",75,0)
+          ; . N J,NT
+"RTN","GPLUNIT",76,0)
+          ; . S NT=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",77,0)
+          ; . W NT,@NT@(0),!
+"RTN","GPLUNIT",78,0)
+          ; . F J=1:1:@NT@(0) D  ;
+"RTN","GPLUNIT",79,0)
+          ; . . W @NT@(J),!
+"RTN","GPLUNIT",80,0)
+          ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
+"RTN","GPLUNIT",81,0)
+          I '$D(ZARY(WHICH))  D  ; TEST SECTION DOESN'T EXIST
+"RTN","GPLUNIT",82,0)
+          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+"RTN","GPLUNIT",83,0)
+          . Q  ; EXIT
+"RTN","GPLUNIT",84,0)
+          N FIRST,LAST
+"RTN","GPLUNIT",85,0)
+          S FIRST=$P(ZARY(WHICH),"^",1)
+"RTN","GPLUNIT",86,0)
+          S LAST=$P(ZARY(WHICH),"^",2)
+"RTN","GPLUNIT",87,0)
+          F ZI=FIRST:1:LAST  D
+"RTN","GPLUNIT",88,0)
+          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+"RTN","GPLUNIT",89,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",90,0)
+          . . ;  W ZP,!
+"RTN","GPLUNIT",91,0)
+          . . S ZX=ZP
+"RTN","GPLUNIT",92,0)
+          . . W "RUNNING: "_ZP
+"RTN","GPLUNIT",93,0)
+          . . X ZX
+"RTN","GPLUNIT",94,0)
+          . . W "..SUCCESS: ",WHICH,!
+"RTN","GPLUNIT",95,0)
+          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+"RTN","GPLUNIT",96,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",97,0)
+          . . S ZX="S ZR="_ZP
+"RTN","GPLUNIT",98,0)
+          . . W "TRYING: "_ZP
+"RTN","GPLUNIT",99,0)
+          . . X ZX
+"RTN","GPLUNIT",100,0)
+          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+"RTN","GPLUNIT",101,0)
+          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+"RTN","GPLUNIT",102,0)
+          . . . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",103,0)
+          . . I ZR S TPASSED=TPASSED+1
+"RTN","GPLUNIT",104,0)
+          . . I 'ZR S TFAILED=TFAILED+1
+"RTN","GPLUNIT",105,0)
+          Q
+"RTN","GPLUNIT",106,0)
+          ;
+"RTN","GPLUNIT",107,0)
+TEST   ; RUN ALL THE TEST CASES
+"RTN","GPLUNIT",108,0)
+          N ZTMP
+"RTN","GPLUNIT",109,0)
+          D ZLOAD(.ZTMP)
+"RTN","GPLUNIT",110,0)
+          D ZTEST(.ZTMP,"ALL")
+"RTN","GPLUNIT",111,0)
+          W "PASSED: ",TPASSED,!
+"RTN","GPLUNIT",112,0)
+          W "FAILED: ",TFAILED,!
+"RTN","GPLUNIT",113,0)
+          W !
+"RTN","GPLUNIT",114,0)
+          W "THE TESTS!",!
+"RTN","GPLUNIT",115,0)
+          ; I DEBUG ZWR ZTMP
+"RTN","GPLUNIT",116,0)
+          Q
+"RTN","GPLUNIT",117,0)
+          ;
+"RTN","GPLUNIT",118,0)
+GTSTS(GTZARY,RTN) ; return an array of test names
+"RTN","GPLUNIT",119,0)
+          N I,J S I="" S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",120,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",121,0)
+          . D PUSH^GPLXPATH(RTN,I)
+"RTN","GPLUNIT",122,0)
+          . S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",123,0)
+          Q
+"RTN","GPLUNIT",124,0)
+          ;
+"RTN","GPLUNIT",125,0)
+TESTALL(RNM) ; RUN ALL THE TESTS
+"RTN","GPLUNIT",126,0)
+          N ZI,J,TZTMP,TSTS,TOTP,TOTF
+"RTN","GPLUNIT",127,0)
+          S TOTP=0 S TOTF=0
+"RTN","GPLUNIT",128,0)
+          D ZLOAD^GPLUNIT("TZTMP",RNM)
+"RTN","GPLUNIT",129,0)
+          D GTSTS(.TZTMP,"TSTS")
+"RTN","GPLUNIT",130,0)
+          F ZI=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",131,0)
+          . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",132,0)
+          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
+"RTN","GPLUNIT",133,0)
+          . S TOTP=TOTP+TPASSED
+"RTN","GPLUNIT",134,0)
+          . S TOTF=TOTF+TFAILED
+"RTN","GPLUNIT",135,0)
+          . S $P(TSTS(ZI),"^",2)=TPASSED
+"RTN","GPLUNIT",136,0)
+          . S $P(TSTS(ZI),"^",3)=TFAILED
+"RTN","GPLUNIT",137,0)
+          F I=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",138,0)
+          . W "TEST=> ",$P(TSTS(ZI),"^",1)
+"RTN","GPLUNIT",139,0)
+          . W " PASSED=>",$P(TSTS(ZI),"^",2)
+"RTN","GPLUNIT",140,0)
+          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+"RTN","GPLUNIT",141,0)
+          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+"RTN","GPLUNIT",142,0)
+          Q
+"RTN","GPLUNIT",143,0)
+          ;
+"RTN","GPLUNIT",144,0)
+TLIST(ZARY) ; LIST ALL THE TESTS
+"RTN","GPLUNIT",145,0)
+          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
+"RTN","GPLUNIT",146,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",147,0)
+          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",148,0)
+          S K=1
+"RTN","GPLUNIT",149,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",150,0)
+          . ; W "I IS NOW=",I,!
+"RTN","GPLUNIT",151,0)
+          . W I," "
+"RTN","GPLUNIT",152,0)
+          . S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",153,0)
+          . S K=K+1 I K=6  D
+"RTN","GPLUNIT",154,0)
+          . . W !
+"RTN","GPLUNIT",155,0)
+          . . S K=1
+"RTN","GPLUNIT",156,0)
+          Q
+"RTN","GPLUNIT",157,0)
+          ;
+"RTN","GPLVITAL")
+0^12^B98509194
+"RTN","GPLVITAL",1,0)
+GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+"RTN","GPLVITAL",2,0)
+          ;;0.1;CCDCCR;;JUL 16,2008;Build 3
+"RTN","GPLVITAL",3,0)
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLVITAL",4,0)
+          ;General Public License See attached copy of the License.
+"RTN","GPLVITAL",5,0)
+          ;
+"RTN","GPLVITAL",6,0)
+          ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLVITAL",7,0)
+          ;it under the terms of the GNU General Public License as published by
+"RTN","GPLVITAL",8,0)
+          ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLVITAL",9,0)
+          ;(at your option) any later version.
+"RTN","GPLVITAL",10,0)
+          ;
+"RTN","GPLVITAL",11,0)
+          ;This program is distributed in the hope that it will be useful,
+"RTN","GPLVITAL",12,0)
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLVITAL",13,0)
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLVITAL",14,0)
+          ;GNU General Public License for more details.
+"RTN","GPLVITAL",15,0)
+          ;
+"RTN","GPLVITAL",16,0)
+          ;You should have received a copy of the GNU General Public License along
+"RTN","GPLVITAL",17,0)
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLVITAL",18,0)
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLVITAL",19,0)
+          ;
+"RTN","GPLVITAL",20,0)
+          W "NO ENTRY FROM TOP",!
+"RTN","GPLVITAL",21,0)
+          Q
+"RTN","GPLVITAL",22,0)
+          ;
+"RTN","GPLVITAL",23,0)
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+"RTN","GPLVITAL",24,0)
+          ;
+"RTN","GPLVITAL",25,0)
+          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLVITAL",26,0)
+          ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLVITAL",27,0)
+          ;
+"RTN","GPLVITAL",28,0)
+          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
+"RTN","GPLVITAL",29,0)
+          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+"RTN","GPLVITAL",30,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." D  ; NULL RESULT FROM RPC
+"RTN","GPLVITAL",31,0)
+          . W "NO VITALS FOUND FROM VITALS RPC",!
+"RTN","GPLVITAL",32,0)
+          . S @VITOUTXML@(0)=0
+"RTN","GPLVITAL",33,0)
+          . Q
+"RTN","GPLVITAL",34,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
+"RTN","GPLVITAL",35,0)
+          ; ZWR RPCRSLT
+"RTN","GPLVITAL",36,0)
+          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
+"RTN","GPLVITAL",37,0)
+          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
+"RTN","GPLVITAL",38,0)
+          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLVITAL",39,0)
+          N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+"RTN","GPLVITAL",40,0)
+          D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","GPLVITAL",41,0)
+          ; I DEBUG ZWR VDATES ;DEBUG
+"RTN","GPLVITAL",42,0)
+          S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+"RTN","GPLVITAL",43,0)
+          ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+"RTN","GPLVITAL",44,0)
+          F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+"RTN","GPLVITAL",45,0)
+          . I $D(VITRSLT(VSORT(J))) D
+"RTN","GPLVITAL",46,0)
+          . . S VITVMAP=$NA(@VITTVMAP@(J))
+"RTN","GPLVITAL",47,0)
+          . . K @VITVMAP
+"RTN","GPLVITAL",48,0)
+          . . I DEBUG W "VMAP= ",VITVMAP,!
+"RTN","GPLVITAL",49,0)
+          . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
+"RTN","GPLVITAL",50,0)
+          . . I DEBUG W "VITAL ",VSORT(J),!
+"RTN","GPLVITAL",51,0)
+          . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
+"RTN","GPLVITAL",52,0)
+          . . I DEBUG W $P(VITPTMP,U,4),!
+"RTN","GPLVITAL",53,0)
+          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+"RTN","GPLVITAL",54,0)
+          . . I $P(VITPTMP,U,2)="HT" D
+"RTN","GPLVITAL",55,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",56,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",57,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",58,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",59,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",60,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",61,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",62,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
+"RTN","GPLVITAL",63,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",64,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",65,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",66,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",67,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+"RTN","GPLVITAL",68,0)
+          . . E  I $P(VITPTMP,U,2)="WT" D
+"RTN","GPLVITAL",69,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",70,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",71,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",72,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",73,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",74,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",75,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",76,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
+"RTN","GPLVITAL",77,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",78,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",79,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",80,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",81,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+"RTN","GPLVITAL",82,0)
+          . . E  I $P(VITPTMP,U,2)="BP" D
+"RTN","GPLVITAL",83,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",84,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",85,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",86,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",87,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",88,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",89,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",90,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
+"RTN","GPLVITAL",91,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",92,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",93,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",94,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",95,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",96,0)
+          . . E  I $P(VITPTMP,U,2)="T" D
+"RTN","GPLVITAL",97,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",98,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",99,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",100,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",101,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",102,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",103,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",104,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
+"RTN","GPLVITAL",105,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",106,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",107,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",108,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",109,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+"RTN","GPLVITAL",110,0)
+          . . E  I $P(VITPTMP,U,2)="R" D
+"RTN","GPLVITAL",111,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",112,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",113,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",114,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",115,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",116,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",117,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",118,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
+"RTN","GPLVITAL",119,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",120,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",121,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",122,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",123,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",124,0)
+          . . E  I $P(VITPTMP,U,2)="P" D
+"RTN","GPLVITAL",125,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",126,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",127,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",128,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",129,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",130,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",131,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",132,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
+"RTN","GPLVITAL",133,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",134,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",135,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",136,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",137,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",138,0)
+          . . E  I $P(VITPTMP,U,2)="PN" D
+"RTN","GPLVITAL",139,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",140,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",141,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",142,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",143,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",144,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",145,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",146,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
+"RTN","GPLVITAL",147,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",148,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",149,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",150,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",151,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",152,0)
+          . . E  D
+"RTN","GPLVITAL",153,0)
+          . . . ;W "IN VITAL:  OTHER",!
+"RTN","GPLVITAL",154,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",155,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",156,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+"RTN","GPLVITAL",157,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",158,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",159,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+"RTN","GPLVITAL",160,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+"RTN","GPLVITAL",161,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+"RTN","GPLVITAL",162,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+"RTN","GPLVITAL",163,0)
+          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",164,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",165,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",166,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+"RTN","GPLVITAL",167,0)
+          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+"RTN","GPLVITAL",168,0)
+          . . K @VITARYTMP
+"RTN","GPLVITAL",169,0)
+          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
+"RTN","GPLVITAL",170,0)
+          . . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLVITAL",171,0)
+          . . . ; W "FIRST ONE",!
+"RTN","GPLVITAL",172,0)
+          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
+"RTN","GPLVITAL",173,0)
+          . . . W "VITOUTXML ",VITOUTXML,!
+"RTN","GPLVITAL",174,0)
+          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLVITAL",175,0)
+          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
+"RTN","GPLVITAL",176,0)
+          ; ZWR ^TMP($J,"VITALS",*)
+"RTN","GPLVITAL",177,0)
+          ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLVITAL",178,0)
+          I DEBUG D PARY^GPLXPATH(VITOUTXML)
+"RTN","GPLVITAL",179,0)
+          N VITTMP,I
+"RTN","GPLVITAL",180,0)
+          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLVITAL",181,0)
+          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLVITAL",182,0)
+          . W "VITALS MISSING ",!
+"RTN","GPLVITAL",183,0)
+          . F I=1:1:VITTMP(0) W VITTMP(I),!
+"RTN","GPLVITAL",184,0)
+          Q
+"RTN","GPLVITAL",185,0)
+          ;
+"RTN","GPLVITAL",186,0)
+VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+"RTN","GPLVITAL",187,0)
+         ; OF DATES IN THE VITALS RESULTS
+"RTN","GPLVITAL",188,0)
+         N VDTI,VDTJ,VTDCNT
+"RTN","GPLVITAL",189,0)
+         S VTDCNT=0 ; COUNT TO BUILD ARRAY
+"RTN","GPLVITAL",190,0)
+         S VDTJ="" ; USED TO VISIT THE RESULTS
+"RTN","GPLVITAL",191,0)
+         F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","GPLVITAL",192,0)
+         . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
+"RTN","GPLVITAL",193,0)
+         . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+"RTN","GPLVITAL",194,0)
+         . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","GPLVITAL",195,0)
+         Q
+"RTN","GPLVITAL",196,0)
+         ;
+"RTN","GPLXPAT0")
+0^19^B44173297
+"RTN","GPLXPAT0",1,0)
+GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
+"RTN","GPLXPAT0",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLXPAT0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPAT0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPAT0",5,0)
+ ;
+"RTN","GPLXPAT0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPAT0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPAT0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPAT0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPAT0",10,0)
+ ;
+"RTN","GPLXPAT0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPAT0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPAT0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPAT0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPAT0",15,0)
+ ;
+"RTN","GPLXPAT0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPAT0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPAT0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPAT0",19,0)
+ ;
+"RTN","GPLXPAT0",20,0)
+        W "NO ENTRY",!
+"RTN","GPLXPAT0",21,0)
+        Q
+"RTN","GPLXPAT0",22,0)
+        ;
+"RTN","GPLXPAT0",23,0)
+ ;;><TEST>
+"RTN","GPLXPAT0",24,0)
+ ;;><INIT>
+"RTN","GPLXPAT0",25,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLXPAT0",26,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FIRST")
+"RTN","GPLXPAT0",27,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","SECOND")
+"RTN","GPLXPAT0",28,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","THIRD")
+"RTN","GPLXPAT0",29,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
+"RTN","GPLXPAT0",30,0)
+ ;;>>?GPL(0)=4
+"RTN","GPLXPAT0",31,0)
+ ;;><INITXML>
+"RTN","GPLXPAT0",32,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",33,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",34,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",35,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",36,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
+"RTN","GPLXPAT0",37,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
+"RTN","GPLXPAT0",38,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
+"RTN","GPLXPAT0",39,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
+"RTN","GPLXPAT0",40,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
+"RTN","GPLXPAT0",41,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",42,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",43,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",44,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",45,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",46,0)
+ ;;><INITXML2>
+"RTN","GPLXPAT0",47,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",48,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",49,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",50,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",51,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
+"RTN","GPLXPAT0",52,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
+"RTN","GPLXPAT0",53,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","DATA2")
+"RTN","GPLXPAT0",54,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
+"RTN","GPLXPAT0",55,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",56,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
+"RTN","GPLXPAT0",57,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
+"RTN","GPLXPAT0",58,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
+"RTN","GPLXPAT0",59,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",60,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",61,0)
+ ;;><PUSHPOP>
+"RTN","GPLXPAT0",62,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",63,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",64,0)
+ ;;>>?GPL(GPL(0))="FOURTH"
+"RTN","GPLXPAT0",65,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",66,0)
+ ;;>>?GX="FOURTH"
+"RTN","GPLXPAT0",67,0)
+ ;;>>?GPL(GPL(0))="THIRD"
+"RTN","GPLXPAT0",68,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",69,0)
+ ;;>>?GX="THIRD"
+"RTN","GPLXPAT0",70,0)
+ ;;>>?GPL(GPL(0))="SECOND"
+"RTN","GPLXPAT0",71,0)
+ ;;><MKMDX>
+"RTN","GPLXPAT0",72,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",73,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",74,0)
+ ;;>>>S GX=""
+"RTN","GPLXPAT0",75,0)
+ ;;>>>D MKMDX^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",76,0)
+ ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
+"RTN","GPLXPAT0",77,0)
+ ;;><XNAME>
+"RTN","GPLXPAT0",78,0)
+ ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
+"RTN","GPLXPAT0",79,0)
+ ;;>>?$$XNAME^GPLXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
+"RTN","GPLXPAT0",80,0)
+ ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
+"RTN","GPLXPAT0",81,0)
+ ;;><INDEX>
+"RTN","GPLXPAT0",82,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",83,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
+"RTN","GPLXPAT0",84,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",85,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",86,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
+"RTN","GPLXPAT0",87,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
+"RTN","GPLXPAT0",88,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
+"RTN","GPLXPAT0",89,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
+"RTN","GPLXPAT0",90,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",91,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",92,0)
+ ;;><INDEX2>
+"RTN","GPLXPAT0",93,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML2")
+"RTN","GPLXPAT0",94,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",95,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",96,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
+"RTN","GPLXPAT0",97,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
+"RTN","GPLXPAT0",98,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
+"RTN","GPLXPAT0",99,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
+"RTN","GPLXPAT0",100,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",101,0)
+ ;;><MISSING>
+"RTN","GPLXPAT0",102,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",103,0)
+ ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
+"RTN","GPLXPAT0",104,0)
+ ;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
+"RTN","GPLXPAT0",105,0)
+ ;;>>?@OUTARY@(1)="DATA1"
+"RTN","GPLXPAT0",106,0)
+ ;;>>?@OUTARY@(2)="DATA2"
+"RTN","GPLXPAT0",107,0)
+ ;;><MAP>
+"RTN","GPLXPAT0",108,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",109,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",110,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",111,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",112,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",113,0)
+ ;;>>?@OUTARY@(6)="VALUE2"
+"RTN","GPLXPAT0",114,0)
+ ;;><MAP2>
+"RTN","GPLXPAT0",115,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",116,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",117,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",118,0)
+ ;;>>>S @MAPARY@("DATA1")="VALUE1"
+"RTN","GPLXPAT0",119,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",120,0)
+ ;;>>>S @MAPARY@("DATA3")="VALUE3"
+"RTN","GPLXPAT0",121,0)
+ ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
+"RTN","GPLXPAT0",122,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",123,0)
+ ;;>>>D PARY^GPLXPATH(OUTARY)
+"RTN","GPLXPAT0",124,0)
+ ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
+"RTN","GPLXPAT0",125,0)
+ ;;><QUEUE>
+"RTN","GPLXPAT0",126,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
+"RTN","GPLXPAT0",127,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
+"RTN","GPLXPAT0",128,0)
+ ;;>>?$P(BTLIST(2),";",2)=4
+"RTN","GPLXPAT0",129,0)
+ ;;><BUILD>
+"RTN","GPLXPAT0",130,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",131,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
+"RTN","GPLXPAT0",132,0)
+ ;;>>>D ZTEST^GPLXPATH("QUEUE")
+"RTN","GPLXPAT0",133,0)
+ ;;>>>D BUILD^GPLXPATH("BTLIST","G3")
+"RTN","GPLXPAT0",134,0)
+ ;;><CP>
+"RTN","GPLXPAT0",135,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",136,0)
+ ;;>>>D CP^GPLXPATH("GXML","G2")
+"RTN","GPLXPAT0",137,0)
+ ;;>>?G2(0)=13
+"RTN","GPLXPAT0",138,0)
+ ;;><QOPEN>
+"RTN","GPLXPAT0",139,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",140,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",141,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",142,0)
+ ;;>>?$P(GBL(1),";",3)=12
+"RTN","GPLXPAT0",143,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",144,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",145,0)
+ ;;><QOPEN2>
+"RTN","GPLXPAT0",146,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",147,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",148,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
+"RTN","GPLXPAT0",149,0)
+ ;;>>?$P(GBL(1),";",3)=11
+"RTN","GPLXPAT0",150,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",151,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",152,0)
+ ;;><QCLOSE>
+"RTN","GPLXPAT0",153,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",154,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",155,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",156,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",157,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",158,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",159,0)
+ ;;><QCLOSE2>
+"RTN","GPLXPAT0",160,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",161,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",162,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",163,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",164,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",165,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",166,0)
+ ;;>>?G2(1)="</THIRD>"
+"RTN","GPLXPAT0",167,0)
+ ;;><INSERT>
+"RTN","GPLXPAT0",168,0)
+ ;;>>>K G2,GBL,G3,G4
+"RTN","GPLXPAT0",169,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",170,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",171,0)
+ ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",172,0)
+ ;;>>>D INSERT^GPLXPATH("G3","G2","//")
+"RTN","GPLXPAT0",173,0)
+ ;;>>?G2(1)=GXML(9)
+"RTN","GPLXPAT0",174,0)
+ ;;><REPLACE>
+"RTN","GPLXPAT0",175,0)
+ ;;>>>K G2,GBL,G3
+"RTN","GPLXPAT0",176,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",177,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",178,0)
+ ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
+"RTN","GPLXPAT0",179,0)
+ ;;>>?GXML(2)="<FIFTH>"
+"RTN","GPLXPAT0",180,0)
+ ;;><INSINNER>
+"RTN","GPLXPAT0",181,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",182,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",183,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",184,0)
+ ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",185,0)
+ ;;>>?GXML(10)="<FIFTH>"
+"RTN","GPLXPAT0",186,0)
+ ;;><INSINNER2>
+"RTN","GPLXPAT0",187,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",188,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",189,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",190,0)
+ ;;>>>D INSINNER^GPLXPATH("G2","G2")
+"RTN","GPLXPAT0",191,0)
+ ;;>>?G2(8)="<FIFTH>"
+"RTN","GPLXPAT0",192,0)
+ ;;></TEST>
+"RTN","GPLXPATH")
+0^9^B261673629
+"RTN","GPLXPATH",1,0)
+GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
+"RTN","GPLXPATH",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 3
+"RTN","GPLXPATH",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPATH",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPATH",5,0)
+ ;
+"RTN","GPLXPATH",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPATH",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPATH",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPATH",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPATH",10,0)
+ ;
+"RTN","GPLXPATH",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPATH",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPATH",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPATH",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPATH",15,0)
+ ;
+"RTN","GPLXPATH",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPATH",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPATH",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPATH",19,0)
+ ;
+"RTN","GPLXPATH",20,0)
+          W "This is an XML XPATH utility library",!
+"RTN","GPLXPATH",21,0)
+          W !
+"RTN","GPLXPATH",22,0)
+          Q
+"RTN","GPLXPATH",23,0)
+          ;
+"RTN","GPLXPATH",24,0)
+OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+"RTN","GPLXPATH",25,0)
+          ;
+"RTN","GPLXPATH",26,0)
+          N Y
+"RTN","GPLXPATH",27,0)
+          S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
+"RTN","GPLXPATH",28,0)
+          I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
+"RTN","GPLXPATH",29,0)
+          ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
+"RTN","GPLXPATH",30,0)
+          Q
+"RTN","GPLXPATH",31,0)
+          ;
+"RTN","GPLXPATH",32,0)
+PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+"RTN","GPLXPATH",33,0)
+          ;  VAL IS A STRING AND STK IS PASSED BY NAME
+"RTN","GPLXPATH",34,0)
+          ;
+"RTN","GPLXPATH",35,0)
+          I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
+"RTN","GPLXPATH",36,0)
+          S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
+"RTN","GPLXPATH",37,0)
+          S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+"RTN","GPLXPATH",38,0)
+          Q
+"RTN","GPLXPATH",39,0)
+          ;
+"RTN","GPLXPATH",40,0)
+POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+"RTN","GPLXPATH",41,0)
+          ; VAL AND STK ARE PASSED BY REFERENCE
+"RTN","GPLXPATH",42,0)
+          ;
+"RTN","GPLXPATH",43,0)
+          I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
+"RTN","GPLXPATH",44,0)
+          . S VAL=""
+"RTN","GPLXPATH",45,0)
+          . S @STK@(0)=0
+"RTN","GPLXPATH",46,0)
+          I @STK@(0)>0  D  ;
+"RTN","GPLXPATH",47,0)
+          . S VAL=@STK@(@STK@(0))
+"RTN","GPLXPATH",48,0)
+          . K @STK@(@STK@(0))
+"RTN","GPLXPATH",49,0)
+          . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+"RTN","GPLXPATH",50,0)
+          Q
+"RTN","GPLXPATH",51,0)
+          ;
+"RTN","GPLXPATH",52,0)
+MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+"RTN","GPLXPATH",53,0)
+          ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
+"RTN","GPLXPATH",54,0)
+          S RTN=""
+"RTN","GPLXPATH",55,0)
+          N I
+"RTN","GPLXPATH",56,0)
+          ; W "STK= ",STK,!
+"RTN","GPLXPATH",57,0)
+          I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",58,0)
+          . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
+"RTN","GPLXPATH",59,0)
+          . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
+"RTN","GPLXPATH",60,0)
+          . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
+"RTN","GPLXPATH",61,0)
+          Q
+"RTN","GPLXPATH",62,0)
+          ;
+"RTN","GPLXPATH",63,0)
+XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+"RTN","GPLXPATH",64,0)
+          ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
+"RTN","GPLXPATH",65,0)
+          ; ISTR IS PASSED BY VALUE
+"RTN","GPLXPATH",66,0)
+          N CUR,TMP
+"RTN","GPLXPATH",67,0)
+          I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
+"RTN","GPLXPATH",68,0)
+          . S TMP=$P(ISTR,"<",2)
+"RTN","GPLXPATH",69,0)
+          I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
+"RTN","GPLXPATH",70,0)
+          . S TMP=$P(TMP,"/",2)
+"RTN","GPLXPATH",71,0)
+          S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
+"RTN","GPLXPATH",72,0)
+          ; W "CUR= ",CUR,!
+"RTN","GPLXPATH",73,0)
+          I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
+"RTN","GPLXPATH",74,0)
+           . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
+"RTN","GPLXPATH",75,0)
+          ; W "CUR2= ",CUR,!
+"RTN","GPLXPATH",76,0)
+          Q CUR
+"RTN","GPLXPATH",77,0)
+          ;
+"RTN","GPLXPATH",78,0)
+INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
+"RTN","GPLXPATH",79,0)
+          ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
+"RTN","GPLXPATH",80,0)
+          ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
+"RTN","GPLXPATH",81,0)
+          ; XML SECTION
+"RTN","GPLXPATH",82,0)
+          ; ZXML IS PASSED BY NAME
+"RTN","GPLXPATH",83,0)
+          N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
+"RTN","GPLXPATH",84,0)
+          N GPLSTK ; LEAVE OUT FOR DEBUGGING
+"RTN","GPLXPATH",85,0)
+          I '$D(@ZXML@(0))  D  ; NO XML PASSED
+"RTN","GPLXPATH",86,0)
+          . W "ERROR IN XML FILE",!
+"RTN","GPLXPATH",87,0)
+          S GPLSTK(0)=0 ; INITIALIZE STACK
+"RTN","GPLXPATH",88,0)
+          F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
+"RTN","GPLXPATH",89,0)
+          . S LINE=@ZXML@(I)
+"RTN","GPLXPATH",90,0)
+          . ;W LINE,!
+"RTN","GPLXPATH",91,0)
+          . S FOUND=0  ; INTIALIZED FOUND FLAG
+"RTN","GPLXPATH",92,0)
+          . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
+"RTN","GPLXPATH",93,0)
+          . I FOUND'=1  D
+"RTN","GPLXPATH",94,0)
+          . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
+"RTN","GPLXPATH",95,0)
+          . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
+"RTN","GPLXPATH",96,0)
+          . . . ; ON THE SAME LINE
+"RTN","GPLXPATH",97,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",98,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",99,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",100,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",101,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",102,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",103,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",104,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",105,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",106,0)
+          . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
+"RTN","GPLXPATH",107,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",108,0)
+          . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
+"RTN","GPLXPATH",109,0)
+          . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
+"RTN","GPLXPATH",110,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",111,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",112,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",113,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",114,0)
+          . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",115,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",116,0)
+          . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
+"RTN","GPLXPATH",117,0)
+          . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
+"RTN","GPLXPATH",118,0)
+          . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
+"RTN","GPLXPATH",119,0)
+          . . . . Q
+"RTN","GPLXPATH",120,0)
+          . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
+"RTN","GPLXPATH",121,0)
+          . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
+"RTN","GPLXPATH",122,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",123,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",124,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",125,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",126,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",127,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",128,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",129,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",130,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",131,0)
+          . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
+"RTN","GPLXPATH",132,0)
+          S @ZXML@("INDEXED")=""
+"RTN","GPLXPATH",133,0)
+          S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
+"RTN","GPLXPATH",134,0)
+          Q
+"RTN","GPLXPATH",135,0)
+          ;
+"RTN","GPLXPATH",136,0)
+QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+"RTN","GPLXPATH",137,0)
+         ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
+"RTN","GPLXPATH",138,0)
+         ; IARY AND OARY ARE PASSED BY NAME
+"RTN","GPLXPATH",139,0)
+         I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
+"RTN","GPLXPATH",140,0)
+         . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
+"RTN","GPLXPATH",141,0)
+         N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
+"RTN","GPLXPATH",142,0)
+         N TMP,I,J,QXPATH
+"RTN","GPLXPATH",143,0)
+         S FIRST=1
+"RTN","GPLXPATH",144,0)
+         S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
+"RTN","GPLXPATH",145,0)
+         I XPATH'="//" D  ; NOT A ROOT QUERY
+"RTN","GPLXPATH",146,0)
+         . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
+"RTN","GPLXPATH",147,0)
+         . S FIRST=$P(TMP,"^",1)
+"RTN","GPLXPATH",148,0)
+         . S LAST=$P(TMP,"^",2)
+"RTN","GPLXPATH",149,0)
+         K @OARY
+"RTN","GPLXPATH",150,0)
+         S @OARY@(0)=+LAST-FIRST+1
+"RTN","GPLXPATH",151,0)
+         S J=1
+"RTN","GPLXPATH",152,0)
+         FOR I=FIRST:1:LAST  D
+"RTN","GPLXPATH",153,0)
+         . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
+"RTN","GPLXPATH",154,0)
+         . S J=J+1
+"RTN","GPLXPATH",155,0)
+         ; ZWR OARY
+"RTN","GPLXPATH",156,0)
+         Q
+"RTN","GPLXPATH",157,0)
+         ;
+"RTN","GPLXPATH",158,0)
+XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+"RTN","GPLXPATH",159,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",160,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",161,0)
+         Q $P(@IDX@(XPATH),"^",1)
+"RTN","GPLXPATH",162,0)
+         ;
+"RTN","GPLXPATH",163,0)
+XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+"RTN","GPLXPATH",164,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",165,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",166,0)
+         Q $P(@IDX@(XPATH),"^",2)
+"RTN","GPLXPATH",167,0)
+         ;
+"RTN","GPLXPATH",168,0)
+START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+"RTN","GPLXPATH",169,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",170,0)
+         ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",171,0)
+         Q $P(ISTR,";",2)
+"RTN","GPLXPATH",172,0)
+         ;
+"RTN","GPLXPATH",173,0)
+FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+"RTN","GPLXPATH",174,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",175,0)
+         Q $P(ISTR,";",3)
+"RTN","GPLXPATH",176,0)
+         ;
+"RTN","GPLXPATH",177,0)
+ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+"RTN","GPLXPATH",178,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",179,0)
+         Q $P(ISTR,";",1)
+"RTN","GPLXPATH",180,0)
+         ;
+"RTN","GPLXPATH",181,0)
+BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+"RTN","GPLXPATH",182,0)
+         ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+"RTN","GPLXPATH",183,0)
+         ; DEST IS CLEARED TO START
+"RTN","GPLXPATH",184,0)
+         ; USES PUSH TO DO THE COPY
+"RTN","GPLXPATH",185,0)
+         N I
+"RTN","GPLXPATH",186,0)
+         K @BDEST
+"RTN","GPLXPATH",187,0)
+         F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
+"RTN","GPLXPATH",188,0)
+         . N J,ATMP
+"RTN","GPLXPATH",189,0)
+         . S ATMP=$$ARRAY(@BLIST@(I))
+"RTN","GPLXPATH",190,0)
+         . I DEBUG W "ATMP=",ATMP,!
+"RTN","GPLXPATH",191,0)
+         . I DEBUG W @BLIST@(I),!
+"RTN","GPLXPATH",192,0)
+         . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
+"RTN","GPLXPATH",193,0)
+         . . ; FOR EACH LINE IN THIS INSTR
+"RTN","GPLXPATH",194,0)
+         . . I DEBUG W "BDEST= ",BDEST,!
+"RTN","GPLXPATH",195,0)
+         . . I DEBUG W "ATMP= ",@ATMP@(J),!
+"RTN","GPLXPATH",196,0)
+         . . D PUSH(BDEST,@ATMP@(J))
+"RTN","GPLXPATH",197,0)
+         Q
+"RTN","GPLXPATH",198,0)
+         ;
+"RTN","GPLXPATH",199,0)
+QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+"RTN","GPLXPATH",200,0)
+         ;
+"RTN","GPLXPATH",201,0)
+         I DEBUG W "QUEUEING ",BLST,!
+"RTN","GPLXPATH",202,0)
+         D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+"RTN","GPLXPATH",203,0)
+         Q
+"RTN","GPLXPATH",204,0)
+         ;
+"RTN","GPLXPATH",205,0)
+CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+"RTN","GPLXPATH",206,0)
+         ; KILLS CPDEST FIRST
+"RTN","GPLXPATH",207,0)
+         N CPINSTR
+"RTN","GPLXPATH",208,0)
+         I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
+"RTN","GPLXPATH",209,0)
+         I @CPSRC@(0)<1 D  ; BAD LENGTH
+"RTN","GPLXPATH",210,0)
+         . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
+"RTN","GPLXPATH",211,0)
+         . Q
+"RTN","GPLXPATH",212,0)
+         ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
+"RTN","GPLXPATH",213,0)
+         D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
+"RTN","GPLXPATH",214,0)
+         D BUILD("CPINSTR",CPDEST)
+"RTN","GPLXPATH",215,0)
+         Q
+"RTN","GPLXPATH",216,0)
+         ;
+"RTN","GPLXPATH",217,0)
+QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+"RTN","GPLXPATH",218,0)
+         ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
+"RTN","GPLXPATH",219,0)
+         ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
+"RTN","GPLXPATH",220,0)
+         ; USED TO INSERT CHILDREN NODES
+"RTN","GPLXPATH",221,0)
+         I @QOXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",222,0)
+         . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
+"RTN","GPLXPATH",223,0)
+         . Q
+"RTN","GPLXPATH",224,0)
+         I DEBUG W "DOING QOPEN",!
+"RTN","GPLXPATH",225,0)
+         N S1,E1,QOT,QOTMP
+"RTN","GPLXPATH",226,0)
+         S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
+"RTN","GPLXPATH",227,0)
+         I $D(QOXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",228,0)
+         . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
+"RTN","GPLXPATH",229,0)
+         . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
+"RTN","GPLXPATH",230,0)
+         I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",231,0)
+         . S E1=@QOXML@(0)-1
+"RTN","GPLXPATH",232,0)
+         D QUEUE(QOBLIST,QOXML,S1,E1)
+"RTN","GPLXPATH",233,0)
+         ; S QOTMP=QOXML_"^"_S1_"^"_E1
+"RTN","GPLXPATH",234,0)
+         ; D PUSH(QOBLIST,QOTMP)
+"RTN","GPLXPATH",235,0)
+         Q
+"RTN","GPLXPATH",236,0)
+         ;
+"RTN","GPLXPATH",237,0)
+QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+"RTN","GPLXPATH",238,0)
+         ; ADDS THE LIST LINE OF QCXML TO QCBLIST
+"RTN","GPLXPATH",239,0)
+         ; USED TO FINISH INSERTING CHILDERN NODES
+"RTN","GPLXPATH",240,0)
+         ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
+"RTN","GPLXPATH",241,0)
+         ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
+"RTN","GPLXPATH",242,0)
+         I @QCXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",243,0)
+         . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
+"RTN","GPLXPATH",244,0)
+         I DEBUG W "GOING TO CLOSE",!
+"RTN","GPLXPATH",245,0)
+         N S1,E1,QCT,QCTMP
+"RTN","GPLXPATH",246,0)
+         S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
+"RTN","GPLXPATH",247,0)
+         I $D(QCXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",248,0)
+         . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
+"RTN","GPLXPATH",249,0)
+         . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
+"RTN","GPLXPATH",250,0)
+         I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",251,0)
+         . S S1=@QCXML@(0)
+"RTN","GPLXPATH",252,0)
+         D QUEUE(QCBLIST,QCXML,S1,E1)
+"RTN","GPLXPATH",253,0)
+         ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+"RTN","GPLXPATH",254,0)
+         Q
+"RTN","GPLXPATH",255,0)
+         ;
+"RTN","GPLXPATH",256,0)
+INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+"RTN","GPLXPATH",257,0)
+         ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
+"RTN","GPLXPATH",258,0)
+         ; OMITTED, INSERTION WILL BE AT THE ROOT
+"RTN","GPLXPATH",259,0)
+         ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
+"RTN","GPLXPATH",260,0)
+         ; XML AT THE END OF THE XPATH POINT
+"RTN","GPLXPATH",261,0)
+         ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
+"RTN","GPLXPATH",262,0)
+         N INSBLD,INSTMP
+"RTN","GPLXPATH",263,0)
+         I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+"RTN","GPLXPATH",264,0)
+         I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+"RTN","GPLXPATH",265,0)
+         I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
+"RTN","GPLXPATH",266,0)
+         . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
+"RTN","GPLXPATH",267,0)
+         I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",268,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",269,0)
+         . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
+"RTN","GPLXPATH",270,0)
+         . . I DEBUG D PARY^GPLXPATH("INSBLD")
+"RTN","GPLXPATH",271,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",272,0)
+         . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
+"RTN","GPLXPATH",273,0)
+         . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
+"RTN","GPLXPATH",274,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",275,0)
+         . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
+"RTN","GPLXPATH",276,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",277,0)
+         . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
+"RTN","GPLXPATH",278,0)
+         . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+"RTN","GPLXPATH",279,0)
+         . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+"RTN","GPLXPATH",280,0)
+         Q
+"RTN","GPLXPATH",281,0)
+         ;
+"RTN","GPLXPATH",282,0)
+INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+"RTN","GPLXPATH",283,0)
+         ; INTO INNXML AT THE INNXPATH XPATH POINT
+"RTN","GPLXPATH",284,0)
+         ;
+"RTN","GPLXPATH",285,0)
+         N INNBLD,UXPATH
+"RTN","GPLXPATH",286,0)
+         N INNTBUF
+"RTN","GPLXPATH",287,0)
+         S INNTBUF=$NA(^TMP($J,"INNTBUF"))
+"RTN","GPLXPATH",288,0)
+         I '$D(INNXPATH) D  ; XPATH NOT PASSED
+"RTN","GPLXPATH",289,0)
+         . S UXPATH="//" ; USE ROOT XPATH
+"RTN","GPLXPATH",290,0)
+         I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
+"RTN","GPLXPATH",291,0)
+         I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
+"RTN","GPLXPATH",292,0)
+         . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
+"RTN","GPLXPATH",293,0)
+         . D BUILD("INNBLD",INNXML)
+"RTN","GPLXPATH",294,0)
+         I @INNXML@(0)>0  D  ; NOT EMPTY
+"RTN","GPLXPATH",295,0)
+         . D QOPEN("INNBLD",INNXML,UXPATH) ;
+"RTN","GPLXPATH",296,0)
+         . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
+"RTN","GPLXPATH",297,0)
+         . D QCLOSE("INNBLD",INNXML,UXPATH)
+"RTN","GPLXPATH",298,0)
+         . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
+"RTN","GPLXPATH",299,0)
+         . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+"RTN","GPLXPATH",300,0)
+         Q
+"RTN","GPLXPATH",301,0)
+         ;
+"RTN","GPLXPATH",302,0)
+INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+"RTN","GPLXPATH",303,0)
+        ; BUT XDEST AN XNEW ARE PASSED BY NAME
+"RTN","GPLXPATH",304,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",305,0)
+        D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
+"RTN","GPLXPATH",306,0)
+        D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
+"RTN","GPLXPATH",307,0)
+        D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
+"RTN","GPLXPATH",308,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",309,0)
+        D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
+"RTN","GPLXPATH",310,0)
+        I DEBUG D PARY("XDEST")
+"RTN","GPLXPATH",311,0)
+        Q
+"RTN","GPLXPATH",312,0)
+        ;
+"RTN","GPLXPATH",313,0)
+REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+"RTN","GPLXPATH",314,0)
+         ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
+"RTN","GPLXPATH",315,0)
+         ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
+"RTN","GPLXPATH",316,0)
+         ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
+"RTN","GPLXPATH",317,0)
+         N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+"RTN","GPLXPATH",318,0)
+         S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+"RTN","GPLXPATH",319,0)
+         D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+"RTN","GPLXPATH",320,0)
+         S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+"RTN","GPLXPATH",321,0)
+         S XFIRST=$P(XNODE,"^",1)
+"RTN","GPLXPATH",322,0)
+         S XLAST=$P(XNODE,"^",2)
+"RTN","GPLXPATH",323,0)
+         I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
+"RTN","GPLXPATH",324,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
+"RTN","GPLXPATH",325,0)
+         . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",326,0)
+         I RENEW'="" D  ; NEW XML IS NOT NULL
+"RTN","GPLXPATH",327,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+"RTN","GPLXPATH",328,0)
+         . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
+"RTN","GPLXPATH",329,0)
+         . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",330,0)
+         I DEBUG W "REPLACE PREBUILD",!
+"RTN","GPLXPATH",331,0)
+         I DEBUG D PARY("REBLD")
+"RTN","GPLXPATH",332,0)
+         D BUILD("REBLD","RTMP")
+"RTN","GPLXPATH",333,0)
+         K @REXML ; KILL WHAT WAS THERE
+"RTN","GPLXPATH",334,0)
+         D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","GPLXPATH",335,0)
+         Q
+"RTN","GPLXPATH",336,0)
+         ;
+"RTN","GPLXPATH",337,0)
+MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+"RTN","GPLXPATH",338,0)
+         ; W "Reporting on the missing",!
+"RTN","GPLXPATH",339,0)
+         ; W OARY
+"RTN","GPLXPATH",340,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
+"RTN","GPLXPATH",341,0)
+         N I
+"RTN","GPLXPATH",342,0)
+         S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
+"RTN","GPLXPATH",343,0)
+         F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",344,0)
+         . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
+"RTN","GPLXPATH",345,0)
+         . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
+"RTN","GPLXPATH",346,0)
+         . . Q
+"RTN","GPLXPATH",347,0)
+         Q
+"RTN","GPLXPATH",348,0)
+         ;
+"RTN","GPLXPATH",349,0)
+MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+"RTN","GPLXPATH",350,0)
+     ; AND PUT THE RESULTS IN OXML
+"RTN","GPLXPATH",351,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
+"RTN","GPLXPATH",352,0)
+         I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
+"RTN","GPLXPATH",353,0)
+         N I,J,TNAM,TVAL,TSTR
+"RTN","GPLXPATH",354,0)
+         S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
+"RTN","GPLXPATH",355,0)
+         F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",356,0)
+         . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
+"RTN","GPLXPATH",357,0)
+         . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
+"RTN","GPLXPATH",358,0)
+         . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+"RTN","GPLXPATH",359,0)
+         . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
+"RTN","GPLXPATH",360,0)
+         . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
+"RTN","GPLXPATH",361,0)
+         . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+"RTN","GPLXPATH",362,0)
+         . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+"RTN","GPLXPATH",363,0)
+         . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
+"RTN","GPLXPATH",364,0)
+         . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+"RTN","GPLXPATH",365,0)
+         . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+"RTN","GPLXPATH",366,0)
+         . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+"RTN","GPLXPATH",367,0)
+         . . I DEBUG W TSTR
+"RTN","GPLXPATH",368,0)
+         W "MAPPED",!
+"RTN","GPLXPATH",369,0)
+         Q
+"RTN","GPLXPATH",370,0)
+         ;
+"RTN","GPLXPATH",371,0)
+TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+"RTN","GPLXPATH",372,0)
+       ; THEXML IS PASSED BY NAME
+"RTN","GPLXPATH",373,0)
+       N I,J,TMPXML,DEL,FOUND,INTXT
+"RTN","GPLXPATH",374,0)
+       S FOUND=0
+"RTN","GPLXPATH",375,0)
+       S INTXT=0
+"RTN","GPLXPATH",376,0)
+       W "DELETING EMPTY ELEMENTS",!
+"RTN","GPLXPATH",377,0)
+       F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
+"RTN","GPLXPATH",378,0)
+       . S J=@THEXML@(I)
+"RTN","GPLXPATH",379,0)
+       . I J["<text>" D
+"RTN","GPLXPATH",380,0)
+       . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
+"RTN","GPLXPATH",381,0)
+       . . W "IN HTML SECTION",!
+"RTN","GPLXPATH",382,0)
+       . N JM,JP,JPX ; JMINUS AND JPLUS
+"RTN","GPLXPATH",383,0)
+       . S JM=@THEXML@(I-1) ; LINE BEFORE
+"RTN","GPLXPATH",384,0)
+       . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
+"RTN","GPLXPATH",385,0)
+       . S JP=@THEXML@(I+1) ; LINE AFTER
+"RTN","GPLXPATH",386,0)
+       . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
+"RTN","GPLXPATH",387,0)
+       . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
+"RTN","GPLXPATH",388,0)
+       . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
+"RTN","GPLXPATH",389,0)
+       . . . W I,J,JP,!
+"RTN","GPLXPATH",390,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",391,0)
+       . . . S DEL(I)="" ; SET LINE TO DELETE
+"RTN","GPLXPATH",392,0)
+       . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
+"RTN","GPLXPATH",393,0)
+       . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
+"RTN","GPLXPATH",394,0)
+       . . . W I,J,!
+"RTN","GPLXPATH",395,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",396,0)
+       . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
+"RTN","GPLXPATH",397,0)
+       . . . I JM=JPX D  ;
+"RTN","GPLXPATH",398,0)
+       . . . . W I,JM_J_JPX,!
+"RTN","GPLXPATH",399,0)
+       . . . . S DEL(I-1)=""
+"RTN","GPLXPATH",400,0)
+       . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
+"RTN","GPLXPATH",401,0)
+       ; . I J'["><" D PUSH("TMPXML",J)
+"RTN","GPLXPATH",402,0)
+       I FOUND D  ; NEED TO DELETE THINGS
+"RTN","GPLXPATH",403,0)
+       . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
+"RTN","GPLXPATH",404,0)
+       . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
+"RTN","GPLXPATH",405,0)
+       . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
+"RTN","GPLXPATH",406,0)
+       . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
+"RTN","GPLXPATH",407,0)
+       Q FOUND
+"RTN","GPLXPATH",408,0)
+       ;
+"RTN","GPLXPATH",409,0)
+UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+"RTN","GPLXPATH",410,0)
+        ; XSEC IS A SECTION PASSED BY NAME
+"RTN","GPLXPATH",411,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",412,0)
+        D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
+"RTN","GPLXPATH",413,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",414,0)
+        D CP("XTMP",XSEC) ; REPLACE PASSED XML
+"RTN","GPLXPATH",415,0)
+        Q
+"RTN","GPLXPATH",416,0)
+        ;
+"RTN","GPLXPATH",417,0)
+PARY(GLO)       ;PRINT AN ARRAY
+"RTN","GPLXPATH",418,0)
+        N I
+"RTN","GPLXPATH",419,0)
+        F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
+"RTN","GPLXPATH",420,0)
+        Q
+"RTN","GPLXPATH",421,0)
+        ;
+"RTN","GPLXPATH",422,0)
+TEST     ; Run all the test cases
+"RTN","GPLXPATH",423,0)
+        D TESTALL^GPLUNIT("GPLXPAT0")
+"RTN","GPLXPATH",424,0)
+        Q
+"RTN","GPLXPATH",425,0)
+        ;
+"RTN","GPLXPATH",426,0)
+ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+"RTN","GPLXPATH",427,0)
+          N ZTMP
+"RTN","GPLXPATH",428,0)
+          S DEBUG=1
+"RTN","GPLXPATH",429,0)
+          D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",430,0)
+          D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLXPATH",431,0)
+          Q
+"RTN","GPLXPATH",432,0)
+          ;
+"RTN","GPLXPATH",433,0)
+TLIST   ; LIST THE TESTS
+"RTN","GPLXPATH",434,0)
+        N ZTMP
+"RTN","GPLXPATH",435,0)
+        D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",436,0)
+        D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLXPATH",437,0)
+        Q
+"RTN","GPLXPATH",438,0)
+        ;
+"VER")
+8.0^22.0
+**END**
+**END**
Index: ccr/tags/CCR_1_0_4/p/CCR_1_0_2_T1_CACHE.KID
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCR_1_0_2_T1_CACHE.KID	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCR_1_0_2_T1_CACHE.KID	(revision 169)
@@ -0,0 +1,8916 @@
+KIDS Distribution saved on Sep 02, 2008@15:08:18
+Remove a ZWR from GPLMEDS
+**KIDS**:CCR*1.0*2^
+
+**INSTALL NAME**
+CCR*1.0*2
+"BLD",6955,0)
+CCR*1.0*2^^0^3080902^n
+"BLD",6955,1,0)
+^^22^22^3080902^
+"BLD",6955,1,1,0)
+CCR AND CCD EXPORT TOOLS 
+"BLD",6955,1,2,0)
+ 
+"BLD",6955,1,3,0)
+SINGLE XML EXPORT TO A HOST DIRECTORY AT 
+"BLD",6955,1,4,0)
+ 
+"BLD",6955,1,5,0)
+BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
+"BLD",6955,1,6,0)
+DIRECTORY
+"BLD",6955,1,7,0)
+ 
+"BLD",6955,1,8,0)
+EXPORT^GPLCRR FOR THE CCR
+"BLD",6955,1,9,0)
+EXPORT^GPLCCD FOR THE CCD
+"BLD",6955,1,10,0)
+XPAT^GPLCCR(DFN,"","") 
+"BLD",6955,1,11,0)
+ 
+"BLD",6955,1,12,0)
+BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
+"BLD",6955,1,13,0)
+ 
+"BLD",6955,1,14,0)
+ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
+"BLD",6955,1,15,0)
+RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
+"BLD",6955,1,16,0)
+ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
+"BLD",6955,1,17,0)
+ 
+"BLD",6955,1,18,0)
+CLIST^GPLRIMA TO LIST CATEGORY TOTALS
+"BLD",6955,1,19,0)
+CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
+"BLD",6955,1,20,0)
+XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
+"BLD",6955,1,21,0)
+ 
+"BLD",6955,1,22,0)
+TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
+"BLD",6955,4,0)
+^9.64PA^^
+"BLD",6955,6.3)
+4
+"BLD",6955,"KRN",0)
+^9.67PA^8989.52^19
+"BLD",6955,"KRN",.4,0)
+.4
+"BLD",6955,"KRN",.401,0)
+.401
+"BLD",6955,"KRN",.402,0)
+.402
+"BLD",6955,"KRN",.403,0)
+.403
+"BLD",6955,"KRN",.5,0)
+.5
+"BLD",6955,"KRN",.84,0)
+.84
+"BLD",6955,"KRN",3.6,0)
+3.6
+"BLD",6955,"KRN",3.8,0)
+3.8
+"BLD",6955,"KRN",9.2,0)
+9.2
+"BLD",6955,"KRN",9.8,0)
+9.8
+"BLD",6955,"KRN",9.8,"NM",0)
+^9.68A^19^19
+"BLD",6955,"KRN",9.8,"NM",1,0)
+CCRDPT^^0^B312345713
+"BLD",6955,"KRN",9.8,"NM",2,0)
+CCRDPTT^^0^B4863621
+"BLD",6955,"KRN",9.8,"NM",3,0)
+CCRMEDS^^0^B36357726
+"BLD",6955,"KRN",9.8,"NM",4,0)
+CCRSYS^^0^B1690193
+"BLD",6955,"KRN",9.8,"NM",5,0)
+CCRUNIT^^0^B8574
+"BLD",6955,"KRN",9.8,"NM",6,0)
+CCRUTIL^^0^B17726385
+"BLD",6955,"KRN",9.8,"NM",7,0)
+CCRVA200^^0^B35847405
+"BLD",6955,"KRN",9.8,"NM",8,0)
+GPLACTOR^^0^B58306782
+"BLD",6955,"KRN",9.8,"NM",9,0)
+GPLXPATH^^0^B261673629
+"BLD",6955,"KRN",9.8,"NM",10,0)
+GPLUNIT^^0^B31630479
+"BLD",6955,"KRN",9.8,"NM",11,0)
+GPLPROBS^^0^B24846496
+"BLD",6955,"KRN",9.8,"NM",12,0)
+GPLVITAL^^0^B98509194
+"BLD",6955,"KRN",9.8,"NM",13,0)
+GPLRIMA^^0^B96435476
+"BLD",6955,"KRN",9.8,"NM",14,0)
+GPLCCR^^0^B66792391
+"BLD",6955,"KRN",9.8,"NM",15,0)
+GPLCCR0^^0^B658213703
+"BLD",6955,"KRN",9.8,"NM",16,0)
+GPLCCD^^0^B106978605
+"BLD",6955,"KRN",9.8,"NM",17,0)
+GPLCCD1^^0^B100039732
+"BLD",6955,"KRN",9.8,"NM",18,0)
+GPLMEDS^^0^B27486154
+"BLD",6955,"KRN",9.8,"NM",19,0)
+GPLXPAT0^^0^B44173297
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPT",1)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPTT",2)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS",3)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRSYS",4)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUNIT",5)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUTIL",6)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRVA200",7)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLACTOR",8)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",16)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",17)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",14)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",15)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLMEDS",18)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",11)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",13)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",10)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",12)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",19)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
+
+"BLD",6955,"KRN",19,0)
+19
+"BLD",6955,"KRN",19.1,0)
+19.1
+"BLD",6955,"KRN",101,0)
+101
+"BLD",6955,"KRN",409.61,0)
+409.61
+"BLD",6955,"KRN",771,0)
+771
+"BLD",6955,"KRN",870,0)
+870
+"BLD",6955,"KRN",8989.51,0)
+8989.51
+"BLD",6955,"KRN",8989.52,0)
+8989.52
+"BLD",6955,"KRN",8994,0)
+8994
+"BLD",6955,"KRN","B",.4,.4)
+
+"BLD",6955,"KRN","B",.401,.401)
+
+"BLD",6955,"KRN","B",.402,.402)
+
+"BLD",6955,"KRN","B",.403,.403)
+
+"BLD",6955,"KRN","B",.5,.5)
+
+"BLD",6955,"KRN","B",.84,.84)
+
+"BLD",6955,"KRN","B",3.6,3.6)
+
+"BLD",6955,"KRN","B",3.8,3.8)
+
+"BLD",6955,"KRN","B",9.2,9.2)
+
+"BLD",6955,"KRN","B",9.8,9.8)
+
+"BLD",6955,"KRN","B",19,19)
+
+"BLD",6955,"KRN","B",19.1,19.1)
+
+"BLD",6955,"KRN","B",101,101)
+
+"BLD",6955,"KRN","B",409.61,409.61)
+
+"BLD",6955,"KRN","B",771,771)
+
+"BLD",6955,"KRN","B",870,870)
+
+"BLD",6955,"KRN","B",8989.51,8989.51)
+
+"BLD",6955,"KRN","B",8989.52,8989.52)
+
+"BLD",6955,"KRN","B",8994,8994)
+
+"BLD",6955,"QUES",0)
+^9.62^^
+"BLD",6955,"REQB",0)
+^9.611^^
+"MBREQ")
+0
+"QUES","XPF1",0)
+Y
+"QUES","XPF1","??")
+^D REP^XPDH
+"QUES","XPF1","A")
+Shall I write over your |FLAG| File
+"QUES","XPF1","B")
+YES
+"QUES","XPF1","M")
+D XPF1^XPDIQ
+"QUES","XPF2",0)
+Y
+"QUES","XPF2","??")
+^D DTA^XPDH
+"QUES","XPF2","A")
+Want my data |FLAG| yours
+"QUES","XPF2","B")
+YES
+"QUES","XPF2","M")
+D XPF2^XPDIQ
+"QUES","XPI1",0)
+YO
+"QUES","XPI1","??")
+^D INHIBIT^XPDH
+"QUES","XPI1","A")
+Want KIDS to INHIBIT LOGONs during the install
+"QUES","XPI1","B")
+NO
+"QUES","XPI1","M")
+D XPI1^XPDIQ
+"QUES","XPM1",0)
+PO^VA(200,:EM
+"QUES","XPM1","??")
+^D MG^XPDH
+"QUES","XPM1","A")
+Enter the Coordinator for Mail Group '|FLAG|'
+"QUES","XPM1","B")
+
+"QUES","XPM1","M")
+D XPM1^XPDIQ
+"QUES","XPO1",0)
+Y
+"QUES","XPO1","??")
+^D MENU^XPDH
+"QUES","XPO1","A")
+Want KIDS to Rebuild Menu Trees Upon Completion of Install
+"QUES","XPO1","B")
+NO
+"QUES","XPO1","M")
+D XPO1^XPDIQ
+"QUES","XPZ1",0)
+Y
+"QUES","XPZ1","??")
+^D OPT^XPDH
+"QUES","XPZ1","A")
+Want to DISABLE Scheduled Options, Menu Options, and Protocols
+"QUES","XPZ1","B")
+NO
+"QUES","XPZ1","M")
+D XPZ1^XPDIQ
+"QUES","XPZ2",0)
+Y
+"QUES","XPZ2","??")
+^D RTN^XPDH
+"QUES","XPZ2","A")
+Want to MOVE routines to other CPUs
+"QUES","XPZ2","B")
+NO
+"QUES","XPZ2","M")
+D XPZ2^XPDIQ
+"RTN")
+19
+"RTN","CCRDPT")
+0^1^B312345713
+"RTN","CCRDPT",1,0)
+CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
+"RTN","CCRDPT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 4
+"RTN","CCRDPT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPT",5,0)
+ ;
+"RTN","CCRDPT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPT",9,0)
+ ;(at your option) any later version.
+"RTN","CCRDPT",10,0)
+ ;
+"RTN","CCRDPT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPT",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPT",15,0)
+ ;
+"RTN","CCRDPT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPT",19,0)
+    ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
+"RTN","CCRDPT",20,0)
+    ; DESTROY to clean-up.
+"RTN","CCRDPT",21,0)
+    ; The first line of every routine tests if the global exists.
+"RTN","CCRDPT",22,0)
+    ;
+"RTN","CCRDPT",23,0)
+    ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
+"RTN","CCRDPT",24,0)
+    ; INIT        9 lines  Copy DFN global to a local variable
+"RTN","CCRDPT",25,0)
+    ; DESTROY     6 lines  Kill local variable
+"RTN","CCRDPT",26,0)
+    ; FAMILY      6 lines  Family Name
+"RTN","CCRDPT",27,0)
+    ; GIVEN       6 lines  Given Name
+"RTN","CCRDPT",28,0)
+    ; MIDDLE      6 lines  Middle Name
+"RTN","CCRDPT",29,0)
+    ; SUFFIX      6 lines  Suffix Name
+"RTN","CCRDPT",30,0)
+    ; DISPNAME    5 lines  Display Name
+"RTN","CCRDPT",31,0)
+    ; DOB         6 lines  Date of Birth
+"RTN","CCRDPT",32,0)
+    ; GENDER      4 lines  Get Gender
+"RTN","CCRDPT",33,0)
+    ; SSN         4 lines  Get SSN for ID
+"RTN","CCRDPT",34,0)
+    ; ADDRTYPE    4 lines  Get Home Address
+"RTN","CCRDPT",35,0)
+    ; ADDR1       4 lines  Get Home Address line 1
+"RTN","CCRDPT",36,0)
+    ; ADDR2       5 lines  Get Home Address line 2
+"RTN","CCRDPT",37,0)
+    ; CITY        4 lines  Get City for Home Address
+"RTN","CCRDPT",38,0)
+    ; STATE      11 lines  Get State for Home Address
+"RTN","CCRDPT",39,0)
+    ; ZIP         4 lines  Get Zip code for Home Address
+"RTN","CCRDPT",40,0)
+    ; COUNTY      4 lines  Get County for our Address
+"RTN","CCRDPT",41,0)
+    ; COUNTRY     4 lines  Get Country for our Address
+"RTN","CCRDPT",42,0)
+    ; RESTEL      4 lines  Residential Telephone
+"RTN","CCRDPT",43,0)
+    ; WORKTEL     4 lines  Work Telephone
+"RTN","CCRDPT",44,0)
+    ; EMAIL       4 lines  Email Adddress
+"RTN","CCRDPT",45,0)
+    ; CELLTEL     4 lines  Cell Phone
+"RTN","CCRDPT",46,0)
+    ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
+"RTN","CCRDPT",47,0)
+    ; NOK1GIV     6 lines  NOK1 Given Name
+"RTN","CCRDPT",48,0)
+    ; NOK1MID     6 lines  NOK1 Middle Name
+"RTN","CCRDPT",49,0)
+    ; NOK1SUF     6 lines  NOK1 Suffi Name
+"RTN","CCRDPT",50,0)
+    ; NOK1DISP    5 lines  NOK1 Display Name
+"RTN","CCRDPT",51,0)
+    ; NOK1REL     4 lines  NOK1 Relationship to the patient
+"RTN","CCRDPT",52,0)
+    ; NOK1ADD1    4 lines  NOK1 Address 1
+"RTN","CCRDPT",53,0)
+    ; NOK1ADD2    5 lines  NOK1 Address 2
+"RTN","CCRDPT",54,0)
+    ; NOK1CITY    4 lines  NOK1 City
+"RTN","CCRDPT",55,0)
+    ; NOK1STAT    5 lines  NOK1 State
+"RTN","CCRDPT",56,0)
+    ; NOK1ZIP     4 lines  NOK1 Zip Code
+"RTN","CCRDPT",57,0)
+    ; NOK1HTEL;   4 lines  NOK1 Home Telephone
+"RTN","CCRDPT",58,0)
+    ; NOK1WTEL;   4 lines  NOK1 Work Telephone
+"RTN","CCRDPT",59,0)
+    ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
+"RTN","CCRDPT",60,0)
+    ; NOK2FAM     6 lines  NOK2 Family Name
+"RTN","CCRDPT",61,0)
+    ; NOK2GIV     6 lines  NOK2 Given Name
+"RTN","CCRDPT",62,0)
+    ; NOK2MID     6 lines  NOK2 Middle Name
+"RTN","CCRDPT",63,0)
+    ; NOK2SUF     5 lines  NOK2 Suffi Name
+"RTN","CCRDPT",64,0)
+    ; NOK2DISP    5 lines  NOK2 Display Name
+"RTN","CCRDPT",65,0)
+    ; NOK2REL     4 lines  NOK2 Relationship to the patient
+"RTN","CCRDPT",66,0)
+    ; NOK2ADD1    4 lines  NOK2 Address 1
+"RTN","CCRDPT",67,0)
+    ; NOK2ADD2    5 lines  NOK2 Address 2
+"RTN","CCRDPT",68,0)
+    ; NOK2CITY    4 lines  NOK2 City
+"RTN","CCRDPT",69,0)
+    ; NOK2STAT    5 lines  NOK2 State
+"RTN","CCRDPT",70,0)
+    ; NOK2ZIP     4 lines  NOK2 Zip Code
+"RTN","CCRDPT",71,0)
+    ; NOK2HTEL;   4 lines  NOK2 Home Telephone
+"RTN","CCRDPT",72,0)
+    ; NOK2WTEL;   4 lines  NOK2 Work Telephone
+"RTN","CCRDPT",73,0)
+    ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
+"RTN","CCRDPT",74,0)
+    ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
+"RTN","CCRDPT",75,0)
+    ; EMERGIV     6 lines  EMER Given Name
+"RTN","CCRDPT",76,0)
+    ; EMERMID     6 lines  EMER Middle Name
+"RTN","CCRDPT",77,0)
+    ; EMERSUF     5 lines  EMER Suffi Name
+"RTN","CCRDPT",78,0)
+    ; EMERDISP    5 lines  EMER Display Name
+"RTN","CCRDPT",79,0)
+    ; EMERREL     4 lines  EMER Relationship to the patient
+"RTN","CCRDPT",80,0)
+    ; EMERADD1    4 lines  EMER Address 1
+"RTN","CCRDPT",81,0)
+    ; EMERADD2    5 lines  EMER Address 2
+"RTN","CCRDPT",82,0)
+    ; EMERCITY    4 lines  EMER City
+"RTN","CCRDPT",83,0)
+    ; EMERSTAT    5 lines  EMER State
+"RTN","CCRDPT",84,0)
+    ; EMERZIP     4 lines  EMER Zip Code
+"RTN","CCRDPT",85,0)
+    ; EMERHTEL;   4 lines  EMER Home Telephone
+"RTN","CCRDPT",86,0)
+    ; EMERWTEL;   4 lines  EMER Work Telephone
+"RTN","CCRDPT",87,0)
+    ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
+"RTN","CCRDPT",88,0)
+    ;
+"RTN","CCRDPT",89,0)
+          W "No Entry at top!" Q
+"RTN","CCRDPT",90,0)
+   ; The following is a map of the relevant data in the patient global.
+"RTN","CCRDPT",91,0)
+    ;
+"RTN","CCRDPT",92,0)
+    ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
+"RTN","CCRDPT",93,0)
+    ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
+"RTN","CCRDPT",94,0)
+    ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
+"RTN","CCRDPT",95,0)
+    ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
+"RTN","CCRDPT",96,0)
+    ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
+"RTN","CCRDPT",97,0)
+    ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
+"RTN","CCRDPT",98,0)
+    ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
+"RTN","CCRDPT",99,0)
+    ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
+"RTN","CCRDPT",100,0)
+    ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
+"RTN","CCRDPT",101,0)
+    ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
+"RTN","CCRDPT",102,0)
+    ; ==>[21S] ^
+"RTN","CCRDPT",103,0)
+    ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
+"RTN","CCRDPT",104,0)
+    ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
+"RTN","CCRDPT",105,0)
+    ; ==>COMPONENTS [3P:20] ^
+"RTN","CCRDPT",106,0)
+    ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
+"RTN","CCRDPT",107,0)
+    ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
+"RTN","CCRDPT",108,0)
+    ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
+"RTN","CCRDPT",109,0)
+    ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
+"RTN","CCRDPT",110,0)
+    ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
+"RTN","CCRDPT",111,0)
+    ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
+"RTN","CCRDPT",112,0)
+    ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
+"RTN","CCRDPT",113,0)
+    ; ==>^
+"RTN","CCRDPT",114,0)
+    ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
+"RTN","CCRDPT",115,0)
+    ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
+"RTN","CCRDPT",116,0)
+    ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
+"RTN","CCRDPT",117,0)
+    ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
+"RTN","CCRDPT",118,0)
+    ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
+"RTN","CCRDPT",119,0)
+    ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
+"RTN","CCRDPT",120,0)
+    ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
+"RTN","CCRDPT",121,0)
+    ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
+"RTN","CCRDPT",122,0)
+    ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
+"RTN","CCRDPT",123,0)
+    ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
+"RTN","CCRDPT",124,0)
+    ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
+"RTN","CCRDPT",125,0)
+    ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
+"RTN","CCRDPT",126,0)
+    ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
+"RTN","CCRDPT",127,0)
+    ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
+"RTN","CCRDPT",128,0)
+    ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
+"RTN","CCRDPT",129,0)
+    ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
+"RTN","CCRDPT",130,0)
+    ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
+"RTN","CCRDPT",131,0)
+    ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
+"RTN","CCRDPT",132,0)
+    ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
+"RTN","CCRDPT",133,0)
+    ; ==>SITE [14P:4] ^
+"RTN","CCRDPT",134,0)
+    ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
+"RTN","CCRDPT",135,0)
+    ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
+"RTN","CCRDPT",136,0)
+    ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
+"RTN","CCRDPT",137,0)
+    ; ==>3] [5F] ^
+"RTN","CCRDPT",138,0)
+    ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
+"RTN","CCRDPT",139,0)
+    ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
+"RTN","CCRDPT",140,0)
+    ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
+"RTN","CCRDPT",141,0)
+    ; ==>^
+"RTN","CCRDPT",142,0)
+    ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
+"RTN","CCRDPT",143,0)
+    ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
+"RTN","CCRDPT",144,0)
+    ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
+"RTN","CCRDPT",145,0)
+    ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
+"RTN","CCRDPT",146,0)
+    ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
+"RTN","CCRDPT",147,0)
+    ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
+"RTN","CCRDPT",148,0)
+    ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
+"RTN","CCRDPT",149,0)
+    ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
+"RTN","CCRDPT",150,0)
+    ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
+"RTN","CCRDPT",151,0)
+    ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
+"RTN","CCRDPT",152,0)
+    ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
+"RTN","CCRDPT",153,0)
+    ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
+"RTN","CCRDPT",154,0)
+    ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
+"RTN","CCRDPT",155,0)
+    ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
+"RTN","CCRDPT",156,0)
+    ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
+"RTN","CCRDPT",157,0)
+    ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
+"RTN","CCRDPT",158,0)
+    ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
+"RTN","CCRDPT",159,0)
+    ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
+"RTN","CCRDPT",160,0)
+    ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
+"RTN","CCRDPT",161,0)
+    ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
+"RTN","CCRDPT",162,0)
+    ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
+"RTN","CCRDPT",163,0)
+    ; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
+"RTN","CCRDPT",164,0)
+    ; INPUT: Patient IEN (DFN)
+"RTN","CCRDPT",165,0)
+    ; OUTPUT: PT in the Symbol Table, representing the patient global
+"RTN","CCRDPT",166,0)
+    ; Instead of accessing a global each single read (SLOOOOW)
+"RTN","CCRDPT",167,0)
+    ; read it off a local variable stored in Memory.
+"RTN","CCRDPT",168,0)
+INIT(DFN) ;
+"RTN","CCRDPT",169,0)
+          M PT=^DPT(DFN)
+"RTN","CCRDPT",170,0)
+          Q
+"RTN","CCRDPT",171,0)
+          ;
+"RTN","CCRDPT",172,0)
+DESTROY ; Kill local variable; PUBLIC
+"RTN","CCRDPT",173,0)
+          ; INPUT: None
+"RTN","CCRDPT",174,0)
+          ; OUTPUT: Kill PT from the Symbol Table after you are done
+"RTN","CCRDPT",175,0)
+          K PT
+"RTN","CCRDPT",176,0)
+          Q
+"RTN","CCRDPT",177,0)
+          ;
+"RTN","CCRDPT",178,0)
+FAMILY() ; Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",179,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",180,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",181,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",182,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",183,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",184,0)
+          ;
+"RTN","CCRDPT",185,0)
+GIVEN() ; Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",186,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",187,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",188,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",189,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",190,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",191,0)
+          ;
+"RTN","CCRDPT",192,0)
+MIDDLE() ; Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",193,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",194,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",195,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",196,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",197,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",198,0)
+          ;
+"RTN","CCRDPT",199,0)
+SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",200,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",201,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",202,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",203,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",204,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",205,0)
+          ;
+"RTN","CCRDPT",206,0)
+DISPNAME() ; Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",207,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",208,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",209,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",210,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",211,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",212,0)
+DOB() ; Date of Birth; PUBLIC; Extrinsic
+"RTN","CCRDPT",213,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",214,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",215,0)
+          N DOB S DOB=$P(PT(0),"^",3)
+"RTN","CCRDPT",216,0)
+          ; Date in FM Date Format. Convert to UTC/ISO 8601.
+"RTN","CCRDPT",217,0)
+          Q $$FMDTOUTC^CCRUTIL(DOB,"D")
+"RTN","CCRDPT",218,0)
+          ;
+"RTN","CCRDPT",219,0)
+GENDER() ; Get Gender; PUBLIC; Extrinsic
+"RTN","CCRDPT",220,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",221,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",222,0)
+          Q $P(PT(0),"^",2)
+"RTN","CCRDPT",223,0)
+          ;
+"RTN","CCRDPT",224,0)
+SSN() ; Get SSN for ID; PUBLIC; Extrinsic
+"RTN","CCRDPT",225,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",226,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",227,0)
+          Q $P(PT(0),"^",9)
+"RTN","CCRDPT",228,0)
+          ;
+"RTN","CCRDPT",229,0)
+ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",230,0)
+          ; Vista only stores a home address for the patient.
+"RTN","CCRDPT",231,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",232,0)
+          Q "Home"
+"RTN","CCRDPT",233,0)
+          ;
+"RTN","CCRDPT",234,0)
+ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",235,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",236,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",237,0)
+          Q $P(PT(.11),"^",1)
+"RTN","CCRDPT",238,0)
+          ;
+"RTN","CCRDPT",239,0)
+ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",240,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",241,0)
+          ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
+"RTN","CCRDPT",242,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",243,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",244,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",245,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",246,0)
+          Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
+"RTN","CCRDPT",247,0)
+          Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
+"RTN","CCRDPT",248,0)
+          ;
+"RTN","CCRDPT",249,0)
+CITY() ; Get City for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",250,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",251,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",252,0)
+          Q $P(PT(.11),"^",4)
+"RTN","CCRDPT",253,0)
+          ;
+"RTN","CCRDPT",254,0)
+STATE() ; Get State for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",255,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",256,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",257,0)
+          ; State is stored as a pointer
+"RTN","CCRDPT",258,0)
+          N STATENUM S STATENUM=$P(PT(.11),"^",5)
+"RTN","CCRDPT",259,0)
+          ;
+"RTN","CCRDPT",260,0)
+          ; State File Global is below
+"RTN","CCRDPT",261,0)
+          ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
+"RTN","CCRDPT",262,0)
+          ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
+"RTN","CCRDPT",263,0)
+          ; ==>US STATE OR POSSESSION [6S] ^
+"RTN","CCRDPT",264,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",265,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",266,0)
+          ;
+"RTN","CCRDPT",267,0)
+ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",268,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",269,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",270,0)
+          Q $P(PT(.11),"^",6)
+"RTN","CCRDPT",271,0)
+          ;
+"RTN","CCRDPT",272,0)
+COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",273,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",274,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",275,0)
+          Q $P(PT(.11),"^",7)
+"RTN","CCRDPT",276,0)
+          ;
+"RTN","CCRDPT",277,0)
+COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",278,0)
+          ; Unfortunately, I can't find where that is stored, so the inevitable...
+"RTN","CCRDPT",279,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",280,0)
+          Q "USA"
+"RTN","CCRDPT",281,0)
+          ;
+"RTN","CCRDPT",282,0)
+RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",283,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",284,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",285,0)
+          Q $P(PT(.13),"^",1)
+"RTN","CCRDPT",286,0)
+          ;
+"RTN","CCRDPT",287,0)
+WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",288,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",289,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",290,0)
+          Q $P(PT(.13),"^",2)
+"RTN","CCRDPT",291,0)
+          ;
+"RTN","CCRDPT",292,0)
+EMAIL() ; Email Adddress; PUBLIC; Extrinsic
+"RTN","CCRDPT",293,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",294,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",295,0)
+          Q $P(PT(.13),"^",3)
+"RTN","CCRDPT",296,0)
+          ;
+"RTN","CCRDPT",297,0)
+CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
+"RTN","CCRDPT",298,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",299,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",300,0)
+          Q $P(PT(.13),"^",4)
+"RTN","CCRDPT",301,0)
+          ;
+"RTN","CCRDPT",302,0)
+NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",303,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",304,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",305,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",306,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",307,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",308,0)
+          ;
+"RTN","CCRDPT",309,0)
+NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",310,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",311,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",312,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",313,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",314,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",315,0)
+          ;
+"RTN","CCRDPT",316,0)
+NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",317,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",318,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",319,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",320,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",321,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",322,0)
+          ;
+"RTN","CCRDPT",323,0)
+NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",324,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",325,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",326,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",327,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",328,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",329,0)
+          ;
+"RTN","CCRDPT",330,0)
+NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",331,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",332,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",333,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",334,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",335,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",336,0)
+NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",337,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",338,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",339,0)
+          Q $P(PT(.21),"^",2)
+"RTN","CCRDPT",340,0)
+          ;
+"RTN","CCRDPT",341,0)
+NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",342,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",343,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",344,0)
+          Q $P(PT(.21),"^",3)
+"RTN","CCRDPT",345,0)
+          ;
+"RTN","CCRDPT",346,0)
+NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",347,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",348,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",349,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",350,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",351,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",352,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",353,0)
+          Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
+"RTN","CCRDPT",354,0)
+          Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
+"RTN","CCRDPT",355,0)
+          ;
+"RTN","CCRDPT",356,0)
+NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",357,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",358,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",359,0)
+          Q $P(PT(.21),"^",6)
+"RTN","CCRDPT",360,0)
+          ;
+"RTN","CCRDPT",361,0)
+NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",362,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",363,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",364,0)
+          N STATENUM S STATENUM=$P(PT(.21),"^",7)
+"RTN","CCRDPT",365,0)
+          Q:STATENUM="" ""
+"RTN","CCRDPT",366,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",367,0)
+          ;
+"RTN","CCRDPT",368,0)
+NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",369,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",370,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",371,0)
+          Q $P(PT(.21),"^",8)
+"RTN","CCRDPT",372,0)
+          ;
+"RTN","CCRDPT",373,0)
+NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",374,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",375,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",376,0)
+          Q $P(PT(.21),"^",9)
+"RTN","CCRDPT",377,0)
+          ;
+"RTN","CCRDPT",378,0)
+NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",379,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",380,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",381,0)
+          Q $P(PT(.21),"^",11)
+"RTN","CCRDPT",382,0)
+          ;
+"RTN","CCRDPT",383,0)
+NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",384,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",385,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",386,0)
+          Q $P(PT(.21),"^",10)
+"RTN","CCRDPT",387,0)
+          ;
+"RTN","CCRDPT",388,0)
+NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",389,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",390,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",391,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",392,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",393,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",394,0)
+          ;
+"RTN","CCRDPT",395,0)
+NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
+"RTN","CCRDPT",396,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",397,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",398,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",399,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",400,0)
+          ;
+"RTN","CCRDPT",401,0)
+NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",402,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",403,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",404,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",405,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",406,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",407,0)
+          ;
+"RTN","CCRDPT",408,0)
+NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",409,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",410,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",411,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",412,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",413,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",414,0)
+NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",415,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",416,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",417,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",418,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",419,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",420,0)
+NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",421,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",422,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",423,0)
+          Q $P(PT(.211),"^",2)
+"RTN","CCRDPT",424,0)
+          ;
+"RTN","CCRDPT",425,0)
+NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",426,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",427,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",428,0)
+          Q $P(PT(.211),"^",3)
+"RTN","CCRDPT",429,0)
+          ;
+"RTN","CCRDPT",430,0)
+NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",431,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",432,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",433,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",434,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",435,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",436,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",437,0)
+          Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
+"RTN","CCRDPT",438,0)
+          Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
+"RTN","CCRDPT",439,0)
+          ;
+"RTN","CCRDPT",440,0)
+NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",441,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",442,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",443,0)
+          Q $P(PT(.211),"^",6)
+"RTN","CCRDPT",444,0)
+          ;
+"RTN","CCRDPT",445,0)
+NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",446,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",447,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",448,0)
+          N STATENUM S STATENUM=$P(PT(.211),"^",7)
+"RTN","CCRDPT",449,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",450,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",451,0)
+          ;
+"RTN","CCRDPT",452,0)
+NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",453,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",454,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",455,0)
+          Q $P(PT(.211),"^",8)
+"RTN","CCRDPT",456,0)
+          ;
+"RTN","CCRDPT",457,0)
+NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",458,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",459,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",460,0)
+          Q $P(PT(.211),"^",9)
+"RTN","CCRDPT",461,0)
+          ;
+"RTN","CCRDPT",462,0)
+NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",463,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",464,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",465,0)
+          Q $P(PT(.211),"^",11)
+"RTN","CCRDPT",466,0)
+          ;
+"RTN","CCRDPT",467,0)
+NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",468,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",469,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",470,0)
+          Q $P(PT(.211),"^",10)
+"RTN","CCRDPT",471,0)
+          ;
+"RTN","CCRDPT",472,0)
+EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",473,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",474,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",475,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",476,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",477,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",478,0)
+          ;
+"RTN","CCRDPT",479,0)
+EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",480,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",481,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",482,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",483,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",484,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",485,0)
+          ;
+"RTN","CCRDPT",486,0)
+EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",487,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",488,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",489,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",490,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",491,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",492,0)
+          ;
+"RTN","CCRDPT",493,0)
+EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",494,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",495,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",496,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",497,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",498,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",499,0)
+EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",500,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",501,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",502,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",503,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",504,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",505,0)
+EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",506,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",507,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",508,0)
+          Q $P(PT(.33),"^",2)
+"RTN","CCRDPT",509,0)
+          ;
+"RTN","CCRDPT",510,0)
+EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",511,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",512,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",513,0)
+          Q $P(PT(.33),"^",3)
+"RTN","CCRDPT",514,0)
+          ;
+"RTN","CCRDPT",515,0)
+EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",516,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",517,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",518,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",519,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",520,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",521,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",522,0)
+          Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
+"RTN","CCRDPT",523,0)
+          Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
+"RTN","CCRDPT",524,0)
+          ;
+"RTN","CCRDPT",525,0)
+EMERCITY() ; EMER City; PUBLIC; Extrinsic
+"RTN","CCRDPT",526,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",527,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",528,0)
+          Q $P(PT(.33),"^",6)
+"RTN","CCRDPT",529,0)
+          ;
+"RTN","CCRDPT",530,0)
+EMERSTAT() ; EMER State; PUBLIC; Extrinsic
+"RTN","CCRDPT",531,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",532,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",533,0)
+          N STATENUM S STATENUM=$P(PT(.33),"^",7)
+"RTN","CCRDPT",534,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",535,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",536,0)
+          ;
+"RTN","CCRDPT",537,0)
+EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",538,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",539,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",540,0)
+          Q $P(PT(.33),"^",8)
+"RTN","CCRDPT",541,0)
+          ;
+"RTN","CCRDPT",542,0)
+EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",543,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",544,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",545,0)
+          Q $P(PT(.33),"^",9)
+"RTN","CCRDPT",546,0)
+          ;
+"RTN","CCRDPT",547,0)
+EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",548,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",549,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",550,0)
+          Q $P(PT(.33),"^",11)
+"RTN","CCRDPT",551,0)
+          ;
+"RTN","CCRDPT",552,0)
+EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
+"RTN","CCRDPT",553,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",554,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",555,0)
+          Q $P(PT(.33),"^",10)
+"RTN","CCRDPT",556,0)
+          ;
+"RTN","CCRDPTT")
+0^2^B4863621
+"RTN","CCRDPTT",1,0)
+CCRDPTT ; Unit Tester...
+"RTN","CCRDPTT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 4
+"RTN","CCRDPTT",3,0)
+ ;
+"RTN","CCRDPTT",4,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPTT",5,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPTT",6,0)
+ ;
+"RTN","CCRDPTT",7,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPTT",8,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPTT",9,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPTT",10,0)
+ ;(at your option) any later version.
+"RTN","CCRDPTT",11,0)
+ ;
+"RTN","CCRDPTT",12,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPTT",13,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPTT",14,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPTT",15,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPTT",16,0)
+ ;
+"RTN","CCRDPTT",17,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPTT",18,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPTT",19,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPTT",20,0)
+          ; Get the functions in the routine using Rick's routine
+"RTN","CCRDPTT",21,0)
+          ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
+"RTN","CCRDPTT",22,0)
+          ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
+"RTN","CCRDPTT",23,0)
+          ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
+"RTN","CCRDPTT",24,0)
+          ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
+"RTN","CCRDPTT",25,0)
+          ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
+"RTN","CCRDPTT",26,0)
+          ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",27,0)
+          ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",28,0)
+          ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
+"RTN","CCRDPTT",29,0)
+          ; etc.
+"RTN","CCRDPTT",30,0)
+          ;
+"RTN","CCRDPTT",31,0)
+          ; Load Routine Entry points; We get a sweeeeeet array
+"RTN","CCRDPTT",32,0)
+          D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
+"RTN","CCRDPTT",33,0)
+          N X,Y
+"RTN","CCRDPTT",34,0)
+          ; Select Patient
+"RTN","CCRDPTT",35,0)
+          S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","CCRDPTT",36,0)
+          ;
+"RTN","CCRDPTT",37,0)
+          W "You have selected patient "_Y,!!
+"RTN","CCRDPTT",38,0)
+          D INIT^CCRDPT($P(Y,"^"))
+"RTN","CCRDPTT",39,0)
+          ; ZWR PT
+"RTN","CCRDPTT",40,0)
+          N I S I=165 F  S I=$O(OUT(I)) Q:I=""  D
+"RTN","CCRDPTT",41,0)
+          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
+"RTN","CCRDPTT",42,0)
+          . W "valued at "
+"RTN","CCRDPTT",43,0)
+          . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
+"RTN","CCRDPTT",44,0)
+          . W !
+"RTN","CCRDPTT",45,0)
+          Q
+"RTN","CCRMEDS")
+0^3^B36357726
+"RTN","CCRMEDS",1,0)
+CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
+"RTN","CCRMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 4
+"RTN","CCRMEDS",3,0)
+   ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRMEDS",4,0)
+   ; General Public License See attached copy of the License.
+"RTN","CCRMEDS",5,0)
+   ; 
+"RTN","CCRMEDS",6,0)
+   ; This program is free software; you can redistribute it and/or modify
+"RTN","CCRMEDS",7,0)
+   ; it under the terms of the GNU General Public License as published by
+"RTN","CCRMEDS",8,0)
+   ; the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRMEDS",9,0)
+   ; (at your option) any later version.
+"RTN","CCRMEDS",10,0)
+   ; 
+"RTN","CCRMEDS",11,0)
+   ; This program is distributed in the hope that it will be useful,
+"RTN","CCRMEDS",12,0)
+   ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRMEDS",13,0)
+   ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRMEDS",14,0)
+   ; GNU General Public License for more details.
+"RTN","CCRMEDS",15,0)
+   ; 
+"RTN","CCRMEDS",16,0)
+   ; You should have received a copy of the GNU General Public License along
+"RTN","CCRMEDS",17,0)
+   ; with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRMEDS",18,0)
+   ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRMEDS",19,0)
+   ;
+"RTN","CCRMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","CCRMEDS",21,0)
+   Q
+"RTN","CCRMEDS",22,0)
+   ;
+"RTN","CCRMEDS",23,0)
+EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","CCRMEDS",24,0)
+   ;
+"RTN","CCRMEDS",25,0)
+   ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","CCRMEDS",26,0)
+   ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","CCRMEDS",27,0)
+   ; 
+"RTN","CCRMEDS",28,0)
+   ; MEDS is return array from RPC.
+"RTN","CCRMEDS",29,0)
+   ; MAP is a mapping variable map (store result) for each med
+"RTN","CCRMEDS",30,0)
+   ; MED is holds each array element from MEDS(J), one medicine
+"RTN","CCRMEDS",31,0)
+   ; J is a counter.
+"RTN","CCRMEDS",32,0)
+   ;
+"RTN","CCRMEDS",33,0)
+   ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+"RTN","CCRMEDS",34,0)
+   ; med data available.
+"RTN","CCRMEDS",35,0)
+   ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+"RTN","CCRMEDS",36,0)
+   ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+"RTN","CCRMEDS",37,0)
+ 
+"RTN","CCRMEDS",38,0)
+   N MEDS,MAP
+"RTN","CCRMEDS",39,0)
+   K ^TMP($J)
+"RTN","CCRMEDS",40,0)
+   D RX^PSO52API(DFN,"CCDCCR")
+"RTN","CCRMEDS",41,0)
+   M MEDS=^TMP($J,"CCDCCR",DFN)
+"RTN","CCRMEDS",42,0)
+   ; @(0) contains the number of meds or -1^NO DATA FOUND
+"RTN","CCRMEDS",43,0)
+   ; If it is -1, we quit.
+"RTN","CCRMEDS",44,0)
+   I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT  
+"RTN","CCRMEDS",45,0)
+   I DEBUG ZWR MEDS
+"RTN","CCRMEDS",46,0)
+   N RXIEN S RXIEN=0
+"RTN","CCRMEDS",47,0)
+   F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+"RTN","CCRMEDS",48,0)
+   . I DEBUG W "RXIEN IS ",RXIEN,!
+"RTN","CCRMEDS",49,0)
+   . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J))
+"RTN","CCRMEDS",50,0)
+   . K @MAP
+"RTN","CCRMEDS",51,0)
+   . I DEBUG W "MAP= ",MAP,!
+"RTN","CCRMEDS",52,0)
+   . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+"RTN","CCRMEDS",53,0)
+   . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+"RTN","CCRMEDS",54,0)
+   . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+"RTN","CCRMEDS",55,0)
+   . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
+"RTN","CCRMEDS",56,0)
+   . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+"RTN","CCRMEDS",57,0)
+   . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
+"RTN","CCRMEDS",58,0)
+   . S @MAP@("MEDRXNOTXT")="Prescription Number"
+"RTN","CCRMEDS",59,0)
+   . S @MAP@("MEDRXNO")=MED(.01)
+"RTN","CCRMEDS",60,0)
+   . S @MAP@("MEDTYPETEXT")="Medication"
+"RTN","CCRMEDS",61,0)
+   . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+"RTN","CCRMEDS",62,0)
+   . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+"RTN","CCRMEDS",63,0)
+   . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+"RTN","CCRMEDS",64,0)
+   . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+"RTN","CCRMEDS",65,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
+"RTN","CCRMEDS",66,0)
+   . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+"RTN","CCRMEDS",67,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
+"RTN","CCRMEDS",68,0)
+   . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+"RTN","CCRMEDS",69,0)
+   . N MEDIEN S MEDIEN=$P(MED(6),U)
+"RTN","CCRMEDS",70,0)
+   . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","CCRMEDS",71,0)
+   . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","CCRMEDS",72,0)
+   . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","CCRMEDS",73,0)
+   . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","CCRMEDS",74,0)
+   . ; Units, concentration, etc, come from another call
+"RTN","CCRMEDS",75,0)
+   . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","CCRMEDS",76,0)
+   . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","CCRMEDS",77,0)
+   . ; NDF Entry IEN, and VA Product Name
+"RTN","CCRMEDS",78,0)
+   . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",79,0)
+   . ; Documented in the same manual.
+"RTN","CCRMEDS",80,0)
+   . N IEN S IEN=^PSDRUG($P(MED(6),U))
+"RTN","CCRMEDS",81,0)
+   . D NDF^PSS50(IEN,,,,,"CONC")
+"RTN","CCRMEDS",82,0)
+   . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN)
+"RTN","CCRMEDS",83,0)
+   . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","CCRMEDS",84,0)
+   . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","CCRMEDS",85,0)
+   . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","CCRMEDS",86,0)
+   . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","CCRMEDS",87,0)
+   . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","CCRMEDS",88,0)
+   . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","CCRMEDS",89,0)
+   . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
+"RTN","CCRMEDS",90,0)
+   . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+"RTN","CCRMEDS",91,0)
+   . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","CCRMEDS",92,0)
+   . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","CCRMEDS",93,0)
+   . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",94,0)
+   . ; Node 14.5 is the Dispense Unit
+"RTN","CCRMEDS",95,0)
+   . D DATA^PSS50(IEN,,,,,"QTY")
+"RTN","CCRMEDS",96,0)
+   . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN)
+"RTN","CCRMEDS",97,0)
+   . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","CCRMEDS",98,0)
+   . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""
+"RTN","CCRMEDS",99,0)
+   . S @MAP@("MEDDOSEINDICATOR")
+"RTN","CCRMEDS",100,0)
+   . S @MAP@("MEDDELIVERYMETHOD")
+"RTN","CCRMEDS",101,0)
+   . S @MAP@("MEDDOSEVALUE")
+"RTN","CCRMEDS",102,0)
+   . S @MAP@("MEDDOSEUNIT")
+"RTN","CCRMEDS",103,0)
+   . S @MAP@("MEDRATEVALUE")
+"RTN","CCRMEDS",104,0)
+   . S @MAP@("MEDRATEUNIT")
+"RTN","CCRMEDS",105,0)
+   . S @MAP@("MEDVEHICLETEXT")
+"RTN","CCRMEDS",106,0)
+   . S @MAP@("MEDDIRECTIONROUTETEXT")
+"RTN","CCRMEDS",107,0)
+   . S @MAP@("MEDFREQUENCYVALUE")
+"RTN","CCRMEDS",108,0)
+   . S @MAP@("MEDFREQUENCYUNIT")
+"RTN","CCRMEDS",109,0)
+   . S @MAP@("MEDINTERVALVALUE")
+"RTN","CCRMEDS",110,0)
+   . S @MAP@("MEDINTERVALUNIT")
+"RTN","CCRMEDS",111,0)
+   . S @MAP@("MEDDURATIONVALUE")
+"RTN","CCRMEDS",112,0)
+   . S @MAP@("MEDDURATIONUNIT")
+"RTN","CCRMEDS",113,0)
+   . S @MAP@("MEDPRNFLAG")
+"RTN","CCRMEDS",114,0)
+   . S @MAP@("MEDPROBLEMOBJECTID")=""
+"RTN","CCRMEDS",115,0)
+   . S @MAP@("MEDPROBLEMDESCRIPTION")=""
+"RTN","CCRMEDS",116,0)
+   . S @MAP@("MEDPROBLEMCODEVALUE")=""
+"RTN","CCRMEDS",117,0)
+   . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
+"RTN","CCRMEDS",118,0)
+   . S @MAP@("MEDPROBLEMCODINGVERSION")=""
+"RTN","CCRMEDS",119,0)
+   . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
+"RTN","CCRMEDS",120,0)
+   . S @MAP@("MEDSTOPINDICATOR")
+"RTN","CCRMEDS",121,0)
+   . S @MAP@("MEDDIRSEQ")
+"RTN","CCRMEDS",122,0)
+   . S @MAP@("MEDMULDIRMOD")
+"RTN","CCRMEDS",123,0)
+   . S @MAP@("MEDPTINSTRUCTIONS")
+"RTN","CCRMEDS",124,0)
+   . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")
+"RTN","CCRMEDS",125,0)
+   . S @MAP@("MEDRFNO")=MED(9)
+"RTN","CCRMEDS",126,0)
+   . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J))
+"RTN","CCRMEDS",127,0)
+   . K @RESULT
+"RTN","CCRMEDS",128,0)
+   . D MAP^GPLXPATH(INXML,MAP,RESULT)
+"RTN","CCRMEDS",129,0)
+   . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+"RTN","CCRMEDS",130,0)
+   . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+"RTN","CCRMEDS",131,0)
+   N MEDTMP,MEDI
+"RTN","CCRMEDS",132,0)
+   D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","CCRMEDS",133,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","CCRMEDS",134,0)
+   . W "MEDICATION MISSING ",!
+"RTN","CCRMEDS",135,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","CCRMEDS",136,0)
+   Q
+"RTN","CCRMEDS",137,0)
+   ;
+"RTN","CCRSYS")
+0^4^B1690193
+"RTN","CCRSYS",1,0)
+CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
+"RTN","CCRSYS",2,0)
+        ;;0.1;CCDCCR;;;Build 4
+"RTN","CCRSYS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRSYS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRSYS",5,0)
+ ;
+"RTN","CCRSYS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRSYS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRSYS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRSYS",9,0)
+ ;(at your option) any later version.
+"RTN","CCRSYS",10,0)
+ ;
+"RTN","CCRSYS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRSYS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRSYS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRSYS",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRSYS",15,0)
+ ;
+"RTN","CCRSYS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRSYS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRSYS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRSYS",19,0)
+    ;
+"RTN","CCRSYS",20,0)
+        W "Enter at appropriate points." Q
+"RTN","CCRSYS",21,0)
+        ;
+"RTN","CCRSYS",22,0)
+        ; Originally, I was going to use VEPERVER, but VEPERVER
+"RTN","CCRSYS",23,0)
+        ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
+"RTN","CCRSYS",24,0)
+        ; manner (press any key to continue),
+"RTN","CCRSYS",25,0)
+        ; and is really a very half finished routine
+"RTN","CCRSYS",26,0)
+        ;
+"RTN","CCRSYS",27,0)
+        ; So for now, I am hard-coding the values.
+"RTN","CCRSYS",28,0)
+        ;
+"RTN","CCRSYS",29,0)
+SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
+"RTN","CCRSYS",30,0)
+        Q "WorldVistA EHR/VOE"
+"RTN","CCRSYS",31,0)
+        ;
+"RTN","CCRSYS",32,0)
+SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
+"RTN","CCRSYS",33,0)
+        Q "1.0"
+"RTN","CCRSYS",34,0)
+        ;
+"RTN","CCRUNIT")
+0^5^B8574
+"RTN","CCRUNIT",1,0)
+CCRUNIT ; A routine that tests some crap
+"RTN","CCRUNIT",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 4
+"RTN","CCRUNIT",3,0)
+        Q
+"RTN","CCRUNIT",4,0)
+        ;
+"RTN","CCRUNIT",5,0)
+MEDS
+"RTN","CCRUNIT",6,0)
+        N DEBUG S DEBUG=0
+"RTN","CCRUNIT",7,0)
+        N DFN S DFN=1
+"RTN","CCRUNIT",8,0)
+        K ^TMP($J)
+"RTN","CCRUNIT",9,0)
+        W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+"RTN","CCRUNIT",10,0)
+        N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
+"RTN","CCRUNIT",11,0)
+        B
+"RTN","CCRUNIT",12,0)
+        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+"RTN","CCRUNIT",13,0)
+        W "XPATH is: "_XPATH,!
+"RTN","CCRUNIT",14,0)
+        W "Getting Med Template into INXML using",!
+"RTN","CCRUNIT",15,0)
+        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+"RTN","CCRUNIT",16,0)
+        N INXML
+"RTN","CCRUNIT",17,0)
+        D QUERY^GPLXPATH(T,XPATH,"INXML")
+"RTN","CCRUNIT",18,0)
+        B
+"RTN","CCRUNIT",19,0)
+        W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
+"RTN","CCRUNIT",20,0)
+        W "OUTXML will be ^TMP($J,""OUT"")",!
+"RTN","CCRUNIT",21,0)
+        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+"RTN","CCRUNIT",22,0)
+        D EXTRACT^GPLMEDS("INXML",DFN,OUTXML)
+"RTN","CCRUNIT",23,0)
+        Q
+"RTN","CCRUTIL")
+0^6^B17726385
+"RTN","CCRUTIL",1,0)
+CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
+"RTN","CCRUTIL",2,0)
+          ;;0.1;CCRCCD;;Jun 15, 2008;Build 4
+"RTN","CCRUTIL",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRUTIL",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRUTIL",5,0)
+ ;
+"RTN","CCRUTIL",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRUTIL",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRUTIL",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRUTIL",9,0)
+ ;(at your option) any later version.
+"RTN","CCRUTIL",10,0)
+ ;
+"RTN","CCRUTIL",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRUTIL",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRUTIL",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRUTIL",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRUTIL",15,0)
+ ;
+"RTN","CCRUTIL",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRUTIL",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRUTIL",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRUTIL",19,0)
+    ;
+"RTN","CCRUTIL",20,0)
+          W "No Entry at Top!"
+"RTN","CCRUTIL",21,0)
+          Q
+"RTN","CCRUTIL",22,0)
+          ;
+"RTN","CCRUTIL",23,0)
+FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
+"RTN","CCRUTIL",24,0)
+          ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+"RTN","CCRUTIL",25,0)
+          ; If not passed, or passed incorrectly, it's assumed that it is D.
+"RTN","CCRUTIL",26,0)
+          ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+"RTN","CCRUTIL",27,0)
+          ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+"RTN","CCRUTIL",28,0)
+          ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+"RTN","CCRUTIL",29,0)
+          N UTC,Y,M,D,H,MM,S,OFF
+"RTN","CCRUTIL",30,0)
+          S Y=1700+$E(DATE,1,3)
+"RTN","CCRUTIL",31,0)
+          S M=$E(DATE,4,5)
+"RTN","CCRUTIL",32,0)
+          S D=$E(DATE,6,7)
+"RTN","CCRUTIL",33,0)
+          S H=$E(DATE,9,10)
+"RTN","CCRUTIL",34,0)
+          I $L(H)=1 S H="0"_H
+"RTN","CCRUTIL",35,0)
+          S MM=$E(DATE,11,12)
+"RTN","CCRUTIL",36,0)
+          I $L(MM)=1 S MM="0"_MM
+"RTN","CCRUTIL",37,0)
+          S S=$E(DATE,13,14)
+"RTN","CCRUTIL",38,0)
+          I $L(S)=1 S S="0"_S
+"RTN","CCRUTIL",39,0)
+          S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+"RTN","CCRUTIL",40,0)
+          ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+"RTN","CCRUTIL",41,0)
+          ; In this case, set H, MM and S to "00"
+"RTN","CCRUTIL",42,0)
+          ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
+"RTN","CCRUTIL",43,0)
+          S:'$L(H) H="00"
+"RTN","CCRUTIL",44,0)
+          S:'$L(MM) MM="00"
+"RTN","CCRUTIL",45,0)
+          S:'$L(S) S="00"
+"RTN","CCRUTIL",46,0)
+          S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+"RTN","CCRUTIL",47,0)
+          I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+"RTN","CCRUTIL",48,0)
+          E  Q $P(UTC,"T")
+"RTN","CCRUTIL",49,0)
+          ;
+"RTN","CCRUTIL",50,0)
+SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+"RTN","CCRUTIL",51,0)
+               ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+"RTN","CCRUTIL",52,0)
+               ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+"RTN","CCRUTIL",53,0)
+               ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+"RTN","CCRUTIL",54,0)
+               ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+"RTN","CCRUTIL",55,0)
+               ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+"RTN","CCRUTIL",56,0)
+               ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+"RTN","CCRUTIL",57,0)
+               ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+"RTN","CCRUTIL",58,0)
+          N VSRT ; TEMP FOR HASHING DATES
+"RTN","CCRUTIL",59,0)
+          N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+"RTN","CCRUTIL",60,0)
+          S ZCNT=0 ; COUNTING NUMBER OF DATES
+"RTN","CCRUTIL",61,0)
+          S ZTMP="" ;
+"RTN","CCRUTIL",62,0)
+          F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
+"RTN","CCRUTIL",63,0)
+          . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","CCRUTIL",64,0)
+          . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
+"RTN","CCRUTIL",65,0)
+          . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
+"RTN","CCRUTIL",66,0)
+          . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
+"RTN","CCRUTIL",67,0)
+          . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
+"RTN","CCRUTIL",68,0)
+          . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
+"RTN","CCRUTIL",69,0)
+          . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
+"RTN","CCRUTIL",70,0)
+          . I DEBUG W "ZTMP=",ZTMP," "
+"RTN","CCRUTIL",71,0)
+          S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
+"RTN","CCRUTIL",72,0)
+          ; I DEBUG ZWR V2
+"RTN","CCRUTIL",73,0)
+          ; I DEBUG ZWR VSRT
+"RTN","CCRUTIL",74,0)
+          N ZD,ZT ; DATA AND TIME ITERATORS
+"RTN","CCRUTIL",75,0)
+          N ZDONE ; DONE FLAG
+"RTN","CCRUTIL",76,0)
+          S (ZD,ZT)=""
+"RTN","CCRUTIL",77,0)
+          S ZDONE=0
+"RTN","CCRUTIL",78,0)
+          N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
+"RTN","CCRUTIL",79,0)
+          S UORDR=ORDR ; DIRECTION TO SORT
+"RTN","CCRUTIL",80,0)
+          I ORDR="" S UORDR=1
+"RTN","CCRUTIL",81,0)
+          N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
+"RTN","CCRUTIL",82,0)
+          F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
+"RTN","CCRUTIL",83,0)
+          . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE
+"RTN","CCRUTIL",84,0)
+          . I ZD="" S ZDONE=1
+"RTN","CCRUTIL",85,0)
+          . I 'ZDONE D  ; MORE DATES
+"RTN","CCRUTIL",86,0)
+          . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
+"RTN","CCRUTIL",87,0)
+          . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
+"RTN","CCRUTIL",88,0)
+          . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
+"RTN","CCRUTIL",89,0)
+          . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
+"RTN","CCRUTIL",90,0)
+          . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
+"RTN","CCRUTIL",91,0)
+          Q ZCNT
+"RTN","CCRUTIL",92,0)
+          ;
+"RTN","CCRVA200")
+0^7^B35847405
+"RTN","CCRVA200",1,0)
+CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
+"RTN","CCRVA200",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 4
+"RTN","CCRVA200",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRVA200",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRVA200",5,0)
+ ;
+"RTN","CCRVA200",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRVA200",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRVA200",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRVA200",9,0)
+ ;(at your option) any later version.
+"RTN","CCRVA200",10,0)
+ ;
+"RTN","CCRVA200",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRVA200",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRVA200",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRVA200",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRVA200",15,0)
+ ;
+"RTN","CCRVA200",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRVA200",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRVA200",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRVA200",19,0)
+        Q
+"RTN","CCRVA200",20,0)
+        ; This routine uses Kernel APIs and Direct Global Access to get
+"RTN","CCRVA200",21,0)
+        ; Proivder Data from File 200.
+"RTN","CCRVA200",22,0)
+        ;
+"RTN","CCRVA200",23,0)
+        ; The Global is VA(200,*)
+"RTN","CCRVA200",24,0)
+        ;
+"RTN","CCRVA200",25,0)
+FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",26,0)
+        ; INPUT: DUZ (i.e. File 200 IEN) ByVal
+"RTN","CCRVA200",27,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",28,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",29,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",30,0)
+        Q NAME("FAMILY")
+"RTN","CCRVA200",31,0)
+        ;
+"RTN","CCRVA200",32,0)
+GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",33,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",34,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",35,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",36,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",37,0)
+        Q NAME("GIVEN")
+"RTN","CCRVA200",38,0)
+        ;
+"RTN","CCRVA200",39,0)
+MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",40,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",41,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",42,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",43,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",44,0)
+        Q NAME("MIDDLE")
+"RTN","CCRVA200",45,0)
+        ;
+"RTN","CCRVA200",46,0)
+SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",47,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",48,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",49,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",50,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",51,0)
+        Q NAME("SUFFIX")
+"RTN","CCRVA200",52,0)
+        ;
+"RTN","CCRVA200",53,0)
+TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",54,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",55,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",56,0)
+        ; Gets External Value of Title field in New Person File.
+"RTN","CCRVA200",57,0)
+        ; It's actually a pointer to file 3.1
+"RTN","CCRVA200",58,0)
+        ; 200=New Person File; 8 is Title Field
+"RTN","CCRVA200",59,0)
+        Q $$GET1^DIQ(200,DUZ_",",8)
+"RTN","CCRVA200",60,0)
+        ;
+"RTN","CCRVA200",61,0)
+NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",62,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",63,0)
+        ; OUTPUT: Delimited String in format:
+"RTN","CCRVA200",64,0)
+        ;       IDType^ID^IDDescription
+"RTN","CCRVA200",65,0)
+        ; If the NPI doesn't exist, "" is returned.
+"RTN","CCRVA200",66,0)
+        ; This routine uses a call documented in the Kernel dev guide
+"RTN","CCRVA200",67,0)
+        ; This call returns as "NPI^TimeEntered^ActiveInactive"
+"RTN","CCRVA200",68,0)
+        ; It returns -1 for NPI if NPI doesn't exist.
+"RTN","CCRVA200",69,0)
+        N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+"RTN","CCRVA200",70,0)
+        Q:NPI=-1 ""
+"RTN","CCRVA200",71,0)
+        Q "NPI^"_NPI_"^HHS"
+"RTN","CCRVA200",72,0)
+        ;
+"RTN","CCRVA200",73,0)
+SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",74,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",75,0)
+        ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
+"RTN","CCRVA200",76,0)
+        ; Uses a Kernel API. Returns -1 if a specialty is not specified
+"RTN","CCRVA200",77,0)
+        ;       in file 200.
+"RTN","CCRVA200",78,0)
+        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
+"RTN","CCRVA200",79,0)
+        N STR S STR=$$GET^XUA4A72(DUZ)
+"RTN","CCRVA200",80,0)
+        Q:+STR<0 ""
+"RTN","CCRVA200",81,0)
+        ; Sometimes we have 3 pieces, or 2. Deal with that.
+"RTN","CCRVA200",82,0)
+        Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+"RTN","CCRVA200",83,0)
+        Q $P(STR,U,2)_"-"_$P(STR,U,3)
+"RTN","CCRVA200",84,0)
+        ;
+"RTN","CCRVA200",85,0)
+ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",86,0)
+        ; INPUT: DUZ, but not needed really... here for future expansion
+"RTN","CCRVA200",87,0)
+        ; OUTPUT: At this point "Work"
+"RTN","CCRVA200",88,0)
+        Q "Work"
+"RTN","CCRVA200",89,0)
+        ;
+"RTN","CCRVA200",90,0)
+ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",91,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",92,0)
+        ; Output: String.
+"RTN","CCRVA200",93,0)
+        ;
+"RTN","CCRVA200",94,0)
+        ; First, get site number from the institution file.
+"RTN","CCRVA200",95,0)
+        ; 1st piece returned by $$SITE^VASITE, which gets the system institution
+"RTN","CCRVA200",96,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",97,0)
+        ;
+"RTN","CCRVA200",98,0)
+        ; Second, get mailing address
+"RTN","CCRVA200",99,0)
+        ; There are two APIs to get the address, one for physical and one for
+"RTN","CCRVA200",100,0)
+        ; mailing. We will check if mailing exists first, since that's the
+"RTN","CCRVA200",101,0)
+        ; one we want to use; then check for physical. If neither exists,
+"RTN","CCRVA200",102,0)
+        ; then we return nothing. We check for the existence of an address
+"RTN","CCRVA200",103,0)
+        ; by the length of the returned string.
+"RTN","CCRVA200",104,0)
+        ; NOTE: API doesn't support Address 2, so I won't even include it
+"RTN","CCRVA200",105,0)
+        ; in the template.
+"RTN","CCRVA200",106,0)
+        N ADD
+"RTN","CCRVA200",107,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",108,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",109,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",110,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",111,0)
+        Q ""
+"RTN","CCRVA200",112,0)
+        ;
+"RTN","CCRVA200",113,0)
+CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",114,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",115,0)
+        ; Output: String.
+"RTN","CCRVA200",116,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",117,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",118,0)
+        N ADD
+"RTN","CCRVA200",119,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",120,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",121,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",122,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",123,0)
+        Q ""
+"RTN","CCRVA200",124,0)
+        ;
+"RTN","CCRVA200",125,0)
+STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",126,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",127,0)
+        ; Output: String.
+"RTN","CCRVA200",128,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",129,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",130,0)
+        N ADD
+"RTN","CCRVA200",131,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",132,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",133,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",134,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",135,0)
+        Q ""
+"RTN","CCRVA200",136,0)
+        ;
+"RTN","CCRVA200",137,0)
+POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",138,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",139,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",140,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",141,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",142,0)
+        N ADD
+"RTN","CCRVA200",143,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",144,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",145,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",146,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",147,0)
+        Q ""
+"RTN","CCRVA200",148,0)
+        ;
+"RTN","CCRVA200",149,0)
+TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",150,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",151,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",152,0)
+        ; Direct global access
+"RTN","CCRVA200",153,0)
+        N TEL S TEL=$G(^VA(200,DUZ,.13))
+"RTN","CCRVA200",154,0)
+        Q $P(TEL,U,2)
+"RTN","CCRVA200",155,0)
+        ;
+"RTN","CCRVA200",156,0)
+TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",157,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",158,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",159,0)
+        Q "Office"
+"RTN","CCRVA200",160,0)
+        ;
+"RTN","CCRVA200",161,0)
+EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",162,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",163,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",164,0)
+        ; Direct global access
+"RTN","CCRVA200",165,0)
+        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+"RTN","CCRVA200",166,0)
+        Q $P(EMAIL,U)
+"RTN","CCRVA200",167,0)
+        ;
+"RTN","GPLACTOR")
+0^8^B58306782
+"RTN","GPLACTOR",1,0)
+GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+"RTN","GPLACTOR",2,0)
+ ;;0.3;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLACTOR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLACTOR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLACTOR",5,0)
+ ;
+"RTN","GPLACTOR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLACTOR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLACTOR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLACTOR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLACTOR",10,0)
+ ;
+"RTN","GPLACTOR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLACTOR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLACTOR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLACTOR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLACTOR",15,0)
+ ;
+"RTN","GPLACTOR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLACTOR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLACTOR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLACTOR",19,0)
+    ;
+"RTN","GPLACTOR",20,0)
+    ;  PROCESS THE ACTORS SECTION OF THE CCR
+"RTN","GPLACTOR",21,0)
+    ;
+"RTN","GPLACTOR",22,0)
+    ; ===Revision History===
+"RTN","GPLACTOR",23,0)
+    ; 0.1 Initial Writing of Skeleton--GPL
+"RTN","GPLACTOR",24,0)
+    ; 0.2 Patient Data Extraction--SMH
+"RTN","GPLACTOR",25,0)
+    ; 0.3 Information System Info Extraction--SMH
+"RTN","GPLACTOR",26,0)
+    ;
+"RTN","GPLACTOR",27,0)
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+"RTN","GPLACTOR",28,0)
+  ; IPXML is the Input Actor Template into which we  substitute values
+"RTN","GPLACTOR",29,0)
+  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+"RTN","GPLACTOR",30,0)
+  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
+"RTN","GPLACTOR",31,0)
+  ; ^TMP(7542,1,"ACTORS",0)=Count
+"RTN","GPLACTOR",32,0)
+  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+"RTN","GPLACTOR",33,0)
+  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+"RTN","GPLACTOR",34,0)
+  ; AXML is the output arrary, to contain XML.
+"RTN","GPLACTOR",35,0)
+  ;
+"RTN","GPLACTOR",36,0)
+           N I,J,AMAP,AOID,ATYP,AIEN
+"RTN","GPLACTOR",37,0)
+           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+"RTN","GPLACTOR",38,0)
+           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+"RTN","GPLACTOR",39,0)
+           W "PROCESSING ACTORS ",!
+"RTN","GPLACTOR",40,0)
+           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+"RTN","GPLACTOR",41,0)
+           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",42,0)
+           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+"RTN","GPLACTOR",43,0)
+           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+"RTN","GPLACTOR",44,0)
+           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+"RTN","GPLACTOR",45,0)
+           . I ATYP="" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",46,0)
+           . ;
+"RTN","GPLACTOR",47,0)
+           . W AOID_" "_ATYP_" "_AIEN,!
+"RTN","GPLACTOR",48,0)
+           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+"RTN","GPLACTOR",49,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+"RTN","GPLACTOR",50,0)
+           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",51,0)
+           . ;
+"RTN","GPLACTOR",52,0)
+           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+"RTN","GPLACTOR",53,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+"RTN","GPLACTOR",54,0)
+           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",55,0)
+           . ;
+"RTN","GPLACTOR",56,0)
+           . I ATYP="NOK" D  ; NOK ACTOR TYPE
+"RTN","GPLACTOR",57,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+"RTN","GPLACTOR",58,0)
+           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",59,0)
+           . ;
+"RTN","GPLACTOR",60,0)
+           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",61,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+"RTN","GPLACTOR",62,0)
+           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",63,0)
+           . ;
+"RTN","GPLACTOR",64,0)
+           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",65,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+"RTN","GPLACTOR",66,0)
+           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",67,0)
+           . ;
+"RTN","GPLACTOR",68,0)
+           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+"RTN","GPLACTOR",69,0)
+           ;
+"RTN","GPLACTOR",70,0)
+           N ACTTMP
+"RTN","GPLACTOR",71,0)
+           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLACTOR",72,0)
+           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLACTOR",73,0)
+           . ; STRINGS MARKED AS @@X@@
+"RTN","GPLACTOR",74,0)
+           . W "ACTORS Missing list: ",!
+"RTN","GPLACTOR",75,0)
+           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+"RTN","GPLACTOR",76,0)
+           Q
+"RTN","GPLACTOR",77,0)
+           ;
+"RTN","GPLACTOR",78,0)
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+"RTN","GPLACTOR",79,0)
+     ;
+"RTN","GPLACTOR",80,0)
+     W "PROCESSING ACTOR PATIENT ",AIEN,!
+"RTN","GPLACTOR",81,0)
+     N AMAP,ZX
+"RTN","GPLACTOR",82,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",83,0)
+     K @AMAP
+"RTN","GPLACTOR",84,0)
+     D INIT^CCRDPT(AIEN)
+"RTN","GPLACTOR",85,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",86,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
+"RTN","GPLACTOR",87,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
+"RTN","GPLACTOR",88,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
+"RTN","GPLACTOR",89,0)
+     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
+"RTN","GPLACTOR",90,0)
+     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
+"RTN","GPLACTOR",91,0)
+     S @AMAP@("ACTORSSN")=""
+"RTN","GPLACTOR",92,0)
+     S @AMAP@("ACTORSSNTEXT")=""
+"RTN","GPLACTOR",93,0)
+     S @AMAP@("ACTORSSNSOURCEID")=""
+"RTN","GPLACTOR",94,0)
+     S ZX=$$SSN^CCRDPT
+"RTN","GPLACTOR",95,0)
+     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+"RTN","GPLACTOR",96,0)
+     . S @AMAP@("ACTORSSN")=ZX
+"RTN","GPLACTOR",97,0)
+     . S @AMAP@("ACTORSSNTEXT")="SSN"
+"RTN","GPLACTOR",98,0)
+     . S @AMAP@("ACTORSSNSOURCEID")=AOID
+"RTN","GPLACTOR",99,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
+"RTN","GPLACTOR",100,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
+"RTN","GPLACTOR",101,0)
+     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
+"RTN","GPLACTOR",102,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
+"RTN","GPLACTOR",103,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
+"RTN","GPLACTOR",104,0)
+     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
+"RTN","GPLACTOR",105,0)
+     S @AMAP@("ACTORRESTEL")=""
+"RTN","GPLACTOR",106,0)
+     S @AMAP@("ACTORRESTELTEXT")=""
+"RTN","GPLACTOR",107,0)
+     S ZX=$$RESTEL^CCRDPT
+"RTN","GPLACTOR",108,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",109,0)
+     . S @AMAP@("ACTORRESTEL")=ZX
+"RTN","GPLACTOR",110,0)
+     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+"RTN","GPLACTOR",111,0)
+     S @AMAP@("ACTORWORKTEL")=""
+"RTN","GPLACTOR",112,0)
+     S @AMAP@("ACTORWORKTELTEXT")=""
+"RTN","GPLACTOR",113,0)
+     S ZX=$$WORKTEL^CCRDPT
+"RTN","GPLACTOR",114,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",115,0)
+     . S @AMAP@("ACTORWORKTEL")=ZX
+"RTN","GPLACTOR",116,0)
+     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+"RTN","GPLACTOR",117,0)
+     S @AMAP@("ACTORCELLTEL")=""
+"RTN","GPLACTOR",118,0)
+     S @AMAP@("ACTORCELLTELTEXT")=""
+"RTN","GPLACTOR",119,0)
+     S ZX=$$CELLTEL^CCRDPT
+"RTN","GPLACTOR",120,0)
+     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+"RTN","GPLACTOR",121,0)
+     . S @AMAP@("ACTORCELLTEL")=ZX
+"RTN","GPLACTOR",122,0)
+     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+"RTN","GPLACTOR",123,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
+"RTN","GPLACTOR",124,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+"RTN","GPLACTOR",125,0)
+     S @AMAP@("ACTORIEN")=AIEN
+"RTN","GPLACTOR",126,0)
+     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+"RTN","GPLACTOR",127,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",128,0)
+         D DESTROY^CCRDPT
+"RTN","GPLACTOR",129,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",130,0)
+     Q
+"RTN","GPLACTOR",131,0)
+     ;
+"RTN","GPLACTOR",132,0)
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+"RTN","GPLACTOR",133,0)
+     ;
+"RTN","GPLACTOR",134,0)
+     ; N AMAP
+"RTN","GPLACTOR",135,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",136,0)
+     K @AMAP
+"RTN","GPLACTOR",137,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",138,0)
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
+"RTN","GPLACTOR",139,0)
+         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
+"RTN","GPLACTOR",140,0)
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+"RTN","GPLACTOR",141,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",142,0)
+     Q
+"RTN","GPLACTOR",143,0)
+     ;
+"RTN","GPLACTOR",144,0)
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+"RTN","GPLACTOR",145,0)
+     ;
+"RTN","GPLACTOR",146,0)
+     ; N AMAP
+"RTN","GPLACTOR",147,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",148,0)
+     K @AMAP
+"RTN","GPLACTOR",149,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",150,0)
+     S @AMAP@("ACTORDISPLAYNAME")=""
+"RTN","GPLACTOR",151,0)
+     S @AMAP@("ACTORRELATION")=""
+"RTN","GPLACTOR",152,0)
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+"RTN","GPLACTOR",153,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",154,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",155,0)
+     Q
+"RTN","GPLACTOR",156,0)
+     ;
+"RTN","GPLACTOR",157,0)
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+"RTN","GPLACTOR",158,0)
+     ;
+"RTN","GPLACTOR",159,0)
+     ; N AMAP
+"RTN","GPLACTOR",160,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",161,0)
+     K @AMAP
+"RTN","GPLACTOR",162,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",163,0)
+     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
+"RTN","GPLACTOR",164,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",165,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",166,0)
+     Q
+"RTN","GPLACTOR",167,0)
+     ;
+"RTN","GPLACTOR",168,0)
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+"RTN","GPLACTOR",169,0)
+     ;
+"RTN","GPLACTOR",170,0)
+     ; N AMAP
+"RTN","GPLACTOR",171,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",172,0)
+     K @AMAP
+"RTN","GPLACTOR",173,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",174,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
+"RTN","GPLACTOR",175,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",176,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
+"RTN","GPLACTOR",177,0)
+         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",178,0)
+         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
+"RTN","GPLACTOR",179,0)
+         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
+"RTN","GPLACTOR",180,0)
+         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
+"RTN","GPLACTOR",181,0)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
+"RTN","GPLACTOR",182,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",183,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
+"RTN","GPLACTOR",184,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
+"RTN","GPLACTOR",185,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
+"RTN","GPLACTOR",186,0)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
+"RTN","GPLACTOR",187,0)
+     S @AMAP@("ACTORTELEPHONE")=""
+"RTN","GPLACTOR",188,0)
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+"RTN","GPLACTOR",189,0)
+     S ZX=$$TEL^CCRVA200(AIEN)
+"RTN","GPLACTOR",190,0)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+"RTN","GPLACTOR",191,0)
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+"RTN","GPLACTOR",192,0)
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",193,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
+"RTN","GPLACTOR",194,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",195,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",196,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",197,0)
+     Q
+"RTN","GPLACTOR",198,0)
+     ;
+"RTN","GPLCCD")
+0^16^B106978605
+"RTN","GPLCCD",1,0)
+GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
+"RTN","GPLCCD",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLCCD",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD",5,0)
+ ;
+"RTN","GPLCCD",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD",10,0)
+ ;
+"RTN","GPLCCD",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD",15,0)
+ ;
+"RTN","GPLCCD",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD",19,0)
+ ;
+"RTN","GPLCCD",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCD",21,0)
+ ;
+"RTN","GPLCCD",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCD",23,0)
+       ; Select a patient.
+"RTN","GPLCCD",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCD",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCD",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCD",27,0)
+       ; N CCDGLO
+"RTN","GPLCCD",28,0)
+       D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+"RTN","GPLCCD",29,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
+"RTN","GPLCCD",30,0)
+       S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+"RTN","GPLCCD",31,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCD",32,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCD",33,0)
+       . S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCD",34,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCD",35,0)
+       . ;S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCD",36,0)
+       S ODIR=@ODIRGLB
+"RTN","GPLCCD",37,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCD",38,0)
+       Q
+"RTN","GPLCCD",39,0)
+       ;
+"RTN","GPLCCD",40,0)
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCD",41,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCD",42,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCD",43,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCD",44,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCD",45,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCD",46,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCD",47,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCD",48,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCD",49,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCD",50,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+"RTN","GPLCCD",51,0)
+    S DEBUG=0
+"RTN","GPLCCD",52,0)
+    N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+"RTN","GPLCCD",53,0)
+    I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+"RTN","GPLCCD",54,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCD",55,0)
+    I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+"RTN","GPLCCD",56,0)
+    E  S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCD",57,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCD",58,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCD",59,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCD",60,0)
+    I CCD D LOAD^GPLCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",61,0)
+    E  D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",62,0)
+    D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCD",63,0)
+    N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+"RTN","GPLCCD",64,0)
+    S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+"RTN","GPLCCD",65,0)
+    S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+"RTN","GPLCCD",66,0)
+    S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+"RTN","GPLCCD",67,0)
+    S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+"RTN","GPLCCD",68,0)
+    S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+"RTN","GPLCCD",69,0)
+    S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+"RTN","GPLCCD",70,0)
+    ;
+"RTN","GPLCCD",71,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCD",72,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCD",73,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",74,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",75,0)
+    I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCD",76,0)
+    I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+"RTN","GPLCCD",77,0)
+    ;
+"RTN","GPLCCD",78,0)
+    I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCD",79,0)
+    ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+"RTN","GPLCCD",80,0)
+    S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+"RTN","GPLCCD",81,0)
+    D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
+"RTN","GPLCCD",82,0)
+    D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+"RTN","GPLCCD",83,0)
+    I DEBUG D PARY^GPLXPATH("ACTT2")
+"RTN","GPLCCD",84,0)
+    D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
+"RTN","GPLCCD",85,0)
+    I DEBUG D PARY^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",86,0)
+    K ACTT1 K ACCT2
+"RTN","GPLCCD",87,0)
+    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+"RTN","GPLCCD",88,0)
+    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+"RTN","GPLCCD",89,0)
+    D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+"RTN","GPLCCD",90,0)
+    D CP^GPLXPATH("ACTT2",CCDGLO)
+"RTN","GPLCCD",91,0)
+    ;
+"RTN","GPLCCD",92,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCD",93,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCD",94,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCD",95,0)
+    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCD",96,0)
+    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCD",97,0)
+    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCD",98,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCD",99,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCD",100,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCD",101,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCD",102,0)
+    . S IXML="INXML"
+"RTN","GPLCCD",103,0)
+    . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+"RTN","GPLCCD",104,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCD",105,0)
+    . ; W OXML,!
+"RTN","GPLCCD",106,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCD",107,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCD",108,0)
+    . X CALL
+"RTN","GPLCCD",109,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCD",110,0)
+    . . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+"RTN","GPLCCD",111,0)
+    . . I CCD D UNSHAVE("ITMP",OXML)
+"RTN","GPLCCD",112,0)
+    . . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+"RTN","GPLCCD",113,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCD",114,0)
+    . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",115,0)
+    . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCD",116,0)
+    ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+"RTN","GPLCCD",117,0)
+    ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCD",118,0)
+    ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCD",119,0)
+    ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCD",120,0)
+    ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",121,0)
+    N I,J,DONE S DONE=0
+"RTN","GPLCCD",122,0)
+    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCD",123,0)
+    . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCD",124,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCD",125,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCD",126,0)
+    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+"RTN","GPLCCD",127,0)
+    . N I
+"RTN","GPLCCD",128,0)
+    . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+"RTN","GPLCCD",129,0)
+    . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",130,0)
+    . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+"RTN","GPLCCD",131,0)
+    . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",132,0)
+    . . . S @CCDGLO@(I)="</structuredBody></component>"
+"RTN","GPLCCD",133,0)
+    S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+"RTN","GPLCCD",134,0)
+    S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+"RTN","GPLCCD",135,0)
+    Q
+"RTN","GPLCCD",136,0)
+    ;
+"RTN","GPLCCD",137,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCD",138,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCD",139,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCD",140,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCD",141,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCD",142,0)
+    ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCD",143,0)
+    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCD",144,0)
+    Q
+"RTN","GPLCCD",145,0)
+    ;
+"RTN","GPLCCD",146,0)
+SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+"RTN","GPLCCD",147,0)
+    ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+"RTN","GPLCCD",148,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",149,0)
+    W SHXML,!
+"RTN","GPLCCD",150,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",151,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+"RTN","GPLCCD",152,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+"RTN","GPLCCD",153,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+"RTN","GPLCCD",154,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",155,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",156,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",157,0)
+    Q
+"RTN","GPLCCD",158,0)
+    ;
+"RTN","GPLCCD",159,0)
+UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+"RTN","GPLCCD",160,0)
+    ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+"RTN","GPLCCD",161,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",162,0)
+    W SHXML,!
+"RTN","GPLCCD",163,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",164,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+"RTN","GPLCCD",165,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+"RTN","GPLCCD",166,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+"RTN","GPLCCD",167,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",168,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",169,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",170,0)
+    Q
+"RTN","GPLCCD",171,0)
+    ;
+"RTN","GPLCCD",172,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCD",173,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCD",174,0)
+    ; K @VMAP
+"RTN","GPLCCD",175,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCD",176,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCD",177,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCD",178,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCD",179,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCD",180,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCD",181,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",182,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",183,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCD",184,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCD",185,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCD",186,0)
+    N CTMP
+"RTN","GPLCCD",187,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCD",188,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCD",189,0)
+    Q
+"RTN","GPLCCD",190,0)
+    ;
+"RTN","GPLCCD",191,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCD",192,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCD",193,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCD",194,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCD",195,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCD",196,0)
+    ;OR INSTITUTION
+"RTN","GPLCCD",197,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCD",198,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCD",199,0)
+    N I,J,K,L
+"RTN","GPLCCD",200,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCD",201,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCD",202,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCD",203,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCD",204,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCD",205,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCD",206,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCD",207,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCD",208,0)
+    F J=0:0 D  Q:$O(K(I))=""  ;
+"RTN","GPLCCD",209,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCD",210,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCD",211,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCD",212,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCD",213,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCD",214,0)
+    Q
+"RTN","GPLCCD",215,0)
+    ;
+"RTN","GPLCCD",216,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCD",217,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCD",218,0)
+  Q
+"RTN","GPLCCD",219,0)
+  ;
+"RTN","GPLCCD",220,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCD",221,0)
+  N ZTMP
+"RTN","GPLCCD",222,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",223,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCD",224,0)
+  Q
+"RTN","GPLCCD",225,0)
+  ;
+"RTN","GPLCCD",226,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCD",227,0)
+  N ZTMP
+"RTN","GPLCCD",228,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",229,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCD",230,0)
+  Q
+"RTN","GPLCCD",231,0)
+  ;
+"RTN","GPLCCD",232,0)
+ ;;><TEST>
+"RTN","GPLCCD",233,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCD",234,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",235,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCD",236,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCD",237,0)
+ ;;><VITALS>
+"RTN","GPLCCD",238,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",239,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCD",240,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCD",241,0)
+ ;;><CCR>
+"RTN","GPLCCD",242,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",243,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",244,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",245,0)
+ ;;><ACTLST>
+"RTN","GPLCCD",246,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",247,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",248,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCD",249,0)
+ ;;><ACTORS>
+"RTN","GPLCCD",250,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCD",251,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCD",252,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCD",253,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCD",254,0)
+ ;;><TRIM>
+"RTN","GPLCCD",255,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCD",256,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",257,0)
+ ;;><CCD>
+"RTN","GPLCCD",258,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",259,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
+"RTN","GPLCCD",260,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",261,0)
+ ;;></TEST>
+"RTN","GPLCCD1")
+0^17^B100039732
+"RTN","GPLCCD1",1,0)
+GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
+"RTN","GPLCCD1",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLCCD1",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD1",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD1",5,0)
+ ;
+"RTN","GPLCCD1",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD1",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD1",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD1",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD1",10,0)
+ ;
+"RTN","GPLCCD1",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD1",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD1",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD1",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD1",15,0)
+ ;
+"RTN","GPLCCD1",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD1",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD1",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD1",19,0)
+ ;
+"RTN","GPLCCD1",20,0)
+          W "This is a CCD TEMPLATE with processing routines",!
+"RTN","GPLCCD1",21,0)
+          W !
+"RTN","GPLCCD1",22,0)
+          Q
+"RTN","GPLCCD1",23,0)
+          ;
+"RTN","GPLCCD1",24,0)
+ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
+"RTN","GPLCCD1",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCD1",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCD1",28,0)
+          ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
+"RTN","GPLCCD1",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCD1",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCD1",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCD1",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCD1",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCD1",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCD1",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCD1",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCD1",37,0)
+          Q
+"RTN","GPLCCD1",38,0)
+          ;
+"RTN","GPLCCD1",39,0)
+ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+"RTN","GPLCCD1",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCD1",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCD1",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCD1",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCD1",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCD1",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCD1",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCD1",48,0)
+          ;
+"RTN","GPLCCD1",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCD1",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCD1",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCD1",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCD1",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCD1",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCD1",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCD1",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCD1",57,0)
+          Q
+"RTN","GPLCCD1",58,0)
+          ;
+"RTN","GPLCCD1",59,0)
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCD1",60,0)
+          D ZLOAD(ARY,"GPLCCD1")
+"RTN","GPLCCD1",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCD1",62,0)
+          Q
+"RTN","GPLCCD1",63,0)
+          ;
+"RTN","GPLCCD1",64,0)
+TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+"RTN","GPLCCD1",65,0)
+          Q
+"RTN","GPLCCD1",66,0)
+MARKUP ;<MARKUP>
+"RTN","GPLCCD1",67,0)
+ ;;<Body>
+"RTN","GPLCCD1",68,0)
+ ;;<Problems>
+"RTN","GPLCCD1",69,0)
+ ;;</Problems>
+"RTN","GPLCCD1",70,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",71,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",72,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",73,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",74,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",75,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",76,0)
+ ;;<Medications>
+"RTN","GPLCCD1",77,0)
+ ;;</Medications>
+"RTN","GPLCCD1",78,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",79,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",80,0)
+ ;;<Results>
+"RTN","GPLCCD1",81,0)
+ ;;</Results>
+"RTN","GPLCCD1",82,0)
+ ;;</Body>
+"RTN","GPLCCD1",83,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCD1",84,0)
+ ;</MARKUP>
+"RTN","GPLCCD1",85,0)
+ ;;<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">
+"RTN","GPLCCD1",86,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",87,0)
+ Q
+"RTN","GPLCCD1",88,0)
+ ;
+"RTN","GPLCCD1",89,0)
+ ;<TEMPLATE>
+"RTN","GPLCCD1",90,0)
+ ;;<?xml version="1.0"?>
+"RTN","GPLCCD1",91,0)
+ ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
+"RTN","GPLCCD1",92,0)
+ ;;<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">
+"RTN","GPLCCD1",93,0)
+ ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
+"RTN","GPLCCD1",94,0)
+ ;;<templateId root="2.16.840.1.113883.10.20.1"/>
+"RTN","GPLCCD1",95,0)
+ ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
+"RTN","GPLCCD1",96,0)
+ ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
+"RTN","GPLCCD1",97,0)
+ ;;<title>Continuity of Care Document</title>
+"RTN","GPLCCD1",98,0)
+ ;;<effectiveTime value="20000407130000+0500"/>
+"RTN","GPLCCD1",99,0)
+ ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+"RTN","GPLCCD1",100,0)
+ ;;<languageCode code="en-US"/>
+"RTN","GPLCCD1",101,0)
+ ;;<recordTarget>
+"RTN","GPLCCD1",102,0)
+ ;;<patientRole>
+"RTN","GPLCCD1",103,0)
+ ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",104,0)
+ ;;<patient>
+"RTN","GPLCCD1",105,0)
+ ;;<name>
+"RTN","GPLCCD1",106,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",107,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",108,0)
+ ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
+"RTN","GPLCCD1",109,0)
+ ;;</name>
+"RTN","GPLCCD1",110,0)
+ ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
+"RTN","GPLCCD1",111,0)
+ ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
+"RTN","GPLCCD1",112,0)
+ ;;</patient>
+"RTN","GPLCCD1",113,0)
+ ;;<providerOrganization>
+"RTN","GPLCCD1",114,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",115,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",116,0)
+ ;;</providerOrganization>
+"RTN","GPLCCD1",117,0)
+ ;;</patientRole>
+"RTN","GPLCCD1",118,0)
+ ;;</recordTarget>
+"RTN","GPLCCD1",119,0)
+ ;;<author>
+"RTN","GPLCCD1",120,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",121,0)
+ ;;<assignedAuthor>
+"RTN","GPLCCD1",122,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",123,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",124,0)
+ ;;<name>
+"RTN","GPLCCD1",125,0)
+ ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
+"RTN","GPLCCD1",126,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",127,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",128,0)
+ ;;</name>
+"RTN","GPLCCD1",129,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",130,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",131,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",132,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",133,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",134,0)
+ ;;</assignedAuthor>
+"RTN","GPLCCD1",135,0)
+ ;;</author>
+"RTN","GPLCCD1",136,0)
+ ;;<informant>
+"RTN","GPLCCD1",137,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",138,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",139,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",140,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",141,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",142,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",143,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",144,0)
+ ;;</informant>
+"RTN","GPLCCD1",145,0)
+ ;;<custodian>
+"RTN","GPLCCD1",146,0)
+ ;;<assignedCustodian>
+"RTN","GPLCCD1",147,0)
+ ;;<representedCustodianOrganization>
+"RTN","GPLCCD1",148,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",149,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",150,0)
+ ;;</representedCustodianOrganization>
+"RTN","GPLCCD1",151,0)
+ ;;</assignedCustodian>
+"RTN","GPLCCD1",152,0)
+ ;;</custodian>
+"RTN","GPLCCD1",153,0)
+ ;;<legalAuthenticator>
+"RTN","GPLCCD1",154,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",155,0)
+ ;;<signatureCode code="S"/>
+"RTN","GPLCCD1",156,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",157,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",158,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",159,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",160,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",161,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",162,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",163,0)
+ ;;</legalAuthenticator>
+"RTN","GPLCCD1",164,0)
+ ;;<Actors>
+"RTN","GPLCCD1",165,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCD1",166,0)
+ ;;<participant typeCode="IND">
+"RTN","GPLCCD1",167,0)
+ ;;<associatedEntity classCode="NOK">
+"RTN","GPLCCD1",168,0)
+ ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
+"RTN","GPLCCD1",169,0)
+ ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
+"RTN","GPLCCD1",170,0)
+ ;;<telecom value="tel:(999)555-1212"/>
+"RTN","GPLCCD1",171,0)
+ ;;<associatedPerson>
+"RTN","GPLCCD1",172,0)
+ ;;<name>
+"RTN","GPLCCD1",173,0)
+ ;;<given>Henrietta</given>
+"RTN","GPLCCD1",174,0)
+ ;;<family>Levin</family>
+"RTN","GPLCCD1",175,0)
+ ;;</name>
+"RTN","GPLCCD1",176,0)
+ ;;</associatedPerson>
+"RTN","GPLCCD1",177,0)
+ ;;</associatedEntity>
+"RTN","GPLCCD1",178,0)
+ ;;</participant>
+"RTN","GPLCCD1",179,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCD1",180,0)
+ ;;</Actors>
+"RTN","GPLCCD1",181,0)
+ ;;<documentationOf>
+"RTN","GPLCCD1",182,0)
+ ;;<serviceEvent classCode="PCPR">
+"RTN","GPLCCD1",183,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",184,0)
+ ;;<high value="@@DATETIME@@"/>
+"RTN","GPLCCD1",185,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",186,0)
+ ;;<performer typeCode="PRF">
+"RTN","GPLCCD1",187,0)
+ ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+"RTN","GPLCCD1",188,0)
+ ;;<time>
+"RTN","GPLCCD1",189,0)
+ ;;<low value="1990"/>
+"RTN","GPLCCD1",190,0)
+ ;;<high value='20000407'/>
+"RTN","GPLCCD1",191,0)
+ ;;</time>
+"RTN","GPLCCD1",192,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",193,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",194,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",195,0)
+ ;;<name>
+"RTN","GPLCCD1",196,0)
+ ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
+"RTN","GPLCCD1",197,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",198,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",199,0)
+ ;;</name>
+"RTN","GPLCCD1",200,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",201,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",202,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",203,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",204,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",205,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",206,0)
+ ;;</performer>
+"RTN","GPLCCD1",207,0)
+ ;;</serviceEvent>
+"RTN","GPLCCD1",208,0)
+ ;;</documentationOf>
+"RTN","GPLCCD1",209,0)
+ ;;<Body>
+"RTN","GPLCCD1",210,0)
+ ;;<PROBLEMS-HTML>
+"RTN","GPLCCD1",211,0)
+ ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
+"RTN","GPLCCD1",212,0)
+ ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
+"RTN","GPLCCD1",213,0)
+ ;;<td>@@PROBLEMDATEOFONSET@@</td>
+"RTN","GPLCCD1",214,0)
+ ;;<td>Active</td></tr>
+"RTN","GPLCCD1",215,0)
+ ;;</tbody></table></text>
+"RTN","GPLCCD1",216,0)
+ ;;</PROBLEMS-HTML>
+"RTN","GPLCCD1",217,0)
+ ;;<Problems>
+"RTN","GPLCCD1",218,0)
+ ;;<component>
+"RTN","GPLCCD1",219,0)
+ ;;<section>
+"RTN","GPLCCD1",220,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
+"RTN","GPLCCD1",221,0)
+ ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
+"RTN","GPLCCD1",222,0)
+ ;;<title>Problems</title>
+"RTN","GPLCCD1",223,0)
+ ;;<entry typeCode="DRIV">
+"RTN","GPLCCD1",224,0)
+ ;;<act classCode="ACT" moodCode="EVN">
+"RTN","GPLCCD1",225,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
+"RTN","GPLCCD1",226,0)
+ ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
+"RTN","GPLCCD1",227,0)
+ ;;<code nullFlavor="NA"/>
+"RTN","GPLCCD1",228,0)
+ ;;<entryRelationship typeCode="SUBJ">
+"RTN","GPLCCD1",229,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",230,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
+"RTN","GPLCCD1",231,0)
+ ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
+"RTN","GPLCCD1",232,0)
+ ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
+"RTN","GPLCCD1",233,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",234,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",235,0)
+ ;;<low value="@@PROBLEMDATEOFONSET@@"/>
+"RTN","GPLCCD1",236,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",237,0)
+ ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
+"RTN","GPLCCD1",238,0)
+ ;;<entryRelationship typeCode="REFR">
+"RTN","GPLCCD1",239,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",240,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
+"RTN","GPLCCD1",241,0)
+ ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+"RTN","GPLCCD1",242,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",243,0)
+ ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
+"RTN","GPLCCD1",244,0)
+ ;;</observation>
+"RTN","GPLCCD1",245,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",246,0)
+ ;;</observation>
+"RTN","GPLCCD1",247,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",248,0)
+ ;;</act>
+"RTN","GPLCCD1",249,0)
+ ;;</entry>
+"RTN","GPLCCD1",250,0)
+ ;;</section>
+"RTN","GPLCCD1",251,0)
+ ;;</component>
+"RTN","GPLCCD1",252,0)
+ ;;</Problems>
+"RTN","GPLCCD1",253,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",254,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",255,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",256,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",257,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",258,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",259,0)
+ ;;<Medications>
+"RTN","GPLCCD1",260,0)
+ ;;</Medications>
+"RTN","GPLCCD1",261,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",262,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",263,0)
+ ;;<Results>
+"RTN","GPLCCD1",264,0)
+ ;;</Results>
+"RTN","GPLCCD1",265,0)
+ ;;</Body>
+"RTN","GPLCCD1",266,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",267,0)
+ ;</TEMPLATE>
+"RTN","GPLCCR")
+0^14^B66792391
+"RTN","GPLCCR",1,0)
+GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
+"RTN","GPLCCR",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLCCR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR",5,0)
+ ;
+"RTN","GPLCCR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR",10,0)
+ ;
+"RTN","GPLCCR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR",15,0)
+ ;
+"RTN","GPLCCR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR",19,0)
+ ;
+"RTN","GPLCCR",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCR",21,0)
+ ;
+"RTN","GPLCCR",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCR",23,0)
+       ; Select a patient.
+"RTN","GPLCCR",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCR",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCR",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCR",27,0)
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+"RTN","GPLCCR",28,0)
+       Q
+"RTN","GPLCCR",29,0)
+       ;
+"RTN","GPLCCR",30,0)
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","GPLCCR",31,0)
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+"RTN","GPLCCR",32,0)
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+"RTN","GPLCCR",33,0)
+       N CCRGLO
+"RTN","GPLCCR",34,0)
+       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
+"RTN","GPLCCR",35,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
+"RTN","GPLCCR",36,0)
+       S ONAM=FN
+"RTN","GPLCCR",37,0)
+       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
+"RTN","GPLCCR",38,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCR",39,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCR",40,0)
+       . ;S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCR",41,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCR",42,0)
+       . S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCR",43,0)
+       S ODIR=DIR
+"RTN","GPLCCR",44,0)
+       I DIR="" S ODIR=@ODIRGLB
+"RTN","GPLCCR",45,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCR",46,0)
+       Q
+"RTN","GPLCCR",47,0)
+       ;
+"RTN","GPLCCR",48,0)
+CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCR",49,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCR",50,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCR",51,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCR",52,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCR",53,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCR",54,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCR",55,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCR",56,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCR",57,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCR",58,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
+"RTN","GPLCCR",59,0)
+    I '$D(DEBUG) S DEBUG=0
+"RTN","GPLCCR",60,0)
+    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
+"RTN","GPLCCR",61,0)
+    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
+"RTN","GPLCCR",62,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCR",63,0)
+    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCR",64,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCR",65,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCR",66,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCR",67,0)
+    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCR",68,0)
+    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCR",69,0)
+    ;
+"RTN","GPLCCR",70,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCR",71,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCR",72,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",73,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",74,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCR",75,0)
+    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+"RTN","GPLCCR",76,0)
+    ;
+"RTN","GPLCCR",77,0)
+    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCR",78,0)
+    ;
+"RTN","GPLCCR",79,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCR",80,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCR",81,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCR",82,0)
+    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCR",83,0)
+    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCR",84,0)
+    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCR",85,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCR",86,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCR",87,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCR",88,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCR",89,0)
+    . S IXML="INXML"
+"RTN","GPLCCR",90,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCR",91,0)
+    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
+"RTN","GPLCCR",92,0)
+    . ; W OXML,!
+"RTN","GPLCCR",93,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCR",94,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCR",95,0)
+    . X CALL
+"RTN","GPLCCR",96,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCR",97,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCR",98,0)
+    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",99,0)
+    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCR",100,0)
+    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCR",101,0)
+    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCR",102,0)
+    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCR",103,0)
+    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",104,0)
+    N TRIMI,J,DONE S DONE=0
+"RTN","GPLCCR",105,0)
+    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCR",106,0)
+    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCR",107,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCR",108,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCR",109,0)
+    Q
+"RTN","GPLCCR",110,0)
+    ;
+"RTN","GPLCCR",111,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCR",112,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCR",113,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCR",114,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCR",115,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCR",116,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCR",117,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCR",118,0)
+    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
+"RTN","GPLCCR",119,0)
+    Q
+"RTN","GPLCCR",120,0)
+    ;
+"RTN","GPLCCR",121,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCR",122,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCR",123,0)
+    ; K @VMAP
+"RTN","GPLCCR",124,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCR",125,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCR",126,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCR",127,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCR",128,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCR",129,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCR",130,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",131,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",132,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCR",133,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCR",134,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCR",135,0)
+    N CTMP
+"RTN","GPLCCR",136,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCR",137,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCR",138,0)
+    Q
+"RTN","GPLCCR",139,0)
+    ;
+"RTN","GPLCCR",140,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCR",141,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCR",142,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCR",143,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCR",144,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCR",145,0)
+    ;OR INSTITUTION
+"RTN","GPLCCR",146,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCR",147,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCR",148,0)
+    N I,J,K,L
+"RTN","GPLCCR",149,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCR",150,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCR",151,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCR",152,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCR",153,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCR",154,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCR",155,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCR",156,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCR",157,0)
+    F J=0:0 D  Q:$O(K(I))=""
+"RTN","GPLCCR",158,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCR",159,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCR",160,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCR",161,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCR",162,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCR",163,0)
+    Q
+"RTN","GPLCCR",164,0)
+    ;
+"RTN","GPLCCR",165,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCR",166,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCR",167,0)
+  Q
+"RTN","GPLCCR",168,0)
+  ;
+"RTN","GPLCCR",169,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCR",170,0)
+  N ZTMP
+"RTN","GPLCCR",171,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",172,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCR",173,0)
+  Q
+"RTN","GPLCCR",174,0)
+  ;
+"RTN","GPLCCR",175,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCR",176,0)
+  N ZTMP
+"RTN","GPLCCR",177,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",178,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCR",179,0)
+  Q
+"RTN","GPLCCR",180,0)
+  ;
+"RTN","GPLCCR",181,0)
+ ;;><TEST>
+"RTN","GPLCCR",182,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCR",183,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",184,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCR",185,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCR",186,0)
+ ;;><VITALS>
+"RTN","GPLCCR",187,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",188,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCR",189,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCR",190,0)
+ ;;><CCR>
+"RTN","GPLCCR",191,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",192,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",193,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCR",194,0)
+ ;;><ACTLST>
+"RTN","GPLCCR",195,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",196,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",197,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCR",198,0)
+ ;;><ACTORS>
+"RTN","GPLCCR",199,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCR",200,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCR",201,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCR",202,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCR",203,0)
+ ;;><TRIM>
+"RTN","GPLCCR",204,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCR",205,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
+"RTN","GPLCCR0")
+0^15^B658213703
+"RTN","GPLCCR0",1,0)
+GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+"RTN","GPLCCR0",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLCCR0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR0",5,0)
+ ;
+"RTN","GPLCCR0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR0",10,0)
+ ;
+"RTN","GPLCCR0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR0",15,0)
+ ;
+"RTN","GPLCCR0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR0",19,0)
+ ;
+"RTN","GPLCCR0",20,0)
+          W "This is a CCR TEMPLATE with processing routines",!
+"RTN","GPLCCR0",21,0)
+          W !
+"RTN","GPLCCR0",22,0)
+          Q
+"RTN","GPLCCR0",23,0)
+          ;
+"RTN","GPLCCR0",24,0)
+ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
+"RTN","GPLCCR0",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCR0",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCR0",28,0)
+          ; I '$G(@ZARY) D  ;
+"RTN","GPLCCR0",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCR0",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCR0",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCR0",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCR0",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCR0",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCR0",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCR0",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCR0",37,0)
+          Q
+"RTN","GPLCCR0",38,0)
+          ;
+"RTN","GPLCCR0",39,0)
+ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
+"RTN","GPLCCR0",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCR0",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCR0",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCR0",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCR0",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCR0",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCR0",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCR0",48,0)
+          ;
+"RTN","GPLCCR0",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCR0",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCR0",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCR0",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCR0",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCR0",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCR0",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCR0",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCR0",57,0)
+          Q
+"RTN","GPLCCR0",58,0)
+          ;
+"RTN","GPLCCR0",59,0)
+LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCR0",60,0)
+          D ZLOAD(ARY,"GPLCCR0")
+"RTN","GPLCCR0",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCR0",62,0)
+          Q
+"RTN","GPLCCR0",63,0)
+          ;
+"RTN","GPLCCR0",64,0)
+ ;<TEMPLATE>
+"RTN","GPLCCR0",65,0)
+ ;;<?xml version="1.0" encoding="UTF-8"?>
+"RTN","GPLCCR0",66,0)
+ ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
+"RTN","GPLCCR0",67,0)
+ ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
+"RTN","GPLCCR0",68,0)
+ ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
+"RTN","GPLCCR0",69,0)
+ ;;<Language>
+"RTN","GPLCCR0",70,0)
+ ;;<Text>English</Text>
+"RTN","GPLCCR0",71,0)
+ ;;</Language>
+"RTN","GPLCCR0",72,0)
+ ;;<Version>V1.0</Version>
+"RTN","GPLCCR0",73,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",74,0)
+ ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",75,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",76,0)
+ ;;<Patient>
+"RTN","GPLCCR0",77,0)
+ ;;<ActorID>@@ACTORPATIENT@@</ActorID>
+"RTN","GPLCCR0",78,0)
+ ;;</Patient>
+"RTN","GPLCCR0",79,0)
+ ;;<From>
+"RTN","GPLCCR0",80,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",81,0)
+ ;;<ActorID>@@ACTORFROM@@</ActorID>
+"RTN","GPLCCR0",82,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",83,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",84,0)
+ ;;<ActorID>@@ACTORFROM2@@</ActorID>
+"RTN","GPLCCR0",85,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",86,0)
+ ;;</From>
+"RTN","GPLCCR0",87,0)
+ ;;<To>
+"RTN","GPLCCR0",88,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",89,0)
+ ;;<ActorID>@@ACTORTO@@</ActorID>
+"RTN","GPLCCR0",90,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",91,0)
+ ;;<Text>@@ACTORTOTEXT@@</Text>
+"RTN","GPLCCR0",92,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",93,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",94,0)
+ ;;</To>
+"RTN","GPLCCR0",95,0)
+ ;;<Purpose>
+"RTN","GPLCCR0",96,0)
+ ;;<Description>
+"RTN","GPLCCR0",97,0)
+ ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
+"RTN","GPLCCR0",98,0)
+ ;;</Description>
+"RTN","GPLCCR0",99,0)
+ ;;</Purpose>
+"RTN","GPLCCR0",100,0)
+ ;;<Body>
+"RTN","GPLCCR0",101,0)
+ ;;<Problems>
+"RTN","GPLCCR0",102,0)
+ ;;<Problem>
+"RTN","GPLCCR0",103,0)
+ ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",104,0)
+ ;;<Type>
+"RTN","GPLCCR0",105,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",106,0)
+ ;;</Type>
+"RTN","GPLCCR0",107,0)
+ ;;<Description>
+"RTN","GPLCCR0",108,0)
+ ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",109,0)
+ ;;<Code>
+"RTN","GPLCCR0",110,0)
+ ;;<Value>@@PROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",111,0)
+ ;;<CodingSystem>ICD9CM</CodingSystem>
+"RTN","GPLCCR0",112,0)
+ ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",113,0)
+ ;;</Code>
+"RTN","GPLCCR0",114,0)
+ ;;</Description>
+"RTN","GPLCCR0",115,0)
+ ;;<Source>
+"RTN","GPLCCR0",116,0)
+ ;;<Actor>
+"RTN","GPLCCR0",117,0)
+ ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",118,0)
+ ;;</Actor>
+"RTN","GPLCCR0",119,0)
+ ;;</Source>
+"RTN","GPLCCR0",120,0)
+ ;;</Problem>
+"RTN","GPLCCR0",121,0)
+ ;;</Problems>
+"RTN","GPLCCR0",122,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCR0",123,0)
+ ;;<FamilyProblemHistory>
+"RTN","GPLCCR0",124,0)
+ ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",125,0)
+ ;;<Source>
+"RTN","GPLCCR0",126,0)
+ ;;<Actor>
+"RTN","GPLCCR0",127,0)
+ ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
+"RTN","GPLCCR0",128,0)
+ ;;</Actor>
+"RTN","GPLCCR0",129,0)
+ ;;</Source>
+"RTN","GPLCCR0",130,0)
+ ;;<FamilyMember>
+"RTN","GPLCCR0",131,0)
+ ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
+"RTN","GPLCCR0",132,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",133,0)
+ ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
+"RTN","GPLCCR0",134,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",135,0)
+ ;;<Source>
+"RTN","GPLCCR0",136,0)
+ ;;<Actor>
+"RTN","GPLCCR0",137,0)
+ ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",138,0)
+ ;;</Actor>
+"RTN","GPLCCR0",139,0)
+ ;;</Source>
+"RTN","GPLCCR0",140,0)
+ ;;</FamilyMember>
+"RTN","GPLCCR0",141,0)
+ ;;<Problem>
+"RTN","GPLCCR0",142,0)
+ ;;<Type>
+"RTN","GPLCCR0",143,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",144,0)
+ ;;</Type>
+"RTN","GPLCCR0",145,0)
+ ;;<Description>
+"RTN","GPLCCR0",146,0)
+ ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",147,0)
+ ;;<Code>
+"RTN","GPLCCR0",148,0)
+ ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
+"RTN","GPLCCR0",149,0)
+ ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",150,0)
+ ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
+"RTN","GPLCCR0",151,0)
+ ;;</Code>
+"RTN","GPLCCR0",152,0)
+ ;;</Description>
+"RTN","GPLCCR0",153,0)
+ ;;<Source>
+"RTN","GPLCCR0",154,0)
+ ;;<Actor>
+"RTN","GPLCCR0",155,0)
+ ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
+"RTN","GPLCCR0",156,0)
+ ;;</Actor>
+"RTN","GPLCCR0",157,0)
+ ;;</Source>
+"RTN","GPLCCR0",158,0)
+ ;;</Problem>
+"RTN","GPLCCR0",159,0)
+ ;;</FamilyProblemHistory>
+"RTN","GPLCCR0",160,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCR0",161,0)
+ ;;<SocialHistory>
+"RTN","GPLCCR0",162,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",163,0)
+ ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",164,0)
+ ;;<Type>
+"RTN","GPLCCR0",165,0)
+ ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
+"RTN","GPLCCR0",166,0)
+ ;;</Type>
+"RTN","GPLCCR0",167,0)
+ ;;<Description>
+"RTN","GPLCCR0",168,0)
+ ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",169,0)
+ ;;</Description>
+"RTN","GPLCCR0",170,0)
+ ;;<Source>
+"RTN","GPLCCR0",171,0)
+ ;;<Actor>
+"RTN","GPLCCR0",172,0)
+ ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",173,0)
+ ;;</Actor>
+"RTN","GPLCCR0",174,0)
+ ;;</Source>
+"RTN","GPLCCR0",175,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",176,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",177,0)
+ ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
+"RTN","GPLCCR0",178,0)
+ ;;<Type>
+"RTN","GPLCCR0",179,0)
+ ;;<Text>Ethnic Origin</Text>
+"RTN","GPLCCR0",180,0)
+ ;;</Type>
+"RTN","GPLCCR0",181,0)
+ ;;<Description>
+"RTN","GPLCCR0",182,0)
+ ;;<Text>Not Hispanic or Latino</Text>
+"RTN","GPLCCR0",183,0)
+ ;;</Description>
+"RTN","GPLCCR0",184,0)
+ ;;<Source>
+"RTN","GPLCCR0",185,0)
+ ;;<Actor>
+"RTN","GPLCCR0",186,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",187,0)
+ ;;</Actor>
+"RTN","GPLCCR0",188,0)
+ ;;</Source>
+"RTN","GPLCCR0",189,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",190,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",191,0)
+ ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
+"RTN","GPLCCR0",192,0)
+ ;;<Type>
+"RTN","GPLCCR0",193,0)
+ ;;<Text>Race</Text>
+"RTN","GPLCCR0",194,0)
+ ;;</Type>
+"RTN","GPLCCR0",195,0)
+ ;;<Description>
+"RTN","GPLCCR0",196,0)
+ ;;<Text>White</Text>
+"RTN","GPLCCR0",197,0)
+ ;;</Description>
+"RTN","GPLCCR0",198,0)
+ ;;<Source>
+"RTN","GPLCCR0",199,0)
+ ;;<Actor>
+"RTN","GPLCCR0",200,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",201,0)
+ ;;</Actor>
+"RTN","GPLCCR0",202,0)
+ ;;</Source>
+"RTN","GPLCCR0",203,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",204,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",205,0)
+ ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
+"RTN","GPLCCR0",206,0)
+ ;;<Type>
+"RTN","GPLCCR0",207,0)
+ ;;<Text>Occupation</Text>
+"RTN","GPLCCR0",208,0)
+ ;;</Type>
+"RTN","GPLCCR0",209,0)
+ ;;<Description>
+"RTN","GPLCCR0",210,0)
+ ;;<Text>Physician</Text>
+"RTN","GPLCCR0",211,0)
+ ;;</Description>
+"RTN","GPLCCR0",212,0)
+ ;;<Source>
+"RTN","GPLCCR0",213,0)
+ ;;<Actor>
+"RTN","GPLCCR0",214,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",215,0)
+ ;;</Actor>
+"RTN","GPLCCR0",216,0)
+ ;;</Source>
+"RTN","GPLCCR0",217,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",218,0)
+ ;;</SocialHistory>
+"RTN","GPLCCR0",219,0)
+ ;;<Alerts>
+"RTN","GPLCCR0",220,0)
+ ;;<Alert>
+"RTN","GPLCCR0",221,0)
+ ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",222,0)
+ ;;<Description>
+"RTN","GPLCCR0",223,0)
+ ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",224,0)
+ ;;<Code>
+"RTN","GPLCCR0",225,0)
+ ;;<Value>@@ALERTCODEVALUE@@</Value>
+"RTN","GPLCCR0",226,0)
+ ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",227,0)
+ ;;</Code>
+"RTN","GPLCCR0",228,0)
+ ;;</Description>
+"RTN","GPLCCR0",229,0)
+ ;;<Status>
+"RTN","GPLCCR0",230,0)
+ ;;<Text>@@ALERTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",231,0)
+ ;;</Status>
+"RTN","GPLCCR0",232,0)
+ ;;<Source>
+"RTN","GPLCCR0",233,0)
+ ;;<Actor>
+"RTN","GPLCCR0",234,0)
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",235,0)
+ ;;</Actor>
+"RTN","GPLCCR0",236,0)
+ ;;</Source>
+"RTN","GPLCCR0",237,0)
+ ;;<Agent>
+"RTN","GPLCCR0",238,0)
+ ;;<Products>
+"RTN","GPLCCR0",239,0)
+ ;;<Product>
+"RTN","GPLCCR0",240,0)
+ ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",241,0)
+ ;;<Source>
+"RTN","GPLCCR0",242,0)
+ ;;<Actor>
+"RTN","GPLCCR0",243,0)
+ ;;<ActorID>@@ALERTAGENTPRODUCTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",244,0)
+ ;;</Actor>
+"RTN","GPLCCR0",245,0)
+ ;;</Source>
+"RTN","GPLCCR0",246,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",247,0)
+ ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",248,0)
+ ;;<Code>
+"RTN","GPLCCR0",249,0)
+ ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
+"RTN","GPLCCR0",250,0)
+ ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",251,0)
+ ;;</Code>
+"RTN","GPLCCR0",252,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",253,0)
+ ;;</Product>
+"RTN","GPLCCR0",254,0)
+ ;;</Products>
+"RTN","GPLCCR0",255,0)
+ ;;</Agent>
+"RTN","GPLCCR0",256,0)
+ ;;<Reaction>
+"RTN","GPLCCR0",257,0)
+ ;;<Description>
+"RTN","GPLCCR0",258,0)
+ ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",259,0)
+ ;;<Code>
+"RTN","GPLCCR0",260,0)
+ ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",261,0)
+ ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",262,0)
+ ;;</Code>
+"RTN","GPLCCR0",263,0)
+ ;;</Description>
+"RTN","GPLCCR0",264,0)
+ ;;</Reaction>
+"RTN","GPLCCR0",265,0)
+ ;;</Alert>
+"RTN","GPLCCR0",266,0)
+ ;;</Alerts>
+"RTN","GPLCCR0",267,0)
+ ;;<Medications>
+"RTN","GPLCCR0",268,0)
+ ;;<Medication>
+"RTN","GPLCCR0",269,0)
+ ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",270,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",271,0)
+ ;;<Type>
+"RTN","GPLCCR0",272,0)
+ ;;<Text>@@MEDISSUEDATETXT@@</Text>
+"RTN","GPLCCR0",273,0)
+ ;;</Type>
+"RTN","GPLCCR0",274,0)
+ ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
+"RTN","GPLCCR0",275,0)
+ ;;<Type>
+"RTN","GPLCCR0",276,0)
+ ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
+"RTN","GPLCCR0",277,0)
+ ;;</Type>
+"RTN","GPLCCR0",278,0)
+ ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
+"RTN","GPLCCR0",279,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",280,0)
+ ;;<IDs>
+"RTN","GPLCCR0",281,0)
+ ;;<Type>
+"RTN","GPLCCR0",282,0)
+ ;;<Text>@@MEDRXNOTXT@@</Text>
+"RTN","GPLCCR0",283,0)
+ ;;</Type>
+"RTN","GPLCCR0",284,0)
+ ;;<ID>@@MEDRXNO@@</ID>
+"RTN","GPLCCR0",285,0)
+ ;;</IDs>
+"RTN","GPLCCR0",286,0)
+ ;;<Type>
+"RTN","GPLCCR0",287,0)
+ ;;<Text>@@MEDTYPETEXT@@</Text>
+"RTN","GPLCCR0",288,0)
+ ;;</Type>
+"RTN","GPLCCR0",289,0)
+ ;;<Description>
+"RTN","GPLCCR0",290,0)
+ ;;<Text>@@MEDDETAILUNADORNED@@</Text>
+"RTN","GPLCCR0",291,0)
+ ;;</Description>
+"RTN","GPLCCR0",292,0)
+ ;;<Status>
+"RTN","GPLCCR0",293,0)
+ ;;<Text>@@MEDSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",294,0)
+ ;;</Status>
+"RTN","GPLCCR0",295,0)
+ ;;<Source>
+"RTN","GPLCCR0",296,0)
+ ;;<Actor>
+"RTN","GPLCCR0",297,0)
+ ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",298,0)
+ ;;</Actor>
+"RTN","GPLCCR0",299,0)
+ ;;</Source>
+"RTN","GPLCCR0",300,0)
+ ;;<Product>
+"RTN","GPLCCR0",301,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",302,0)
+ ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",303,0)
+ ;;<Code>
+"RTN","GPLCCR0",304,0)
+ ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
+"RTN","GPLCCR0",305,0)
+ ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",306,0)
+ ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
+"RTN","GPLCCR0",307,0)
+ ;;</Code>
+"RTN","GPLCCR0",308,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",309,0)
+ ;;<BrandName>
+"RTN","GPLCCR0",310,0)
+ ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
+"RTN","GPLCCR0",311,0)
+ ;;</BrandName>
+"RTN","GPLCCR0",312,0)
+ ;;<Strength>
+"RTN","GPLCCR0",313,0)
+ ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
+"RTN","GPLCCR0",314,0)
+ ;;<Units>
+"RTN","GPLCCR0",315,0)
+ ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
+"RTN","GPLCCR0",316,0)
+ ;;</Units>
+"RTN","GPLCCR0",317,0)
+ ;;</Strength>
+"RTN","GPLCCR0",318,0)
+ ;;<Form>
+"RTN","GPLCCR0",319,0)
+ ;;<Text>@@MEDFORMTEXT@@</Text>
+"RTN","GPLCCR0",320,0)
+ ;;</Form>
+"RTN","GPLCCR0",321,0)
+ ;;<Concentration>
+"RTN","GPLCCR0",322,0)
+ ;;<Value>@@MEDCONCVALUE@@</Value>
+"RTN","GPLCCR0",323,0)
+ ;;<Units>
+"RTN","GPLCCR0",324,0)
+ ;;<Unit>@@MEDCONCUNIT@@</Unit>
+"RTN","GPLCCR0",325,0)
+ ;;</Units>
+"RTN","GPLCCR0",326,0)
+ ;;</Concentration>
+"RTN","GPLCCR0",327,0)
+ ;;<Size>
+"RTN","GPLCCR0",328,0)
+ ;;<Text>@@MEDSIZETEXT@@</Text>
+"RTN","GPLCCR0",329,0)
+ ;;</Size>
+"RTN","GPLCCR0",330,0)
+ ;;</Product>
+"RTN","GPLCCR0",331,0)
+ ;;<Quantity>
+"RTN","GPLCCR0",332,0)
+ ;;<Value>@@MEDQUANTITYVALUE@@</Value>
+"RTN","GPLCCR0",333,0)
+ ;;<Units>
+"RTN","GPLCCR0",334,0)
+ ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
+"RTN","GPLCCR0",335,0)
+ ;;</Units>
+"RTN","GPLCCR0",336,0)
+ ;;</Quantity>
+"RTN","GPLCCR0",337,0)
+ ;;<Directions>
+"RTN","GPLCCR0",338,0)
+ ;;<Direction>
+"RTN","GPLCCR0",339,0)
+ ;;<Description>
+"RTN","GPLCCR0",340,0)
+ ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",341,0)
+ ;;</Description>
+"RTN","GPLCCR0",342,0)
+ ;;<DoseIndicator>
+"RTN","GPLCCR0",343,0)
+ ;;<Text>@@MEDDOSEINDICATOR@@</Text>
+"RTN","GPLCCR0",344,0)
+ ;;</DoseIndicator>
+"RTN","GPLCCR0",345,0)
+ ;;<DeliveryMethod>
+"RTN","GPLCCR0",346,0)
+ ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
+"RTN","GPLCCR0",347,0)
+ ;;</DeliveryMethod>
+"RTN","GPLCCR0",348,0)
+ ;;<Dose>
+"RTN","GPLCCR0",349,0)
+ ;;<Value>@@MEDDOSEVALUE@@</Value>
+"RTN","GPLCCR0",350,0)
+ ;;<Units>
+"RTN","GPLCCR0",351,0)
+ ;;<Unit>@@MEDDOSEUNIT@@</Unit>
+"RTN","GPLCCR0",352,0)
+ ;;</Units>
+"RTN","GPLCCR0",353,0)
+ ;;<Rate>
+"RTN","GPLCCR0",354,0)
+ ;;<Value>@@MEDRATEVALUE@@</Value>
+"RTN","GPLCCR0",355,0)
+ ;;<Units>
+"RTN","GPLCCR0",356,0)
+ ;;<Unit>@@MEDRATEUNIT@@</Unit>
+"RTN","GPLCCR0",357,0)
+ ;;</Units>
+"RTN","GPLCCR0",358,0)
+ ;;</Rate>
+"RTN","GPLCCR0",359,0)
+ ;;</Dose>
+"RTN","GPLCCR0",360,0)
+ ;;<Vehicle>
+"RTN","GPLCCR0",361,0)
+ ;;<Text>@@MEDVEHICLETEXT@@</Text>
+"RTN","GPLCCR0",362,0)
+ ;;</Vehicle>
+"RTN","GPLCCR0",363,0)
+ ;;<Route>
+"RTN","GPLCCR0",364,0)
+ ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
+"RTN","GPLCCR0",365,0)
+ ;;</Route>
+"RTN","GPLCCR0",366,0)
+ ;;<Frequency>
+"RTN","GPLCCR0",367,0)
+ ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
+"RTN","GPLCCR0",368,0)
+ ;;<Units>
+"RTN","GPLCCR0",369,0)
+ ;;<Unit>@@MEDFREQUENCYUNIT@@</Unit>
+"RTN","GPLCCR0",370,0)
+ ;;</Units>
+"RTN","GPLCCR0",371,0)
+ ;;</Frequency>
+"RTN","GPLCCR0",372,0)
+ ;;<Interval>
+"RTN","GPLCCR0",373,0)
+ ;;<Value>@@MEDINTERVALVALUE@@</Value>
+"RTN","GPLCCR0",374,0)
+ ;;<Units>
+"RTN","GPLCCR0",375,0)
+ ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
+"RTN","GPLCCR0",376,0)
+ ;;</Units>
+"RTN","GPLCCR0",377,0)
+ ;;</Interval>
+"RTN","GPLCCR0",378,0)
+ ;;<Duration>
+"RTN","GPLCCR0",379,0)
+ ;;<Value>@@MEDDURATIONVALUE@@</Value>
+"RTN","GPLCCR0",380,0)
+ ;;<Units>
+"RTN","GPLCCR0",381,0)
+ ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
+"RTN","GPLCCR0",382,0)
+ ;;</Units>
+"RTN","GPLCCR0",383,0)
+ ;;</Duration>
+"RTN","GPLCCR0",384,0)
+ ;;<Indication>
+"RTN","GPLCCR0",385,0)
+ ;;<PRNFlag>
+"RTN","GPLCCR0",386,0)
+ ;;<Text>@@MEDPRNFLAG@@</Text>
+"RTN","GPLCCR0",387,0)
+ ;;</PRNFlag>
+"RTN","GPLCCR0",388,0)
+ ;;<Problem>
+"RTN","GPLCCR0",389,0)
+ ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",390,0)
+ ;;<Type>
+"RTN","GPLCCR0",391,0)
+ ;;<Text>@@PROBLEM@@</Text>
+"RTN","GPLCCR0",392,0)
+ ;;</Type>
+"RTN","GPLCCR0",393,0)
+ ;;<Description>
+"RTN","GPLCCR0",394,0)
+ ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",395,0)
+ ;;<Code>
+"RTN","GPLCCR0",396,0)
+ ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",397,0)
+ ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",398,0)
+ ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",399,0)
+ ;;</Code>
+"RTN","GPLCCR0",400,0)
+ ;;</Description>
+"RTN","GPLCCR0",401,0)
+ ;;<Source>
+"RTN","GPLCCR0",402,0)
+ ;;<Actor>
+"RTN","GPLCCR0",403,0)
+ ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",404,0)
+ ;;</Actor>
+"RTN","GPLCCR0",405,0)
+ ;;</Source>
+"RTN","GPLCCR0",406,0)
+ ;;</Problem>
+"RTN","GPLCCR0",407,0)
+ ;;</Indication>
+"RTN","GPLCCR0",408,0)
+ ;;<StopIndicator>
+"RTN","GPLCCR0",409,0)
+ ;;<Text>@@MEDSTOPINDICATOR@@</Text>
+"RTN","GPLCCR0",410,0)
+ ;;</StopIndicator>
+"RTN","GPLCCR0",411,0)
+ ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
+"RTN","GPLCCR0",412,0)
+ ;;<MultipleDirectionModifier>
+"RTN","GPLCCR0",413,0)
+ ;;<Text>@@MEDMULDIRMOD@@</Text>
+"RTN","GPLCCR0",414,0)
+ ;;</MultipleDirectionModifier>
+"RTN","GPLCCR0",415,0)
+ ;;</Direction>
+"RTN","GPLCCR0",416,0)
+ ;;</Directions>
+"RTN","GPLCCR0",417,0)
+ ;;<PatientInstructions>
+"RTN","GPLCCR0",418,0)
+ ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",419,0)
+ ;;</PatientInstructions>
+"RTN","GPLCCR0",420,0)
+ ;;<FullfillmentInstructions>
+"RTN","GPLCCR0",421,0)
+ ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",422,0)
+ ;;</FullfillmentInstructions>
+"RTN","GPLCCR0",423,0)
+ ;;<Refills>
+"RTN","GPLCCR0",424,0)
+ ;;<Refill>
+"RTN","GPLCCR0",425,0)
+ ;;<Number>@@MEDRFNO@@</Number>
+"RTN","GPLCCR0",426,0)
+ ;;</Refill>
+"RTN","GPLCCR0",427,0)
+ ;;</Refills>
+"RTN","GPLCCR0",428,0)
+ ;;</Medication>
+"RTN","GPLCCR0",429,0)
+ ;;</Medications>
+"RTN","GPLCCR0",430,0)
+ ;;<VitalSigns>
+"RTN","GPLCCR0",431,0)
+ ;;<Result>
+"RTN","GPLCCR0",432,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",433,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",434,0)
+ ;;<Type>
+"RTN","GPLCCR0",435,0)
+ ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
+"RTN","GPLCCR0",436,0)
+ ;;</Type>
+"RTN","GPLCCR0",437,0)
+ ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",438,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",439,0)
+ ;;<Description>
+"RTN","GPLCCR0",440,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",441,0)
+ ;;</Description>
+"RTN","GPLCCR0",442,0)
+ ;;<Source>
+"RTN","GPLCCR0",443,0)
+ ;;<Actor>
+"RTN","GPLCCR0",444,0)
+ ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",445,0)
+ ;;</Actor>
+"RTN","GPLCCR0",446,0)
+ ;;</Source>
+"RTN","GPLCCR0",447,0)
+ ;;<Test>
+"RTN","GPLCCR0",448,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",449,0)
+ ;;<Type>
+"RTN","GPLCCR0",450,0)
+ ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
+"RTN","GPLCCR0",451,0)
+ ;;</Type>
+"RTN","GPLCCR0",452,0)
+ ;;<Description>
+"RTN","GPLCCR0",453,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",454,0)
+ ;;<Code>
+"RTN","GPLCCR0",455,0)
+ ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",456,0)
+ ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",457,0)
+ ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
+"RTN","GPLCCR0",458,0)
+ ;;</Code>
+"RTN","GPLCCR0",459,0)
+ ;;</Description>
+"RTN","GPLCCR0",460,0)
+ ;;<Source>
+"RTN","GPLCCR0",461,0)
+ ;;<Actor>
+"RTN","GPLCCR0",462,0)
+ ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",463,0)
+ ;;</Actor>
+"RTN","GPLCCR0",464,0)
+ ;;</Source>
+"RTN","GPLCCR0",465,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",466,0)
+ ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
+"RTN","GPLCCR0",467,0)
+ ;;<Units>
+"RTN","GPLCCR0",468,0)
+ ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
+"RTN","GPLCCR0",469,0)
+ ;;</Units>
+"RTN","GPLCCR0",470,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",471,0)
+ ;;</Test>
+"RTN","GPLCCR0",472,0)
+ ;;</Result>
+"RTN","GPLCCR0",473,0)
+ ;;</VitalSigns>
+"RTN","GPLCCR0",474,0)
+ ;;<Results>
+"RTN","GPLCCR0",475,0)
+ ;;<Result>
+"RTN","GPLCCR0",476,0)
+ ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",477,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",478,0)
+ ;;<Type>
+"RTN","GPLCCR0",479,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",480,0)
+ ;;</Type>
+"RTN","GPLCCR0",481,0)
+ ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",482,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",483,0)
+ ;;<Description>
+"RTN","GPLCCR0",484,0)
+ ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",485,0)
+ ;;<Code>
+"RTN","GPLCCR0",486,0)
+ ;;<Value>@@RESULTCODE@@</Value>
+"RTN","GPLCCR0",487,0)
+ ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",488,0)
+ ;;</Code>
+"RTN","GPLCCR0",489,0)
+ ;;</Description>
+"RTN","GPLCCR0",490,0)
+ ;;<Status>
+"RTN","GPLCCR0",491,0)
+ ;;<Text>@@RESULTSTATUS@@</Text>
+"RTN","GPLCCR0",492,0)
+ ;;</Status>
+"RTN","GPLCCR0",493,0)
+ ;;<Source>
+"RTN","GPLCCR0",494,0)
+ ;;<Actor>
+"RTN","GPLCCR0",495,0)
+ ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",496,0)
+ ;;</Actor>
+"RTN","GPLCCR0",497,0)
+ ;;</Source>
+"RTN","GPLCCR0",498,0)
+ ;;<TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",499,0)
+ ;;<Test>
+"RTN","GPLCCR0",500,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",501,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",502,0)
+ ;;<Type>
+"RTN","GPLCCR0",503,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",504,0)
+ ;;</Type>
+"RTN","GPLCCR0",505,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",506,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",507,0)
+ ;;<Description>
+"RTN","GPLCCR0",508,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",509,0)
+ ;;<Code>
+"RTN","GPLCCR0",510,0)
+ ;;<Value>@@RESULTTESTCODE@@</Value>
+"RTN","GPLCCR0",511,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",512,0)
+ ;;</Code>
+"RTN","GPLCCR0",513,0)
+ ;;</Description>
+"RTN","GPLCCR0",514,0)
+ ;;<Status>
+"RTN","GPLCCR0",515,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",516,0)
+ ;;</Status>
+"RTN","GPLCCR0",517,0)
+ ;;<Source>
+"RTN","GPLCCR0",518,0)
+ ;;<Actor>
+"RTN","GPLCCR0",519,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",520,0)
+ ;;</Actor>
+"RTN","GPLCCR0",521,0)
+ ;;</Source>
+"RTN","GPLCCR0",522,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",523,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",524,0)
+ ;;<Units>
+"RTN","GPLCCR0",525,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",526,0)
+ ;;</Units>
+"RTN","GPLCCR0",527,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",528,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",529,0)
+ ;;<Normal>
+"RTN","GPLCCR0",530,0)
+ ;;<Description>
+"RTN","GPLCCR0",531,0)
+ ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",532,0)
+ ;;</Description>
+"RTN","GPLCCR0",533,0)
+ ;;<Source>
+"RTN","GPLCCR0",534,0)
+ ;;<Actor>
+"RTN","GPLCCR0",535,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",536,0)
+ ;;</Actor>
+"RTN","GPLCCR0",537,0)
+ ;;</Source>
+"RTN","GPLCCR0",538,0)
+ ;;</Normal>
+"RTN","GPLCCR0",539,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",540,0)
+ ;;<Flag>
+"RTN","GPLCCR0",541,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",542,0)
+ ;;</Flag>
+"RTN","GPLCCR0",543,0)
+ ;;</Test>
+"RTN","GPLCCR0",544,0)
+ ;;</TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",545,0)
+ ;;<TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",546,0)
+ ;;<Test>
+"RTN","GPLCCR0",547,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",548,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",549,0)
+ ;;<Type>
+"RTN","GPLCCR0",550,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",551,0)
+ ;;</Type>
+"RTN","GPLCCR0",552,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",553,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",554,0)
+ ;;<Description>
+"RTN","GPLCCR0",555,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",556,0)
+ ;;<Code>
+"RTN","GPLCCR0",557,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",558,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",559,0)
+ ;;</Code>
+"RTN","GPLCCR0",560,0)
+ ;;</Description>
+"RTN","GPLCCR0",561,0)
+ ;;<Status>
+"RTN","GPLCCR0",562,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",563,0)
+ ;;</Status>
+"RTN","GPLCCR0",564,0)
+ ;;<Source>
+"RTN","GPLCCR0",565,0)
+ ;;<Actor>
+"RTN","GPLCCR0",566,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",567,0)
+ ;;</Actor>
+"RTN","GPLCCR0",568,0)
+ ;;</Source>
+"RTN","GPLCCR0",569,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",570,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",571,0)
+ ;;<Units>
+"RTN","GPLCCR0",572,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",573,0)
+ ;;</Units>
+"RTN","GPLCCR0",574,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",575,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",576,0)
+ ;;<Normal>
+"RTN","GPLCCR0",577,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
+"RTN","GPLCCR0",578,0)
+ ;;<Units>
+"RTN","GPLCCR0",579,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
+"RTN","GPLCCR0",580,0)
+ ;;</Units>
+"RTN","GPLCCR0",581,0)
+ ;;<ValueSequencePosition>1</ValueSequencePosition>
+"RTN","GPLCCR0",582,0)
+ ;;<Source>
+"RTN","GPLCCR0",583,0)
+ ;;<Actor>
+"RTN","GPLCCR0",584,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",585,0)
+ ;;</Actor>
+"RTN","GPLCCR0",586,0)
+ ;;</Source>
+"RTN","GPLCCR0",587,0)
+ ;;</Normal>
+"RTN","GPLCCR0",588,0)
+ ;;<Normal>
+"RTN","GPLCCR0",589,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
+"RTN","GPLCCR0",590,0)
+ ;;<Units>
+"RTN","GPLCCR0",591,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
+"RTN","GPLCCR0",592,0)
+ ;;</Units>
+"RTN","GPLCCR0",593,0)
+ ;;<ValueSequencePosition>2</ValueSequencePosition>
+"RTN","GPLCCR0",594,0)
+ ;;<VariableNomalModifier>
+"RTN","GPLCCR0",595,0)
+ ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
+"RTN","GPLCCR0",596,0)
+ ;;</VariableNomalModifier>
+"RTN","GPLCCR0",597,0)
+ ;;<Source>
+"RTN","GPLCCR0",598,0)
+ ;;<Actor>
+"RTN","GPLCCR0",599,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",600,0)
+ ;;</Actor>
+"RTN","GPLCCR0",601,0)
+ ;;</Source>
+"RTN","GPLCCR0",602,0)
+ ;;</Normal>
+"RTN","GPLCCR0",603,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",604,0)
+ ;;<Flag>
+"RTN","GPLCCR0",605,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",606,0)
+ ;;</Flag>
+"RTN","GPLCCR0",607,0)
+ ;;</Test>
+"RTN","GPLCCR0",608,0)
+ ;;</TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",609,0)
+ ;;</Result>
+"RTN","GPLCCR0",610,0)
+ ;;</Results>
+"RTN","GPLCCR0",611,0)
+ ;;<HealthCareProviders>
+"RTN","GPLCCR0",612,0)
+ ;;<Provider>
+"RTN","GPLCCR0",613,0)
+ ;;<ActorID>AA0005</ActorID>
+"RTN","GPLCCR0",614,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",615,0)
+ ;;<Text>Primary Provider</Text>
+"RTN","GPLCCR0",616,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",617,0)
+ ;;</Provider>
+"RTN","GPLCCR0",618,0)
+ ;;</HealthCareProviders>
+"RTN","GPLCCR0",619,0)
+ ;;</Body>
+"RTN","GPLCCR0",620,0)
+ ;;<Actors>
+"RTN","GPLCCR0",621,0)
+ ;;<ACTOR-PATIENT>
+"RTN","GPLCCR0",622,0)
+ ;;<Actor>
+"RTN","GPLCCR0",623,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",624,0)
+ ;;<Person>
+"RTN","GPLCCR0",625,0)
+ ;;<Name>
+"RTN","GPLCCR0",626,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",627,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",628,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",629,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",630,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",631,0)
+ ;;</Name>
+"RTN","GPLCCR0",632,0)
+ ;;<DateOfBirth>
+"RTN","GPLCCR0",633,0)
+ ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
+"RTN","GPLCCR0",634,0)
+ ;;</DateOfBirth>
+"RTN","GPLCCR0",635,0)
+ ;;<Gender>
+"RTN","GPLCCR0",636,0)
+ ;;<Text>@@ACTORGENDER@@</Text>
+"RTN","GPLCCR0",637,0)
+ ;;<Code>
+"RTN","GPLCCR0",638,0)
+ ;;<Value>@@ACTORGENDER@@</Value>
+"RTN","GPLCCR0",639,0)
+ ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
+"RTN","GPLCCR0",640,0)
+ ;;</Code>
+"RTN","GPLCCR0",641,0)
+ ;;</Gender>
+"RTN","GPLCCR0",642,0)
+ ;;</Person>
+"RTN","GPLCCR0",643,0)
+ ;;<IDs>
+"RTN","GPLCCR0",644,0)
+ ;;<Type>
+"RTN","GPLCCR0",645,0)
+ ;;<Text>@@ACTORSSNTEXT@@</Text>
+"RTN","GPLCCR0",646,0)
+ ;;</Type>
+"RTN","GPLCCR0",647,0)
+ ;;<ID>@@ACTORSSN@@</ID>
+"RTN","GPLCCR0",648,0)
+ ;;<Source>
+"RTN","GPLCCR0",649,0)
+ ;;<Actor>
+"RTN","GPLCCR0",650,0)
+ ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
+"RTN","GPLCCR0",651,0)
+ ;;</Actor>
+"RTN","GPLCCR0",652,0)
+ ;;</Source>
+"RTN","GPLCCR0",653,0)
+ ;;</IDs>
+"RTN","GPLCCR0",654,0)
+ ;;<Address>
+"RTN","GPLCCR0",655,0)
+ ;;<Type>
+"RTN","GPLCCR0",656,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",657,0)
+ ;;</Type>
+"RTN","GPLCCR0",658,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",659,0)
+ ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
+"RTN","GPLCCR0",660,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",661,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",662,0)
+ ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
+"RTN","GPLCCR0",663,0)
+ ;;</Address>
+"RTN","GPLCCR0",664,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",665,0)
+ ;;<Value>@@ACTORRESTEL@@</Value>
+"RTN","GPLCCR0",666,0)
+ ;;<Type>
+"RTN","GPLCCR0",667,0)
+ ;;<Text>@@ACTORRESTELTEXT@@</Text>
+"RTN","GPLCCR0",668,0)
+ ;;</Type>
+"RTN","GPLCCR0",669,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",670,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",671,0)
+ ;;<Value>@@ACTORWORKTEL@@</Value>
+"RTN","GPLCCR0",672,0)
+ ;;<Type>
+"RTN","GPLCCR0",673,0)
+ ;;<Text>@@ACTORWORKTELTEXT@@</Text>
+"RTN","GPLCCR0",674,0)
+ ;;</Type>
+"RTN","GPLCCR0",675,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",676,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",677,0)
+ ;;<Value>@@ACTORCELLTEL@@</Value>
+"RTN","GPLCCR0",678,0)
+ ;;<Type>
+"RTN","GPLCCR0",679,0)
+ ;;<Text>@@ACTORCELLTELTEXT@@</Text>
+"RTN","GPLCCR0",680,0)
+ ;;</Type>
+"RTN","GPLCCR0",681,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",682,0)
+ ;;<EMail>
+"RTN","GPLCCR0",683,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",684,0)
+ ;;</EMail>
+"RTN","GPLCCR0",685,0)
+ ;;<Source>
+"RTN","GPLCCR0",686,0)
+ ;;<Actor>
+"RTN","GPLCCR0",687,0)
+ ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",688,0)
+ ;;</Actor>
+"RTN","GPLCCR0",689,0)
+ ;;</Source>
+"RTN","GPLCCR0",690,0)
+ ;;</Actor>
+"RTN","GPLCCR0",691,0)
+ ;;</ACTOR-PATIENT>
+"RTN","GPLCCR0",692,0)
+ ;;<ACTOR-SYSTEM>
+"RTN","GPLCCR0",693,0)
+ ;;<Actor>
+"RTN","GPLCCR0",694,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",695,0)
+ ;;<InformationSystem>
+"RTN","GPLCCR0",696,0)
+ ;;<Name>@@ACTORINFOSYSNAME@@</Name>
+"RTN","GPLCCR0",697,0)
+ ;;<Version>@@ACTORINFOSYSVER@@</Version>
+"RTN","GPLCCR0",698,0)
+ ;;</InformationSystem>
+"RTN","GPLCCR0",699,0)
+ ;;<Source>
+"RTN","GPLCCR0",700,0)
+ ;;<Actor>
+"RTN","GPLCCR0",701,0)
+ ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",702,0)
+ ;;</Actor>
+"RTN","GPLCCR0",703,0)
+ ;;</Source>
+"RTN","GPLCCR0",704,0)
+ ;;</Actor>
+"RTN","GPLCCR0",705,0)
+ ;;</ACTOR-SYSTEM>
+"RTN","GPLCCR0",706,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCR0",707,0)
+ ;;<Actor>
+"RTN","GPLCCR0",708,0)
+ ;;<ActorObjectID>AA0003</ActorObjectID>
+"RTN","GPLCCR0",709,0)
+ ;;<Person>
+"RTN","GPLCCR0",710,0)
+ ;;<Name>
+"RTN","GPLCCR0",711,0)
+ ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
+"RTN","GPLCCR0",712,0)
+ ;;</Name>
+"RTN","GPLCCR0",713,0)
+ ;;</Person>
+"RTN","GPLCCR0",714,0)
+ ;;<Relation>
+"RTN","GPLCCR0",715,0)
+ ;;<Text>@@ACTORRELATION@@</Text>
+"RTN","GPLCCR0",716,0)
+ ;;</Relation>
+"RTN","GPLCCR0",717,0)
+ ;;<Source>
+"RTN","GPLCCR0",718,0)
+ ;;<Actor>
+"RTN","GPLCCR0",719,0)
+ ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
+"RTN","GPLCCR0",720,0)
+ ;;</Actor>
+"RTN","GPLCCR0",721,0)
+ ;;</Source>
+"RTN","GPLCCR0",722,0)
+ ;;</Actor>
+"RTN","GPLCCR0",723,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCR0",724,0)
+ ;;<ACTOR-PROVIDER>
+"RTN","GPLCCR0",725,0)
+ ;;<Actor>
+"RTN","GPLCCR0",726,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",727,0)
+ ;;<Person>
+"RTN","GPLCCR0",728,0)
+ ;;<Name>
+"RTN","GPLCCR0",729,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",730,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",731,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",732,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",733,0)
+ ;;<Title>@@ACTORTITLE@@</Title>
+"RTN","GPLCCR0",734,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",735,0)
+ ;;</Name>
+"RTN","GPLCCR0",736,0)
+ ;;</Person>
+"RTN","GPLCCR0",737,0)
+ ;;<IDs>
+"RTN","GPLCCR0",738,0)
+ ;;<Type>
+"RTN","GPLCCR0",739,0)
+ ;;<Text>@@IDTYPE@@</Text>
+"RTN","GPLCCR0",740,0)
+ ;;</Type>
+"RTN","GPLCCR0",741,0)
+ ;;<ID>@@ID@@</ID>
+"RTN","GPLCCR0",742,0)
+ ;;<IssuedBy>
+"RTN","GPLCCR0",743,0)
+ ;;<Description>
+"RTN","GPLCCR0",744,0)
+ ;;<Text>@@IDDESC@@</Text>
+"RTN","GPLCCR0",745,0)
+ ;;</Description>
+"RTN","GPLCCR0",746,0)
+ ;;</IssuedBy>
+"RTN","GPLCCR0",747,0)
+ ;;</IDs>
+"RTN","GPLCCR0",748,0)
+ ;;<Specialty>
+"RTN","GPLCCR0",749,0)
+ ;;<Text>@@ACTORSPECIALITY@@</Text>
+"RTN","GPLCCR0",750,0)
+ ;;</Specialty>
+"RTN","GPLCCR0",751,0)
+ ;;<Address>
+"RTN","GPLCCR0",752,0)
+ ;;<Type>
+"RTN","GPLCCR0",753,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",754,0)
+ ;;</Type>
+"RTN","GPLCCR0",755,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",756,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",757,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",758,0)
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+"RTN","GPLCCR0",759,0)
+ ;;</Address>
+"RTN","GPLCCR0",760,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",761,0)
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+"RTN","GPLCCR0",762,0)
+ ;;<Type>
+"RTN","GPLCCR0",763,0)
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+"RTN","GPLCCR0",764,0)
+ ;;</Type>
+"RTN","GPLCCR0",765,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",766,0)
+ ;;<Email>
+"RTN","GPLCCR0",767,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",768,0)
+ ;;</Email>
+"RTN","GPLCCR0",769,0)
+ ;;<Source>
+"RTN","GPLCCR0",770,0)
+ ;;<Actor>
+"RTN","GPLCCR0",771,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",772,0)
+ ;;</Actor>
+"RTN","GPLCCR0",773,0)
+ ;;</Source>
+"RTN","GPLCCR0",774,0)
+ ;;</Actor>
+"RTN","GPLCCR0",775,0)
+ ;;</ACTOR-PROVIDER>
+"RTN","GPLCCR0",776,0)
+ ;;<ACTOR-ORG>
+"RTN","GPLCCR0",777,0)
+ ;;<Actor>
+"RTN","GPLCCR0",778,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",779,0)
+ ;;<Organization>
+"RTN","GPLCCR0",780,0)
+ ;;<Name>@@ORGANIZATIONNAME@@</Name>
+"RTN","GPLCCR0",781,0)
+ ;;</Organization>
+"RTN","GPLCCR0",782,0)
+ ;;<Source>
+"RTN","GPLCCR0",783,0)
+ ;;<Actor>
+"RTN","GPLCCR0",784,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",785,0)
+ ;;</Actor>
+"RTN","GPLCCR0",786,0)
+ ;;</Source>
+"RTN","GPLCCR0",787,0)
+ ;;</Actor>
+"RTN","GPLCCR0",788,0)
+ ;;</ACTOR-ORG>
+"RTN","GPLCCR0",789,0)
+ ;;</Actors>
+"RTN","GPLCCR0",790,0)
+ ;;<Signatures>
+"RTN","GPLCCR0",791,0)
+ ;;<CCRSignature>
+"RTN","GPLCCR0",792,0)
+ ;;<SignatureObjectID>S0001</SignatureObjectID>
+"RTN","GPLCCR0",793,0)
+ ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
+"RTN","GPLCCR0",794,0)
+ ;;<Source>
+"RTN","GPLCCR0",795,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",796,0)
+ ;;</Source>
+"RTN","GPLCCR0",797,0)
+ ;;<Signature>
+"RTN","GPLCCR0",798,0)
+ ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
+"RTN","GPLCCR0",799,0)
+ ;;<SignedInfo>
+"RTN","GPLCCR0",800,0)
+ ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
+"RTN","GPLCCR0",801,0)
+ ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
+"RTN","GPLCCR0",802,0)
+ ;;<Reference URI="">
+"RTN","GPLCCR0",803,0)
+ ;;<Transforms>
+"RTN","GPLCCR0",804,0)
+ ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
+"RTN","GPLCCR0",805,0)
+ ;;</Transforms>
+"RTN","GPLCCR0",806,0)
+ ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
+"RTN","GPLCCR0",807,0)
+ ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
+"RTN","GPLCCR0",808,0)
+ ;;</Reference>
+"RTN","GPLCCR0",809,0)
+ ;;</SignedInfo>
+"RTN","GPLCCR0",810,0)
+ ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
+"RTN","GPLCCR0",811,0)
+ ;;<KeyInfo>
+"RTN","GPLCCR0",812,0)
+ ;;<KeyValue>
+"RTN","GPLCCR0",813,0)
+ ;;<RSAKeyValue>
+"RTN","GPLCCR0",814,0)
+ ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
+"RTN","GPLCCR0",815,0)
+ ;;<Exponent>AQAB</Exponent>
+"RTN","GPLCCR0",816,0)
+ ;;</RSAKeyValue>
+"RTN","GPLCCR0",817,0)
+ ;;</KeyValue>
+"RTN","GPLCCR0",818,0)
+ ;;</KeyInfo>
+"RTN","GPLCCR0",819,0)
+ ;;</Signature>
+"RTN","GPLCCR0",820,0)
+ ;;</Signature>
+"RTN","GPLCCR0",821,0)
+ ;;</CCRSignature>
+"RTN","GPLCCR0",822,0)
+ ;;</Signatures>
+"RTN","GPLCCR0",823,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCR0",824,0)
+ ;</TEMPLATE>
+"RTN","GPLMEDS")
+0^18^B27486154
+"RTN","GPLMEDS",1,0)
+GPLMEDS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
+"RTN","GPLMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 4
+"RTN","GPLMEDS",3,0)
+   ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLMEDS",4,0)
+   ;General Public License See attached copy of the License.
+"RTN","GPLMEDS",5,0)
+   ;
+"RTN","GPLMEDS",6,0)
+   ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLMEDS",7,0)
+   ;it under the terms of the GNU General Public License as published by
+"RTN","GPLMEDS",8,0)
+   ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLMEDS",9,0)
+   ;(at your option) any later version.
+"RTN","GPLMEDS",10,0)
+   ;
+"RTN","GPLMEDS",11,0)
+   ;This program is distributed in the hope that it will be useful,
+"RTN","GPLMEDS",12,0)
+   ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLMEDS",13,0)
+   ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLMEDS",14,0)
+   ;GNU General Public License for more details.
+"RTN","GPLMEDS",15,0)
+   ;
+"RTN","GPLMEDS",16,0)
+   ;You should have received a copy of the GNU General Public License along
+"RTN","GPLMEDS",17,0)
+   ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLMEDS",18,0)
+   ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLMEDS",19,0)
+   ;
+"RTN","GPLMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","GPLMEDS",21,0)
+   Q
+"RTN","GPLMEDS",22,0)
+   ;
+"RTN","GPLMEDS",23,0)
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","GPLMEDS",24,0)
+   ;
+"RTN","GPLMEDS",25,0)
+   ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLMEDS",26,0)
+   ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLMEDS",27,0)
+   ;
+"RTN","GPLMEDS",28,0)
+   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+"RTN","GPLMEDS",29,0)
+   D ACTIVE^ORWPS(.MEDRSLT,DFN)
+"RTN","GPLMEDS",30,0)
+   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+"RTN","GPLMEDS",31,0)
+   . W "ERROR RUNNINIG MEDICATIONS RPC",!
+"RTN","GPLMEDS",32,0)
+   . S @MEDOUTXML@(0)=0
+"RTN","GPLMEDS",33,0)
+   . Q
+"RTN","GPLMEDS",34,0)
+   ; I DEBUG ZWR MEDRSLT
+"RTN","GPLMEDS",35,0)
+   M GPLMEDS=MEDRSLT
+"RTN","GPLMEDS",36,0)
+   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
+"RTN","GPLMEDS",37,0)
+   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+"RTN","GPLMEDS",38,0)
+   K @MEDTVMAP,@MEDTARYTMP
+"RTN","GPLMEDS",39,0)
+   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
+"RTN","GPLMEDS",40,0)
+   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
+"RTN","GPLMEDS",41,0)
+   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
+"RTN","GPLMEDS",42,0)
+   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
+"RTN","GPLMEDS",43,0)
+   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
+"RTN","GPLMEDS",44,0)
+   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
+"RTN","GPLMEDS",45,0)
+   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
+"RTN","GPLMEDS",46,0)
+   . . S ZI=ZI+1 ; INCREMENT MED COUNT
+"RTN","GPLMEDS",47,0)
+   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
+"RTN","GPLMEDS",48,0)
+   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
+"RTN","GPLMEDS",49,0)
+   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
+"RTN","GPLMEDS",50,0)
+   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
+"RTN","GPLMEDS",51,0)
+   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
+"RTN","GPLMEDS",52,0)
+   ;ZWR ZA
+"RTN","GPLMEDS",53,0)
+   F ZI=1:1:ZA(0) D  ; FOR EACH MED
+"RTN","GPLMEDS",54,0)
+   . I DEBUG W "ZI IS ",ZI,!
+"RTN","GPLMEDS",55,0)
+   . S MEDVMAP=$NA(@MEDTVMAP@(ZI))
+"RTN","GPLMEDS",56,0)
+   . K @MEDVMAP
+"RTN","GPLMEDS",57,0)
+   . I DEBUG W "VMAP= ",MEDVMAP,!
+"RTN","GPLMEDS",58,0)
+   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
+"RTN","GPLMEDS",59,0)
+   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
+"RTN","GPLMEDS",60,0)
+   . S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS
+"RTN","GPLMEDS",61,0)
+   . S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+"RTN","GPLMEDS",62,0)
+   . S @MEDVMAP@("MEDDATETIMEAGE")=""
+"RTN","GPLMEDS",63,0)
+   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
+"RTN","GPLMEDS",64,0)
+   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
+"RTN","GPLMEDS",65,0)
+   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+"RTN","GPLMEDS",66,0)
+   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLMEDS",67,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+"RTN","GPLMEDS",68,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=""
+"RTN","GPLMEDS",69,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+"RTN","GPLMEDS",70,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
+"RTN","GPLMEDS",71,0)
+   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
+"RTN","GPLMEDS",72,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
+"RTN","GPLMEDS",73,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
+"RTN","GPLMEDS",74,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
+"RTN","GPLMEDS",75,0)
+   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
+"RTN","GPLMEDS",76,0)
+   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
+"RTN","GPLMEDS",77,0)
+   . S @MEDVMAP@("MEDFORMTEXT")=""
+"RTN","GPLMEDS",78,0)
+   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
+"RTN","GPLMEDS",79,0)
+   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
+"RTN","GPLMEDS",80,0)
+   . S @MEDVMAP@("MEDRFNO")=""
+"RTN","GPLMEDS",81,0)
+   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
+"RTN","GPLMEDS",82,0)
+   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
+"RTN","GPLMEDS",83,0)
+   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
+"RTN","GPLMEDS",84,0)
+   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
+"RTN","GPLMEDS",85,0)
+   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
+"RTN","GPLMEDS",86,0)
+   . . S ZN=0 ; DON'T KNOW WHY
+"RTN","GPLMEDS",87,0)
+   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
+"RTN","GPLMEDS",88,0)
+   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
+"RTN","GPLMEDS",89,0)
+   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
+"RTN","GPLMEDS",90,0)
+   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
+"RTN","GPLMEDS",91,0)
+   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
+"RTN","GPLMEDS",92,0)
+   . S @MEDVMAP@("MEDDOSEVALUE")=""
+"RTN","GPLMEDS",93,0)
+   . S @MEDVMAP@("MEDDOSEUNIT")=""
+"RTN","GPLMEDS",94,0)
+   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
+"RTN","GPLMEDS",95,0)
+   . S @MEDVMAP@("MEDDURATIONVALUE")=""
+"RTN","GPLMEDS",96,0)
+   . S @MEDVMAP@("MEDDURATIONUNIT")=""
+"RTN","GPLMEDS",97,0)
+   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
+"RTN","GPLMEDS",98,0)
+   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
+"RTN","GPLMEDS",99,0)
+   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
+"RTN","GPLMEDS",100,0)
+   . K @MEDARYTMP
+"RTN","GPLMEDS",101,0)
+   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+"RTN","GPLMEDS",102,0)
+   . I ZI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLMEDS",103,0)
+   . . ; W "FIRST ONE",!
+"RTN","GPLMEDS",104,0)
+   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
+"RTN","GPLMEDS",105,0)
+   . I ZI>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLMEDS",106,0)
+   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+"RTN","GPLMEDS",107,0)
+   N MEDTMP,MEDI
+"RTN","GPLMEDS",108,0)
+   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLMEDS",109,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLMEDS",110,0)
+   . W "MEDICATION MISSING ",!
+"RTN","GPLMEDS",111,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","GPLMEDS",112,0)
+   Q
+"RTN","GPLMEDS",113,0)
+   ;
+"RTN","GPLPROBS")
+0^11^B24846496
+"RTN","GPLPROBS",1,0)
+GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
+"RTN","GPLPROBS",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLPROBS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLPROBS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLPROBS",5,0)
+ ;
+"RTN","GPLPROBS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLPROBS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLPROBS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLPROBS",9,0)
+ ;(at your option) any later version.
+"RTN","GPLPROBS",10,0)
+ ;
+"RTN","GPLPROBS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLPROBS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLPROBS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLPROBS",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLPROBS",15,0)
+ ;
+"RTN","GPLPROBS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLPROBS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLPROBS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLPROBS",19,0)
+ ;
+"RTN","GPLPROBS",20,0)
+           ;
+"RTN","GPLPROBS",21,0)
+           ;  PROCESS THE PROBLEMS SECTION OF THE CCR
+"RTN","GPLPROBS",22,0)
+           ;
+"RTN","GPLPROBS",23,0)
+EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+"RTN","GPLPROBS",24,0)
+          ;
+"RTN","GPLPROBS",25,0)
+          ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLPROBS",26,0)
+          ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLPROBS",27,0)
+          ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+"RTN","GPLPROBS",28,0)
+          ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+"RTN","GPLPROBS",29,0)
+          ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+"RTN","GPLPROBS",30,0)
+          ;
+"RTN","GPLPROBS",31,0)
+          N RPCRSLT,J,K,PTMP,X,VMAP,TBU
+"RTN","GPLPROBS",32,0)
+          S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
+"RTN","GPLPROBS",33,0)
+          S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
+"RTN","GPLPROBS",34,0)
+          K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLPROBS",35,0)
+          D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+"RTN","GPLPROBS",36,0)
+          I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
+"RTN","GPLPROBS",37,0)
+          . W "NULL RESULT FROM LIST^ORQQPL3 ",!
+"RTN","GPLPROBS",38,0)
+          . S @OUTXML@(0)=0
+"RTN","GPLPROBS",39,0)
+          . ; Q
+"RTN","GPLPROBS",40,0)
+          ; I DEBUG ZWR RPCRSLT
+"RTN","GPLPROBS",41,0)
+          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
+"RTN","GPLPROBS",42,0)
+          . S VMAP=$NA(@TVMAP@(J))
+"RTN","GPLPROBS",43,0)
+          . K @VMAP
+"RTN","GPLPROBS",44,0)
+          . W "VMAP= ",VMAP,!
+"RTN","GPLPROBS",45,0)
+          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+"RTN","GPLPROBS",46,0)
+          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
+"RTN","GPLPROBS",47,0)
+          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
+"RTN","GPLPROBS",48,0)
+          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
+"RTN","GPLPROBS",49,0)
+          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+"RTN","GPLPROBS",50,0)
+          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+"RTN","GPLPROBS",51,0)
+          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
+"RTN","GPLPROBS",52,0)
+          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
+"RTN","GPLPROBS",53,0)
+          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
+"RTN","GPLPROBS",54,0)
+          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
+"RTN","GPLPROBS",55,0)
+          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
+"RTN","GPLPROBS",56,0)
+          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
+"RTN","GPLPROBS",57,0)
+          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
+"RTN","GPLPROBS",58,0)
+          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
+"RTN","GPLPROBS",59,0)
+          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+"RTN","GPLPROBS",60,0)
+          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
+"RTN","GPLPROBS",61,0)
+          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
+"RTN","GPLPROBS",62,0)
+          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
+"RTN","GPLPROBS",63,0)
+          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
+"RTN","GPLPROBS",64,0)
+          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
+"RTN","GPLPROBS",65,0)
+          . S ARYTMP=$NA(@TARYTMP@(J))
+"RTN","GPLPROBS",66,0)
+          . ; W "ARYTMP= ",ARYTMP,!
+"RTN","GPLPROBS",67,0)
+          . K @ARYTMP
+"RTN","GPLPROBS",68,0)
+          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
+"RTN","GPLPROBS",69,0)
+          . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",70,0)
+          . . ; W "FIRST ONE",!
+"RTN","GPLPROBS",71,0)
+          . . D CP^GPLXPATH(ARYTMP,OUTXML)
+"RTN","GPLPROBS",72,0)
+          . . ; W "OUTXML ",OUTXML,!
+"RTN","GPLPROBS",73,0)
+          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLPROBS",74,0)
+          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
+"RTN","GPLPROBS",75,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
+"RTN","GPLPROBS",76,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLPROBS",77,0)
+          ; ZWR @OUTXML
+"RTN","GPLPROBS",78,0)
+          ; $$HTML^DILF(
+"RTN","GPLPROBS",79,0)
+          ; GENERATE THE NARITIVE HTML FOR THE CCD
+"RTN","GPLPROBS",80,0)
+          I CCD D  ; IF THIS IS FOR A CCD
+"RTN","GPLPROBS",81,0)
+          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
+"RTN","GPLPROBS",82,0)
+          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
+"RTN","GPLPROBS",83,0)
+          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
+"RTN","GPLPROBS",84,0)
+          . . W "VMAP =",VMAP,!
+"RTN","GPLPROBS",85,0)
+          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
+"RTN","GPLPROBS",86,0)
+          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
+"RTN","GPLPROBS",87,0)
+          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
+"RTN","GPLPROBS",88,0)
+          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
+"RTN","GPLPROBS",89,0)
+          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
+"RTN","GPLPROBS",90,0)
+          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",91,0)
+          . . . D CP^GPLXPATH("HOUT","HTMLO")
+"RTN","GPLPROBS",92,0)
+          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
+"RTN","GPLPROBS",93,0)
+          . . . W "DOING INNER",!
+"RTN","GPLPROBS",94,0)
+          . . . N HTMLBLD,HTMLTMP
+"RTN","GPLPROBS",95,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
+"RTN","GPLPROBS",96,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
+"RTN","GPLPROBS",97,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
+"RTN","GPLPROBS",98,0)
+          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
+"RTN","GPLPROBS",99,0)
+          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
+"RTN","GPLPROBS",100,0)
+          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
+"RTN","GPLPROBS",101,0)
+          . I DEBUG D PARY^GPLXPATH("HTMLO")
+"RTN","GPLPROBS",102,0)
+          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+"RTN","GPLPROBS",103,0)
+          N PROBSTMP,I
+"RTN","GPLPROBS",104,0)
+          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLPROBS",105,0)
+          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLPROBS",106,0)
+          . ; STRINGS MARKED AS @@X@@
+"RTN","GPLPROBS",107,0)
+          . W "PROBLEMS Missing list: ",!
+"RTN","GPLPROBS",108,0)
+          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
+"RTN","GPLPROBS",109,0)
+          Q
+"RTN","GPLPROBS",110,0)
+          ;
+"RTN","GPLRIMA")
+0^13^B96435476
+"RTN","GPLRIMA",1,0)
+GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+"RTN","GPLRIMA",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLRIMA",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLRIMA",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLRIMA",5,0)
+ ;
+"RTN","GPLRIMA",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLRIMA",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLRIMA",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLRIMA",9,0)
+ ;(at your option) any later version.
+"RTN","GPLRIMA",10,0)
+ ;
+"RTN","GPLRIMA",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLRIMA",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLRIMA",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLRIMA",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLRIMA",15,0)
+ ;
+"RTN","GPLRIMA",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLRIMA",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLRIMA",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLRIMA",19,0)
+ ;
+"RTN","GPLRIMA",20,0)
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+"RTN","GPLRIMA",21,0)
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+"RTN","GPLRIMA",22,0)
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+"RTN","GPLRIMA",23,0)
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+"RTN","GPLRIMA",24,0)
+ ; CONVEYED VIA THE CCR OR CCD.
+"RTN","GPLRIMA",25,0)
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+"RTN","GPLRIMA",26,0)
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+"RTN","GPLRIMA",27,0)
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+"RTN","GPLRIMA",28,0)
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+"RTN","GPLRIMA",29,0)
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+"RTN","GPLRIMA",30,0)
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+"RTN","GPLRIMA",31,0)
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+"RTN","GPLRIMA",32,0)
+ ;
+"RTN","GPLRIMA",33,0)
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+"RTN","GPLRIMA",34,0)
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+"RTN","GPLRIMA",35,0)
+ ;    CONVEYANCE TO THE RIM APPLICATION.
+"RTN","GPLRIMA",36,0)
+ ;
+"RTN","GPLRIMA",37,0)
+ ;
+"RTN","GPLRIMA",38,0)
+ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
+"RTN","GPLRIMA",39,0)
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+"RTN","GPLRIMA",40,0)
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+"RTN","GPLRIMA",41,0)
+    ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
+"RTN","GPLRIMA",42,0)
+    ;
+"RTN","GPLRIMA",43,0)
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+"RTN","GPLRIMA",44,0)
+    N CCRGLO
+"RTN","GPLRIMA",45,0)
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
+"RTN","GPLRIMA",46,0)
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+"RTN","GPLRIMA",47,0)
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+"RTN","GPLRIMA",48,0)
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+"RTN","GPLRIMA",49,0)
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+"RTN","GPLRIMA",50,0)
+    I RIMDFN="" S RIMDFN=RESUME
+"RTN","GPLRIMA",51,0)
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+"RTN","GPLRIMA",52,0)
+    . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
+"RTN","GPLRIMA",53,0)
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+"RTN","GPLRIMA",54,0)
+    . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
+"RTN","GPLRIMA",55,0)
+    . W RIMDFN,!
+"RTN","GPLRIMA",56,0)
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+"RTN","GPLRIMA",57,0)
+    . ;
+"RTN","GPLRIMA",58,0)
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
+"RTN","GPLRIMA",59,0)
+    . ;
+"RTN","GPLRIMA",60,0)
+    . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+"RTN","GPLRIMA",61,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
+"RTN","GPLRIMA",62,0)
+    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+"RTN","GPLRIMA",63,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
+"RTN","GPLRIMA",64,0)
+    . I $D(^TMP("GPLCCR",$J,"MEDICATIONS",1)) D  ; MEDS VARS EXISTS
+"RTN","GPLRIMA",65,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDICATIONS")
+"RTN","GPLRIMA",66,0)
+    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+"RTN","GPLRIMA",67,0)
+    . ;
+"RTN","GPLRIMA",68,0)
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+"RTN","GPLRIMA",69,0)
+    . ;
+"RTN","GPLRIMA",70,0)
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+"RTN","GPLRIMA",71,0)
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+"RTN","GPLRIMA",72,0)
+    . ;
+"RTN","GPLRIMA",73,0)
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
+"RTN","GPLRIMA",74,0)
+    . ;
+"RTN","GPLRIMA",75,0)
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+"RTN","GPLRIMA",76,0)
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+"RTN","GPLRIMA",77,0)
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+"RTN","GPLRIMA",78,0)
+    . ;
+"RTN","GPLRIMA",79,0)
+    . N CATNAME,CATTBL
+"RTN","GPLRIMA",80,0)
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+"RTN","GPLRIMA",81,0)
+    . S CATNAME=""
+"RTN","GPLRIMA",82,0)
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+"RTN","GPLRIMA",83,0)
+    . W "CATEGORY NAME: ",CATNAME,!
+"RTN","GPLRIMA",84,0)
+    . ;
+"RTN","GPLRIMA",85,0)
+    . S RIMDFN=$O(^DPT(RIMDFN)) ; NEXT PATIENT
+"RTN","GPLRIMA",86,0)
+    S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+"RTN","GPLRIMA",87,0)
+    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
+"RTN","GPLRIMA",88,0)
+    Q
+"RTN","GPLRIMA",89,0)
+    ;
+"RTN","GPLRIMA",90,0)
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+"RTN","GPLRIMA",91,0)
+    N SBASE,SATTR
+"RTN","GPLRIMA",92,0)
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+"RTN","GPLRIMA",93,0)
+    D APOST("SATTR","RIMTBL","HEADER")
+"RTN","GPLRIMA",94,0)
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+"RTN","GPLRIMA",95,0)
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+"RTN","GPLRIMA",96,0)
+    . W "POSTING PROBLEMS",!
+"RTN","GPLRIMA",97,0)
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+"RTN","GPLRIMA",98,0)
+    I $D(@SBASE@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS")
+"RTN","GPLRIMA",99,0)
+    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+"RTN","GPLRIMA",100,0)
+    W "ATTRIBUTES: ",SATTR,!
+"RTN","GPLRIMA",101,0)
+    Q SATTR
+"RTN","GPLRIMA",102,0)
+    ;
+"RTN","GPLRIMA",103,0)
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+"RTN","GPLRIMA",104,0)
+    K ^TMP("GPLRIM","RESUME")
+"RTN","GPLRIMA",105,0)
+    K ^TMP("GPLRIM")
+"RTN","GPLRIMA",106,0)
+    Q
+"RTN","GPLRIMA",107,0)
+    ;
+"RTN","GPLRIMA",108,0)
+CLIST ; LIST THE CATEGORIES
+"RTN","GPLRIMA",109,0)
+    ;
+"RTN","GPLRIMA",110,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",111,0)
+    N CLBASE,CLNUM,ZI,CLIDX
+"RTN","GPLRIMA",112,0)
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+"RTN","GPLRIMA",113,0)
+    S CLNUM=@CLBASE@(0)
+"RTN","GPLRIMA",114,0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+"RTN","GPLRIMA",115,0)
+    . S CLIDX=@CLBASE@(ZI)
+"RTN","GPLRIMA",116,0)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+"RTN","GPLRIMA",117,0)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+"RTN","GPLRIMA",118,0)
+    . W CLIDX,!
+"RTN","GPLRIMA",119,0)
+    ; D PARY^GPLXPATH(CLBASE)
+"RTN","GPLRIMA",120,0)
+    Q
+"RTN","GPLRIMA",121,0)
+    ;
+"RTN","GPLRIMA",122,0)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+"RTN","GPLRIMA",123,0)
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+"RTN","GPLRIMA",124,0)
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+"RTN","GPLRIMA",125,0)
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+"RTN","GPLRIMA",126,0)
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+"RTN","GPLRIMA",127,0)
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+"RTN","GPLRIMA",128,0)
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+"RTN","GPLRIMA",129,0)
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+"RTN","GPLRIMA",130,0)
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+"RTN","GPLRIMA",131,0)
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+"RTN","GPLRIMA",132,0)
+    ; NUMBER IE CTBL_X(CDFN)=""
+"RTN","GPLRIMA",133,0)
+    ;
+"RTN","GPLRIMA",134,0)
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+"RTN","GPLRIMA",135,0)
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+"RTN","GPLRIMA",136,0)
+    W "CBASE: ",CCTBL,!
+"RTN","GPLRIMA",137,0)
+    ;
+"RTN","GPLRIMA",138,0)
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+"RTN","GPLRIMA",139,0)
+    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+"RTN","GPLRIMA",140,0)
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+"RTN","GPLRIMA",141,0)
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+"RTN","GPLRIMA",142,0)
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+"RTN","GPLRIMA",143,0)
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+"RTN","GPLRIMA",144,0)
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+"RTN","GPLRIMA",145,0)
+    ;
+"RTN","GPLRIMA",146,0)
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+"RTN","GPLRIMA",147,0)
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",148,0)
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+"RTN","GPLRIMA",149,0)
+    ;
+"RTN","GPLRIMA",150,0)
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+"RTN","GPLRIMA",151,0)
+    ;
+"RTN","GPLRIMA",152,0)
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+"RTN","GPLRIMA",153,0)
+    W "PATS BASE: ",CPATLIST,!
+"RTN","GPLRIMA",154,0)
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+"RTN","GPLRIMA",155,0)
+    ;
+"RTN","GPLRIMA",156,0)
+    Q
+"RTN","GPLRIMA",157,0)
+    ;
+"RTN","GPLRIMA",158,0)
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+"RTN","GPLRIMA",159,0)
+    ;
+"RTN","GPLRIMA",160,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",161,0)
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+"RTN","GPLRIMA",162,0)
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+"RTN","GPLRIMA",163,0)
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+"RTN","GPLRIMA",164,0)
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+"RTN","GPLRIMA",165,0)
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+"RTN","GPLRIMA",166,0)
+    . S ZCNT=0
+"RTN","GPLRIMA",167,0)
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+"RTN","GPLRIMA",168,0)
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+"RTN","GPLRIMA",169,0)
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+"RTN","GPLRIMA",170,0)
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+"RTN","GPLRIMA",171,0)
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",172,0)
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+"RTN","GPLRIMA",173,0)
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+"RTN","GPLRIMA",174,0)
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+"RTN","GPLRIMA",175,0)
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+"RTN","GPLRIMA",176,0)
+    . S ZTOT=ZTOT+ZCNT
+"RTN","GPLRIMA",177,0)
+    W "TOTAL: ",ZTOT,!
+"RTN","GPLRIMA",178,0)
+    Q
+"RTN","GPLRIMA",179,0)
+    ;
+"RTN","GPLRIMA",180,0)
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+"RTN","GPLRIMA",181,0)
+    ; INLST IS PASSED BY NAME
+"RTN","GPLRIMA",182,0)
+    N ZI,ZDX,ZCOUNT
+"RTN","GPLRIMA",183,0)
+    W INLST,!
+"RTN","GPLRIMA",184,0)
+    S ZCOUNT=0
+"RTN","GPLRIMA",185,0)
+    S ZDX=""
+"RTN","GPLRIMA",186,0)
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+"RTN","GPLRIMA",187,0)
+    . S ZCOUNT=ZCOUNT+1
+"RTN","GPLRIMA",188,0)
+    . S ZDX=$O(@INLST@(ZDX))
+"RTN","GPLRIMA",189,0)
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+"RTN","GPLRIMA",190,0)
+    Q ZCOUNT
+"RTN","GPLRIMA",191,0)
+    ;
+"RTN","GPLRIMA",192,0)
+XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+"RTN","GPLRIMA",193,0)
+    ;
+"RTN","GPLRIMA",194,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",195,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",196,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",197,0)
+    S ZI=""
+"RTN","GPLRIMA",198,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",199,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",200,0)
+    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
+"RTN","GPLRIMA",201,0)
+    Q
+"RTN","GPLRIMA",202,0)
+    ;
+"RTN","GPLRIMA",203,0)
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+"RTN","GPLRIMA",204,0)
+    ;
+"RTN","GPLRIMA",205,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",206,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",207,0)
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+"RTN","GPLRIMA",208,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",209,0)
+    S ZI=""
+"RTN","GPLRIMA",210,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",211,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",212,0)
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+"RTN","GPLRIMA",213,0)
+    . W ZI," "
+"RTN","GPLRIMA",214,0)
+    . I ZC=10 D  ; NEW LINE
+"RTN","GPLRIMA",215,0)
+    . . S ZC=0
+"RTN","GPLRIMA",216,0)
+    . . W !
+"RTN","GPLRIMA",217,0)
+    Q
+"RTN","GPLRIMA",218,0)
+    ;
+"RTN","GPLRIMA",219,0)
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+"RTN","GPLRIMA",220,0)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+"RTN","GPLRIMA",221,0)
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+"RTN","GPLRIMA",222,0)
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+"RTN","GPLRIMA",223,0)
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+"RTN","GPLRIMA",224,0)
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+"RTN","GPLRIMA",225,0)
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+"RTN","GPLRIMA",226,0)
+    ;
+"RTN","GPLRIMA",227,0)
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+"RTN","GPLRIMA",228,0)
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+"RTN","GPLRIMA",229,0)
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+"RTN","GPLRIMA",230,0)
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+"RTN","GPLRIMA",231,0)
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+"RTN","GPLRIMA",232,0)
+    Q
+"RTN","GPLRIMA",233,0)
+    ;
+"RTN","GPLRIMA",234,0)
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+"RTN","GPLRIMA",235,0)
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
+"RTN","GPLRIMA",236,0)
+      I '$D(@RIMBASE) S @RIMBASE=""
+"RTN","GPLRIMA",237,0)
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
+"RTN","GPLRIMA",238,0)
+      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+"RTN","GPLRIMA",239,0)
+      Q
+"RTN","GPLRIMA",240,0)
+      ;
+"RTN","GPLRIMA",241,0)
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+"RTN","GPLRIMA",242,0)
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",243,0)
+      K @RIMTBL
+"RTN","GPLRIMA",244,0)
+      D APUSH(RIMTBL,"EXTRACTED")
+"RTN","GPLRIMA",245,0)
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+"RTN","GPLRIMA",246,0)
+      D APUSH(RIMTBL,"HEADER")
+"RTN","GPLRIMA",247,0)
+      D APUSH(RIMTBL,"NOPCP")
+"RTN","GPLRIMA",248,0)
+      D APUSH(RIMTBL,"PCP")
+"RTN","GPLRIMA",249,0)
+      D APUSH(RIMTBL,"PROBLEMS")
+"RTN","GPLRIMA",250,0)
+      D APUSH(RIMTBL,"PROBCODE")
+"RTN","GPLRIMA",251,0)
+      D APUSH(RIMTBL,"PROBNOCODE")
+"RTN","GPLRIMA",252,0)
+      D APUSH(RIMTBL,"PROBDATE")
+"RTN","GPLRIMA",253,0)
+      D APUSH(RIMTBL,"PROBNODATE")
+"RTN","GPLRIMA",254,0)
+      D APUSH(RIMTBL,"VITALS")
+"RTN","GPLRIMA",255,0)
+      D APUSH(RIMTBL,"VITALSCODE")
+"RTN","GPLRIMA",256,0)
+      D APUSH(RIMTBL,"VITALSNOCODE")
+"RTN","GPLRIMA",257,0)
+      D APUSH(RIMTBL,"VITALSDATE")
+"RTN","GPLRIMA",258,0)
+      D APUSH(RIMTBL,"VITALSNODATE")
+"RTN","GPLRIMA",259,0)
+      D APUSH(RIMTBL,"MEDS")
+"RTN","GPLRIMA",260,0)
+      D APUSH(RIMTBL,"MEDSCODE")
+"RTN","GPLRIMA",261,0)
+      D APUSH(RIMTBL,"MEDSNOCODE")
+"RTN","GPLRIMA",262,0)
+      D APUSH(RIMTBL,"MEDSDATE")
+"RTN","GPLRIMA",263,0)
+      D APUSH(RIMTBL,"MEDSNODATE")
+"RTN","GPLRIMA",264,0)
+      Q
+"RTN","GPLRIMA",265,0)
+      ;
+"RTN","GPLRIMA",266,0)
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+"RTN","GPLRIMA",267,0)
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+"RTN","GPLRIMA",268,0)
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+"RTN","GPLRIMA",269,0)
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+"RTN","GPLRIMA",270,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+"RTN","GPLRIMA",271,0)
+    N USETBL
+"RTN","GPLRIMA",272,0)
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+"RTN","GPLRIMA",273,0)
+    . W "ERROR NO SUCH TABLE",!
+"RTN","GPLRIMA",274,0)
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+"RTN","GPLRIMA",275,0)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+"RTN","GPLRIMA",276,0)
+    Q
+"RTN","GPLUNIT")
+0^10^B31630479
+"RTN","GPLUNIT",1,0)
+GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
+"RTN","GPLUNIT",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLUNIT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLUNIT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLUNIT",5,0)
+ ;
+"RTN","GPLUNIT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLUNIT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLUNIT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLUNIT",9,0)
+ ;(at your option) any later version.
+"RTN","GPLUNIT",10,0)
+ ;
+"RTN","GPLUNIT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLUNIT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLUNIT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLUNIT",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLUNIT",15,0)
+ ;
+"RTN","GPLUNIT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLUNIT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLUNIT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLUNIT",19,0)
+ ;
+"RTN","GPLUNIT",20,0)
+          W "This is a unit testing library",!
+"RTN","GPLUNIT",21,0)
+          W !
+"RTN","GPLUNIT",22,0)
+          Q
+"RTN","GPLUNIT",23,0)
+          ;
+"RTN","GPLUNIT",24,0)
+ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
+"RTN","GPLUNIT",25,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",26,0)
+          ; BAT is a string identifying the test battery
+"RTN","GPLUNIT",27,0)
+          ; TST is a test which will evaluate to true or false
+"RTN","GPLUNIT",28,0)
+          ; I '$G(ZARY) D
+"RTN","GPLUNIT",29,0)
+          ; . S ZARY(0)=0 ; initially there are no elements
+"RTN","GPLUNIT",30,0)
+          ; W "GOT HERE LOADING "_TST,!
+"RTN","GPLUNIT",31,0)
+          N CNT ; count of array elements
+"RTN","GPLUNIT",32,0)
+          S CNT=ZARY(0) ; contains array count
+"RTN","GPLUNIT",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLUNIT",34,0)
+          S ZARY(CNT)=TST ; put the test in the array
+"RTN","GPLUNIT",35,0)
+          I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
+"RTN","GPLUNIT",36,0)
+          . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+"RTN","GPLUNIT",37,0)
+          . S II=$P(ZARY(BAT),"^",2)
+"RTN","GPLUNIT",38,0)
+          . S $P(ZARY(BAT),"^",2)=II+1
+"RTN","GPLUNIT",39,0)
+          I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
+"RTN","GPLUNIT",40,0)
+          . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+"RTN","GPLUNIT",41,0)
+          . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+"RTN","GPLUNIT",42,0)
+          . ; S TN=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",43,0)
+          . ; D PUSH^GPLXPATH(TN,BAT)
+"RTN","GPLUNIT",44,0)
+          S ZARY(0)=CNT ; update the array counter
+"RTN","GPLUNIT",45,0)
+          Q
+"RTN","GPLUNIT",46,0)
+          ;
+"RTN","GPLUNIT",47,0)
+ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
+"RTN","GPLUNIT",48,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLUNIT",49,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLUNIT",50,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLUNIT",51,0)
+          K @ZARY
+"RTN","GPLUNIT",52,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLUNIT",53,0)
+          N LINE,LABEL,BODY
+"RTN","GPLUNIT",54,0)
+          N INTEST S INTEST=0 ; switch for in the test case section
+"RTN","GPLUNIT",55,0)
+          N SECTION S SECTION="[anonymous]" ; test case section
+"RTN","GPLUNIT",56,0)
+          ;
+"RTN","GPLUNIT",57,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLUNIT",58,0)
+          . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
+"RTN","GPLUNIT",59,0)
+          . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+"RTN","GPLUNIT",60,0)
+          . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+"RTN","GPLUNIT",61,0)
+          . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
+"RTN","GPLUNIT",62,0)
+          . I INTEST  D  ; within the testing section
+"RTN","GPLUNIT",63,0)
+          . . I LINE?." "1";;><".E  D  ; section name found
+"RTN","GPLUNIT",64,0)
+          . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+"RTN","GPLUNIT",65,0)
+          . . I LINE?." "1";;>>".E  D  ; test case found
+"RTN","GPLUNIT",66,0)
+          . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+"RTN","GPLUNIT",67,0)
+          S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+"RTN","GPLUNIT",68,0)
+          Q
+"RTN","GPLUNIT",69,0)
+          ;
+"RTN","GPLUNIT",70,0)
+ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+"RTN","GPLUNIT",71,0)
+          N ZI,ZX,ZR,ZP
+"RTN","GPLUNIT",72,0)
+          S DEBUG=0
+"RTN","GPLUNIT",73,0)
+          ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+"RTN","GPLUNIT",74,0)
+          ; . W "DOING ALL",!
+"RTN","GPLUNIT",75,0)
+          ; . N J,NT
+"RTN","GPLUNIT",76,0)
+          ; . S NT=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",77,0)
+          ; . W NT,@NT@(0),!
+"RTN","GPLUNIT",78,0)
+          ; . F J=1:1:@NT@(0) D  ;
+"RTN","GPLUNIT",79,0)
+          ; . . W @NT@(J),!
+"RTN","GPLUNIT",80,0)
+          ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
+"RTN","GPLUNIT",81,0)
+          I '$D(ZARY(WHICH))  D  ; TEST SECTION DOESN'T EXIST
+"RTN","GPLUNIT",82,0)
+          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+"RTN","GPLUNIT",83,0)
+          . Q  ; EXIT
+"RTN","GPLUNIT",84,0)
+          N FIRST,LAST
+"RTN","GPLUNIT",85,0)
+          S FIRST=$P(ZARY(WHICH),"^",1)
+"RTN","GPLUNIT",86,0)
+          S LAST=$P(ZARY(WHICH),"^",2)
+"RTN","GPLUNIT",87,0)
+          F ZI=FIRST:1:LAST  D
+"RTN","GPLUNIT",88,0)
+          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+"RTN","GPLUNIT",89,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",90,0)
+          . . ;  W ZP,!
+"RTN","GPLUNIT",91,0)
+          . . S ZX=ZP
+"RTN","GPLUNIT",92,0)
+          . . W "RUNNING: "_ZP
+"RTN","GPLUNIT",93,0)
+          . . X ZX
+"RTN","GPLUNIT",94,0)
+          . . W "..SUCCESS: ",WHICH,!
+"RTN","GPLUNIT",95,0)
+          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+"RTN","GPLUNIT",96,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",97,0)
+          . . S ZX="S ZR="_ZP
+"RTN","GPLUNIT",98,0)
+          . . W "TRYING: "_ZP
+"RTN","GPLUNIT",99,0)
+          . . X ZX
+"RTN","GPLUNIT",100,0)
+          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+"RTN","GPLUNIT",101,0)
+          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+"RTN","GPLUNIT",102,0)
+          . . . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",103,0)
+          . . I ZR S TPASSED=TPASSED+1
+"RTN","GPLUNIT",104,0)
+          . . I 'ZR S TFAILED=TFAILED+1
+"RTN","GPLUNIT",105,0)
+          Q
+"RTN","GPLUNIT",106,0)
+          ;
+"RTN","GPLUNIT",107,0)
+TEST   ; RUN ALL THE TEST CASES
+"RTN","GPLUNIT",108,0)
+          N ZTMP
+"RTN","GPLUNIT",109,0)
+          D ZLOAD(.ZTMP)
+"RTN","GPLUNIT",110,0)
+          D ZTEST(.ZTMP,"ALL")
+"RTN","GPLUNIT",111,0)
+          W "PASSED: ",TPASSED,!
+"RTN","GPLUNIT",112,0)
+          W "FAILED: ",TFAILED,!
+"RTN","GPLUNIT",113,0)
+          W !
+"RTN","GPLUNIT",114,0)
+          W "THE TESTS!",!
+"RTN","GPLUNIT",115,0)
+          ; I DEBUG ZWR ZTMP
+"RTN","GPLUNIT",116,0)
+          Q
+"RTN","GPLUNIT",117,0)
+          ;
+"RTN","GPLUNIT",118,0)
+GTSTS(GTZARY,RTN) ; return an array of test names
+"RTN","GPLUNIT",119,0)
+          N I,J S I="" S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",120,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",121,0)
+          . D PUSH^GPLXPATH(RTN,I)
+"RTN","GPLUNIT",122,0)
+          . S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",123,0)
+          Q
+"RTN","GPLUNIT",124,0)
+          ;
+"RTN","GPLUNIT",125,0)
+TESTALL(RNM) ; RUN ALL THE TESTS
+"RTN","GPLUNIT",126,0)
+          N ZI,J,TZTMP,TSTS,TOTP,TOTF
+"RTN","GPLUNIT",127,0)
+          S TOTP=0 S TOTF=0
+"RTN","GPLUNIT",128,0)
+          D ZLOAD^GPLUNIT("TZTMP",RNM)
+"RTN","GPLUNIT",129,0)
+          D GTSTS(.TZTMP,"TSTS")
+"RTN","GPLUNIT",130,0)
+          F ZI=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",131,0)
+          . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",132,0)
+          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
+"RTN","GPLUNIT",133,0)
+          . S TOTP=TOTP+TPASSED
+"RTN","GPLUNIT",134,0)
+          . S TOTF=TOTF+TFAILED
+"RTN","GPLUNIT",135,0)
+          . S $P(TSTS(ZI),"^",2)=TPASSED
+"RTN","GPLUNIT",136,0)
+          . S $P(TSTS(ZI),"^",3)=TFAILED
+"RTN","GPLUNIT",137,0)
+          F I=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",138,0)
+          . W "TEST=> ",$P(TSTS(ZI),"^",1)
+"RTN","GPLUNIT",139,0)
+          . W " PASSED=>",$P(TSTS(ZI),"^",2)
+"RTN","GPLUNIT",140,0)
+          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+"RTN","GPLUNIT",141,0)
+          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+"RTN","GPLUNIT",142,0)
+          Q
+"RTN","GPLUNIT",143,0)
+          ;
+"RTN","GPLUNIT",144,0)
+TLIST(ZARY) ; LIST ALL THE TESTS
+"RTN","GPLUNIT",145,0)
+          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
+"RTN","GPLUNIT",146,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",147,0)
+          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",148,0)
+          S K=1
+"RTN","GPLUNIT",149,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",150,0)
+          . ; W "I IS NOW=",I,!
+"RTN","GPLUNIT",151,0)
+          . W I," "
+"RTN","GPLUNIT",152,0)
+          . S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",153,0)
+          . S K=K+1 I K=6  D
+"RTN","GPLUNIT",154,0)
+          . . W !
+"RTN","GPLUNIT",155,0)
+          . . S K=1
+"RTN","GPLUNIT",156,0)
+          Q
+"RTN","GPLUNIT",157,0)
+          ;
+"RTN","GPLVITAL")
+0^12^B98509194
+"RTN","GPLVITAL",1,0)
+GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+"RTN","GPLVITAL",2,0)
+          ;;0.1;CCDCCR;;JUL 16,2008;Build 4
+"RTN","GPLVITAL",3,0)
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLVITAL",4,0)
+          ;General Public License See attached copy of the License.
+"RTN","GPLVITAL",5,0)
+          ;
+"RTN","GPLVITAL",6,0)
+          ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLVITAL",7,0)
+          ;it under the terms of the GNU General Public License as published by
+"RTN","GPLVITAL",8,0)
+          ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLVITAL",9,0)
+          ;(at your option) any later version.
+"RTN","GPLVITAL",10,0)
+          ;
+"RTN","GPLVITAL",11,0)
+          ;This program is distributed in the hope that it will be useful,
+"RTN","GPLVITAL",12,0)
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLVITAL",13,0)
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLVITAL",14,0)
+          ;GNU General Public License for more details.
+"RTN","GPLVITAL",15,0)
+          ;
+"RTN","GPLVITAL",16,0)
+          ;You should have received a copy of the GNU General Public License along
+"RTN","GPLVITAL",17,0)
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLVITAL",18,0)
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLVITAL",19,0)
+          ;
+"RTN","GPLVITAL",20,0)
+          W "NO ENTRY FROM TOP",!
+"RTN","GPLVITAL",21,0)
+          Q
+"RTN","GPLVITAL",22,0)
+          ;
+"RTN","GPLVITAL",23,0)
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+"RTN","GPLVITAL",24,0)
+          ;
+"RTN","GPLVITAL",25,0)
+          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLVITAL",26,0)
+          ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLVITAL",27,0)
+          ;
+"RTN","GPLVITAL",28,0)
+          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
+"RTN","GPLVITAL",29,0)
+          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+"RTN","GPLVITAL",30,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." D  ; NULL RESULT FROM RPC
+"RTN","GPLVITAL",31,0)
+          . W "NO VITALS FOUND FROM VITALS RPC",!
+"RTN","GPLVITAL",32,0)
+          . S @VITOUTXML@(0)=0
+"RTN","GPLVITAL",33,0)
+          . Q
+"RTN","GPLVITAL",34,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
+"RTN","GPLVITAL",35,0)
+          ; ZWR RPCRSLT
+"RTN","GPLVITAL",36,0)
+          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
+"RTN","GPLVITAL",37,0)
+          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
+"RTN","GPLVITAL",38,0)
+          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLVITAL",39,0)
+          N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+"RTN","GPLVITAL",40,0)
+          D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","GPLVITAL",41,0)
+          ; I DEBUG ZWR VDATES ;DEBUG
+"RTN","GPLVITAL",42,0)
+          S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+"RTN","GPLVITAL",43,0)
+          ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+"RTN","GPLVITAL",44,0)
+          F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+"RTN","GPLVITAL",45,0)
+          . I $D(VITRSLT(VSORT(J))) D
+"RTN","GPLVITAL",46,0)
+          . . S VITVMAP=$NA(@VITTVMAP@(J))
+"RTN","GPLVITAL",47,0)
+          . . K @VITVMAP
+"RTN","GPLVITAL",48,0)
+          . . I DEBUG W "VMAP= ",VITVMAP,!
+"RTN","GPLVITAL",49,0)
+          . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
+"RTN","GPLVITAL",50,0)
+          . . I DEBUG W "VITAL ",VSORT(J),!
+"RTN","GPLVITAL",51,0)
+          . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
+"RTN","GPLVITAL",52,0)
+          . . I DEBUG W $P(VITPTMP,U,4),!
+"RTN","GPLVITAL",53,0)
+          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+"RTN","GPLVITAL",54,0)
+          . . I $P(VITPTMP,U,2)="HT" D
+"RTN","GPLVITAL",55,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",56,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",57,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",58,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",59,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",60,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",61,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",62,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
+"RTN","GPLVITAL",63,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",64,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",65,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",66,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",67,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+"RTN","GPLVITAL",68,0)
+          . . E  I $P(VITPTMP,U,2)="WT" D
+"RTN","GPLVITAL",69,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",70,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",71,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",72,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",73,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",74,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",75,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",76,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
+"RTN","GPLVITAL",77,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",78,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",79,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",80,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",81,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+"RTN","GPLVITAL",82,0)
+          . . E  I $P(VITPTMP,U,2)="BP" D
+"RTN","GPLVITAL",83,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",84,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",85,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",86,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",87,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",88,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",89,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",90,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
+"RTN","GPLVITAL",91,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",92,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",93,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",94,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",95,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",96,0)
+          . . E  I $P(VITPTMP,U,2)="T" D
+"RTN","GPLVITAL",97,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",98,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",99,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",100,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",101,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",102,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",103,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",104,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
+"RTN","GPLVITAL",105,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",106,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",107,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",108,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",109,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+"RTN","GPLVITAL",110,0)
+          . . E  I $P(VITPTMP,U,2)="R" D
+"RTN","GPLVITAL",111,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",112,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",113,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",114,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",115,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",116,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",117,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",118,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
+"RTN","GPLVITAL",119,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",120,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",121,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",122,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",123,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",124,0)
+          . . E  I $P(VITPTMP,U,2)="P" D
+"RTN","GPLVITAL",125,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",126,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",127,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",128,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",129,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",130,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",131,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",132,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
+"RTN","GPLVITAL",133,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",134,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",135,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",136,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",137,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",138,0)
+          . . E  I $P(VITPTMP,U,2)="PN" D
+"RTN","GPLVITAL",139,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",140,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",141,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",142,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",143,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",144,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",145,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",146,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
+"RTN","GPLVITAL",147,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",148,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",149,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",150,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",151,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",152,0)
+          . . E  D
+"RTN","GPLVITAL",153,0)
+          . . . ;W "IN VITAL:  OTHER",!
+"RTN","GPLVITAL",154,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",155,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",156,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+"RTN","GPLVITAL",157,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",158,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",159,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+"RTN","GPLVITAL",160,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+"RTN","GPLVITAL",161,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+"RTN","GPLVITAL",162,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+"RTN","GPLVITAL",163,0)
+          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",164,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",165,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",166,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+"RTN","GPLVITAL",167,0)
+          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+"RTN","GPLVITAL",168,0)
+          . . K @VITARYTMP
+"RTN","GPLVITAL",169,0)
+          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
+"RTN","GPLVITAL",170,0)
+          . . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLVITAL",171,0)
+          . . . ; W "FIRST ONE",!
+"RTN","GPLVITAL",172,0)
+          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
+"RTN","GPLVITAL",173,0)
+          . . . W "VITOUTXML ",VITOUTXML,!
+"RTN","GPLVITAL",174,0)
+          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLVITAL",175,0)
+          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
+"RTN","GPLVITAL",176,0)
+          ; ZWR ^TMP($J,"VITALS",*)
+"RTN","GPLVITAL",177,0)
+          ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLVITAL",178,0)
+          I DEBUG D PARY^GPLXPATH(VITOUTXML)
+"RTN","GPLVITAL",179,0)
+          N VITTMP,I
+"RTN","GPLVITAL",180,0)
+          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLVITAL",181,0)
+          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLVITAL",182,0)
+          . W "VITALS MISSING ",!
+"RTN","GPLVITAL",183,0)
+          . F I=1:1:VITTMP(0) W VITTMP(I),!
+"RTN","GPLVITAL",184,0)
+          Q
+"RTN","GPLVITAL",185,0)
+          ;
+"RTN","GPLVITAL",186,0)
+VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+"RTN","GPLVITAL",187,0)
+         ; OF DATES IN THE VITALS RESULTS
+"RTN","GPLVITAL",188,0)
+         N VDTI,VDTJ,VTDCNT
+"RTN","GPLVITAL",189,0)
+         S VTDCNT=0 ; COUNT TO BUILD ARRAY
+"RTN","GPLVITAL",190,0)
+         S VDTJ="" ; USED TO VISIT THE RESULTS
+"RTN","GPLVITAL",191,0)
+         F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","GPLVITAL",192,0)
+         . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
+"RTN","GPLVITAL",193,0)
+         . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+"RTN","GPLVITAL",194,0)
+         . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","GPLVITAL",195,0)
+         Q
+"RTN","GPLVITAL",196,0)
+         ;
+"RTN","GPLXPAT0")
+0^19^B44173297
+"RTN","GPLXPAT0",1,0)
+GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
+"RTN","GPLXPAT0",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLXPAT0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPAT0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPAT0",5,0)
+ ;
+"RTN","GPLXPAT0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPAT0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPAT0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPAT0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPAT0",10,0)
+ ;
+"RTN","GPLXPAT0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPAT0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPAT0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPAT0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPAT0",15,0)
+ ;
+"RTN","GPLXPAT0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPAT0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPAT0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPAT0",19,0)
+ ;
+"RTN","GPLXPAT0",20,0)
+        W "NO ENTRY",!
+"RTN","GPLXPAT0",21,0)
+        Q
+"RTN","GPLXPAT0",22,0)
+        ;
+"RTN","GPLXPAT0",23,0)
+ ;;><TEST>
+"RTN","GPLXPAT0",24,0)
+ ;;><INIT>
+"RTN","GPLXPAT0",25,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLXPAT0",26,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FIRST")
+"RTN","GPLXPAT0",27,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","SECOND")
+"RTN","GPLXPAT0",28,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","THIRD")
+"RTN","GPLXPAT0",29,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
+"RTN","GPLXPAT0",30,0)
+ ;;>>?GPL(0)=4
+"RTN","GPLXPAT0",31,0)
+ ;;><INITXML>
+"RTN","GPLXPAT0",32,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",33,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",34,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",35,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",36,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
+"RTN","GPLXPAT0",37,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
+"RTN","GPLXPAT0",38,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
+"RTN","GPLXPAT0",39,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
+"RTN","GPLXPAT0",40,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
+"RTN","GPLXPAT0",41,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",42,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",43,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",44,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",45,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",46,0)
+ ;;><INITXML2>
+"RTN","GPLXPAT0",47,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",48,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",49,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",50,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",51,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
+"RTN","GPLXPAT0",52,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
+"RTN","GPLXPAT0",53,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","DATA2")
+"RTN","GPLXPAT0",54,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
+"RTN","GPLXPAT0",55,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",56,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
+"RTN","GPLXPAT0",57,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
+"RTN","GPLXPAT0",58,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
+"RTN","GPLXPAT0",59,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",60,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",61,0)
+ ;;><PUSHPOP>
+"RTN","GPLXPAT0",62,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",63,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",64,0)
+ ;;>>?GPL(GPL(0))="FOURTH"
+"RTN","GPLXPAT0",65,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",66,0)
+ ;;>>?GX="FOURTH"
+"RTN","GPLXPAT0",67,0)
+ ;;>>?GPL(GPL(0))="THIRD"
+"RTN","GPLXPAT0",68,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",69,0)
+ ;;>>?GX="THIRD"
+"RTN","GPLXPAT0",70,0)
+ ;;>>?GPL(GPL(0))="SECOND"
+"RTN","GPLXPAT0",71,0)
+ ;;><MKMDX>
+"RTN","GPLXPAT0",72,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",73,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",74,0)
+ ;;>>>S GX=""
+"RTN","GPLXPAT0",75,0)
+ ;;>>>D MKMDX^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",76,0)
+ ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
+"RTN","GPLXPAT0",77,0)
+ ;;><XNAME>
+"RTN","GPLXPAT0",78,0)
+ ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
+"RTN","GPLXPAT0",79,0)
+ ;;>>?$$XNAME^GPLXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
+"RTN","GPLXPAT0",80,0)
+ ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
+"RTN","GPLXPAT0",81,0)
+ ;;><INDEX>
+"RTN","GPLXPAT0",82,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",83,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
+"RTN","GPLXPAT0",84,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",85,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",86,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
+"RTN","GPLXPAT0",87,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
+"RTN","GPLXPAT0",88,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
+"RTN","GPLXPAT0",89,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
+"RTN","GPLXPAT0",90,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",91,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",92,0)
+ ;;><INDEX2>
+"RTN","GPLXPAT0",93,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML2")
+"RTN","GPLXPAT0",94,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",95,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",96,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
+"RTN","GPLXPAT0",97,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
+"RTN","GPLXPAT0",98,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
+"RTN","GPLXPAT0",99,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
+"RTN","GPLXPAT0",100,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",101,0)
+ ;;><MISSING>
+"RTN","GPLXPAT0",102,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",103,0)
+ ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
+"RTN","GPLXPAT0",104,0)
+ ;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
+"RTN","GPLXPAT0",105,0)
+ ;;>>?@OUTARY@(1)="DATA1"
+"RTN","GPLXPAT0",106,0)
+ ;;>>?@OUTARY@(2)="DATA2"
+"RTN","GPLXPAT0",107,0)
+ ;;><MAP>
+"RTN","GPLXPAT0",108,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",109,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",110,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",111,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",112,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",113,0)
+ ;;>>?@OUTARY@(6)="VALUE2"
+"RTN","GPLXPAT0",114,0)
+ ;;><MAP2>
+"RTN","GPLXPAT0",115,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",116,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",117,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",118,0)
+ ;;>>>S @MAPARY@("DATA1")="VALUE1"
+"RTN","GPLXPAT0",119,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",120,0)
+ ;;>>>S @MAPARY@("DATA3")="VALUE3"
+"RTN","GPLXPAT0",121,0)
+ ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
+"RTN","GPLXPAT0",122,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",123,0)
+ ;;>>>D PARY^GPLXPATH(OUTARY)
+"RTN","GPLXPAT0",124,0)
+ ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
+"RTN","GPLXPAT0",125,0)
+ ;;><QUEUE>
+"RTN","GPLXPAT0",126,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
+"RTN","GPLXPAT0",127,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
+"RTN","GPLXPAT0",128,0)
+ ;;>>?$P(BTLIST(2),";",2)=4
+"RTN","GPLXPAT0",129,0)
+ ;;><BUILD>
+"RTN","GPLXPAT0",130,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",131,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
+"RTN","GPLXPAT0",132,0)
+ ;;>>>D ZTEST^GPLXPATH("QUEUE")
+"RTN","GPLXPAT0",133,0)
+ ;;>>>D BUILD^GPLXPATH("BTLIST","G3")
+"RTN","GPLXPAT0",134,0)
+ ;;><CP>
+"RTN","GPLXPAT0",135,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",136,0)
+ ;;>>>D CP^GPLXPATH("GXML","G2")
+"RTN","GPLXPAT0",137,0)
+ ;;>>?G2(0)=13
+"RTN","GPLXPAT0",138,0)
+ ;;><QOPEN>
+"RTN","GPLXPAT0",139,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",140,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",141,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",142,0)
+ ;;>>?$P(GBL(1),";",3)=12
+"RTN","GPLXPAT0",143,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",144,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",145,0)
+ ;;><QOPEN2>
+"RTN","GPLXPAT0",146,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",147,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",148,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
+"RTN","GPLXPAT0",149,0)
+ ;;>>?$P(GBL(1),";",3)=11
+"RTN","GPLXPAT0",150,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",151,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",152,0)
+ ;;><QCLOSE>
+"RTN","GPLXPAT0",153,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",154,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",155,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",156,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",157,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",158,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",159,0)
+ ;;><QCLOSE2>
+"RTN","GPLXPAT0",160,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",161,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",162,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",163,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",164,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",165,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",166,0)
+ ;;>>?G2(1)="</THIRD>"
+"RTN","GPLXPAT0",167,0)
+ ;;><INSERT>
+"RTN","GPLXPAT0",168,0)
+ ;;>>>K G2,GBL,G3,G4
+"RTN","GPLXPAT0",169,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",170,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",171,0)
+ ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",172,0)
+ ;;>>>D INSERT^GPLXPATH("G3","G2","//")
+"RTN","GPLXPAT0",173,0)
+ ;;>>?G2(1)=GXML(9)
+"RTN","GPLXPAT0",174,0)
+ ;;><REPLACE>
+"RTN","GPLXPAT0",175,0)
+ ;;>>>K G2,GBL,G3
+"RTN","GPLXPAT0",176,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",177,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",178,0)
+ ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
+"RTN","GPLXPAT0",179,0)
+ ;;>>?GXML(2)="<FIFTH>"
+"RTN","GPLXPAT0",180,0)
+ ;;><INSINNER>
+"RTN","GPLXPAT0",181,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",182,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",183,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",184,0)
+ ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",185,0)
+ ;;>>?GXML(10)="<FIFTH>"
+"RTN","GPLXPAT0",186,0)
+ ;;><INSINNER2>
+"RTN","GPLXPAT0",187,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",188,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",189,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",190,0)
+ ;;>>>D INSINNER^GPLXPATH("G2","G2")
+"RTN","GPLXPAT0",191,0)
+ ;;>>?G2(8)="<FIFTH>"
+"RTN","GPLXPAT0",192,0)
+ ;;></TEST>
+"RTN","GPLXPATH")
+0^9^B261673629
+"RTN","GPLXPATH",1,0)
+GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
+"RTN","GPLXPATH",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 4
+"RTN","GPLXPATH",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPATH",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPATH",5,0)
+ ;
+"RTN","GPLXPATH",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPATH",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPATH",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPATH",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPATH",10,0)
+ ;
+"RTN","GPLXPATH",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPATH",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPATH",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPATH",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPATH",15,0)
+ ;
+"RTN","GPLXPATH",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPATH",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPATH",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPATH",19,0)
+ ;
+"RTN","GPLXPATH",20,0)
+          W "This is an XML XPATH utility library",!
+"RTN","GPLXPATH",21,0)
+          W !
+"RTN","GPLXPATH",22,0)
+          Q
+"RTN","GPLXPATH",23,0)
+          ;
+"RTN","GPLXPATH",24,0)
+OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+"RTN","GPLXPATH",25,0)
+          ;
+"RTN","GPLXPATH",26,0)
+          N Y
+"RTN","GPLXPATH",27,0)
+          S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
+"RTN","GPLXPATH",28,0)
+          I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
+"RTN","GPLXPATH",29,0)
+          ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
+"RTN","GPLXPATH",30,0)
+          Q
+"RTN","GPLXPATH",31,0)
+          ;
+"RTN","GPLXPATH",32,0)
+PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+"RTN","GPLXPATH",33,0)
+          ;  VAL IS A STRING AND STK IS PASSED BY NAME
+"RTN","GPLXPATH",34,0)
+          ;
+"RTN","GPLXPATH",35,0)
+          I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
+"RTN","GPLXPATH",36,0)
+          S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
+"RTN","GPLXPATH",37,0)
+          S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+"RTN","GPLXPATH",38,0)
+          Q
+"RTN","GPLXPATH",39,0)
+          ;
+"RTN","GPLXPATH",40,0)
+POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+"RTN","GPLXPATH",41,0)
+          ; VAL AND STK ARE PASSED BY REFERENCE
+"RTN","GPLXPATH",42,0)
+          ;
+"RTN","GPLXPATH",43,0)
+          I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
+"RTN","GPLXPATH",44,0)
+          . S VAL=""
+"RTN","GPLXPATH",45,0)
+          . S @STK@(0)=0
+"RTN","GPLXPATH",46,0)
+          I @STK@(0)>0  D  ;
+"RTN","GPLXPATH",47,0)
+          . S VAL=@STK@(@STK@(0))
+"RTN","GPLXPATH",48,0)
+          . K @STK@(@STK@(0))
+"RTN","GPLXPATH",49,0)
+          . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+"RTN","GPLXPATH",50,0)
+          Q
+"RTN","GPLXPATH",51,0)
+          ;
+"RTN","GPLXPATH",52,0)
+MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+"RTN","GPLXPATH",53,0)
+          ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
+"RTN","GPLXPATH",54,0)
+          S RTN=""
+"RTN","GPLXPATH",55,0)
+          N I
+"RTN","GPLXPATH",56,0)
+          ; W "STK= ",STK,!
+"RTN","GPLXPATH",57,0)
+          I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",58,0)
+          . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
+"RTN","GPLXPATH",59,0)
+          . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
+"RTN","GPLXPATH",60,0)
+          . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
+"RTN","GPLXPATH",61,0)
+          Q
+"RTN","GPLXPATH",62,0)
+          ;
+"RTN","GPLXPATH",63,0)
+XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+"RTN","GPLXPATH",64,0)
+          ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
+"RTN","GPLXPATH",65,0)
+          ; ISTR IS PASSED BY VALUE
+"RTN","GPLXPATH",66,0)
+          N CUR,TMP
+"RTN","GPLXPATH",67,0)
+          I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
+"RTN","GPLXPATH",68,0)
+          . S TMP=$P(ISTR,"<",2)
+"RTN","GPLXPATH",69,0)
+          I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
+"RTN","GPLXPATH",70,0)
+          . S TMP=$P(TMP,"/",2)
+"RTN","GPLXPATH",71,0)
+          S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
+"RTN","GPLXPATH",72,0)
+          ; W "CUR= ",CUR,!
+"RTN","GPLXPATH",73,0)
+          I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
+"RTN","GPLXPATH",74,0)
+           . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
+"RTN","GPLXPATH",75,0)
+          ; W "CUR2= ",CUR,!
+"RTN","GPLXPATH",76,0)
+          Q CUR
+"RTN","GPLXPATH",77,0)
+          ;
+"RTN","GPLXPATH",78,0)
+INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
+"RTN","GPLXPATH",79,0)
+          ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
+"RTN","GPLXPATH",80,0)
+          ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
+"RTN","GPLXPATH",81,0)
+          ; XML SECTION
+"RTN","GPLXPATH",82,0)
+          ; ZXML IS PASSED BY NAME
+"RTN","GPLXPATH",83,0)
+          N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
+"RTN","GPLXPATH",84,0)
+          N GPLSTK ; LEAVE OUT FOR DEBUGGING
+"RTN","GPLXPATH",85,0)
+          I '$D(@ZXML@(0))  D  ; NO XML PASSED
+"RTN","GPLXPATH",86,0)
+          . W "ERROR IN XML FILE",!
+"RTN","GPLXPATH",87,0)
+          S GPLSTK(0)=0 ; INITIALIZE STACK
+"RTN","GPLXPATH",88,0)
+          F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
+"RTN","GPLXPATH",89,0)
+          . S LINE=@ZXML@(I)
+"RTN","GPLXPATH",90,0)
+          . ;W LINE,!
+"RTN","GPLXPATH",91,0)
+          . S FOUND=0  ; INTIALIZED FOUND FLAG
+"RTN","GPLXPATH",92,0)
+          . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
+"RTN","GPLXPATH",93,0)
+          . I FOUND'=1  D
+"RTN","GPLXPATH",94,0)
+          . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
+"RTN","GPLXPATH",95,0)
+          . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
+"RTN","GPLXPATH",96,0)
+          . . . ; ON THE SAME LINE
+"RTN","GPLXPATH",97,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",98,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",99,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",100,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",101,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",102,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",103,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",104,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",105,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",106,0)
+          . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
+"RTN","GPLXPATH",107,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",108,0)
+          . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
+"RTN","GPLXPATH",109,0)
+          . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
+"RTN","GPLXPATH",110,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",111,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",112,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",113,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",114,0)
+          . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",115,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",116,0)
+          . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
+"RTN","GPLXPATH",117,0)
+          . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
+"RTN","GPLXPATH",118,0)
+          . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
+"RTN","GPLXPATH",119,0)
+          . . . . Q
+"RTN","GPLXPATH",120,0)
+          . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
+"RTN","GPLXPATH",121,0)
+          . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
+"RTN","GPLXPATH",122,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",123,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",124,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",125,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",126,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",127,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",128,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",129,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",130,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",131,0)
+          . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
+"RTN","GPLXPATH",132,0)
+          S @ZXML@("INDEXED")=""
+"RTN","GPLXPATH",133,0)
+          S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
+"RTN","GPLXPATH",134,0)
+          Q
+"RTN","GPLXPATH",135,0)
+          ;
+"RTN","GPLXPATH",136,0)
+QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+"RTN","GPLXPATH",137,0)
+         ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
+"RTN","GPLXPATH",138,0)
+         ; IARY AND OARY ARE PASSED BY NAME
+"RTN","GPLXPATH",139,0)
+         I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
+"RTN","GPLXPATH",140,0)
+         . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
+"RTN","GPLXPATH",141,0)
+         N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
+"RTN","GPLXPATH",142,0)
+         N TMP,I,J,QXPATH
+"RTN","GPLXPATH",143,0)
+         S FIRST=1
+"RTN","GPLXPATH",144,0)
+         S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
+"RTN","GPLXPATH",145,0)
+         I XPATH'="//" D  ; NOT A ROOT QUERY
+"RTN","GPLXPATH",146,0)
+         . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
+"RTN","GPLXPATH",147,0)
+         . S FIRST=$P(TMP,"^",1)
+"RTN","GPLXPATH",148,0)
+         . S LAST=$P(TMP,"^",2)
+"RTN","GPLXPATH",149,0)
+         K @OARY
+"RTN","GPLXPATH",150,0)
+         S @OARY@(0)=+LAST-FIRST+1
+"RTN","GPLXPATH",151,0)
+         S J=1
+"RTN","GPLXPATH",152,0)
+         FOR I=FIRST:1:LAST  D
+"RTN","GPLXPATH",153,0)
+         . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
+"RTN","GPLXPATH",154,0)
+         . S J=J+1
+"RTN","GPLXPATH",155,0)
+         ; ZWR OARY
+"RTN","GPLXPATH",156,0)
+         Q
+"RTN","GPLXPATH",157,0)
+         ;
+"RTN","GPLXPATH",158,0)
+XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+"RTN","GPLXPATH",159,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",160,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",161,0)
+         Q $P(@IDX@(XPATH),"^",1)
+"RTN","GPLXPATH",162,0)
+         ;
+"RTN","GPLXPATH",163,0)
+XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+"RTN","GPLXPATH",164,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",165,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",166,0)
+         Q $P(@IDX@(XPATH),"^",2)
+"RTN","GPLXPATH",167,0)
+         ;
+"RTN","GPLXPATH",168,0)
+START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+"RTN","GPLXPATH",169,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",170,0)
+         ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",171,0)
+         Q $P(ISTR,";",2)
+"RTN","GPLXPATH",172,0)
+         ;
+"RTN","GPLXPATH",173,0)
+FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+"RTN","GPLXPATH",174,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",175,0)
+         Q $P(ISTR,";",3)
+"RTN","GPLXPATH",176,0)
+         ;
+"RTN","GPLXPATH",177,0)
+ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+"RTN","GPLXPATH",178,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",179,0)
+         Q $P(ISTR,";",1)
+"RTN","GPLXPATH",180,0)
+         ;
+"RTN","GPLXPATH",181,0)
+BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+"RTN","GPLXPATH",182,0)
+         ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+"RTN","GPLXPATH",183,0)
+         ; DEST IS CLEARED TO START
+"RTN","GPLXPATH",184,0)
+         ; USES PUSH TO DO THE COPY
+"RTN","GPLXPATH",185,0)
+         N I
+"RTN","GPLXPATH",186,0)
+         K @BDEST
+"RTN","GPLXPATH",187,0)
+         F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
+"RTN","GPLXPATH",188,0)
+         . N J,ATMP
+"RTN","GPLXPATH",189,0)
+         . S ATMP=$$ARRAY(@BLIST@(I))
+"RTN","GPLXPATH",190,0)
+         . I DEBUG W "ATMP=",ATMP,!
+"RTN","GPLXPATH",191,0)
+         . I DEBUG W @BLIST@(I),!
+"RTN","GPLXPATH",192,0)
+         . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
+"RTN","GPLXPATH",193,0)
+         . . ; FOR EACH LINE IN THIS INSTR
+"RTN","GPLXPATH",194,0)
+         . . I DEBUG W "BDEST= ",BDEST,!
+"RTN","GPLXPATH",195,0)
+         . . I DEBUG W "ATMP= ",@ATMP@(J),!
+"RTN","GPLXPATH",196,0)
+         . . D PUSH(BDEST,@ATMP@(J))
+"RTN","GPLXPATH",197,0)
+         Q
+"RTN","GPLXPATH",198,0)
+         ;
+"RTN","GPLXPATH",199,0)
+QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+"RTN","GPLXPATH",200,0)
+         ;
+"RTN","GPLXPATH",201,0)
+         I DEBUG W "QUEUEING ",BLST,!
+"RTN","GPLXPATH",202,0)
+         D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+"RTN","GPLXPATH",203,0)
+         Q
+"RTN","GPLXPATH",204,0)
+         ;
+"RTN","GPLXPATH",205,0)
+CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+"RTN","GPLXPATH",206,0)
+         ; KILLS CPDEST FIRST
+"RTN","GPLXPATH",207,0)
+         N CPINSTR
+"RTN","GPLXPATH",208,0)
+         I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
+"RTN","GPLXPATH",209,0)
+         I @CPSRC@(0)<1 D  ; BAD LENGTH
+"RTN","GPLXPATH",210,0)
+         . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
+"RTN","GPLXPATH",211,0)
+         . Q
+"RTN","GPLXPATH",212,0)
+         ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
+"RTN","GPLXPATH",213,0)
+         D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
+"RTN","GPLXPATH",214,0)
+         D BUILD("CPINSTR",CPDEST)
+"RTN","GPLXPATH",215,0)
+         Q
+"RTN","GPLXPATH",216,0)
+         ;
+"RTN","GPLXPATH",217,0)
+QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+"RTN","GPLXPATH",218,0)
+         ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
+"RTN","GPLXPATH",219,0)
+         ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
+"RTN","GPLXPATH",220,0)
+         ; USED TO INSERT CHILDREN NODES
+"RTN","GPLXPATH",221,0)
+         I @QOXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",222,0)
+         . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
+"RTN","GPLXPATH",223,0)
+         . Q
+"RTN","GPLXPATH",224,0)
+         I DEBUG W "DOING QOPEN",!
+"RTN","GPLXPATH",225,0)
+         N S1,E1,QOT,QOTMP
+"RTN","GPLXPATH",226,0)
+         S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
+"RTN","GPLXPATH",227,0)
+         I $D(QOXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",228,0)
+         . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
+"RTN","GPLXPATH",229,0)
+         . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
+"RTN","GPLXPATH",230,0)
+         I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",231,0)
+         . S E1=@QOXML@(0)-1
+"RTN","GPLXPATH",232,0)
+         D QUEUE(QOBLIST,QOXML,S1,E1)
+"RTN","GPLXPATH",233,0)
+         ; S QOTMP=QOXML_"^"_S1_"^"_E1
+"RTN","GPLXPATH",234,0)
+         ; D PUSH(QOBLIST,QOTMP)
+"RTN","GPLXPATH",235,0)
+         Q
+"RTN","GPLXPATH",236,0)
+         ;
+"RTN","GPLXPATH",237,0)
+QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+"RTN","GPLXPATH",238,0)
+         ; ADDS THE LIST LINE OF QCXML TO QCBLIST
+"RTN","GPLXPATH",239,0)
+         ; USED TO FINISH INSERTING CHILDERN NODES
+"RTN","GPLXPATH",240,0)
+         ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
+"RTN","GPLXPATH",241,0)
+         ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
+"RTN","GPLXPATH",242,0)
+         I @QCXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",243,0)
+         . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
+"RTN","GPLXPATH",244,0)
+         I DEBUG W "GOING TO CLOSE",!
+"RTN","GPLXPATH",245,0)
+         N S1,E1,QCT,QCTMP
+"RTN","GPLXPATH",246,0)
+         S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
+"RTN","GPLXPATH",247,0)
+         I $D(QCXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",248,0)
+         . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
+"RTN","GPLXPATH",249,0)
+         . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
+"RTN","GPLXPATH",250,0)
+         I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",251,0)
+         . S S1=@QCXML@(0)
+"RTN","GPLXPATH",252,0)
+         D QUEUE(QCBLIST,QCXML,S1,E1)
+"RTN","GPLXPATH",253,0)
+         ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+"RTN","GPLXPATH",254,0)
+         Q
+"RTN","GPLXPATH",255,0)
+         ;
+"RTN","GPLXPATH",256,0)
+INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+"RTN","GPLXPATH",257,0)
+         ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
+"RTN","GPLXPATH",258,0)
+         ; OMITTED, INSERTION WILL BE AT THE ROOT
+"RTN","GPLXPATH",259,0)
+         ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
+"RTN","GPLXPATH",260,0)
+         ; XML AT THE END OF THE XPATH POINT
+"RTN","GPLXPATH",261,0)
+         ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
+"RTN","GPLXPATH",262,0)
+         N INSBLD,INSTMP
+"RTN","GPLXPATH",263,0)
+         I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+"RTN","GPLXPATH",264,0)
+         I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+"RTN","GPLXPATH",265,0)
+         I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
+"RTN","GPLXPATH",266,0)
+         . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
+"RTN","GPLXPATH",267,0)
+         I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",268,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",269,0)
+         . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
+"RTN","GPLXPATH",270,0)
+         . . I DEBUG D PARY^GPLXPATH("INSBLD")
+"RTN","GPLXPATH",271,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",272,0)
+         . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
+"RTN","GPLXPATH",273,0)
+         . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
+"RTN","GPLXPATH",274,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",275,0)
+         . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
+"RTN","GPLXPATH",276,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",277,0)
+         . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
+"RTN","GPLXPATH",278,0)
+         . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+"RTN","GPLXPATH",279,0)
+         . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+"RTN","GPLXPATH",280,0)
+         Q
+"RTN","GPLXPATH",281,0)
+         ;
+"RTN","GPLXPATH",282,0)
+INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+"RTN","GPLXPATH",283,0)
+         ; INTO INNXML AT THE INNXPATH XPATH POINT
+"RTN","GPLXPATH",284,0)
+         ;
+"RTN","GPLXPATH",285,0)
+         N INNBLD,UXPATH
+"RTN","GPLXPATH",286,0)
+         N INNTBUF
+"RTN","GPLXPATH",287,0)
+         S INNTBUF=$NA(^TMP($J,"INNTBUF"))
+"RTN","GPLXPATH",288,0)
+         I '$D(INNXPATH) D  ; XPATH NOT PASSED
+"RTN","GPLXPATH",289,0)
+         . S UXPATH="//" ; USE ROOT XPATH
+"RTN","GPLXPATH",290,0)
+         I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
+"RTN","GPLXPATH",291,0)
+         I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
+"RTN","GPLXPATH",292,0)
+         . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
+"RTN","GPLXPATH",293,0)
+         . D BUILD("INNBLD",INNXML)
+"RTN","GPLXPATH",294,0)
+         I @INNXML@(0)>0  D  ; NOT EMPTY
+"RTN","GPLXPATH",295,0)
+         . D QOPEN("INNBLD",INNXML,UXPATH) ;
+"RTN","GPLXPATH",296,0)
+         . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
+"RTN","GPLXPATH",297,0)
+         . D QCLOSE("INNBLD",INNXML,UXPATH)
+"RTN","GPLXPATH",298,0)
+         . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
+"RTN","GPLXPATH",299,0)
+         . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+"RTN","GPLXPATH",300,0)
+         Q
+"RTN","GPLXPATH",301,0)
+         ;
+"RTN","GPLXPATH",302,0)
+INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+"RTN","GPLXPATH",303,0)
+        ; BUT XDEST AN XNEW ARE PASSED BY NAME
+"RTN","GPLXPATH",304,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",305,0)
+        D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
+"RTN","GPLXPATH",306,0)
+        D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
+"RTN","GPLXPATH",307,0)
+        D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
+"RTN","GPLXPATH",308,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",309,0)
+        D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
+"RTN","GPLXPATH",310,0)
+        I DEBUG D PARY("XDEST")
+"RTN","GPLXPATH",311,0)
+        Q
+"RTN","GPLXPATH",312,0)
+        ;
+"RTN","GPLXPATH",313,0)
+REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+"RTN","GPLXPATH",314,0)
+         ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
+"RTN","GPLXPATH",315,0)
+         ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
+"RTN","GPLXPATH",316,0)
+         ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
+"RTN","GPLXPATH",317,0)
+         N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+"RTN","GPLXPATH",318,0)
+         S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+"RTN","GPLXPATH",319,0)
+         D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+"RTN","GPLXPATH",320,0)
+         S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+"RTN","GPLXPATH",321,0)
+         S XFIRST=$P(XNODE,"^",1)
+"RTN","GPLXPATH",322,0)
+         S XLAST=$P(XNODE,"^",2)
+"RTN","GPLXPATH",323,0)
+         I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
+"RTN","GPLXPATH",324,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
+"RTN","GPLXPATH",325,0)
+         . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",326,0)
+         I RENEW'="" D  ; NEW XML IS NOT NULL
+"RTN","GPLXPATH",327,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+"RTN","GPLXPATH",328,0)
+         . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
+"RTN","GPLXPATH",329,0)
+         . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",330,0)
+         I DEBUG W "REPLACE PREBUILD",!
+"RTN","GPLXPATH",331,0)
+         I DEBUG D PARY("REBLD")
+"RTN","GPLXPATH",332,0)
+         D BUILD("REBLD","RTMP")
+"RTN","GPLXPATH",333,0)
+         K @REXML ; KILL WHAT WAS THERE
+"RTN","GPLXPATH",334,0)
+         D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","GPLXPATH",335,0)
+         Q
+"RTN","GPLXPATH",336,0)
+         ;
+"RTN","GPLXPATH",337,0)
+MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+"RTN","GPLXPATH",338,0)
+         ; W "Reporting on the missing",!
+"RTN","GPLXPATH",339,0)
+         ; W OARY
+"RTN","GPLXPATH",340,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
+"RTN","GPLXPATH",341,0)
+         N I
+"RTN","GPLXPATH",342,0)
+         S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
+"RTN","GPLXPATH",343,0)
+         F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",344,0)
+         . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
+"RTN","GPLXPATH",345,0)
+         . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
+"RTN","GPLXPATH",346,0)
+         . . Q
+"RTN","GPLXPATH",347,0)
+         Q
+"RTN","GPLXPATH",348,0)
+         ;
+"RTN","GPLXPATH",349,0)
+MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+"RTN","GPLXPATH",350,0)
+     ; AND PUT THE RESULTS IN OXML
+"RTN","GPLXPATH",351,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
+"RTN","GPLXPATH",352,0)
+         I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
+"RTN","GPLXPATH",353,0)
+         N I,J,TNAM,TVAL,TSTR
+"RTN","GPLXPATH",354,0)
+         S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
+"RTN","GPLXPATH",355,0)
+         F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",356,0)
+         . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
+"RTN","GPLXPATH",357,0)
+         . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
+"RTN","GPLXPATH",358,0)
+         . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+"RTN","GPLXPATH",359,0)
+         . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
+"RTN","GPLXPATH",360,0)
+         . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
+"RTN","GPLXPATH",361,0)
+         . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+"RTN","GPLXPATH",362,0)
+         . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+"RTN","GPLXPATH",363,0)
+         . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
+"RTN","GPLXPATH",364,0)
+         . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+"RTN","GPLXPATH",365,0)
+         . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+"RTN","GPLXPATH",366,0)
+         . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+"RTN","GPLXPATH",367,0)
+         . . I DEBUG W TSTR
+"RTN","GPLXPATH",368,0)
+         W "MAPPED",!
+"RTN","GPLXPATH",369,0)
+         Q
+"RTN","GPLXPATH",370,0)
+         ;
+"RTN","GPLXPATH",371,0)
+TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+"RTN","GPLXPATH",372,0)
+       ; THEXML IS PASSED BY NAME
+"RTN","GPLXPATH",373,0)
+       N I,J,TMPXML,DEL,FOUND,INTXT
+"RTN","GPLXPATH",374,0)
+       S FOUND=0
+"RTN","GPLXPATH",375,0)
+       S INTXT=0
+"RTN","GPLXPATH",376,0)
+       W "DELETING EMPTY ELEMENTS",!
+"RTN","GPLXPATH",377,0)
+       F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
+"RTN","GPLXPATH",378,0)
+       . S J=@THEXML@(I)
+"RTN","GPLXPATH",379,0)
+       . I J["<text>" D
+"RTN","GPLXPATH",380,0)
+       . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
+"RTN","GPLXPATH",381,0)
+       . . W "IN HTML SECTION",!
+"RTN","GPLXPATH",382,0)
+       . N JM,JP,JPX ; JMINUS AND JPLUS
+"RTN","GPLXPATH",383,0)
+       . S JM=@THEXML@(I-1) ; LINE BEFORE
+"RTN","GPLXPATH",384,0)
+       . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
+"RTN","GPLXPATH",385,0)
+       . S JP=@THEXML@(I+1) ; LINE AFTER
+"RTN","GPLXPATH",386,0)
+       . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
+"RTN","GPLXPATH",387,0)
+       . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
+"RTN","GPLXPATH",388,0)
+       . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
+"RTN","GPLXPATH",389,0)
+       . . . W I,J,JP,!
+"RTN","GPLXPATH",390,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",391,0)
+       . . . S DEL(I)="" ; SET LINE TO DELETE
+"RTN","GPLXPATH",392,0)
+       . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
+"RTN","GPLXPATH",393,0)
+       . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
+"RTN","GPLXPATH",394,0)
+       . . . W I,J,!
+"RTN","GPLXPATH",395,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",396,0)
+       . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
+"RTN","GPLXPATH",397,0)
+       . . . I JM=JPX D  ;
+"RTN","GPLXPATH",398,0)
+       . . . . W I,JM_J_JPX,!
+"RTN","GPLXPATH",399,0)
+       . . . . S DEL(I-1)=""
+"RTN","GPLXPATH",400,0)
+       . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
+"RTN","GPLXPATH",401,0)
+       ; . I J'["><" D PUSH("TMPXML",J)
+"RTN","GPLXPATH",402,0)
+       I FOUND D  ; NEED TO DELETE THINGS
+"RTN","GPLXPATH",403,0)
+       . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
+"RTN","GPLXPATH",404,0)
+       . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
+"RTN","GPLXPATH",405,0)
+       . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
+"RTN","GPLXPATH",406,0)
+       . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
+"RTN","GPLXPATH",407,0)
+       Q FOUND
+"RTN","GPLXPATH",408,0)
+       ;
+"RTN","GPLXPATH",409,0)
+UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+"RTN","GPLXPATH",410,0)
+        ; XSEC IS A SECTION PASSED BY NAME
+"RTN","GPLXPATH",411,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",412,0)
+        D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
+"RTN","GPLXPATH",413,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",414,0)
+        D CP("XTMP",XSEC) ; REPLACE PASSED XML
+"RTN","GPLXPATH",415,0)
+        Q
+"RTN","GPLXPATH",416,0)
+        ;
+"RTN","GPLXPATH",417,0)
+PARY(GLO)       ;PRINT AN ARRAY
+"RTN","GPLXPATH",418,0)
+        N I
+"RTN","GPLXPATH",419,0)
+        F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
+"RTN","GPLXPATH",420,0)
+        Q
+"RTN","GPLXPATH",421,0)
+        ;
+"RTN","GPLXPATH",422,0)
+TEST     ; Run all the test cases
+"RTN","GPLXPATH",423,0)
+        D TESTALL^GPLUNIT("GPLXPAT0")
+"RTN","GPLXPATH",424,0)
+        Q
+"RTN","GPLXPATH",425,0)
+        ;
+"RTN","GPLXPATH",426,0)
+ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+"RTN","GPLXPATH",427,0)
+          N ZTMP
+"RTN","GPLXPATH",428,0)
+          S DEBUG=1
+"RTN","GPLXPATH",429,0)
+          D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",430,0)
+          D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLXPATH",431,0)
+          Q
+"RTN","GPLXPATH",432,0)
+          ;
+"RTN","GPLXPATH",433,0)
+TLIST   ; LIST THE TESTS
+"RTN","GPLXPATH",434,0)
+        N ZTMP
+"RTN","GPLXPATH",435,0)
+        D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",436,0)
+        D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLXPATH",437,0)
+        Q
+"RTN","GPLXPATH",438,0)
+        ;
+"VER")
+8.0^22.0
+**END**
+**END**
Index: ccr/tags/CCR_1_0_4/p/CCR_1_0_2_T2_CACHE.KID
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCR_1_0_2_T2_CACHE.KID	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCR_1_0_2_T2_CACHE.KID	(revision 169)
@@ -0,0 +1,8916 @@
+KIDS Distribution saved on Sep 02, 2008@16:48:45
+check for no array returned by VITALS RPC
+**KIDS**:CCR*1.0*2^
+
+**INSTALL NAME**
+CCR*1.0*2
+"BLD",6955,0)
+CCR*1.0*2^^0^3080902^n
+"BLD",6955,1,0)
+^^22^22^3080902^
+"BLD",6955,1,1,0)
+CCR AND CCD EXPORT TOOLS 
+"BLD",6955,1,2,0)
+ 
+"BLD",6955,1,3,0)
+SINGLE XML EXPORT TO A HOST DIRECTORY AT 
+"BLD",6955,1,4,0)
+ 
+"BLD",6955,1,5,0)
+BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
+"BLD",6955,1,6,0)
+DIRECTORY
+"BLD",6955,1,7,0)
+ 
+"BLD",6955,1,8,0)
+EXPORT^GPLCRR FOR THE CCR
+"BLD",6955,1,9,0)
+EXPORT^GPLCCD FOR THE CCD
+"BLD",6955,1,10,0)
+XPAT^GPLCCR(DFN,"","") 
+"BLD",6955,1,11,0)
+ 
+"BLD",6955,1,12,0)
+BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
+"BLD",6955,1,13,0)
+ 
+"BLD",6955,1,14,0)
+ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
+"BLD",6955,1,15,0)
+RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
+"BLD",6955,1,16,0)
+ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
+"BLD",6955,1,17,0)
+ 
+"BLD",6955,1,18,0)
+CLIST^GPLRIMA TO LIST CATEGORY TOTALS
+"BLD",6955,1,19,0)
+CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
+"BLD",6955,1,20,0)
+XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
+"BLD",6955,1,21,0)
+ 
+"BLD",6955,1,22,0)
+TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
+"BLD",6955,4,0)
+^9.64PA^^
+"BLD",6955,6.3)
+5
+"BLD",6955,"KRN",0)
+^9.67PA^8989.52^19
+"BLD",6955,"KRN",.4,0)
+.4
+"BLD",6955,"KRN",.401,0)
+.401
+"BLD",6955,"KRN",.402,0)
+.402
+"BLD",6955,"KRN",.403,0)
+.403
+"BLD",6955,"KRN",.5,0)
+.5
+"BLD",6955,"KRN",.84,0)
+.84
+"BLD",6955,"KRN",3.6,0)
+3.6
+"BLD",6955,"KRN",3.8,0)
+3.8
+"BLD",6955,"KRN",9.2,0)
+9.2
+"BLD",6955,"KRN",9.8,0)
+9.8
+"BLD",6955,"KRN",9.8,"NM",0)
+^9.68A^19^19
+"BLD",6955,"KRN",9.8,"NM",1,0)
+CCRDPT^^0^B312345713
+"BLD",6955,"KRN",9.8,"NM",2,0)
+CCRDPTT^^0^B4863621
+"BLD",6955,"KRN",9.8,"NM",3,0)
+CCRMEDS^^0^B36357726
+"BLD",6955,"KRN",9.8,"NM",4,0)
+CCRSYS^^0^B1690193
+"BLD",6955,"KRN",9.8,"NM",5,0)
+CCRUNIT^^0^B8574
+"BLD",6955,"KRN",9.8,"NM",6,0)
+CCRUTIL^^0^B17726385
+"BLD",6955,"KRN",9.8,"NM",7,0)
+CCRVA200^^0^B35847405
+"BLD",6955,"KRN",9.8,"NM",8,0)
+GPLACTOR^^0^B58306782
+"BLD",6955,"KRN",9.8,"NM",9,0)
+GPLXPATH^^0^B261673629
+"BLD",6955,"KRN",9.8,"NM",10,0)
+GPLUNIT^^0^B31630479
+"BLD",6955,"KRN",9.8,"NM",11,0)
+GPLPROBS^^0^B24846496
+"BLD",6955,"KRN",9.8,"NM",12,0)
+GPLVITAL^^0^B98849168
+"BLD",6955,"KRN",9.8,"NM",13,0)
+GPLRIMA^^0^B96435476
+"BLD",6955,"KRN",9.8,"NM",14,0)
+GPLCCR^^0^B66792391
+"BLD",6955,"KRN",9.8,"NM",15,0)
+GPLCCR0^^0^B658213703
+"BLD",6955,"KRN",9.8,"NM",16,0)
+GPLCCD^^0^B106978605
+"BLD",6955,"KRN",9.8,"NM",17,0)
+GPLCCD1^^0^B100039732
+"BLD",6955,"KRN",9.8,"NM",18,0)
+GPLMEDS^^0^B27486154
+"BLD",6955,"KRN",9.8,"NM",19,0)
+GPLXPAT0^^0^B44173297
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPT",1)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPTT",2)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS",3)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRSYS",4)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUNIT",5)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUTIL",6)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRVA200",7)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLACTOR",8)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",16)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",17)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",14)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",15)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLMEDS",18)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",11)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",13)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",10)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",12)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",19)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
+
+"BLD",6955,"KRN",19,0)
+19
+"BLD",6955,"KRN",19.1,0)
+19.1
+"BLD",6955,"KRN",101,0)
+101
+"BLD",6955,"KRN",409.61,0)
+409.61
+"BLD",6955,"KRN",771,0)
+771
+"BLD",6955,"KRN",870,0)
+870
+"BLD",6955,"KRN",8989.51,0)
+8989.51
+"BLD",6955,"KRN",8989.52,0)
+8989.52
+"BLD",6955,"KRN",8994,0)
+8994
+"BLD",6955,"KRN","B",.4,.4)
+
+"BLD",6955,"KRN","B",.401,.401)
+
+"BLD",6955,"KRN","B",.402,.402)
+
+"BLD",6955,"KRN","B",.403,.403)
+
+"BLD",6955,"KRN","B",.5,.5)
+
+"BLD",6955,"KRN","B",.84,.84)
+
+"BLD",6955,"KRN","B",3.6,3.6)
+
+"BLD",6955,"KRN","B",3.8,3.8)
+
+"BLD",6955,"KRN","B",9.2,9.2)
+
+"BLD",6955,"KRN","B",9.8,9.8)
+
+"BLD",6955,"KRN","B",19,19)
+
+"BLD",6955,"KRN","B",19.1,19.1)
+
+"BLD",6955,"KRN","B",101,101)
+
+"BLD",6955,"KRN","B",409.61,409.61)
+
+"BLD",6955,"KRN","B",771,771)
+
+"BLD",6955,"KRN","B",870,870)
+
+"BLD",6955,"KRN","B",8989.51,8989.51)
+
+"BLD",6955,"KRN","B",8989.52,8989.52)
+
+"BLD",6955,"KRN","B",8994,8994)
+
+"BLD",6955,"QUES",0)
+^9.62^^
+"BLD",6955,"REQB",0)
+^9.611^^
+"MBREQ")
+0
+"QUES","XPF1",0)
+Y
+"QUES","XPF1","??")
+^D REP^XPDH
+"QUES","XPF1","A")
+Shall I write over your |FLAG| File
+"QUES","XPF1","B")
+YES
+"QUES","XPF1","M")
+D XPF1^XPDIQ
+"QUES","XPF2",0)
+Y
+"QUES","XPF2","??")
+^D DTA^XPDH
+"QUES","XPF2","A")
+Want my data |FLAG| yours
+"QUES","XPF2","B")
+YES
+"QUES","XPF2","M")
+D XPF2^XPDIQ
+"QUES","XPI1",0)
+YO
+"QUES","XPI1","??")
+^D INHIBIT^XPDH
+"QUES","XPI1","A")
+Want KIDS to INHIBIT LOGONs during the install
+"QUES","XPI1","B")
+NO
+"QUES","XPI1","M")
+D XPI1^XPDIQ
+"QUES","XPM1",0)
+PO^VA(200,:EM
+"QUES","XPM1","??")
+^D MG^XPDH
+"QUES","XPM1","A")
+Enter the Coordinator for Mail Group '|FLAG|'
+"QUES","XPM1","B")
+
+"QUES","XPM1","M")
+D XPM1^XPDIQ
+"QUES","XPO1",0)
+Y
+"QUES","XPO1","??")
+^D MENU^XPDH
+"QUES","XPO1","A")
+Want KIDS to Rebuild Menu Trees Upon Completion of Install
+"QUES","XPO1","B")
+NO
+"QUES","XPO1","M")
+D XPO1^XPDIQ
+"QUES","XPZ1",0)
+Y
+"QUES","XPZ1","??")
+^D OPT^XPDH
+"QUES","XPZ1","A")
+Want to DISABLE Scheduled Options, Menu Options, and Protocols
+"QUES","XPZ1","B")
+NO
+"QUES","XPZ1","M")
+D XPZ1^XPDIQ
+"QUES","XPZ2",0)
+Y
+"QUES","XPZ2","??")
+^D RTN^XPDH
+"QUES","XPZ2","A")
+Want to MOVE routines to other CPUs
+"QUES","XPZ2","B")
+NO
+"QUES","XPZ2","M")
+D XPZ2^XPDIQ
+"RTN")
+19
+"RTN","CCRDPT")
+0^1^B312345713
+"RTN","CCRDPT",1,0)
+CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
+"RTN","CCRDPT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 5
+"RTN","CCRDPT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPT",5,0)
+ ;
+"RTN","CCRDPT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPT",9,0)
+ ;(at your option) any later version.
+"RTN","CCRDPT",10,0)
+ ;
+"RTN","CCRDPT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPT",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPT",15,0)
+ ;
+"RTN","CCRDPT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPT",19,0)
+    ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
+"RTN","CCRDPT",20,0)
+    ; DESTROY to clean-up.
+"RTN","CCRDPT",21,0)
+    ; The first line of every routine tests if the global exists.
+"RTN","CCRDPT",22,0)
+    ;
+"RTN","CCRDPT",23,0)
+    ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
+"RTN","CCRDPT",24,0)
+    ; INIT        9 lines  Copy DFN global to a local variable
+"RTN","CCRDPT",25,0)
+    ; DESTROY     6 lines  Kill local variable
+"RTN","CCRDPT",26,0)
+    ; FAMILY      6 lines  Family Name
+"RTN","CCRDPT",27,0)
+    ; GIVEN       6 lines  Given Name
+"RTN","CCRDPT",28,0)
+    ; MIDDLE      6 lines  Middle Name
+"RTN","CCRDPT",29,0)
+    ; SUFFIX      6 lines  Suffix Name
+"RTN","CCRDPT",30,0)
+    ; DISPNAME    5 lines  Display Name
+"RTN","CCRDPT",31,0)
+    ; DOB         6 lines  Date of Birth
+"RTN","CCRDPT",32,0)
+    ; GENDER      4 lines  Get Gender
+"RTN","CCRDPT",33,0)
+    ; SSN         4 lines  Get SSN for ID
+"RTN","CCRDPT",34,0)
+    ; ADDRTYPE    4 lines  Get Home Address
+"RTN","CCRDPT",35,0)
+    ; ADDR1       4 lines  Get Home Address line 1
+"RTN","CCRDPT",36,0)
+    ; ADDR2       5 lines  Get Home Address line 2
+"RTN","CCRDPT",37,0)
+    ; CITY        4 lines  Get City for Home Address
+"RTN","CCRDPT",38,0)
+    ; STATE      11 lines  Get State for Home Address
+"RTN","CCRDPT",39,0)
+    ; ZIP         4 lines  Get Zip code for Home Address
+"RTN","CCRDPT",40,0)
+    ; COUNTY      4 lines  Get County for our Address
+"RTN","CCRDPT",41,0)
+    ; COUNTRY     4 lines  Get Country for our Address
+"RTN","CCRDPT",42,0)
+    ; RESTEL      4 lines  Residential Telephone
+"RTN","CCRDPT",43,0)
+    ; WORKTEL     4 lines  Work Telephone
+"RTN","CCRDPT",44,0)
+    ; EMAIL       4 lines  Email Adddress
+"RTN","CCRDPT",45,0)
+    ; CELLTEL     4 lines  Cell Phone
+"RTN","CCRDPT",46,0)
+    ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
+"RTN","CCRDPT",47,0)
+    ; NOK1GIV     6 lines  NOK1 Given Name
+"RTN","CCRDPT",48,0)
+    ; NOK1MID     6 lines  NOK1 Middle Name
+"RTN","CCRDPT",49,0)
+    ; NOK1SUF     6 lines  NOK1 Suffi Name
+"RTN","CCRDPT",50,0)
+    ; NOK1DISP    5 lines  NOK1 Display Name
+"RTN","CCRDPT",51,0)
+    ; NOK1REL     4 lines  NOK1 Relationship to the patient
+"RTN","CCRDPT",52,0)
+    ; NOK1ADD1    4 lines  NOK1 Address 1
+"RTN","CCRDPT",53,0)
+    ; NOK1ADD2    5 lines  NOK1 Address 2
+"RTN","CCRDPT",54,0)
+    ; NOK1CITY    4 lines  NOK1 City
+"RTN","CCRDPT",55,0)
+    ; NOK1STAT    5 lines  NOK1 State
+"RTN","CCRDPT",56,0)
+    ; NOK1ZIP     4 lines  NOK1 Zip Code
+"RTN","CCRDPT",57,0)
+    ; NOK1HTEL;   4 lines  NOK1 Home Telephone
+"RTN","CCRDPT",58,0)
+    ; NOK1WTEL;   4 lines  NOK1 Work Telephone
+"RTN","CCRDPT",59,0)
+    ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
+"RTN","CCRDPT",60,0)
+    ; NOK2FAM     6 lines  NOK2 Family Name
+"RTN","CCRDPT",61,0)
+    ; NOK2GIV     6 lines  NOK2 Given Name
+"RTN","CCRDPT",62,0)
+    ; NOK2MID     6 lines  NOK2 Middle Name
+"RTN","CCRDPT",63,0)
+    ; NOK2SUF     5 lines  NOK2 Suffi Name
+"RTN","CCRDPT",64,0)
+    ; NOK2DISP    5 lines  NOK2 Display Name
+"RTN","CCRDPT",65,0)
+    ; NOK2REL     4 lines  NOK2 Relationship to the patient
+"RTN","CCRDPT",66,0)
+    ; NOK2ADD1    4 lines  NOK2 Address 1
+"RTN","CCRDPT",67,0)
+    ; NOK2ADD2    5 lines  NOK2 Address 2
+"RTN","CCRDPT",68,0)
+    ; NOK2CITY    4 lines  NOK2 City
+"RTN","CCRDPT",69,0)
+    ; NOK2STAT    5 lines  NOK2 State
+"RTN","CCRDPT",70,0)
+    ; NOK2ZIP     4 lines  NOK2 Zip Code
+"RTN","CCRDPT",71,0)
+    ; NOK2HTEL;   4 lines  NOK2 Home Telephone
+"RTN","CCRDPT",72,0)
+    ; NOK2WTEL;   4 lines  NOK2 Work Telephone
+"RTN","CCRDPT",73,0)
+    ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
+"RTN","CCRDPT",74,0)
+    ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
+"RTN","CCRDPT",75,0)
+    ; EMERGIV     6 lines  EMER Given Name
+"RTN","CCRDPT",76,0)
+    ; EMERMID     6 lines  EMER Middle Name
+"RTN","CCRDPT",77,0)
+    ; EMERSUF     5 lines  EMER Suffi Name
+"RTN","CCRDPT",78,0)
+    ; EMERDISP    5 lines  EMER Display Name
+"RTN","CCRDPT",79,0)
+    ; EMERREL     4 lines  EMER Relationship to the patient
+"RTN","CCRDPT",80,0)
+    ; EMERADD1    4 lines  EMER Address 1
+"RTN","CCRDPT",81,0)
+    ; EMERADD2    5 lines  EMER Address 2
+"RTN","CCRDPT",82,0)
+    ; EMERCITY    4 lines  EMER City
+"RTN","CCRDPT",83,0)
+    ; EMERSTAT    5 lines  EMER State
+"RTN","CCRDPT",84,0)
+    ; EMERZIP     4 lines  EMER Zip Code
+"RTN","CCRDPT",85,0)
+    ; EMERHTEL;   4 lines  EMER Home Telephone
+"RTN","CCRDPT",86,0)
+    ; EMERWTEL;   4 lines  EMER Work Telephone
+"RTN","CCRDPT",87,0)
+    ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
+"RTN","CCRDPT",88,0)
+    ;
+"RTN","CCRDPT",89,0)
+          W "No Entry at top!" Q
+"RTN","CCRDPT",90,0)
+   ; The following is a map of the relevant data in the patient global.
+"RTN","CCRDPT",91,0)
+    ;
+"RTN","CCRDPT",92,0)
+    ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
+"RTN","CCRDPT",93,0)
+    ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
+"RTN","CCRDPT",94,0)
+    ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
+"RTN","CCRDPT",95,0)
+    ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
+"RTN","CCRDPT",96,0)
+    ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
+"RTN","CCRDPT",97,0)
+    ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
+"RTN","CCRDPT",98,0)
+    ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
+"RTN","CCRDPT",99,0)
+    ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
+"RTN","CCRDPT",100,0)
+    ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
+"RTN","CCRDPT",101,0)
+    ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
+"RTN","CCRDPT",102,0)
+    ; ==>[21S] ^
+"RTN","CCRDPT",103,0)
+    ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
+"RTN","CCRDPT",104,0)
+    ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
+"RTN","CCRDPT",105,0)
+    ; ==>COMPONENTS [3P:20] ^
+"RTN","CCRDPT",106,0)
+    ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
+"RTN","CCRDPT",107,0)
+    ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
+"RTN","CCRDPT",108,0)
+    ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
+"RTN","CCRDPT",109,0)
+    ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
+"RTN","CCRDPT",110,0)
+    ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
+"RTN","CCRDPT",111,0)
+    ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
+"RTN","CCRDPT",112,0)
+    ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
+"RTN","CCRDPT",113,0)
+    ; ==>^
+"RTN","CCRDPT",114,0)
+    ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
+"RTN","CCRDPT",115,0)
+    ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
+"RTN","CCRDPT",116,0)
+    ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
+"RTN","CCRDPT",117,0)
+    ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
+"RTN","CCRDPT",118,0)
+    ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
+"RTN","CCRDPT",119,0)
+    ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
+"RTN","CCRDPT",120,0)
+    ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
+"RTN","CCRDPT",121,0)
+    ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
+"RTN","CCRDPT",122,0)
+    ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
+"RTN","CCRDPT",123,0)
+    ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
+"RTN","CCRDPT",124,0)
+    ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
+"RTN","CCRDPT",125,0)
+    ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
+"RTN","CCRDPT",126,0)
+    ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
+"RTN","CCRDPT",127,0)
+    ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
+"RTN","CCRDPT",128,0)
+    ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
+"RTN","CCRDPT",129,0)
+    ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
+"RTN","CCRDPT",130,0)
+    ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
+"RTN","CCRDPT",131,0)
+    ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
+"RTN","CCRDPT",132,0)
+    ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
+"RTN","CCRDPT",133,0)
+    ; ==>SITE [14P:4] ^
+"RTN","CCRDPT",134,0)
+    ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
+"RTN","CCRDPT",135,0)
+    ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
+"RTN","CCRDPT",136,0)
+    ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
+"RTN","CCRDPT",137,0)
+    ; ==>3] [5F] ^
+"RTN","CCRDPT",138,0)
+    ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
+"RTN","CCRDPT",139,0)
+    ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
+"RTN","CCRDPT",140,0)
+    ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
+"RTN","CCRDPT",141,0)
+    ; ==>^
+"RTN","CCRDPT",142,0)
+    ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
+"RTN","CCRDPT",143,0)
+    ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
+"RTN","CCRDPT",144,0)
+    ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
+"RTN","CCRDPT",145,0)
+    ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
+"RTN","CCRDPT",146,0)
+    ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
+"RTN","CCRDPT",147,0)
+    ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
+"RTN","CCRDPT",148,0)
+    ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
+"RTN","CCRDPT",149,0)
+    ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
+"RTN","CCRDPT",150,0)
+    ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
+"RTN","CCRDPT",151,0)
+    ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
+"RTN","CCRDPT",152,0)
+    ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
+"RTN","CCRDPT",153,0)
+    ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
+"RTN","CCRDPT",154,0)
+    ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
+"RTN","CCRDPT",155,0)
+    ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
+"RTN","CCRDPT",156,0)
+    ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
+"RTN","CCRDPT",157,0)
+    ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
+"RTN","CCRDPT",158,0)
+    ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
+"RTN","CCRDPT",159,0)
+    ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
+"RTN","CCRDPT",160,0)
+    ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
+"RTN","CCRDPT",161,0)
+    ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
+"RTN","CCRDPT",162,0)
+    ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
+"RTN","CCRDPT",163,0)
+    ; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
+"RTN","CCRDPT",164,0)
+    ; INPUT: Patient IEN (DFN)
+"RTN","CCRDPT",165,0)
+    ; OUTPUT: PT in the Symbol Table, representing the patient global
+"RTN","CCRDPT",166,0)
+    ; Instead of accessing a global each single read (SLOOOOW)
+"RTN","CCRDPT",167,0)
+    ; read it off a local variable stored in Memory.
+"RTN","CCRDPT",168,0)
+INIT(DFN) ;
+"RTN","CCRDPT",169,0)
+          M PT=^DPT(DFN)
+"RTN","CCRDPT",170,0)
+          Q
+"RTN","CCRDPT",171,0)
+          ;
+"RTN","CCRDPT",172,0)
+DESTROY ; Kill local variable; PUBLIC
+"RTN","CCRDPT",173,0)
+          ; INPUT: None
+"RTN","CCRDPT",174,0)
+          ; OUTPUT: Kill PT from the Symbol Table after you are done
+"RTN","CCRDPT",175,0)
+          K PT
+"RTN","CCRDPT",176,0)
+          Q
+"RTN","CCRDPT",177,0)
+          ;
+"RTN","CCRDPT",178,0)
+FAMILY() ; Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",179,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",180,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",181,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",182,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",183,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",184,0)
+          ;
+"RTN","CCRDPT",185,0)
+GIVEN() ; Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",186,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",187,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",188,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",189,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",190,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",191,0)
+          ;
+"RTN","CCRDPT",192,0)
+MIDDLE() ; Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",193,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",194,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",195,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",196,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",197,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",198,0)
+          ;
+"RTN","CCRDPT",199,0)
+SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",200,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",201,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",202,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",203,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",204,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",205,0)
+          ;
+"RTN","CCRDPT",206,0)
+DISPNAME() ; Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",207,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",208,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",209,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",210,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",211,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",212,0)
+DOB() ; Date of Birth; PUBLIC; Extrinsic
+"RTN","CCRDPT",213,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",214,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",215,0)
+          N DOB S DOB=$P(PT(0),"^",3)
+"RTN","CCRDPT",216,0)
+          ; Date in FM Date Format. Convert to UTC/ISO 8601.
+"RTN","CCRDPT",217,0)
+          Q $$FMDTOUTC^CCRUTIL(DOB,"D")
+"RTN","CCRDPT",218,0)
+          ;
+"RTN","CCRDPT",219,0)
+GENDER() ; Get Gender; PUBLIC; Extrinsic
+"RTN","CCRDPT",220,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",221,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",222,0)
+          Q $P(PT(0),"^",2)
+"RTN","CCRDPT",223,0)
+          ;
+"RTN","CCRDPT",224,0)
+SSN() ; Get SSN for ID; PUBLIC; Extrinsic
+"RTN","CCRDPT",225,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",226,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",227,0)
+          Q $P(PT(0),"^",9)
+"RTN","CCRDPT",228,0)
+          ;
+"RTN","CCRDPT",229,0)
+ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",230,0)
+          ; Vista only stores a home address for the patient.
+"RTN","CCRDPT",231,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",232,0)
+          Q "Home"
+"RTN","CCRDPT",233,0)
+          ;
+"RTN","CCRDPT",234,0)
+ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",235,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",236,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",237,0)
+          Q $P(PT(.11),"^",1)
+"RTN","CCRDPT",238,0)
+          ;
+"RTN","CCRDPT",239,0)
+ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",240,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",241,0)
+          ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
+"RTN","CCRDPT",242,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",243,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",244,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",245,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",246,0)
+          Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
+"RTN","CCRDPT",247,0)
+          Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
+"RTN","CCRDPT",248,0)
+          ;
+"RTN","CCRDPT",249,0)
+CITY() ; Get City for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",250,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",251,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",252,0)
+          Q $P(PT(.11),"^",4)
+"RTN","CCRDPT",253,0)
+          ;
+"RTN","CCRDPT",254,0)
+STATE() ; Get State for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",255,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",256,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",257,0)
+          ; State is stored as a pointer
+"RTN","CCRDPT",258,0)
+          N STATENUM S STATENUM=$P(PT(.11),"^",5)
+"RTN","CCRDPT",259,0)
+          ;
+"RTN","CCRDPT",260,0)
+          ; State File Global is below
+"RTN","CCRDPT",261,0)
+          ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
+"RTN","CCRDPT",262,0)
+          ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
+"RTN","CCRDPT",263,0)
+          ; ==>US STATE OR POSSESSION [6S] ^
+"RTN","CCRDPT",264,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",265,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",266,0)
+          ;
+"RTN","CCRDPT",267,0)
+ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",268,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",269,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",270,0)
+          Q $P(PT(.11),"^",6)
+"RTN","CCRDPT",271,0)
+          ;
+"RTN","CCRDPT",272,0)
+COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",273,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",274,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",275,0)
+          Q $P(PT(.11),"^",7)
+"RTN","CCRDPT",276,0)
+          ;
+"RTN","CCRDPT",277,0)
+COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",278,0)
+          ; Unfortunately, I can't find where that is stored, so the inevitable...
+"RTN","CCRDPT",279,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",280,0)
+          Q "USA"
+"RTN","CCRDPT",281,0)
+          ;
+"RTN","CCRDPT",282,0)
+RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",283,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",284,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",285,0)
+          Q $P(PT(.13),"^",1)
+"RTN","CCRDPT",286,0)
+          ;
+"RTN","CCRDPT",287,0)
+WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",288,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",289,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",290,0)
+          Q $P(PT(.13),"^",2)
+"RTN","CCRDPT",291,0)
+          ;
+"RTN","CCRDPT",292,0)
+EMAIL() ; Email Adddress; PUBLIC; Extrinsic
+"RTN","CCRDPT",293,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",294,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",295,0)
+          Q $P(PT(.13),"^",3)
+"RTN","CCRDPT",296,0)
+          ;
+"RTN","CCRDPT",297,0)
+CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
+"RTN","CCRDPT",298,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",299,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",300,0)
+          Q $P(PT(.13),"^",4)
+"RTN","CCRDPT",301,0)
+          ;
+"RTN","CCRDPT",302,0)
+NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",303,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",304,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",305,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",306,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",307,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",308,0)
+          ;
+"RTN","CCRDPT",309,0)
+NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",310,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",311,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",312,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",313,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",314,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",315,0)
+          ;
+"RTN","CCRDPT",316,0)
+NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",317,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",318,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",319,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",320,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",321,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",322,0)
+          ;
+"RTN","CCRDPT",323,0)
+NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",324,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",325,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",326,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",327,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",328,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",329,0)
+          ;
+"RTN","CCRDPT",330,0)
+NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",331,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",332,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",333,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",334,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",335,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",336,0)
+NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",337,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",338,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",339,0)
+          Q $P(PT(.21),"^",2)
+"RTN","CCRDPT",340,0)
+          ;
+"RTN","CCRDPT",341,0)
+NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",342,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",343,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",344,0)
+          Q $P(PT(.21),"^",3)
+"RTN","CCRDPT",345,0)
+          ;
+"RTN","CCRDPT",346,0)
+NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",347,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",348,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",349,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",350,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",351,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",352,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",353,0)
+          Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
+"RTN","CCRDPT",354,0)
+          Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
+"RTN","CCRDPT",355,0)
+          ;
+"RTN","CCRDPT",356,0)
+NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",357,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",358,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",359,0)
+          Q $P(PT(.21),"^",6)
+"RTN","CCRDPT",360,0)
+          ;
+"RTN","CCRDPT",361,0)
+NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",362,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",363,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",364,0)
+          N STATENUM S STATENUM=$P(PT(.21),"^",7)
+"RTN","CCRDPT",365,0)
+          Q:STATENUM="" ""
+"RTN","CCRDPT",366,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",367,0)
+          ;
+"RTN","CCRDPT",368,0)
+NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",369,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",370,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",371,0)
+          Q $P(PT(.21),"^",8)
+"RTN","CCRDPT",372,0)
+          ;
+"RTN","CCRDPT",373,0)
+NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",374,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",375,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",376,0)
+          Q $P(PT(.21),"^",9)
+"RTN","CCRDPT",377,0)
+          ;
+"RTN","CCRDPT",378,0)
+NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",379,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",380,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",381,0)
+          Q $P(PT(.21),"^",11)
+"RTN","CCRDPT",382,0)
+          ;
+"RTN","CCRDPT",383,0)
+NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",384,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",385,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",386,0)
+          Q $P(PT(.21),"^",10)
+"RTN","CCRDPT",387,0)
+          ;
+"RTN","CCRDPT",388,0)
+NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",389,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",390,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",391,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",392,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",393,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",394,0)
+          ;
+"RTN","CCRDPT",395,0)
+NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
+"RTN","CCRDPT",396,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",397,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",398,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",399,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",400,0)
+          ;
+"RTN","CCRDPT",401,0)
+NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",402,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",403,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",404,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",405,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",406,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",407,0)
+          ;
+"RTN","CCRDPT",408,0)
+NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",409,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",410,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",411,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",412,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",413,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",414,0)
+NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",415,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",416,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",417,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",418,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",419,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",420,0)
+NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",421,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",422,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",423,0)
+          Q $P(PT(.211),"^",2)
+"RTN","CCRDPT",424,0)
+          ;
+"RTN","CCRDPT",425,0)
+NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",426,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",427,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",428,0)
+          Q $P(PT(.211),"^",3)
+"RTN","CCRDPT",429,0)
+          ;
+"RTN","CCRDPT",430,0)
+NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",431,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",432,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",433,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",434,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",435,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",436,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",437,0)
+          Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
+"RTN","CCRDPT",438,0)
+          Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
+"RTN","CCRDPT",439,0)
+          ;
+"RTN","CCRDPT",440,0)
+NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",441,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",442,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",443,0)
+          Q $P(PT(.211),"^",6)
+"RTN","CCRDPT",444,0)
+          ;
+"RTN","CCRDPT",445,0)
+NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",446,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",447,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",448,0)
+          N STATENUM S STATENUM=$P(PT(.211),"^",7)
+"RTN","CCRDPT",449,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",450,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",451,0)
+          ;
+"RTN","CCRDPT",452,0)
+NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",453,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",454,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",455,0)
+          Q $P(PT(.211),"^",8)
+"RTN","CCRDPT",456,0)
+          ;
+"RTN","CCRDPT",457,0)
+NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",458,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",459,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",460,0)
+          Q $P(PT(.211),"^",9)
+"RTN","CCRDPT",461,0)
+          ;
+"RTN","CCRDPT",462,0)
+NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",463,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",464,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",465,0)
+          Q $P(PT(.211),"^",11)
+"RTN","CCRDPT",466,0)
+          ;
+"RTN","CCRDPT",467,0)
+NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",468,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",469,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",470,0)
+          Q $P(PT(.211),"^",10)
+"RTN","CCRDPT",471,0)
+          ;
+"RTN","CCRDPT",472,0)
+EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",473,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",474,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",475,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",476,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",477,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",478,0)
+          ;
+"RTN","CCRDPT",479,0)
+EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",480,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",481,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",482,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",483,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",484,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",485,0)
+          ;
+"RTN","CCRDPT",486,0)
+EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",487,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",488,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",489,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",490,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",491,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",492,0)
+          ;
+"RTN","CCRDPT",493,0)
+EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",494,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",495,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",496,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",497,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",498,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",499,0)
+EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",500,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",501,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",502,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",503,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",504,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",505,0)
+EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",506,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",507,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",508,0)
+          Q $P(PT(.33),"^",2)
+"RTN","CCRDPT",509,0)
+          ;
+"RTN","CCRDPT",510,0)
+EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",511,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",512,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",513,0)
+          Q $P(PT(.33),"^",3)
+"RTN","CCRDPT",514,0)
+          ;
+"RTN","CCRDPT",515,0)
+EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",516,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",517,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",518,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",519,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",520,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",521,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",522,0)
+          Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
+"RTN","CCRDPT",523,0)
+          Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
+"RTN","CCRDPT",524,0)
+          ;
+"RTN","CCRDPT",525,0)
+EMERCITY() ; EMER City; PUBLIC; Extrinsic
+"RTN","CCRDPT",526,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",527,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",528,0)
+          Q $P(PT(.33),"^",6)
+"RTN","CCRDPT",529,0)
+          ;
+"RTN","CCRDPT",530,0)
+EMERSTAT() ; EMER State; PUBLIC; Extrinsic
+"RTN","CCRDPT",531,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",532,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",533,0)
+          N STATENUM S STATENUM=$P(PT(.33),"^",7)
+"RTN","CCRDPT",534,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",535,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",536,0)
+          ;
+"RTN","CCRDPT",537,0)
+EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",538,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",539,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",540,0)
+          Q $P(PT(.33),"^",8)
+"RTN","CCRDPT",541,0)
+          ;
+"RTN","CCRDPT",542,0)
+EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",543,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",544,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",545,0)
+          Q $P(PT(.33),"^",9)
+"RTN","CCRDPT",546,0)
+          ;
+"RTN","CCRDPT",547,0)
+EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",548,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",549,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",550,0)
+          Q $P(PT(.33),"^",11)
+"RTN","CCRDPT",551,0)
+          ;
+"RTN","CCRDPT",552,0)
+EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
+"RTN","CCRDPT",553,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",554,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",555,0)
+          Q $P(PT(.33),"^",10)
+"RTN","CCRDPT",556,0)
+          ;
+"RTN","CCRDPTT")
+0^2^B4863621
+"RTN","CCRDPTT",1,0)
+CCRDPTT ; Unit Tester...
+"RTN","CCRDPTT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 5
+"RTN","CCRDPTT",3,0)
+ ;
+"RTN","CCRDPTT",4,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPTT",5,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPTT",6,0)
+ ;
+"RTN","CCRDPTT",7,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPTT",8,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPTT",9,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPTT",10,0)
+ ;(at your option) any later version.
+"RTN","CCRDPTT",11,0)
+ ;
+"RTN","CCRDPTT",12,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPTT",13,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPTT",14,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPTT",15,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPTT",16,0)
+ ;
+"RTN","CCRDPTT",17,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPTT",18,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPTT",19,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPTT",20,0)
+          ; Get the functions in the routine using Rick's routine
+"RTN","CCRDPTT",21,0)
+          ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
+"RTN","CCRDPTT",22,0)
+          ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
+"RTN","CCRDPTT",23,0)
+          ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
+"RTN","CCRDPTT",24,0)
+          ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
+"RTN","CCRDPTT",25,0)
+          ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
+"RTN","CCRDPTT",26,0)
+          ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",27,0)
+          ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",28,0)
+          ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
+"RTN","CCRDPTT",29,0)
+          ; etc.
+"RTN","CCRDPTT",30,0)
+          ;
+"RTN","CCRDPTT",31,0)
+          ; Load Routine Entry points; We get a sweeeeeet array
+"RTN","CCRDPTT",32,0)
+          D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
+"RTN","CCRDPTT",33,0)
+          N X,Y
+"RTN","CCRDPTT",34,0)
+          ; Select Patient
+"RTN","CCRDPTT",35,0)
+          S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","CCRDPTT",36,0)
+          ;
+"RTN","CCRDPTT",37,0)
+          W "You have selected patient "_Y,!!
+"RTN","CCRDPTT",38,0)
+          D INIT^CCRDPT($P(Y,"^"))
+"RTN","CCRDPTT",39,0)
+          ; ZWR PT
+"RTN","CCRDPTT",40,0)
+          N I S I=165 F  S I=$O(OUT(I)) Q:I=""  D
+"RTN","CCRDPTT",41,0)
+          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
+"RTN","CCRDPTT",42,0)
+          . W "valued at "
+"RTN","CCRDPTT",43,0)
+          . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
+"RTN","CCRDPTT",44,0)
+          . W !
+"RTN","CCRDPTT",45,0)
+          Q
+"RTN","CCRMEDS")
+0^3^B36357726
+"RTN","CCRMEDS",1,0)
+CCRMEDS ; WV/CCDCCR/SMH,CJE,GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
+"RTN","CCRMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 5
+"RTN","CCRMEDS",3,0)
+   ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRMEDS",4,0)
+   ; General Public License See attached copy of the License.
+"RTN","CCRMEDS",5,0)
+   ; 
+"RTN","CCRMEDS",6,0)
+   ; This program is free software; you can redistribute it and/or modify
+"RTN","CCRMEDS",7,0)
+   ; it under the terms of the GNU General Public License as published by
+"RTN","CCRMEDS",8,0)
+   ; the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRMEDS",9,0)
+   ; (at your option) any later version.
+"RTN","CCRMEDS",10,0)
+   ; 
+"RTN","CCRMEDS",11,0)
+   ; This program is distributed in the hope that it will be useful,
+"RTN","CCRMEDS",12,0)
+   ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRMEDS",13,0)
+   ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRMEDS",14,0)
+   ; GNU General Public License for more details.
+"RTN","CCRMEDS",15,0)
+   ; 
+"RTN","CCRMEDS",16,0)
+   ; You should have received a copy of the GNU General Public License along
+"RTN","CCRMEDS",17,0)
+   ; with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRMEDS",18,0)
+   ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRMEDS",19,0)
+   ;
+"RTN","CCRMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","CCRMEDS",21,0)
+   Q
+"RTN","CCRMEDS",22,0)
+   ;
+"RTN","CCRMEDS",23,0)
+EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","CCRMEDS",24,0)
+   ;
+"RTN","CCRMEDS",25,0)
+   ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","CCRMEDS",26,0)
+   ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","CCRMEDS",27,0)
+   ; 
+"RTN","CCRMEDS",28,0)
+   ; MEDS is return array from RPC.
+"RTN","CCRMEDS",29,0)
+   ; MAP is a mapping variable map (store result) for each med
+"RTN","CCRMEDS",30,0)
+   ; MED is holds each array element from MEDS(J), one medicine
+"RTN","CCRMEDS",31,0)
+   ; J is a counter.
+"RTN","CCRMEDS",32,0)
+   ;
+"RTN","CCRMEDS",33,0)
+   ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+"RTN","CCRMEDS",34,0)
+   ; med data available.
+"RTN","CCRMEDS",35,0)
+   ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+"RTN","CCRMEDS",36,0)
+   ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+"RTN","CCRMEDS",37,0)
+ 
+"RTN","CCRMEDS",38,0)
+   N MEDS,MAP
+"RTN","CCRMEDS",39,0)
+   K ^TMP($J)
+"RTN","CCRMEDS",40,0)
+   D RX^PSO52API(DFN,"CCDCCR")
+"RTN","CCRMEDS",41,0)
+   M MEDS=^TMP($J,"CCDCCR",DFN)
+"RTN","CCRMEDS",42,0)
+   ; @(0) contains the number of meds or -1^NO DATA FOUND
+"RTN","CCRMEDS",43,0)
+   ; If it is -1, we quit.
+"RTN","CCRMEDS",44,0)
+   I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT  
+"RTN","CCRMEDS",45,0)
+   I DEBUG ZWR MEDS
+"RTN","CCRMEDS",46,0)
+   N RXIEN S RXIEN=0
+"RTN","CCRMEDS",47,0)
+   F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+"RTN","CCRMEDS",48,0)
+   . I DEBUG W "RXIEN IS ",RXIEN,!
+"RTN","CCRMEDS",49,0)
+   . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J))
+"RTN","CCRMEDS",50,0)
+   . K @MAP
+"RTN","CCRMEDS",51,0)
+   . I DEBUG W "MAP= ",MAP,!
+"RTN","CCRMEDS",52,0)
+   . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+"RTN","CCRMEDS",53,0)
+   . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+"RTN","CCRMEDS",54,0)
+   . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+"RTN","CCRMEDS",55,0)
+   . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
+"RTN","CCRMEDS",56,0)
+   . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+"RTN","CCRMEDS",57,0)
+   . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
+"RTN","CCRMEDS",58,0)
+   . S @MAP@("MEDRXNOTXT")="Prescription Number"
+"RTN","CCRMEDS",59,0)
+   . S @MAP@("MEDRXNO")=MED(.01)
+"RTN","CCRMEDS",60,0)
+   . S @MAP@("MEDTYPETEXT")="Medication"
+"RTN","CCRMEDS",61,0)
+   . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+"RTN","CCRMEDS",62,0)
+   . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+"RTN","CCRMEDS",63,0)
+   . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+"RTN","CCRMEDS",64,0)
+   . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+"RTN","CCRMEDS",65,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
+"RTN","CCRMEDS",66,0)
+   . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+"RTN","CCRMEDS",67,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
+"RTN","CCRMEDS",68,0)
+   . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+"RTN","CCRMEDS",69,0)
+   . N MEDIEN S MEDIEN=$P(MED(6),U)
+"RTN","CCRMEDS",70,0)
+   . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","CCRMEDS",71,0)
+   . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","CCRMEDS",72,0)
+   . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","CCRMEDS",73,0)
+   . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","CCRMEDS",74,0)
+   . ; Units, concentration, etc, come from another call
+"RTN","CCRMEDS",75,0)
+   . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","CCRMEDS",76,0)
+   . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","CCRMEDS",77,0)
+   . ; NDF Entry IEN, and VA Product Name
+"RTN","CCRMEDS",78,0)
+   . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",79,0)
+   . ; Documented in the same manual.
+"RTN","CCRMEDS",80,0)
+   . N IEN S IEN=^PSDRUG($P(MED(6),U))
+"RTN","CCRMEDS",81,0)
+   . D NDF^PSS50(IEN,,,,,"CONC")
+"RTN","CCRMEDS",82,0)
+   . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN)
+"RTN","CCRMEDS",83,0)
+   . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","CCRMEDS",84,0)
+   . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","CCRMEDS",85,0)
+   . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","CCRMEDS",86,0)
+   . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","CCRMEDS",87,0)
+   . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","CCRMEDS",88,0)
+   . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","CCRMEDS",89,0)
+   . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
+"RTN","CCRMEDS",90,0)
+   . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+"RTN","CCRMEDS",91,0)
+   . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","CCRMEDS",92,0)
+   . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","CCRMEDS",93,0)
+   . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",94,0)
+   . ; Node 14.5 is the Dispense Unit
+"RTN","CCRMEDS",95,0)
+   . D DATA^PSS50(IEN,,,,,"QTY")
+"RTN","CCRMEDS",96,0)
+   . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN)
+"RTN","CCRMEDS",97,0)
+   . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","CCRMEDS",98,0)
+   . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""
+"RTN","CCRMEDS",99,0)
+   . S @MAP@("MEDDOSEINDICATOR")
+"RTN","CCRMEDS",100,0)
+   . S @MAP@("MEDDELIVERYMETHOD")
+"RTN","CCRMEDS",101,0)
+   . S @MAP@("MEDDOSEVALUE")
+"RTN","CCRMEDS",102,0)
+   . S @MAP@("MEDDOSEUNIT")
+"RTN","CCRMEDS",103,0)
+   . S @MAP@("MEDRATEVALUE")
+"RTN","CCRMEDS",104,0)
+   . S @MAP@("MEDRATEUNIT")
+"RTN","CCRMEDS",105,0)
+   . S @MAP@("MEDVEHICLETEXT")
+"RTN","CCRMEDS",106,0)
+   . S @MAP@("MEDDIRECTIONROUTETEXT")
+"RTN","CCRMEDS",107,0)
+   . S @MAP@("MEDFREQUENCYVALUE")
+"RTN","CCRMEDS",108,0)
+   . S @MAP@("MEDFREQUENCYUNIT")
+"RTN","CCRMEDS",109,0)
+   . S @MAP@("MEDINTERVALVALUE")
+"RTN","CCRMEDS",110,0)
+   . S @MAP@("MEDINTERVALUNIT")
+"RTN","CCRMEDS",111,0)
+   . S @MAP@("MEDDURATIONVALUE")
+"RTN","CCRMEDS",112,0)
+   . S @MAP@("MEDDURATIONUNIT")
+"RTN","CCRMEDS",113,0)
+   . S @MAP@("MEDPRNFLAG")
+"RTN","CCRMEDS",114,0)
+   . S @MAP@("MEDPROBLEMOBJECTID")=""
+"RTN","CCRMEDS",115,0)
+   . S @MAP@("MEDPROBLEMDESCRIPTION")=""
+"RTN","CCRMEDS",116,0)
+   . S @MAP@("MEDPROBLEMCODEVALUE")=""
+"RTN","CCRMEDS",117,0)
+   . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
+"RTN","CCRMEDS",118,0)
+   . S @MAP@("MEDPROBLEMCODINGVERSION")=""
+"RTN","CCRMEDS",119,0)
+   . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
+"RTN","CCRMEDS",120,0)
+   . S @MAP@("MEDSTOPINDICATOR")
+"RTN","CCRMEDS",121,0)
+   . S @MAP@("MEDDIRSEQ")
+"RTN","CCRMEDS",122,0)
+   . S @MAP@("MEDMULDIRMOD")
+"RTN","CCRMEDS",123,0)
+   . S @MAP@("MEDPTINSTRUCTIONS")
+"RTN","CCRMEDS",124,0)
+   . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")
+"RTN","CCRMEDS",125,0)
+   . S @MAP@("MEDRFNO")=MED(9)
+"RTN","CCRMEDS",126,0)
+   . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J))
+"RTN","CCRMEDS",127,0)
+   . K @RESULT
+"RTN","CCRMEDS",128,0)
+   . D MAP^GPLXPATH(INXML,MAP,RESULT)
+"RTN","CCRMEDS",129,0)
+   . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+"RTN","CCRMEDS",130,0)
+   . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+"RTN","CCRMEDS",131,0)
+   N MEDTMP,MEDI
+"RTN","CCRMEDS",132,0)
+   D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","CCRMEDS",133,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","CCRMEDS",134,0)
+   . W "MEDICATION MISSING ",!
+"RTN","CCRMEDS",135,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","CCRMEDS",136,0)
+   Q
+"RTN","CCRMEDS",137,0)
+   ;
+"RTN","CCRSYS")
+0^4^B1690193
+"RTN","CCRSYS",1,0)
+CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
+"RTN","CCRSYS",2,0)
+        ;;0.1;CCDCCR;;;Build 5
+"RTN","CCRSYS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRSYS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRSYS",5,0)
+ ;
+"RTN","CCRSYS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRSYS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRSYS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRSYS",9,0)
+ ;(at your option) any later version.
+"RTN","CCRSYS",10,0)
+ ;
+"RTN","CCRSYS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRSYS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRSYS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRSYS",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRSYS",15,0)
+ ;
+"RTN","CCRSYS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRSYS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRSYS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRSYS",19,0)
+    ;
+"RTN","CCRSYS",20,0)
+        W "Enter at appropriate points." Q
+"RTN","CCRSYS",21,0)
+        ;
+"RTN","CCRSYS",22,0)
+        ; Originally, I was going to use VEPERVER, but VEPERVER
+"RTN","CCRSYS",23,0)
+        ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
+"RTN","CCRSYS",24,0)
+        ; manner (press any key to continue),
+"RTN","CCRSYS",25,0)
+        ; and is really a very half finished routine
+"RTN","CCRSYS",26,0)
+        ;
+"RTN","CCRSYS",27,0)
+        ; So for now, I am hard-coding the values.
+"RTN","CCRSYS",28,0)
+        ;
+"RTN","CCRSYS",29,0)
+SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
+"RTN","CCRSYS",30,0)
+        Q "WorldVistA EHR/VOE"
+"RTN","CCRSYS",31,0)
+        ;
+"RTN","CCRSYS",32,0)
+SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
+"RTN","CCRSYS",33,0)
+        Q "1.0"
+"RTN","CCRSYS",34,0)
+        ;
+"RTN","CCRUNIT")
+0^5^B8574
+"RTN","CCRUNIT",1,0)
+CCRUNIT ; A routine that tests some crap
+"RTN","CCRUNIT",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 5
+"RTN","CCRUNIT",3,0)
+        Q
+"RTN","CCRUNIT",4,0)
+        ;
+"RTN","CCRUNIT",5,0)
+MEDS
+"RTN","CCRUNIT",6,0)
+        N DEBUG S DEBUG=0
+"RTN","CCRUNIT",7,0)
+        N DFN S DFN=1
+"RTN","CCRUNIT",8,0)
+        K ^TMP($J)
+"RTN","CCRUNIT",9,0)
+        W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+"RTN","CCRUNIT",10,0)
+        N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
+"RTN","CCRUNIT",11,0)
+        B
+"RTN","CCRUNIT",12,0)
+        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+"RTN","CCRUNIT",13,0)
+        W "XPATH is: "_XPATH,!
+"RTN","CCRUNIT",14,0)
+        W "Getting Med Template into INXML using",!
+"RTN","CCRUNIT",15,0)
+        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+"RTN","CCRUNIT",16,0)
+        N INXML
+"RTN","CCRUNIT",17,0)
+        D QUERY^GPLXPATH(T,XPATH,"INXML")
+"RTN","CCRUNIT",18,0)
+        B
+"RTN","CCRUNIT",19,0)
+        W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
+"RTN","CCRUNIT",20,0)
+        W "OUTXML will be ^TMP($J,""OUT"")",!
+"RTN","CCRUNIT",21,0)
+        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+"RTN","CCRUNIT",22,0)
+        D EXTRACT^GPLMEDS("INXML",DFN,OUTXML)
+"RTN","CCRUNIT",23,0)
+        Q
+"RTN","CCRUTIL")
+0^6^B17726385
+"RTN","CCRUTIL",1,0)
+CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
+"RTN","CCRUTIL",2,0)
+          ;;0.1;CCRCCD;;Jun 15, 2008;Build 5
+"RTN","CCRUTIL",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRUTIL",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRUTIL",5,0)
+ ;
+"RTN","CCRUTIL",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRUTIL",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRUTIL",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRUTIL",9,0)
+ ;(at your option) any later version.
+"RTN","CCRUTIL",10,0)
+ ;
+"RTN","CCRUTIL",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRUTIL",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRUTIL",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRUTIL",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRUTIL",15,0)
+ ;
+"RTN","CCRUTIL",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRUTIL",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRUTIL",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRUTIL",19,0)
+    ;
+"RTN","CCRUTIL",20,0)
+          W "No Entry at Top!"
+"RTN","CCRUTIL",21,0)
+          Q
+"RTN","CCRUTIL",22,0)
+          ;
+"RTN","CCRUTIL",23,0)
+FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
+"RTN","CCRUTIL",24,0)
+          ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+"RTN","CCRUTIL",25,0)
+          ; If not passed, or passed incorrectly, it's assumed that it is D.
+"RTN","CCRUTIL",26,0)
+          ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+"RTN","CCRUTIL",27,0)
+          ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+"RTN","CCRUTIL",28,0)
+          ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+"RTN","CCRUTIL",29,0)
+          N UTC,Y,M,D,H,MM,S,OFF
+"RTN","CCRUTIL",30,0)
+          S Y=1700+$E(DATE,1,3)
+"RTN","CCRUTIL",31,0)
+          S M=$E(DATE,4,5)
+"RTN","CCRUTIL",32,0)
+          S D=$E(DATE,6,7)
+"RTN","CCRUTIL",33,0)
+          S H=$E(DATE,9,10)
+"RTN","CCRUTIL",34,0)
+          I $L(H)=1 S H="0"_H
+"RTN","CCRUTIL",35,0)
+          S MM=$E(DATE,11,12)
+"RTN","CCRUTIL",36,0)
+          I $L(MM)=1 S MM="0"_MM
+"RTN","CCRUTIL",37,0)
+          S S=$E(DATE,13,14)
+"RTN","CCRUTIL",38,0)
+          I $L(S)=1 S S="0"_S
+"RTN","CCRUTIL",39,0)
+          S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+"RTN","CCRUTIL",40,0)
+          ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+"RTN","CCRUTIL",41,0)
+          ; In this case, set H, MM and S to "00"
+"RTN","CCRUTIL",42,0)
+          ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
+"RTN","CCRUTIL",43,0)
+          S:'$L(H) H="00"
+"RTN","CCRUTIL",44,0)
+          S:'$L(MM) MM="00"
+"RTN","CCRUTIL",45,0)
+          S:'$L(S) S="00"
+"RTN","CCRUTIL",46,0)
+          S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+"RTN","CCRUTIL",47,0)
+          I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+"RTN","CCRUTIL",48,0)
+          E  Q $P(UTC,"T")
+"RTN","CCRUTIL",49,0)
+          ;
+"RTN","CCRUTIL",50,0)
+SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+"RTN","CCRUTIL",51,0)
+               ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+"RTN","CCRUTIL",52,0)
+               ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+"RTN","CCRUTIL",53,0)
+               ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+"RTN","CCRUTIL",54,0)
+               ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+"RTN","CCRUTIL",55,0)
+               ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+"RTN","CCRUTIL",56,0)
+               ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+"RTN","CCRUTIL",57,0)
+               ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+"RTN","CCRUTIL",58,0)
+          N VSRT ; TEMP FOR HASHING DATES
+"RTN","CCRUTIL",59,0)
+          N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+"RTN","CCRUTIL",60,0)
+          S ZCNT=0 ; COUNTING NUMBER OF DATES
+"RTN","CCRUTIL",61,0)
+          S ZTMP="" ;
+"RTN","CCRUTIL",62,0)
+          F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
+"RTN","CCRUTIL",63,0)
+          . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","CCRUTIL",64,0)
+          . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
+"RTN","CCRUTIL",65,0)
+          . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
+"RTN","CCRUTIL",66,0)
+          . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
+"RTN","CCRUTIL",67,0)
+          . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
+"RTN","CCRUTIL",68,0)
+          . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
+"RTN","CCRUTIL",69,0)
+          . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
+"RTN","CCRUTIL",70,0)
+          . I DEBUG W "ZTMP=",ZTMP," "
+"RTN","CCRUTIL",71,0)
+          S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
+"RTN","CCRUTIL",72,0)
+          ; I DEBUG ZWR V2
+"RTN","CCRUTIL",73,0)
+          ; I DEBUG ZWR VSRT
+"RTN","CCRUTIL",74,0)
+          N ZD,ZT ; DATA AND TIME ITERATORS
+"RTN","CCRUTIL",75,0)
+          N ZDONE ; DONE FLAG
+"RTN","CCRUTIL",76,0)
+          S (ZD,ZT)=""
+"RTN","CCRUTIL",77,0)
+          S ZDONE=0
+"RTN","CCRUTIL",78,0)
+          N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
+"RTN","CCRUTIL",79,0)
+          S UORDR=ORDR ; DIRECTION TO SORT
+"RTN","CCRUTIL",80,0)
+          I ORDR="" S UORDR=1
+"RTN","CCRUTIL",81,0)
+          N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
+"RTN","CCRUTIL",82,0)
+          F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
+"RTN","CCRUTIL",83,0)
+          . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE
+"RTN","CCRUTIL",84,0)
+          . I ZD="" S ZDONE=1
+"RTN","CCRUTIL",85,0)
+          . I 'ZDONE D  ; MORE DATES
+"RTN","CCRUTIL",86,0)
+          . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
+"RTN","CCRUTIL",87,0)
+          . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
+"RTN","CCRUTIL",88,0)
+          . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
+"RTN","CCRUTIL",89,0)
+          . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
+"RTN","CCRUTIL",90,0)
+          . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
+"RTN","CCRUTIL",91,0)
+          Q ZCNT
+"RTN","CCRUTIL",92,0)
+          ;
+"RTN","CCRVA200")
+0^7^B35847405
+"RTN","CCRVA200",1,0)
+CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
+"RTN","CCRVA200",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 5
+"RTN","CCRVA200",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRVA200",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRVA200",5,0)
+ ;
+"RTN","CCRVA200",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRVA200",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRVA200",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRVA200",9,0)
+ ;(at your option) any later version.
+"RTN","CCRVA200",10,0)
+ ;
+"RTN","CCRVA200",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRVA200",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRVA200",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRVA200",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRVA200",15,0)
+ ;
+"RTN","CCRVA200",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRVA200",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRVA200",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRVA200",19,0)
+        Q
+"RTN","CCRVA200",20,0)
+        ; This routine uses Kernel APIs and Direct Global Access to get
+"RTN","CCRVA200",21,0)
+        ; Proivder Data from File 200.
+"RTN","CCRVA200",22,0)
+        ;
+"RTN","CCRVA200",23,0)
+        ; The Global is VA(200,*)
+"RTN","CCRVA200",24,0)
+        ;
+"RTN","CCRVA200",25,0)
+FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",26,0)
+        ; INPUT: DUZ (i.e. File 200 IEN) ByVal
+"RTN","CCRVA200",27,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",28,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",29,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",30,0)
+        Q NAME("FAMILY")
+"RTN","CCRVA200",31,0)
+        ;
+"RTN","CCRVA200",32,0)
+GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",33,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",34,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",35,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",36,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",37,0)
+        Q NAME("GIVEN")
+"RTN","CCRVA200",38,0)
+        ;
+"RTN","CCRVA200",39,0)
+MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",40,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",41,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",42,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",43,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",44,0)
+        Q NAME("MIDDLE")
+"RTN","CCRVA200",45,0)
+        ;
+"RTN","CCRVA200",46,0)
+SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",47,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",48,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",49,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",50,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",51,0)
+        Q NAME("SUFFIX")
+"RTN","CCRVA200",52,0)
+        ;
+"RTN","CCRVA200",53,0)
+TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",54,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",55,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",56,0)
+        ; Gets External Value of Title field in New Person File.
+"RTN","CCRVA200",57,0)
+        ; It's actually a pointer to file 3.1
+"RTN","CCRVA200",58,0)
+        ; 200=New Person File; 8 is Title Field
+"RTN","CCRVA200",59,0)
+        Q $$GET1^DIQ(200,DUZ_",",8)
+"RTN","CCRVA200",60,0)
+        ;
+"RTN","CCRVA200",61,0)
+NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",62,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",63,0)
+        ; OUTPUT: Delimited String in format:
+"RTN","CCRVA200",64,0)
+        ;       IDType^ID^IDDescription
+"RTN","CCRVA200",65,0)
+        ; If the NPI doesn't exist, "" is returned.
+"RTN","CCRVA200",66,0)
+        ; This routine uses a call documented in the Kernel dev guide
+"RTN","CCRVA200",67,0)
+        ; This call returns as "NPI^TimeEntered^ActiveInactive"
+"RTN","CCRVA200",68,0)
+        ; It returns -1 for NPI if NPI doesn't exist.
+"RTN","CCRVA200",69,0)
+        N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+"RTN","CCRVA200",70,0)
+        Q:NPI=-1 ""
+"RTN","CCRVA200",71,0)
+        Q "NPI^"_NPI_"^HHS"
+"RTN","CCRVA200",72,0)
+        ;
+"RTN","CCRVA200",73,0)
+SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",74,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",75,0)
+        ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
+"RTN","CCRVA200",76,0)
+        ; Uses a Kernel API. Returns -1 if a specialty is not specified
+"RTN","CCRVA200",77,0)
+        ;       in file 200.
+"RTN","CCRVA200",78,0)
+        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
+"RTN","CCRVA200",79,0)
+        N STR S STR=$$GET^XUA4A72(DUZ)
+"RTN","CCRVA200",80,0)
+        Q:+STR<0 ""
+"RTN","CCRVA200",81,0)
+        ; Sometimes we have 3 pieces, or 2. Deal with that.
+"RTN","CCRVA200",82,0)
+        Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+"RTN","CCRVA200",83,0)
+        Q $P(STR,U,2)_"-"_$P(STR,U,3)
+"RTN","CCRVA200",84,0)
+        ;
+"RTN","CCRVA200",85,0)
+ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",86,0)
+        ; INPUT: DUZ, but not needed really... here for future expansion
+"RTN","CCRVA200",87,0)
+        ; OUTPUT: At this point "Work"
+"RTN","CCRVA200",88,0)
+        Q "Work"
+"RTN","CCRVA200",89,0)
+        ;
+"RTN","CCRVA200",90,0)
+ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",91,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",92,0)
+        ; Output: String.
+"RTN","CCRVA200",93,0)
+        ;
+"RTN","CCRVA200",94,0)
+        ; First, get site number from the institution file.
+"RTN","CCRVA200",95,0)
+        ; 1st piece returned by $$SITE^VASITE, which gets the system institution
+"RTN","CCRVA200",96,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",97,0)
+        ;
+"RTN","CCRVA200",98,0)
+        ; Second, get mailing address
+"RTN","CCRVA200",99,0)
+        ; There are two APIs to get the address, one for physical and one for
+"RTN","CCRVA200",100,0)
+        ; mailing. We will check if mailing exists first, since that's the
+"RTN","CCRVA200",101,0)
+        ; one we want to use; then check for physical. If neither exists,
+"RTN","CCRVA200",102,0)
+        ; then we return nothing. We check for the existence of an address
+"RTN","CCRVA200",103,0)
+        ; by the length of the returned string.
+"RTN","CCRVA200",104,0)
+        ; NOTE: API doesn't support Address 2, so I won't even include it
+"RTN","CCRVA200",105,0)
+        ; in the template.
+"RTN","CCRVA200",106,0)
+        N ADD
+"RTN","CCRVA200",107,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",108,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",109,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",110,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",111,0)
+        Q ""
+"RTN","CCRVA200",112,0)
+        ;
+"RTN","CCRVA200",113,0)
+CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",114,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",115,0)
+        ; Output: String.
+"RTN","CCRVA200",116,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",117,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",118,0)
+        N ADD
+"RTN","CCRVA200",119,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",120,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",121,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",122,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",123,0)
+        Q ""
+"RTN","CCRVA200",124,0)
+        ;
+"RTN","CCRVA200",125,0)
+STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",126,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",127,0)
+        ; Output: String.
+"RTN","CCRVA200",128,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",129,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",130,0)
+        N ADD
+"RTN","CCRVA200",131,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",132,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",133,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",134,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",135,0)
+        Q ""
+"RTN","CCRVA200",136,0)
+        ;
+"RTN","CCRVA200",137,0)
+POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",138,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",139,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",140,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",141,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",142,0)
+        N ADD
+"RTN","CCRVA200",143,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",144,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",145,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",146,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",147,0)
+        Q ""
+"RTN","CCRVA200",148,0)
+        ;
+"RTN","CCRVA200",149,0)
+TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",150,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",151,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",152,0)
+        ; Direct global access
+"RTN","CCRVA200",153,0)
+        N TEL S TEL=$G(^VA(200,DUZ,.13))
+"RTN","CCRVA200",154,0)
+        Q $P(TEL,U,2)
+"RTN","CCRVA200",155,0)
+        ;
+"RTN","CCRVA200",156,0)
+TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",157,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",158,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",159,0)
+        Q "Office"
+"RTN","CCRVA200",160,0)
+        ;
+"RTN","CCRVA200",161,0)
+EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",162,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",163,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",164,0)
+        ; Direct global access
+"RTN","CCRVA200",165,0)
+        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+"RTN","CCRVA200",166,0)
+        Q $P(EMAIL,U)
+"RTN","CCRVA200",167,0)
+        ;
+"RTN","GPLACTOR")
+0^8^B58306782
+"RTN","GPLACTOR",1,0)
+GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+"RTN","GPLACTOR",2,0)
+ ;;0.3;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLACTOR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLACTOR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLACTOR",5,0)
+ ;
+"RTN","GPLACTOR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLACTOR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLACTOR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLACTOR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLACTOR",10,0)
+ ;
+"RTN","GPLACTOR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLACTOR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLACTOR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLACTOR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLACTOR",15,0)
+ ;
+"RTN","GPLACTOR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLACTOR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLACTOR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLACTOR",19,0)
+    ;
+"RTN","GPLACTOR",20,0)
+    ;  PROCESS THE ACTORS SECTION OF THE CCR
+"RTN","GPLACTOR",21,0)
+    ;
+"RTN","GPLACTOR",22,0)
+    ; ===Revision History===
+"RTN","GPLACTOR",23,0)
+    ; 0.1 Initial Writing of Skeleton--GPL
+"RTN","GPLACTOR",24,0)
+    ; 0.2 Patient Data Extraction--SMH
+"RTN","GPLACTOR",25,0)
+    ; 0.3 Information System Info Extraction--SMH
+"RTN","GPLACTOR",26,0)
+    ;
+"RTN","GPLACTOR",27,0)
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+"RTN","GPLACTOR",28,0)
+  ; IPXML is the Input Actor Template into which we  substitute values
+"RTN","GPLACTOR",29,0)
+  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+"RTN","GPLACTOR",30,0)
+  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
+"RTN","GPLACTOR",31,0)
+  ; ^TMP(7542,1,"ACTORS",0)=Count
+"RTN","GPLACTOR",32,0)
+  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+"RTN","GPLACTOR",33,0)
+  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+"RTN","GPLACTOR",34,0)
+  ; AXML is the output arrary, to contain XML.
+"RTN","GPLACTOR",35,0)
+  ;
+"RTN","GPLACTOR",36,0)
+           N I,J,AMAP,AOID,ATYP,AIEN
+"RTN","GPLACTOR",37,0)
+           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+"RTN","GPLACTOR",38,0)
+           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+"RTN","GPLACTOR",39,0)
+           W "PROCESSING ACTORS ",!
+"RTN","GPLACTOR",40,0)
+           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+"RTN","GPLACTOR",41,0)
+           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",42,0)
+           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+"RTN","GPLACTOR",43,0)
+           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+"RTN","GPLACTOR",44,0)
+           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+"RTN","GPLACTOR",45,0)
+           . I ATYP="" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",46,0)
+           . ;
+"RTN","GPLACTOR",47,0)
+           . W AOID_" "_ATYP_" "_AIEN,!
+"RTN","GPLACTOR",48,0)
+           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+"RTN","GPLACTOR",49,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+"RTN","GPLACTOR",50,0)
+           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",51,0)
+           . ;
+"RTN","GPLACTOR",52,0)
+           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+"RTN","GPLACTOR",53,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+"RTN","GPLACTOR",54,0)
+           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",55,0)
+           . ;
+"RTN","GPLACTOR",56,0)
+           . I ATYP="NOK" D  ; NOK ACTOR TYPE
+"RTN","GPLACTOR",57,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+"RTN","GPLACTOR",58,0)
+           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",59,0)
+           . ;
+"RTN","GPLACTOR",60,0)
+           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",61,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+"RTN","GPLACTOR",62,0)
+           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",63,0)
+           . ;
+"RTN","GPLACTOR",64,0)
+           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",65,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+"RTN","GPLACTOR",66,0)
+           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",67,0)
+           . ;
+"RTN","GPLACTOR",68,0)
+           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+"RTN","GPLACTOR",69,0)
+           ;
+"RTN","GPLACTOR",70,0)
+           N ACTTMP
+"RTN","GPLACTOR",71,0)
+           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLACTOR",72,0)
+           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLACTOR",73,0)
+           . ; STRINGS MARKED AS @@X@@
+"RTN","GPLACTOR",74,0)
+           . W "ACTORS Missing list: ",!
+"RTN","GPLACTOR",75,0)
+           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+"RTN","GPLACTOR",76,0)
+           Q
+"RTN","GPLACTOR",77,0)
+           ;
+"RTN","GPLACTOR",78,0)
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+"RTN","GPLACTOR",79,0)
+     ;
+"RTN","GPLACTOR",80,0)
+     W "PROCESSING ACTOR PATIENT ",AIEN,!
+"RTN","GPLACTOR",81,0)
+     N AMAP,ZX
+"RTN","GPLACTOR",82,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",83,0)
+     K @AMAP
+"RTN","GPLACTOR",84,0)
+     D INIT^CCRDPT(AIEN)
+"RTN","GPLACTOR",85,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",86,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
+"RTN","GPLACTOR",87,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
+"RTN","GPLACTOR",88,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
+"RTN","GPLACTOR",89,0)
+     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
+"RTN","GPLACTOR",90,0)
+     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
+"RTN","GPLACTOR",91,0)
+     S @AMAP@("ACTORSSN")=""
+"RTN","GPLACTOR",92,0)
+     S @AMAP@("ACTORSSNTEXT")=""
+"RTN","GPLACTOR",93,0)
+     S @AMAP@("ACTORSSNSOURCEID")=""
+"RTN","GPLACTOR",94,0)
+     S ZX=$$SSN^CCRDPT
+"RTN","GPLACTOR",95,0)
+     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+"RTN","GPLACTOR",96,0)
+     . S @AMAP@("ACTORSSN")=ZX
+"RTN","GPLACTOR",97,0)
+     . S @AMAP@("ACTORSSNTEXT")="SSN"
+"RTN","GPLACTOR",98,0)
+     . S @AMAP@("ACTORSSNSOURCEID")=AOID
+"RTN","GPLACTOR",99,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
+"RTN","GPLACTOR",100,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
+"RTN","GPLACTOR",101,0)
+     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
+"RTN","GPLACTOR",102,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
+"RTN","GPLACTOR",103,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
+"RTN","GPLACTOR",104,0)
+     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
+"RTN","GPLACTOR",105,0)
+     S @AMAP@("ACTORRESTEL")=""
+"RTN","GPLACTOR",106,0)
+     S @AMAP@("ACTORRESTELTEXT")=""
+"RTN","GPLACTOR",107,0)
+     S ZX=$$RESTEL^CCRDPT
+"RTN","GPLACTOR",108,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",109,0)
+     . S @AMAP@("ACTORRESTEL")=ZX
+"RTN","GPLACTOR",110,0)
+     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+"RTN","GPLACTOR",111,0)
+     S @AMAP@("ACTORWORKTEL")=""
+"RTN","GPLACTOR",112,0)
+     S @AMAP@("ACTORWORKTELTEXT")=""
+"RTN","GPLACTOR",113,0)
+     S ZX=$$WORKTEL^CCRDPT
+"RTN","GPLACTOR",114,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",115,0)
+     . S @AMAP@("ACTORWORKTEL")=ZX
+"RTN","GPLACTOR",116,0)
+     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+"RTN","GPLACTOR",117,0)
+     S @AMAP@("ACTORCELLTEL")=""
+"RTN","GPLACTOR",118,0)
+     S @AMAP@("ACTORCELLTELTEXT")=""
+"RTN","GPLACTOR",119,0)
+     S ZX=$$CELLTEL^CCRDPT
+"RTN","GPLACTOR",120,0)
+     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+"RTN","GPLACTOR",121,0)
+     . S @AMAP@("ACTORCELLTEL")=ZX
+"RTN","GPLACTOR",122,0)
+     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+"RTN","GPLACTOR",123,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
+"RTN","GPLACTOR",124,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+"RTN","GPLACTOR",125,0)
+     S @AMAP@("ACTORIEN")=AIEN
+"RTN","GPLACTOR",126,0)
+     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+"RTN","GPLACTOR",127,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",128,0)
+         D DESTROY^CCRDPT
+"RTN","GPLACTOR",129,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",130,0)
+     Q
+"RTN","GPLACTOR",131,0)
+     ;
+"RTN","GPLACTOR",132,0)
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+"RTN","GPLACTOR",133,0)
+     ;
+"RTN","GPLACTOR",134,0)
+     ; N AMAP
+"RTN","GPLACTOR",135,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",136,0)
+     K @AMAP
+"RTN","GPLACTOR",137,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",138,0)
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
+"RTN","GPLACTOR",139,0)
+         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
+"RTN","GPLACTOR",140,0)
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+"RTN","GPLACTOR",141,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",142,0)
+     Q
+"RTN","GPLACTOR",143,0)
+     ;
+"RTN","GPLACTOR",144,0)
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+"RTN","GPLACTOR",145,0)
+     ;
+"RTN","GPLACTOR",146,0)
+     ; N AMAP
+"RTN","GPLACTOR",147,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",148,0)
+     K @AMAP
+"RTN","GPLACTOR",149,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",150,0)
+     S @AMAP@("ACTORDISPLAYNAME")=""
+"RTN","GPLACTOR",151,0)
+     S @AMAP@("ACTORRELATION")=""
+"RTN","GPLACTOR",152,0)
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+"RTN","GPLACTOR",153,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",154,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",155,0)
+     Q
+"RTN","GPLACTOR",156,0)
+     ;
+"RTN","GPLACTOR",157,0)
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+"RTN","GPLACTOR",158,0)
+     ;
+"RTN","GPLACTOR",159,0)
+     ; N AMAP
+"RTN","GPLACTOR",160,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",161,0)
+     K @AMAP
+"RTN","GPLACTOR",162,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",163,0)
+     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
+"RTN","GPLACTOR",164,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",165,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",166,0)
+     Q
+"RTN","GPLACTOR",167,0)
+     ;
+"RTN","GPLACTOR",168,0)
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+"RTN","GPLACTOR",169,0)
+     ;
+"RTN","GPLACTOR",170,0)
+     ; N AMAP
+"RTN","GPLACTOR",171,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",172,0)
+     K @AMAP
+"RTN","GPLACTOR",173,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",174,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
+"RTN","GPLACTOR",175,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",176,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
+"RTN","GPLACTOR",177,0)
+         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",178,0)
+         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
+"RTN","GPLACTOR",179,0)
+         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
+"RTN","GPLACTOR",180,0)
+         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
+"RTN","GPLACTOR",181,0)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
+"RTN","GPLACTOR",182,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",183,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
+"RTN","GPLACTOR",184,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
+"RTN","GPLACTOR",185,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
+"RTN","GPLACTOR",186,0)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
+"RTN","GPLACTOR",187,0)
+     S @AMAP@("ACTORTELEPHONE")=""
+"RTN","GPLACTOR",188,0)
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+"RTN","GPLACTOR",189,0)
+     S ZX=$$TEL^CCRVA200(AIEN)
+"RTN","GPLACTOR",190,0)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+"RTN","GPLACTOR",191,0)
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+"RTN","GPLACTOR",192,0)
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",193,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
+"RTN","GPLACTOR",194,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",195,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",196,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",197,0)
+     Q
+"RTN","GPLACTOR",198,0)
+     ;
+"RTN","GPLCCD")
+0^16^B106978605
+"RTN","GPLCCD",1,0)
+GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
+"RTN","GPLCCD",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLCCD",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD",5,0)
+ ;
+"RTN","GPLCCD",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD",10,0)
+ ;
+"RTN","GPLCCD",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD",15,0)
+ ;
+"RTN","GPLCCD",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD",19,0)
+ ;
+"RTN","GPLCCD",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCD",21,0)
+ ;
+"RTN","GPLCCD",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCD",23,0)
+       ; Select a patient.
+"RTN","GPLCCD",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCD",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCD",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCD",27,0)
+       ; N CCDGLO
+"RTN","GPLCCD",28,0)
+       D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+"RTN","GPLCCD",29,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
+"RTN","GPLCCD",30,0)
+       S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+"RTN","GPLCCD",31,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCD",32,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCD",33,0)
+       . S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCD",34,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCD",35,0)
+       . ;S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCD",36,0)
+       S ODIR=@ODIRGLB
+"RTN","GPLCCD",37,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCD",38,0)
+       Q
+"RTN","GPLCCD",39,0)
+       ;
+"RTN","GPLCCD",40,0)
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCD",41,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCD",42,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCD",43,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCD",44,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCD",45,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCD",46,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCD",47,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCD",48,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCD",49,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCD",50,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+"RTN","GPLCCD",51,0)
+    S DEBUG=0
+"RTN","GPLCCD",52,0)
+    N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+"RTN","GPLCCD",53,0)
+    I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+"RTN","GPLCCD",54,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCD",55,0)
+    I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+"RTN","GPLCCD",56,0)
+    E  S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCD",57,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCD",58,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCD",59,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCD",60,0)
+    I CCD D LOAD^GPLCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",61,0)
+    E  D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",62,0)
+    D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCD",63,0)
+    N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+"RTN","GPLCCD",64,0)
+    S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+"RTN","GPLCCD",65,0)
+    S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+"RTN","GPLCCD",66,0)
+    S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+"RTN","GPLCCD",67,0)
+    S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+"RTN","GPLCCD",68,0)
+    S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+"RTN","GPLCCD",69,0)
+    S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+"RTN","GPLCCD",70,0)
+    ;
+"RTN","GPLCCD",71,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCD",72,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCD",73,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",74,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",75,0)
+    I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCD",76,0)
+    I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+"RTN","GPLCCD",77,0)
+    ;
+"RTN","GPLCCD",78,0)
+    I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCD",79,0)
+    ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+"RTN","GPLCCD",80,0)
+    S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+"RTN","GPLCCD",81,0)
+    D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
+"RTN","GPLCCD",82,0)
+    D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+"RTN","GPLCCD",83,0)
+    I DEBUG D PARY^GPLXPATH("ACTT2")
+"RTN","GPLCCD",84,0)
+    D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
+"RTN","GPLCCD",85,0)
+    I DEBUG D PARY^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",86,0)
+    K ACTT1 K ACCT2
+"RTN","GPLCCD",87,0)
+    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+"RTN","GPLCCD",88,0)
+    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+"RTN","GPLCCD",89,0)
+    D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+"RTN","GPLCCD",90,0)
+    D CP^GPLXPATH("ACTT2",CCDGLO)
+"RTN","GPLCCD",91,0)
+    ;
+"RTN","GPLCCD",92,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCD",93,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCD",94,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCD",95,0)
+    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCD",96,0)
+    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCD",97,0)
+    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCD",98,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCD",99,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCD",100,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCD",101,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCD",102,0)
+    . S IXML="INXML"
+"RTN","GPLCCD",103,0)
+    . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+"RTN","GPLCCD",104,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCD",105,0)
+    . ; W OXML,!
+"RTN","GPLCCD",106,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCD",107,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCD",108,0)
+    . X CALL
+"RTN","GPLCCD",109,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCD",110,0)
+    . . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+"RTN","GPLCCD",111,0)
+    . . I CCD D UNSHAVE("ITMP",OXML)
+"RTN","GPLCCD",112,0)
+    . . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+"RTN","GPLCCD",113,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCD",114,0)
+    . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",115,0)
+    . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCD",116,0)
+    ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+"RTN","GPLCCD",117,0)
+    ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCD",118,0)
+    ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCD",119,0)
+    ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCD",120,0)
+    ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",121,0)
+    N I,J,DONE S DONE=0
+"RTN","GPLCCD",122,0)
+    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCD",123,0)
+    . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCD",124,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCD",125,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCD",126,0)
+    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+"RTN","GPLCCD",127,0)
+    . N I
+"RTN","GPLCCD",128,0)
+    . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+"RTN","GPLCCD",129,0)
+    . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",130,0)
+    . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+"RTN","GPLCCD",131,0)
+    . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",132,0)
+    . . . S @CCDGLO@(I)="</structuredBody></component>"
+"RTN","GPLCCD",133,0)
+    S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+"RTN","GPLCCD",134,0)
+    S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+"RTN","GPLCCD",135,0)
+    Q
+"RTN","GPLCCD",136,0)
+    ;
+"RTN","GPLCCD",137,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCD",138,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCD",139,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCD",140,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCD",141,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCD",142,0)
+    ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCD",143,0)
+    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCD",144,0)
+    Q
+"RTN","GPLCCD",145,0)
+    ;
+"RTN","GPLCCD",146,0)
+SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+"RTN","GPLCCD",147,0)
+    ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+"RTN","GPLCCD",148,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",149,0)
+    W SHXML,!
+"RTN","GPLCCD",150,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",151,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+"RTN","GPLCCD",152,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+"RTN","GPLCCD",153,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+"RTN","GPLCCD",154,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",155,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",156,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",157,0)
+    Q
+"RTN","GPLCCD",158,0)
+    ;
+"RTN","GPLCCD",159,0)
+UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+"RTN","GPLCCD",160,0)
+    ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+"RTN","GPLCCD",161,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",162,0)
+    W SHXML,!
+"RTN","GPLCCD",163,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",164,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+"RTN","GPLCCD",165,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+"RTN","GPLCCD",166,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+"RTN","GPLCCD",167,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",168,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",169,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",170,0)
+    Q
+"RTN","GPLCCD",171,0)
+    ;
+"RTN","GPLCCD",172,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCD",173,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCD",174,0)
+    ; K @VMAP
+"RTN","GPLCCD",175,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCD",176,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCD",177,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCD",178,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCD",179,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCD",180,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCD",181,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",182,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",183,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCD",184,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCD",185,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCD",186,0)
+    N CTMP
+"RTN","GPLCCD",187,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCD",188,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCD",189,0)
+    Q
+"RTN","GPLCCD",190,0)
+    ;
+"RTN","GPLCCD",191,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCD",192,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCD",193,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCD",194,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCD",195,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCD",196,0)
+    ;OR INSTITUTION
+"RTN","GPLCCD",197,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCD",198,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCD",199,0)
+    N I,J,K,L
+"RTN","GPLCCD",200,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCD",201,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCD",202,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCD",203,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCD",204,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCD",205,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCD",206,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCD",207,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCD",208,0)
+    F J=0:0 D  Q:$O(K(I))=""  ;
+"RTN","GPLCCD",209,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCD",210,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCD",211,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCD",212,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCD",213,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCD",214,0)
+    Q
+"RTN","GPLCCD",215,0)
+    ;
+"RTN","GPLCCD",216,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCD",217,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCD",218,0)
+  Q
+"RTN","GPLCCD",219,0)
+  ;
+"RTN","GPLCCD",220,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCD",221,0)
+  N ZTMP
+"RTN","GPLCCD",222,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",223,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCD",224,0)
+  Q
+"RTN","GPLCCD",225,0)
+  ;
+"RTN","GPLCCD",226,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCD",227,0)
+  N ZTMP
+"RTN","GPLCCD",228,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",229,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCD",230,0)
+  Q
+"RTN","GPLCCD",231,0)
+  ;
+"RTN","GPLCCD",232,0)
+ ;;><TEST>
+"RTN","GPLCCD",233,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCD",234,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",235,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCD",236,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCD",237,0)
+ ;;><VITALS>
+"RTN","GPLCCD",238,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",239,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCD",240,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCD",241,0)
+ ;;><CCR>
+"RTN","GPLCCD",242,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",243,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",244,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",245,0)
+ ;;><ACTLST>
+"RTN","GPLCCD",246,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",247,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",248,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCD",249,0)
+ ;;><ACTORS>
+"RTN","GPLCCD",250,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCD",251,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCD",252,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCD",253,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCD",254,0)
+ ;;><TRIM>
+"RTN","GPLCCD",255,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCD",256,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",257,0)
+ ;;><CCD>
+"RTN","GPLCCD",258,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",259,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
+"RTN","GPLCCD",260,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",261,0)
+ ;;></TEST>
+"RTN","GPLCCD1")
+0^17^B100039732
+"RTN","GPLCCD1",1,0)
+GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
+"RTN","GPLCCD1",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLCCD1",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD1",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD1",5,0)
+ ;
+"RTN","GPLCCD1",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD1",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD1",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD1",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD1",10,0)
+ ;
+"RTN","GPLCCD1",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD1",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD1",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD1",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD1",15,0)
+ ;
+"RTN","GPLCCD1",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD1",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD1",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD1",19,0)
+ ;
+"RTN","GPLCCD1",20,0)
+          W "This is a CCD TEMPLATE with processing routines",!
+"RTN","GPLCCD1",21,0)
+          W !
+"RTN","GPLCCD1",22,0)
+          Q
+"RTN","GPLCCD1",23,0)
+          ;
+"RTN","GPLCCD1",24,0)
+ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
+"RTN","GPLCCD1",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCD1",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCD1",28,0)
+          ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
+"RTN","GPLCCD1",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCD1",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCD1",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCD1",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCD1",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCD1",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCD1",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCD1",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCD1",37,0)
+          Q
+"RTN","GPLCCD1",38,0)
+          ;
+"RTN","GPLCCD1",39,0)
+ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+"RTN","GPLCCD1",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCD1",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCD1",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCD1",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCD1",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCD1",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCD1",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCD1",48,0)
+          ;
+"RTN","GPLCCD1",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCD1",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCD1",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCD1",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCD1",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCD1",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCD1",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCD1",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCD1",57,0)
+          Q
+"RTN","GPLCCD1",58,0)
+          ;
+"RTN","GPLCCD1",59,0)
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCD1",60,0)
+          D ZLOAD(ARY,"GPLCCD1")
+"RTN","GPLCCD1",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCD1",62,0)
+          Q
+"RTN","GPLCCD1",63,0)
+          ;
+"RTN","GPLCCD1",64,0)
+TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+"RTN","GPLCCD1",65,0)
+          Q
+"RTN","GPLCCD1",66,0)
+MARKUP ;<MARKUP>
+"RTN","GPLCCD1",67,0)
+ ;;<Body>
+"RTN","GPLCCD1",68,0)
+ ;;<Problems>
+"RTN","GPLCCD1",69,0)
+ ;;</Problems>
+"RTN","GPLCCD1",70,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",71,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",72,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",73,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",74,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",75,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",76,0)
+ ;;<Medications>
+"RTN","GPLCCD1",77,0)
+ ;;</Medications>
+"RTN","GPLCCD1",78,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",79,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",80,0)
+ ;;<Results>
+"RTN","GPLCCD1",81,0)
+ ;;</Results>
+"RTN","GPLCCD1",82,0)
+ ;;</Body>
+"RTN","GPLCCD1",83,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCD1",84,0)
+ ;</MARKUP>
+"RTN","GPLCCD1",85,0)
+ ;;<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">
+"RTN","GPLCCD1",86,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",87,0)
+ Q
+"RTN","GPLCCD1",88,0)
+ ;
+"RTN","GPLCCD1",89,0)
+ ;<TEMPLATE>
+"RTN","GPLCCD1",90,0)
+ ;;<?xml version="1.0"?>
+"RTN","GPLCCD1",91,0)
+ ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
+"RTN","GPLCCD1",92,0)
+ ;;<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">
+"RTN","GPLCCD1",93,0)
+ ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
+"RTN","GPLCCD1",94,0)
+ ;;<templateId root="2.16.840.1.113883.10.20.1"/>
+"RTN","GPLCCD1",95,0)
+ ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
+"RTN","GPLCCD1",96,0)
+ ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
+"RTN","GPLCCD1",97,0)
+ ;;<title>Continuity of Care Document</title>
+"RTN","GPLCCD1",98,0)
+ ;;<effectiveTime value="20000407130000+0500"/>
+"RTN","GPLCCD1",99,0)
+ ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+"RTN","GPLCCD1",100,0)
+ ;;<languageCode code="en-US"/>
+"RTN","GPLCCD1",101,0)
+ ;;<recordTarget>
+"RTN","GPLCCD1",102,0)
+ ;;<patientRole>
+"RTN","GPLCCD1",103,0)
+ ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",104,0)
+ ;;<patient>
+"RTN","GPLCCD1",105,0)
+ ;;<name>
+"RTN","GPLCCD1",106,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",107,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",108,0)
+ ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
+"RTN","GPLCCD1",109,0)
+ ;;</name>
+"RTN","GPLCCD1",110,0)
+ ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
+"RTN","GPLCCD1",111,0)
+ ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
+"RTN","GPLCCD1",112,0)
+ ;;</patient>
+"RTN","GPLCCD1",113,0)
+ ;;<providerOrganization>
+"RTN","GPLCCD1",114,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",115,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",116,0)
+ ;;</providerOrganization>
+"RTN","GPLCCD1",117,0)
+ ;;</patientRole>
+"RTN","GPLCCD1",118,0)
+ ;;</recordTarget>
+"RTN","GPLCCD1",119,0)
+ ;;<author>
+"RTN","GPLCCD1",120,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",121,0)
+ ;;<assignedAuthor>
+"RTN","GPLCCD1",122,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",123,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",124,0)
+ ;;<name>
+"RTN","GPLCCD1",125,0)
+ ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
+"RTN","GPLCCD1",126,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",127,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",128,0)
+ ;;</name>
+"RTN","GPLCCD1",129,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",130,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",131,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",132,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",133,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",134,0)
+ ;;</assignedAuthor>
+"RTN","GPLCCD1",135,0)
+ ;;</author>
+"RTN","GPLCCD1",136,0)
+ ;;<informant>
+"RTN","GPLCCD1",137,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",138,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",139,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",140,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",141,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",142,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",143,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",144,0)
+ ;;</informant>
+"RTN","GPLCCD1",145,0)
+ ;;<custodian>
+"RTN","GPLCCD1",146,0)
+ ;;<assignedCustodian>
+"RTN","GPLCCD1",147,0)
+ ;;<representedCustodianOrganization>
+"RTN","GPLCCD1",148,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",149,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",150,0)
+ ;;</representedCustodianOrganization>
+"RTN","GPLCCD1",151,0)
+ ;;</assignedCustodian>
+"RTN","GPLCCD1",152,0)
+ ;;</custodian>
+"RTN","GPLCCD1",153,0)
+ ;;<legalAuthenticator>
+"RTN","GPLCCD1",154,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",155,0)
+ ;;<signatureCode code="S"/>
+"RTN","GPLCCD1",156,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",157,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",158,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",159,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",160,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",161,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",162,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",163,0)
+ ;;</legalAuthenticator>
+"RTN","GPLCCD1",164,0)
+ ;;<Actors>
+"RTN","GPLCCD1",165,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCD1",166,0)
+ ;;<participant typeCode="IND">
+"RTN","GPLCCD1",167,0)
+ ;;<associatedEntity classCode="NOK">
+"RTN","GPLCCD1",168,0)
+ ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
+"RTN","GPLCCD1",169,0)
+ ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
+"RTN","GPLCCD1",170,0)
+ ;;<telecom value="tel:(999)555-1212"/>
+"RTN","GPLCCD1",171,0)
+ ;;<associatedPerson>
+"RTN","GPLCCD1",172,0)
+ ;;<name>
+"RTN","GPLCCD1",173,0)
+ ;;<given>Henrietta</given>
+"RTN","GPLCCD1",174,0)
+ ;;<family>Levin</family>
+"RTN","GPLCCD1",175,0)
+ ;;</name>
+"RTN","GPLCCD1",176,0)
+ ;;</associatedPerson>
+"RTN","GPLCCD1",177,0)
+ ;;</associatedEntity>
+"RTN","GPLCCD1",178,0)
+ ;;</participant>
+"RTN","GPLCCD1",179,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCD1",180,0)
+ ;;</Actors>
+"RTN","GPLCCD1",181,0)
+ ;;<documentationOf>
+"RTN","GPLCCD1",182,0)
+ ;;<serviceEvent classCode="PCPR">
+"RTN","GPLCCD1",183,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",184,0)
+ ;;<high value="@@DATETIME@@"/>
+"RTN","GPLCCD1",185,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",186,0)
+ ;;<performer typeCode="PRF">
+"RTN","GPLCCD1",187,0)
+ ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+"RTN","GPLCCD1",188,0)
+ ;;<time>
+"RTN","GPLCCD1",189,0)
+ ;;<low value="1990"/>
+"RTN","GPLCCD1",190,0)
+ ;;<high value='20000407'/>
+"RTN","GPLCCD1",191,0)
+ ;;</time>
+"RTN","GPLCCD1",192,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",193,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",194,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",195,0)
+ ;;<name>
+"RTN","GPLCCD1",196,0)
+ ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
+"RTN","GPLCCD1",197,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",198,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",199,0)
+ ;;</name>
+"RTN","GPLCCD1",200,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",201,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",202,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",203,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",204,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",205,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",206,0)
+ ;;</performer>
+"RTN","GPLCCD1",207,0)
+ ;;</serviceEvent>
+"RTN","GPLCCD1",208,0)
+ ;;</documentationOf>
+"RTN","GPLCCD1",209,0)
+ ;;<Body>
+"RTN","GPLCCD1",210,0)
+ ;;<PROBLEMS-HTML>
+"RTN","GPLCCD1",211,0)
+ ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
+"RTN","GPLCCD1",212,0)
+ ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
+"RTN","GPLCCD1",213,0)
+ ;;<td>@@PROBLEMDATEOFONSET@@</td>
+"RTN","GPLCCD1",214,0)
+ ;;<td>Active</td></tr>
+"RTN","GPLCCD1",215,0)
+ ;;</tbody></table></text>
+"RTN","GPLCCD1",216,0)
+ ;;</PROBLEMS-HTML>
+"RTN","GPLCCD1",217,0)
+ ;;<Problems>
+"RTN","GPLCCD1",218,0)
+ ;;<component>
+"RTN","GPLCCD1",219,0)
+ ;;<section>
+"RTN","GPLCCD1",220,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
+"RTN","GPLCCD1",221,0)
+ ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
+"RTN","GPLCCD1",222,0)
+ ;;<title>Problems</title>
+"RTN","GPLCCD1",223,0)
+ ;;<entry typeCode="DRIV">
+"RTN","GPLCCD1",224,0)
+ ;;<act classCode="ACT" moodCode="EVN">
+"RTN","GPLCCD1",225,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
+"RTN","GPLCCD1",226,0)
+ ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
+"RTN","GPLCCD1",227,0)
+ ;;<code nullFlavor="NA"/>
+"RTN","GPLCCD1",228,0)
+ ;;<entryRelationship typeCode="SUBJ">
+"RTN","GPLCCD1",229,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",230,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
+"RTN","GPLCCD1",231,0)
+ ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
+"RTN","GPLCCD1",232,0)
+ ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
+"RTN","GPLCCD1",233,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",234,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",235,0)
+ ;;<low value="@@PROBLEMDATEOFONSET@@"/>
+"RTN","GPLCCD1",236,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",237,0)
+ ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
+"RTN","GPLCCD1",238,0)
+ ;;<entryRelationship typeCode="REFR">
+"RTN","GPLCCD1",239,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",240,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
+"RTN","GPLCCD1",241,0)
+ ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+"RTN","GPLCCD1",242,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",243,0)
+ ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
+"RTN","GPLCCD1",244,0)
+ ;;</observation>
+"RTN","GPLCCD1",245,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",246,0)
+ ;;</observation>
+"RTN","GPLCCD1",247,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",248,0)
+ ;;</act>
+"RTN","GPLCCD1",249,0)
+ ;;</entry>
+"RTN","GPLCCD1",250,0)
+ ;;</section>
+"RTN","GPLCCD1",251,0)
+ ;;</component>
+"RTN","GPLCCD1",252,0)
+ ;;</Problems>
+"RTN","GPLCCD1",253,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",254,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",255,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",256,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",257,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",258,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",259,0)
+ ;;<Medications>
+"RTN","GPLCCD1",260,0)
+ ;;</Medications>
+"RTN","GPLCCD1",261,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",262,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",263,0)
+ ;;<Results>
+"RTN","GPLCCD1",264,0)
+ ;;</Results>
+"RTN","GPLCCD1",265,0)
+ ;;</Body>
+"RTN","GPLCCD1",266,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",267,0)
+ ;</TEMPLATE>
+"RTN","GPLCCR")
+0^14^B66792391
+"RTN","GPLCCR",1,0)
+GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
+"RTN","GPLCCR",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLCCR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR",5,0)
+ ;
+"RTN","GPLCCR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR",10,0)
+ ;
+"RTN","GPLCCR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR",15,0)
+ ;
+"RTN","GPLCCR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR",19,0)
+ ;
+"RTN","GPLCCR",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCR",21,0)
+ ;
+"RTN","GPLCCR",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCR",23,0)
+       ; Select a patient.
+"RTN","GPLCCR",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCR",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCR",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCR",27,0)
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+"RTN","GPLCCR",28,0)
+       Q
+"RTN","GPLCCR",29,0)
+       ;
+"RTN","GPLCCR",30,0)
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","GPLCCR",31,0)
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+"RTN","GPLCCR",32,0)
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+"RTN","GPLCCR",33,0)
+       N CCRGLO
+"RTN","GPLCCR",34,0)
+       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
+"RTN","GPLCCR",35,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
+"RTN","GPLCCR",36,0)
+       S ONAM=FN
+"RTN","GPLCCR",37,0)
+       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
+"RTN","GPLCCR",38,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCR",39,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCR",40,0)
+       . ;S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCR",41,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCR",42,0)
+       . S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCR",43,0)
+       S ODIR=DIR
+"RTN","GPLCCR",44,0)
+       I DIR="" S ODIR=@ODIRGLB
+"RTN","GPLCCR",45,0)
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCR",46,0)
+       Q
+"RTN","GPLCCR",47,0)
+       ;
+"RTN","GPLCCR",48,0)
+CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCR",49,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCR",50,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCR",51,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCR",52,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCR",53,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCR",54,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCR",55,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCR",56,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCR",57,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCR",58,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
+"RTN","GPLCCR",59,0)
+    I '$D(DEBUG) S DEBUG=0
+"RTN","GPLCCR",60,0)
+    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
+"RTN","GPLCCR",61,0)
+    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
+"RTN","GPLCCR",62,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCR",63,0)
+    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCR",64,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCR",65,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCR",66,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCR",67,0)
+    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCR",68,0)
+    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCR",69,0)
+    ;
+"RTN","GPLCCR",70,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCR",71,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCR",72,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",73,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",74,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCR",75,0)
+    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+"RTN","GPLCCR",76,0)
+    ;
+"RTN","GPLCCR",77,0)
+    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCR",78,0)
+    ;
+"RTN","GPLCCR",79,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCR",80,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCR",81,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCR",82,0)
+    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCR",83,0)
+    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCR",84,0)
+    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCR",85,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCR",86,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCR",87,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCR",88,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCR",89,0)
+    . S IXML="INXML"
+"RTN","GPLCCR",90,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCR",91,0)
+    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
+"RTN","GPLCCR",92,0)
+    . ; W OXML,!
+"RTN","GPLCCR",93,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCR",94,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCR",95,0)
+    . X CALL
+"RTN","GPLCCR",96,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCR",97,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCR",98,0)
+    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",99,0)
+    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCR",100,0)
+    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCR",101,0)
+    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCR",102,0)
+    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCR",103,0)
+    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",104,0)
+    N TRIMI,J,DONE S DONE=0
+"RTN","GPLCCR",105,0)
+    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCR",106,0)
+    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCR",107,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCR",108,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCR",109,0)
+    Q
+"RTN","GPLCCR",110,0)
+    ;
+"RTN","GPLCCR",111,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCR",112,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCR",113,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCR",114,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCR",115,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCR",116,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCR",117,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCR",118,0)
+    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
+"RTN","GPLCCR",119,0)
+    Q
+"RTN","GPLCCR",120,0)
+    ;
+"RTN","GPLCCR",121,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCR",122,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCR",123,0)
+    ; K @VMAP
+"RTN","GPLCCR",124,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCR",125,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCR",126,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCR",127,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCR",128,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCR",129,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCR",130,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",131,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",132,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCR",133,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCR",134,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCR",135,0)
+    N CTMP
+"RTN","GPLCCR",136,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCR",137,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCR",138,0)
+    Q
+"RTN","GPLCCR",139,0)
+    ;
+"RTN","GPLCCR",140,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCR",141,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCR",142,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCR",143,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCR",144,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCR",145,0)
+    ;OR INSTITUTION
+"RTN","GPLCCR",146,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCR",147,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCR",148,0)
+    N I,J,K,L
+"RTN","GPLCCR",149,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCR",150,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCR",151,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCR",152,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCR",153,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCR",154,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCR",155,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCR",156,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCR",157,0)
+    F J=0:0 D  Q:$O(K(I))=""
+"RTN","GPLCCR",158,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCR",159,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCR",160,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCR",161,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCR",162,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCR",163,0)
+    Q
+"RTN","GPLCCR",164,0)
+    ;
+"RTN","GPLCCR",165,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCR",166,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCR",167,0)
+  Q
+"RTN","GPLCCR",168,0)
+  ;
+"RTN","GPLCCR",169,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCR",170,0)
+  N ZTMP
+"RTN","GPLCCR",171,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",172,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCR",173,0)
+  Q
+"RTN","GPLCCR",174,0)
+  ;
+"RTN","GPLCCR",175,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCR",176,0)
+  N ZTMP
+"RTN","GPLCCR",177,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",178,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCR",179,0)
+  Q
+"RTN","GPLCCR",180,0)
+  ;
+"RTN","GPLCCR",181,0)
+ ;;><TEST>
+"RTN","GPLCCR",182,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCR",183,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",184,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCR",185,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCR",186,0)
+ ;;><VITALS>
+"RTN","GPLCCR",187,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",188,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCR",189,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCR",190,0)
+ ;;><CCR>
+"RTN","GPLCCR",191,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",192,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",193,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCR",194,0)
+ ;;><ACTLST>
+"RTN","GPLCCR",195,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",196,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",197,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCR",198,0)
+ ;;><ACTORS>
+"RTN","GPLCCR",199,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCR",200,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCR",201,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCR",202,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCR",203,0)
+ ;;><TRIM>
+"RTN","GPLCCR",204,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCR",205,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
+"RTN","GPLCCR0")
+0^15^B658213703
+"RTN","GPLCCR0",1,0)
+GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+"RTN","GPLCCR0",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLCCR0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR0",5,0)
+ ;
+"RTN","GPLCCR0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR0",10,0)
+ ;
+"RTN","GPLCCR0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR0",15,0)
+ ;
+"RTN","GPLCCR0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR0",19,0)
+ ;
+"RTN","GPLCCR0",20,0)
+          W "This is a CCR TEMPLATE with processing routines",!
+"RTN","GPLCCR0",21,0)
+          W !
+"RTN","GPLCCR0",22,0)
+          Q
+"RTN","GPLCCR0",23,0)
+          ;
+"RTN","GPLCCR0",24,0)
+ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
+"RTN","GPLCCR0",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCR0",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCR0",28,0)
+          ; I '$G(@ZARY) D  ;
+"RTN","GPLCCR0",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCR0",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCR0",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCR0",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCR0",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCR0",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCR0",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCR0",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCR0",37,0)
+          Q
+"RTN","GPLCCR0",38,0)
+          ;
+"RTN","GPLCCR0",39,0)
+ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
+"RTN","GPLCCR0",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCR0",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCR0",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCR0",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCR0",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCR0",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCR0",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCR0",48,0)
+          ;
+"RTN","GPLCCR0",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCR0",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCR0",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCR0",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCR0",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCR0",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCR0",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCR0",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCR0",57,0)
+          Q
+"RTN","GPLCCR0",58,0)
+          ;
+"RTN","GPLCCR0",59,0)
+LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCR0",60,0)
+          D ZLOAD(ARY,"GPLCCR0")
+"RTN","GPLCCR0",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCR0",62,0)
+          Q
+"RTN","GPLCCR0",63,0)
+          ;
+"RTN","GPLCCR0",64,0)
+ ;<TEMPLATE>
+"RTN","GPLCCR0",65,0)
+ ;;<?xml version="1.0" encoding="UTF-8"?>
+"RTN","GPLCCR0",66,0)
+ ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
+"RTN","GPLCCR0",67,0)
+ ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
+"RTN","GPLCCR0",68,0)
+ ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
+"RTN","GPLCCR0",69,0)
+ ;;<Language>
+"RTN","GPLCCR0",70,0)
+ ;;<Text>English</Text>
+"RTN","GPLCCR0",71,0)
+ ;;</Language>
+"RTN","GPLCCR0",72,0)
+ ;;<Version>V1.0</Version>
+"RTN","GPLCCR0",73,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",74,0)
+ ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",75,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",76,0)
+ ;;<Patient>
+"RTN","GPLCCR0",77,0)
+ ;;<ActorID>@@ACTORPATIENT@@</ActorID>
+"RTN","GPLCCR0",78,0)
+ ;;</Patient>
+"RTN","GPLCCR0",79,0)
+ ;;<From>
+"RTN","GPLCCR0",80,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",81,0)
+ ;;<ActorID>@@ACTORFROM@@</ActorID>
+"RTN","GPLCCR0",82,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",83,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",84,0)
+ ;;<ActorID>@@ACTORFROM2@@</ActorID>
+"RTN","GPLCCR0",85,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",86,0)
+ ;;</From>
+"RTN","GPLCCR0",87,0)
+ ;;<To>
+"RTN","GPLCCR0",88,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",89,0)
+ ;;<ActorID>@@ACTORTO@@</ActorID>
+"RTN","GPLCCR0",90,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",91,0)
+ ;;<Text>@@ACTORTOTEXT@@</Text>
+"RTN","GPLCCR0",92,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",93,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",94,0)
+ ;;</To>
+"RTN","GPLCCR0",95,0)
+ ;;<Purpose>
+"RTN","GPLCCR0",96,0)
+ ;;<Description>
+"RTN","GPLCCR0",97,0)
+ ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
+"RTN","GPLCCR0",98,0)
+ ;;</Description>
+"RTN","GPLCCR0",99,0)
+ ;;</Purpose>
+"RTN","GPLCCR0",100,0)
+ ;;<Body>
+"RTN","GPLCCR0",101,0)
+ ;;<Problems>
+"RTN","GPLCCR0",102,0)
+ ;;<Problem>
+"RTN","GPLCCR0",103,0)
+ ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",104,0)
+ ;;<Type>
+"RTN","GPLCCR0",105,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",106,0)
+ ;;</Type>
+"RTN","GPLCCR0",107,0)
+ ;;<Description>
+"RTN","GPLCCR0",108,0)
+ ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",109,0)
+ ;;<Code>
+"RTN","GPLCCR0",110,0)
+ ;;<Value>@@PROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",111,0)
+ ;;<CodingSystem>ICD9CM</CodingSystem>
+"RTN","GPLCCR0",112,0)
+ ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",113,0)
+ ;;</Code>
+"RTN","GPLCCR0",114,0)
+ ;;</Description>
+"RTN","GPLCCR0",115,0)
+ ;;<Source>
+"RTN","GPLCCR0",116,0)
+ ;;<Actor>
+"RTN","GPLCCR0",117,0)
+ ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",118,0)
+ ;;</Actor>
+"RTN","GPLCCR0",119,0)
+ ;;</Source>
+"RTN","GPLCCR0",120,0)
+ ;;</Problem>
+"RTN","GPLCCR0",121,0)
+ ;;</Problems>
+"RTN","GPLCCR0",122,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCR0",123,0)
+ ;;<FamilyProblemHistory>
+"RTN","GPLCCR0",124,0)
+ ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",125,0)
+ ;;<Source>
+"RTN","GPLCCR0",126,0)
+ ;;<Actor>
+"RTN","GPLCCR0",127,0)
+ ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
+"RTN","GPLCCR0",128,0)
+ ;;</Actor>
+"RTN","GPLCCR0",129,0)
+ ;;</Source>
+"RTN","GPLCCR0",130,0)
+ ;;<FamilyMember>
+"RTN","GPLCCR0",131,0)
+ ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
+"RTN","GPLCCR0",132,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",133,0)
+ ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
+"RTN","GPLCCR0",134,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",135,0)
+ ;;<Source>
+"RTN","GPLCCR0",136,0)
+ ;;<Actor>
+"RTN","GPLCCR0",137,0)
+ ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",138,0)
+ ;;</Actor>
+"RTN","GPLCCR0",139,0)
+ ;;</Source>
+"RTN","GPLCCR0",140,0)
+ ;;</FamilyMember>
+"RTN","GPLCCR0",141,0)
+ ;;<Problem>
+"RTN","GPLCCR0",142,0)
+ ;;<Type>
+"RTN","GPLCCR0",143,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",144,0)
+ ;;</Type>
+"RTN","GPLCCR0",145,0)
+ ;;<Description>
+"RTN","GPLCCR0",146,0)
+ ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",147,0)
+ ;;<Code>
+"RTN","GPLCCR0",148,0)
+ ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
+"RTN","GPLCCR0",149,0)
+ ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",150,0)
+ ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
+"RTN","GPLCCR0",151,0)
+ ;;</Code>
+"RTN","GPLCCR0",152,0)
+ ;;</Description>
+"RTN","GPLCCR0",153,0)
+ ;;<Source>
+"RTN","GPLCCR0",154,0)
+ ;;<Actor>
+"RTN","GPLCCR0",155,0)
+ ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
+"RTN","GPLCCR0",156,0)
+ ;;</Actor>
+"RTN","GPLCCR0",157,0)
+ ;;</Source>
+"RTN","GPLCCR0",158,0)
+ ;;</Problem>
+"RTN","GPLCCR0",159,0)
+ ;;</FamilyProblemHistory>
+"RTN","GPLCCR0",160,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCR0",161,0)
+ ;;<SocialHistory>
+"RTN","GPLCCR0",162,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",163,0)
+ ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",164,0)
+ ;;<Type>
+"RTN","GPLCCR0",165,0)
+ ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
+"RTN","GPLCCR0",166,0)
+ ;;</Type>
+"RTN","GPLCCR0",167,0)
+ ;;<Description>
+"RTN","GPLCCR0",168,0)
+ ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",169,0)
+ ;;</Description>
+"RTN","GPLCCR0",170,0)
+ ;;<Source>
+"RTN","GPLCCR0",171,0)
+ ;;<Actor>
+"RTN","GPLCCR0",172,0)
+ ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",173,0)
+ ;;</Actor>
+"RTN","GPLCCR0",174,0)
+ ;;</Source>
+"RTN","GPLCCR0",175,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",176,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",177,0)
+ ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
+"RTN","GPLCCR0",178,0)
+ ;;<Type>
+"RTN","GPLCCR0",179,0)
+ ;;<Text>Ethnic Origin</Text>
+"RTN","GPLCCR0",180,0)
+ ;;</Type>
+"RTN","GPLCCR0",181,0)
+ ;;<Description>
+"RTN","GPLCCR0",182,0)
+ ;;<Text>Not Hispanic or Latino</Text>
+"RTN","GPLCCR0",183,0)
+ ;;</Description>
+"RTN","GPLCCR0",184,0)
+ ;;<Source>
+"RTN","GPLCCR0",185,0)
+ ;;<Actor>
+"RTN","GPLCCR0",186,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",187,0)
+ ;;</Actor>
+"RTN","GPLCCR0",188,0)
+ ;;</Source>
+"RTN","GPLCCR0",189,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",190,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",191,0)
+ ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
+"RTN","GPLCCR0",192,0)
+ ;;<Type>
+"RTN","GPLCCR0",193,0)
+ ;;<Text>Race</Text>
+"RTN","GPLCCR0",194,0)
+ ;;</Type>
+"RTN","GPLCCR0",195,0)
+ ;;<Description>
+"RTN","GPLCCR0",196,0)
+ ;;<Text>White</Text>
+"RTN","GPLCCR0",197,0)
+ ;;</Description>
+"RTN","GPLCCR0",198,0)
+ ;;<Source>
+"RTN","GPLCCR0",199,0)
+ ;;<Actor>
+"RTN","GPLCCR0",200,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",201,0)
+ ;;</Actor>
+"RTN","GPLCCR0",202,0)
+ ;;</Source>
+"RTN","GPLCCR0",203,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",204,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",205,0)
+ ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
+"RTN","GPLCCR0",206,0)
+ ;;<Type>
+"RTN","GPLCCR0",207,0)
+ ;;<Text>Occupation</Text>
+"RTN","GPLCCR0",208,0)
+ ;;</Type>
+"RTN","GPLCCR0",209,0)
+ ;;<Description>
+"RTN","GPLCCR0",210,0)
+ ;;<Text>Physician</Text>
+"RTN","GPLCCR0",211,0)
+ ;;</Description>
+"RTN","GPLCCR0",212,0)
+ ;;<Source>
+"RTN","GPLCCR0",213,0)
+ ;;<Actor>
+"RTN","GPLCCR0",214,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",215,0)
+ ;;</Actor>
+"RTN","GPLCCR0",216,0)
+ ;;</Source>
+"RTN","GPLCCR0",217,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",218,0)
+ ;;</SocialHistory>
+"RTN","GPLCCR0",219,0)
+ ;;<Alerts>
+"RTN","GPLCCR0",220,0)
+ ;;<Alert>
+"RTN","GPLCCR0",221,0)
+ ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",222,0)
+ ;;<Description>
+"RTN","GPLCCR0",223,0)
+ ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",224,0)
+ ;;<Code>
+"RTN","GPLCCR0",225,0)
+ ;;<Value>@@ALERTCODEVALUE@@</Value>
+"RTN","GPLCCR0",226,0)
+ ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",227,0)
+ ;;</Code>
+"RTN","GPLCCR0",228,0)
+ ;;</Description>
+"RTN","GPLCCR0",229,0)
+ ;;<Status>
+"RTN","GPLCCR0",230,0)
+ ;;<Text>@@ALERTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",231,0)
+ ;;</Status>
+"RTN","GPLCCR0",232,0)
+ ;;<Source>
+"RTN","GPLCCR0",233,0)
+ ;;<Actor>
+"RTN","GPLCCR0",234,0)
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",235,0)
+ ;;</Actor>
+"RTN","GPLCCR0",236,0)
+ ;;</Source>
+"RTN","GPLCCR0",237,0)
+ ;;<Agent>
+"RTN","GPLCCR0",238,0)
+ ;;<Products>
+"RTN","GPLCCR0",239,0)
+ ;;<Product>
+"RTN","GPLCCR0",240,0)
+ ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",241,0)
+ ;;<Source>
+"RTN","GPLCCR0",242,0)
+ ;;<Actor>
+"RTN","GPLCCR0",243,0)
+ ;;<ActorID>@@ALERTAGENTPRODUCTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",244,0)
+ ;;</Actor>
+"RTN","GPLCCR0",245,0)
+ ;;</Source>
+"RTN","GPLCCR0",246,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",247,0)
+ ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",248,0)
+ ;;<Code>
+"RTN","GPLCCR0",249,0)
+ ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
+"RTN","GPLCCR0",250,0)
+ ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",251,0)
+ ;;</Code>
+"RTN","GPLCCR0",252,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",253,0)
+ ;;</Product>
+"RTN","GPLCCR0",254,0)
+ ;;</Products>
+"RTN","GPLCCR0",255,0)
+ ;;</Agent>
+"RTN","GPLCCR0",256,0)
+ ;;<Reaction>
+"RTN","GPLCCR0",257,0)
+ ;;<Description>
+"RTN","GPLCCR0",258,0)
+ ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",259,0)
+ ;;<Code>
+"RTN","GPLCCR0",260,0)
+ ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",261,0)
+ ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",262,0)
+ ;;</Code>
+"RTN","GPLCCR0",263,0)
+ ;;</Description>
+"RTN","GPLCCR0",264,0)
+ ;;</Reaction>
+"RTN","GPLCCR0",265,0)
+ ;;</Alert>
+"RTN","GPLCCR0",266,0)
+ ;;</Alerts>
+"RTN","GPLCCR0",267,0)
+ ;;<Medications>
+"RTN","GPLCCR0",268,0)
+ ;;<Medication>
+"RTN","GPLCCR0",269,0)
+ ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",270,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",271,0)
+ ;;<Type>
+"RTN","GPLCCR0",272,0)
+ ;;<Text>@@MEDISSUEDATETXT@@</Text>
+"RTN","GPLCCR0",273,0)
+ ;;</Type>
+"RTN","GPLCCR0",274,0)
+ ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
+"RTN","GPLCCR0",275,0)
+ ;;<Type>
+"RTN","GPLCCR0",276,0)
+ ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
+"RTN","GPLCCR0",277,0)
+ ;;</Type>
+"RTN","GPLCCR0",278,0)
+ ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
+"RTN","GPLCCR0",279,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",280,0)
+ ;;<IDs>
+"RTN","GPLCCR0",281,0)
+ ;;<Type>
+"RTN","GPLCCR0",282,0)
+ ;;<Text>@@MEDRXNOTXT@@</Text>
+"RTN","GPLCCR0",283,0)
+ ;;</Type>
+"RTN","GPLCCR0",284,0)
+ ;;<ID>@@MEDRXNO@@</ID>
+"RTN","GPLCCR0",285,0)
+ ;;</IDs>
+"RTN","GPLCCR0",286,0)
+ ;;<Type>
+"RTN","GPLCCR0",287,0)
+ ;;<Text>@@MEDTYPETEXT@@</Text>
+"RTN","GPLCCR0",288,0)
+ ;;</Type>
+"RTN","GPLCCR0",289,0)
+ ;;<Description>
+"RTN","GPLCCR0",290,0)
+ ;;<Text>@@MEDDETAILUNADORNED@@</Text>
+"RTN","GPLCCR0",291,0)
+ ;;</Description>
+"RTN","GPLCCR0",292,0)
+ ;;<Status>
+"RTN","GPLCCR0",293,0)
+ ;;<Text>@@MEDSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",294,0)
+ ;;</Status>
+"RTN","GPLCCR0",295,0)
+ ;;<Source>
+"RTN","GPLCCR0",296,0)
+ ;;<Actor>
+"RTN","GPLCCR0",297,0)
+ ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",298,0)
+ ;;</Actor>
+"RTN","GPLCCR0",299,0)
+ ;;</Source>
+"RTN","GPLCCR0",300,0)
+ ;;<Product>
+"RTN","GPLCCR0",301,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",302,0)
+ ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",303,0)
+ ;;<Code>
+"RTN","GPLCCR0",304,0)
+ ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
+"RTN","GPLCCR0",305,0)
+ ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",306,0)
+ ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
+"RTN","GPLCCR0",307,0)
+ ;;</Code>
+"RTN","GPLCCR0",308,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",309,0)
+ ;;<BrandName>
+"RTN","GPLCCR0",310,0)
+ ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
+"RTN","GPLCCR0",311,0)
+ ;;</BrandName>
+"RTN","GPLCCR0",312,0)
+ ;;<Strength>
+"RTN","GPLCCR0",313,0)
+ ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
+"RTN","GPLCCR0",314,0)
+ ;;<Units>
+"RTN","GPLCCR0",315,0)
+ ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
+"RTN","GPLCCR0",316,0)
+ ;;</Units>
+"RTN","GPLCCR0",317,0)
+ ;;</Strength>
+"RTN","GPLCCR0",318,0)
+ ;;<Form>
+"RTN","GPLCCR0",319,0)
+ ;;<Text>@@MEDFORMTEXT@@</Text>
+"RTN","GPLCCR0",320,0)
+ ;;</Form>
+"RTN","GPLCCR0",321,0)
+ ;;<Concentration>
+"RTN","GPLCCR0",322,0)
+ ;;<Value>@@MEDCONCVALUE@@</Value>
+"RTN","GPLCCR0",323,0)
+ ;;<Units>
+"RTN","GPLCCR0",324,0)
+ ;;<Unit>@@MEDCONCUNIT@@</Unit>
+"RTN","GPLCCR0",325,0)
+ ;;</Units>
+"RTN","GPLCCR0",326,0)
+ ;;</Concentration>
+"RTN","GPLCCR0",327,0)
+ ;;<Size>
+"RTN","GPLCCR0",328,0)
+ ;;<Text>@@MEDSIZETEXT@@</Text>
+"RTN","GPLCCR0",329,0)
+ ;;</Size>
+"RTN","GPLCCR0",330,0)
+ ;;</Product>
+"RTN","GPLCCR0",331,0)
+ ;;<Quantity>
+"RTN","GPLCCR0",332,0)
+ ;;<Value>@@MEDQUANTITYVALUE@@</Value>
+"RTN","GPLCCR0",333,0)
+ ;;<Units>
+"RTN","GPLCCR0",334,0)
+ ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
+"RTN","GPLCCR0",335,0)
+ ;;</Units>
+"RTN","GPLCCR0",336,0)
+ ;;</Quantity>
+"RTN","GPLCCR0",337,0)
+ ;;<Directions>
+"RTN","GPLCCR0",338,0)
+ ;;<Direction>
+"RTN","GPLCCR0",339,0)
+ ;;<Description>
+"RTN","GPLCCR0",340,0)
+ ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",341,0)
+ ;;</Description>
+"RTN","GPLCCR0",342,0)
+ ;;<DoseIndicator>
+"RTN","GPLCCR0",343,0)
+ ;;<Text>@@MEDDOSEINDICATOR@@</Text>
+"RTN","GPLCCR0",344,0)
+ ;;</DoseIndicator>
+"RTN","GPLCCR0",345,0)
+ ;;<DeliveryMethod>
+"RTN","GPLCCR0",346,0)
+ ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
+"RTN","GPLCCR0",347,0)
+ ;;</DeliveryMethod>
+"RTN","GPLCCR0",348,0)
+ ;;<Dose>
+"RTN","GPLCCR0",349,0)
+ ;;<Value>@@MEDDOSEVALUE@@</Value>
+"RTN","GPLCCR0",350,0)
+ ;;<Units>
+"RTN","GPLCCR0",351,0)
+ ;;<Unit>@@MEDDOSEUNIT@@</Unit>
+"RTN","GPLCCR0",352,0)
+ ;;</Units>
+"RTN","GPLCCR0",353,0)
+ ;;<Rate>
+"RTN","GPLCCR0",354,0)
+ ;;<Value>@@MEDRATEVALUE@@</Value>
+"RTN","GPLCCR0",355,0)
+ ;;<Units>
+"RTN","GPLCCR0",356,0)
+ ;;<Unit>@@MEDRATEUNIT@@</Unit>
+"RTN","GPLCCR0",357,0)
+ ;;</Units>
+"RTN","GPLCCR0",358,0)
+ ;;</Rate>
+"RTN","GPLCCR0",359,0)
+ ;;</Dose>
+"RTN","GPLCCR0",360,0)
+ ;;<Vehicle>
+"RTN","GPLCCR0",361,0)
+ ;;<Text>@@MEDVEHICLETEXT@@</Text>
+"RTN","GPLCCR0",362,0)
+ ;;</Vehicle>
+"RTN","GPLCCR0",363,0)
+ ;;<Route>
+"RTN","GPLCCR0",364,0)
+ ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
+"RTN","GPLCCR0",365,0)
+ ;;</Route>
+"RTN","GPLCCR0",366,0)
+ ;;<Frequency>
+"RTN","GPLCCR0",367,0)
+ ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
+"RTN","GPLCCR0",368,0)
+ ;;<Units>
+"RTN","GPLCCR0",369,0)
+ ;;<Unit>@@MEDFREQUENCYUNIT@@</Unit>
+"RTN","GPLCCR0",370,0)
+ ;;</Units>
+"RTN","GPLCCR0",371,0)
+ ;;</Frequency>
+"RTN","GPLCCR0",372,0)
+ ;;<Interval>
+"RTN","GPLCCR0",373,0)
+ ;;<Value>@@MEDINTERVALVALUE@@</Value>
+"RTN","GPLCCR0",374,0)
+ ;;<Units>
+"RTN","GPLCCR0",375,0)
+ ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
+"RTN","GPLCCR0",376,0)
+ ;;</Units>
+"RTN","GPLCCR0",377,0)
+ ;;</Interval>
+"RTN","GPLCCR0",378,0)
+ ;;<Duration>
+"RTN","GPLCCR0",379,0)
+ ;;<Value>@@MEDDURATIONVALUE@@</Value>
+"RTN","GPLCCR0",380,0)
+ ;;<Units>
+"RTN","GPLCCR0",381,0)
+ ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
+"RTN","GPLCCR0",382,0)
+ ;;</Units>
+"RTN","GPLCCR0",383,0)
+ ;;</Duration>
+"RTN","GPLCCR0",384,0)
+ ;;<Indication>
+"RTN","GPLCCR0",385,0)
+ ;;<PRNFlag>
+"RTN","GPLCCR0",386,0)
+ ;;<Text>@@MEDPRNFLAG@@</Text>
+"RTN","GPLCCR0",387,0)
+ ;;</PRNFlag>
+"RTN","GPLCCR0",388,0)
+ ;;<Problem>
+"RTN","GPLCCR0",389,0)
+ ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",390,0)
+ ;;<Type>
+"RTN","GPLCCR0",391,0)
+ ;;<Text>@@PROBLEM@@</Text>
+"RTN","GPLCCR0",392,0)
+ ;;</Type>
+"RTN","GPLCCR0",393,0)
+ ;;<Description>
+"RTN","GPLCCR0",394,0)
+ ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",395,0)
+ ;;<Code>
+"RTN","GPLCCR0",396,0)
+ ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",397,0)
+ ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",398,0)
+ ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",399,0)
+ ;;</Code>
+"RTN","GPLCCR0",400,0)
+ ;;</Description>
+"RTN","GPLCCR0",401,0)
+ ;;<Source>
+"RTN","GPLCCR0",402,0)
+ ;;<Actor>
+"RTN","GPLCCR0",403,0)
+ ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",404,0)
+ ;;</Actor>
+"RTN","GPLCCR0",405,0)
+ ;;</Source>
+"RTN","GPLCCR0",406,0)
+ ;;</Problem>
+"RTN","GPLCCR0",407,0)
+ ;;</Indication>
+"RTN","GPLCCR0",408,0)
+ ;;<StopIndicator>
+"RTN","GPLCCR0",409,0)
+ ;;<Text>@@MEDSTOPINDICATOR@@</Text>
+"RTN","GPLCCR0",410,0)
+ ;;</StopIndicator>
+"RTN","GPLCCR0",411,0)
+ ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
+"RTN","GPLCCR0",412,0)
+ ;;<MultipleDirectionModifier>
+"RTN","GPLCCR0",413,0)
+ ;;<Text>@@MEDMULDIRMOD@@</Text>
+"RTN","GPLCCR0",414,0)
+ ;;</MultipleDirectionModifier>
+"RTN","GPLCCR0",415,0)
+ ;;</Direction>
+"RTN","GPLCCR0",416,0)
+ ;;</Directions>
+"RTN","GPLCCR0",417,0)
+ ;;<PatientInstructions>
+"RTN","GPLCCR0",418,0)
+ ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",419,0)
+ ;;</PatientInstructions>
+"RTN","GPLCCR0",420,0)
+ ;;<FullfillmentInstructions>
+"RTN","GPLCCR0",421,0)
+ ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",422,0)
+ ;;</FullfillmentInstructions>
+"RTN","GPLCCR0",423,0)
+ ;;<Refills>
+"RTN","GPLCCR0",424,0)
+ ;;<Refill>
+"RTN","GPLCCR0",425,0)
+ ;;<Number>@@MEDRFNO@@</Number>
+"RTN","GPLCCR0",426,0)
+ ;;</Refill>
+"RTN","GPLCCR0",427,0)
+ ;;</Refills>
+"RTN","GPLCCR0",428,0)
+ ;;</Medication>
+"RTN","GPLCCR0",429,0)
+ ;;</Medications>
+"RTN","GPLCCR0",430,0)
+ ;;<VitalSigns>
+"RTN","GPLCCR0",431,0)
+ ;;<Result>
+"RTN","GPLCCR0",432,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",433,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",434,0)
+ ;;<Type>
+"RTN","GPLCCR0",435,0)
+ ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
+"RTN","GPLCCR0",436,0)
+ ;;</Type>
+"RTN","GPLCCR0",437,0)
+ ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",438,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",439,0)
+ ;;<Description>
+"RTN","GPLCCR0",440,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",441,0)
+ ;;</Description>
+"RTN","GPLCCR0",442,0)
+ ;;<Source>
+"RTN","GPLCCR0",443,0)
+ ;;<Actor>
+"RTN","GPLCCR0",444,0)
+ ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",445,0)
+ ;;</Actor>
+"RTN","GPLCCR0",446,0)
+ ;;</Source>
+"RTN","GPLCCR0",447,0)
+ ;;<Test>
+"RTN","GPLCCR0",448,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",449,0)
+ ;;<Type>
+"RTN","GPLCCR0",450,0)
+ ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
+"RTN","GPLCCR0",451,0)
+ ;;</Type>
+"RTN","GPLCCR0",452,0)
+ ;;<Description>
+"RTN","GPLCCR0",453,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",454,0)
+ ;;<Code>
+"RTN","GPLCCR0",455,0)
+ ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",456,0)
+ ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",457,0)
+ ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
+"RTN","GPLCCR0",458,0)
+ ;;</Code>
+"RTN","GPLCCR0",459,0)
+ ;;</Description>
+"RTN","GPLCCR0",460,0)
+ ;;<Source>
+"RTN","GPLCCR0",461,0)
+ ;;<Actor>
+"RTN","GPLCCR0",462,0)
+ ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",463,0)
+ ;;</Actor>
+"RTN","GPLCCR0",464,0)
+ ;;</Source>
+"RTN","GPLCCR0",465,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",466,0)
+ ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
+"RTN","GPLCCR0",467,0)
+ ;;<Units>
+"RTN","GPLCCR0",468,0)
+ ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
+"RTN","GPLCCR0",469,0)
+ ;;</Units>
+"RTN","GPLCCR0",470,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",471,0)
+ ;;</Test>
+"RTN","GPLCCR0",472,0)
+ ;;</Result>
+"RTN","GPLCCR0",473,0)
+ ;;</VitalSigns>
+"RTN","GPLCCR0",474,0)
+ ;;<Results>
+"RTN","GPLCCR0",475,0)
+ ;;<Result>
+"RTN","GPLCCR0",476,0)
+ ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",477,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",478,0)
+ ;;<Type>
+"RTN","GPLCCR0",479,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",480,0)
+ ;;</Type>
+"RTN","GPLCCR0",481,0)
+ ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",482,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",483,0)
+ ;;<Description>
+"RTN","GPLCCR0",484,0)
+ ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",485,0)
+ ;;<Code>
+"RTN","GPLCCR0",486,0)
+ ;;<Value>@@RESULTCODE@@</Value>
+"RTN","GPLCCR0",487,0)
+ ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",488,0)
+ ;;</Code>
+"RTN","GPLCCR0",489,0)
+ ;;</Description>
+"RTN","GPLCCR0",490,0)
+ ;;<Status>
+"RTN","GPLCCR0",491,0)
+ ;;<Text>@@RESULTSTATUS@@</Text>
+"RTN","GPLCCR0",492,0)
+ ;;</Status>
+"RTN","GPLCCR0",493,0)
+ ;;<Source>
+"RTN","GPLCCR0",494,0)
+ ;;<Actor>
+"RTN","GPLCCR0",495,0)
+ ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",496,0)
+ ;;</Actor>
+"RTN","GPLCCR0",497,0)
+ ;;</Source>
+"RTN","GPLCCR0",498,0)
+ ;;<TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",499,0)
+ ;;<Test>
+"RTN","GPLCCR0",500,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",501,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",502,0)
+ ;;<Type>
+"RTN","GPLCCR0",503,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",504,0)
+ ;;</Type>
+"RTN","GPLCCR0",505,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",506,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",507,0)
+ ;;<Description>
+"RTN","GPLCCR0",508,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",509,0)
+ ;;<Code>
+"RTN","GPLCCR0",510,0)
+ ;;<Value>@@RESULTTESTCODE@@</Value>
+"RTN","GPLCCR0",511,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",512,0)
+ ;;</Code>
+"RTN","GPLCCR0",513,0)
+ ;;</Description>
+"RTN","GPLCCR0",514,0)
+ ;;<Status>
+"RTN","GPLCCR0",515,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",516,0)
+ ;;</Status>
+"RTN","GPLCCR0",517,0)
+ ;;<Source>
+"RTN","GPLCCR0",518,0)
+ ;;<Actor>
+"RTN","GPLCCR0",519,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",520,0)
+ ;;</Actor>
+"RTN","GPLCCR0",521,0)
+ ;;</Source>
+"RTN","GPLCCR0",522,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",523,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",524,0)
+ ;;<Units>
+"RTN","GPLCCR0",525,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",526,0)
+ ;;</Units>
+"RTN","GPLCCR0",527,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",528,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",529,0)
+ ;;<Normal>
+"RTN","GPLCCR0",530,0)
+ ;;<Description>
+"RTN","GPLCCR0",531,0)
+ ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",532,0)
+ ;;</Description>
+"RTN","GPLCCR0",533,0)
+ ;;<Source>
+"RTN","GPLCCR0",534,0)
+ ;;<Actor>
+"RTN","GPLCCR0",535,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",536,0)
+ ;;</Actor>
+"RTN","GPLCCR0",537,0)
+ ;;</Source>
+"RTN","GPLCCR0",538,0)
+ ;;</Normal>
+"RTN","GPLCCR0",539,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",540,0)
+ ;;<Flag>
+"RTN","GPLCCR0",541,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",542,0)
+ ;;</Flag>
+"RTN","GPLCCR0",543,0)
+ ;;</Test>
+"RTN","GPLCCR0",544,0)
+ ;;</TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",545,0)
+ ;;<TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",546,0)
+ ;;<Test>
+"RTN","GPLCCR0",547,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",548,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",549,0)
+ ;;<Type>
+"RTN","GPLCCR0",550,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",551,0)
+ ;;</Type>
+"RTN","GPLCCR0",552,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",553,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",554,0)
+ ;;<Description>
+"RTN","GPLCCR0",555,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",556,0)
+ ;;<Code>
+"RTN","GPLCCR0",557,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",558,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",559,0)
+ ;;</Code>
+"RTN","GPLCCR0",560,0)
+ ;;</Description>
+"RTN","GPLCCR0",561,0)
+ ;;<Status>
+"RTN","GPLCCR0",562,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",563,0)
+ ;;</Status>
+"RTN","GPLCCR0",564,0)
+ ;;<Source>
+"RTN","GPLCCR0",565,0)
+ ;;<Actor>
+"RTN","GPLCCR0",566,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",567,0)
+ ;;</Actor>
+"RTN","GPLCCR0",568,0)
+ ;;</Source>
+"RTN","GPLCCR0",569,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",570,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",571,0)
+ ;;<Units>
+"RTN","GPLCCR0",572,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",573,0)
+ ;;</Units>
+"RTN","GPLCCR0",574,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",575,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",576,0)
+ ;;<Normal>
+"RTN","GPLCCR0",577,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
+"RTN","GPLCCR0",578,0)
+ ;;<Units>
+"RTN","GPLCCR0",579,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
+"RTN","GPLCCR0",580,0)
+ ;;</Units>
+"RTN","GPLCCR0",581,0)
+ ;;<ValueSequencePosition>1</ValueSequencePosition>
+"RTN","GPLCCR0",582,0)
+ ;;<Source>
+"RTN","GPLCCR0",583,0)
+ ;;<Actor>
+"RTN","GPLCCR0",584,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",585,0)
+ ;;</Actor>
+"RTN","GPLCCR0",586,0)
+ ;;</Source>
+"RTN","GPLCCR0",587,0)
+ ;;</Normal>
+"RTN","GPLCCR0",588,0)
+ ;;<Normal>
+"RTN","GPLCCR0",589,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
+"RTN","GPLCCR0",590,0)
+ ;;<Units>
+"RTN","GPLCCR0",591,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
+"RTN","GPLCCR0",592,0)
+ ;;</Units>
+"RTN","GPLCCR0",593,0)
+ ;;<ValueSequencePosition>2</ValueSequencePosition>
+"RTN","GPLCCR0",594,0)
+ ;;<VariableNomalModifier>
+"RTN","GPLCCR0",595,0)
+ ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
+"RTN","GPLCCR0",596,0)
+ ;;</VariableNomalModifier>
+"RTN","GPLCCR0",597,0)
+ ;;<Source>
+"RTN","GPLCCR0",598,0)
+ ;;<Actor>
+"RTN","GPLCCR0",599,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",600,0)
+ ;;</Actor>
+"RTN","GPLCCR0",601,0)
+ ;;</Source>
+"RTN","GPLCCR0",602,0)
+ ;;</Normal>
+"RTN","GPLCCR0",603,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",604,0)
+ ;;<Flag>
+"RTN","GPLCCR0",605,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",606,0)
+ ;;</Flag>
+"RTN","GPLCCR0",607,0)
+ ;;</Test>
+"RTN","GPLCCR0",608,0)
+ ;;</TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",609,0)
+ ;;</Result>
+"RTN","GPLCCR0",610,0)
+ ;;</Results>
+"RTN","GPLCCR0",611,0)
+ ;;<HealthCareProviders>
+"RTN","GPLCCR0",612,0)
+ ;;<Provider>
+"RTN","GPLCCR0",613,0)
+ ;;<ActorID>AA0005</ActorID>
+"RTN","GPLCCR0",614,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",615,0)
+ ;;<Text>Primary Provider</Text>
+"RTN","GPLCCR0",616,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",617,0)
+ ;;</Provider>
+"RTN","GPLCCR0",618,0)
+ ;;</HealthCareProviders>
+"RTN","GPLCCR0",619,0)
+ ;;</Body>
+"RTN","GPLCCR0",620,0)
+ ;;<Actors>
+"RTN","GPLCCR0",621,0)
+ ;;<ACTOR-PATIENT>
+"RTN","GPLCCR0",622,0)
+ ;;<Actor>
+"RTN","GPLCCR0",623,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",624,0)
+ ;;<Person>
+"RTN","GPLCCR0",625,0)
+ ;;<Name>
+"RTN","GPLCCR0",626,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",627,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",628,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",629,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",630,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",631,0)
+ ;;</Name>
+"RTN","GPLCCR0",632,0)
+ ;;<DateOfBirth>
+"RTN","GPLCCR0",633,0)
+ ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
+"RTN","GPLCCR0",634,0)
+ ;;</DateOfBirth>
+"RTN","GPLCCR0",635,0)
+ ;;<Gender>
+"RTN","GPLCCR0",636,0)
+ ;;<Text>@@ACTORGENDER@@</Text>
+"RTN","GPLCCR0",637,0)
+ ;;<Code>
+"RTN","GPLCCR0",638,0)
+ ;;<Value>@@ACTORGENDER@@</Value>
+"RTN","GPLCCR0",639,0)
+ ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
+"RTN","GPLCCR0",640,0)
+ ;;</Code>
+"RTN","GPLCCR0",641,0)
+ ;;</Gender>
+"RTN","GPLCCR0",642,0)
+ ;;</Person>
+"RTN","GPLCCR0",643,0)
+ ;;<IDs>
+"RTN","GPLCCR0",644,0)
+ ;;<Type>
+"RTN","GPLCCR0",645,0)
+ ;;<Text>@@ACTORSSNTEXT@@</Text>
+"RTN","GPLCCR0",646,0)
+ ;;</Type>
+"RTN","GPLCCR0",647,0)
+ ;;<ID>@@ACTORSSN@@</ID>
+"RTN","GPLCCR0",648,0)
+ ;;<Source>
+"RTN","GPLCCR0",649,0)
+ ;;<Actor>
+"RTN","GPLCCR0",650,0)
+ ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
+"RTN","GPLCCR0",651,0)
+ ;;</Actor>
+"RTN","GPLCCR0",652,0)
+ ;;</Source>
+"RTN","GPLCCR0",653,0)
+ ;;</IDs>
+"RTN","GPLCCR0",654,0)
+ ;;<Address>
+"RTN","GPLCCR0",655,0)
+ ;;<Type>
+"RTN","GPLCCR0",656,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",657,0)
+ ;;</Type>
+"RTN","GPLCCR0",658,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",659,0)
+ ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
+"RTN","GPLCCR0",660,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",661,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",662,0)
+ ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
+"RTN","GPLCCR0",663,0)
+ ;;</Address>
+"RTN","GPLCCR0",664,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",665,0)
+ ;;<Value>@@ACTORRESTEL@@</Value>
+"RTN","GPLCCR0",666,0)
+ ;;<Type>
+"RTN","GPLCCR0",667,0)
+ ;;<Text>@@ACTORRESTELTEXT@@</Text>
+"RTN","GPLCCR0",668,0)
+ ;;</Type>
+"RTN","GPLCCR0",669,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",670,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",671,0)
+ ;;<Value>@@ACTORWORKTEL@@</Value>
+"RTN","GPLCCR0",672,0)
+ ;;<Type>
+"RTN","GPLCCR0",673,0)
+ ;;<Text>@@ACTORWORKTELTEXT@@</Text>
+"RTN","GPLCCR0",674,0)
+ ;;</Type>
+"RTN","GPLCCR0",675,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",676,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",677,0)
+ ;;<Value>@@ACTORCELLTEL@@</Value>
+"RTN","GPLCCR0",678,0)
+ ;;<Type>
+"RTN","GPLCCR0",679,0)
+ ;;<Text>@@ACTORCELLTELTEXT@@</Text>
+"RTN","GPLCCR0",680,0)
+ ;;</Type>
+"RTN","GPLCCR0",681,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",682,0)
+ ;;<EMail>
+"RTN","GPLCCR0",683,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",684,0)
+ ;;</EMail>
+"RTN","GPLCCR0",685,0)
+ ;;<Source>
+"RTN","GPLCCR0",686,0)
+ ;;<Actor>
+"RTN","GPLCCR0",687,0)
+ ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",688,0)
+ ;;</Actor>
+"RTN","GPLCCR0",689,0)
+ ;;</Source>
+"RTN","GPLCCR0",690,0)
+ ;;</Actor>
+"RTN","GPLCCR0",691,0)
+ ;;</ACTOR-PATIENT>
+"RTN","GPLCCR0",692,0)
+ ;;<ACTOR-SYSTEM>
+"RTN","GPLCCR0",693,0)
+ ;;<Actor>
+"RTN","GPLCCR0",694,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",695,0)
+ ;;<InformationSystem>
+"RTN","GPLCCR0",696,0)
+ ;;<Name>@@ACTORINFOSYSNAME@@</Name>
+"RTN","GPLCCR0",697,0)
+ ;;<Version>@@ACTORINFOSYSVER@@</Version>
+"RTN","GPLCCR0",698,0)
+ ;;</InformationSystem>
+"RTN","GPLCCR0",699,0)
+ ;;<Source>
+"RTN","GPLCCR0",700,0)
+ ;;<Actor>
+"RTN","GPLCCR0",701,0)
+ ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",702,0)
+ ;;</Actor>
+"RTN","GPLCCR0",703,0)
+ ;;</Source>
+"RTN","GPLCCR0",704,0)
+ ;;</Actor>
+"RTN","GPLCCR0",705,0)
+ ;;</ACTOR-SYSTEM>
+"RTN","GPLCCR0",706,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCR0",707,0)
+ ;;<Actor>
+"RTN","GPLCCR0",708,0)
+ ;;<ActorObjectID>AA0003</ActorObjectID>
+"RTN","GPLCCR0",709,0)
+ ;;<Person>
+"RTN","GPLCCR0",710,0)
+ ;;<Name>
+"RTN","GPLCCR0",711,0)
+ ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
+"RTN","GPLCCR0",712,0)
+ ;;</Name>
+"RTN","GPLCCR0",713,0)
+ ;;</Person>
+"RTN","GPLCCR0",714,0)
+ ;;<Relation>
+"RTN","GPLCCR0",715,0)
+ ;;<Text>@@ACTORRELATION@@</Text>
+"RTN","GPLCCR0",716,0)
+ ;;</Relation>
+"RTN","GPLCCR0",717,0)
+ ;;<Source>
+"RTN","GPLCCR0",718,0)
+ ;;<Actor>
+"RTN","GPLCCR0",719,0)
+ ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
+"RTN","GPLCCR0",720,0)
+ ;;</Actor>
+"RTN","GPLCCR0",721,0)
+ ;;</Source>
+"RTN","GPLCCR0",722,0)
+ ;;</Actor>
+"RTN","GPLCCR0",723,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCR0",724,0)
+ ;;<ACTOR-PROVIDER>
+"RTN","GPLCCR0",725,0)
+ ;;<Actor>
+"RTN","GPLCCR0",726,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",727,0)
+ ;;<Person>
+"RTN","GPLCCR0",728,0)
+ ;;<Name>
+"RTN","GPLCCR0",729,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",730,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",731,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",732,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",733,0)
+ ;;<Title>@@ACTORTITLE@@</Title>
+"RTN","GPLCCR0",734,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",735,0)
+ ;;</Name>
+"RTN","GPLCCR0",736,0)
+ ;;</Person>
+"RTN","GPLCCR0",737,0)
+ ;;<IDs>
+"RTN","GPLCCR0",738,0)
+ ;;<Type>
+"RTN","GPLCCR0",739,0)
+ ;;<Text>@@IDTYPE@@</Text>
+"RTN","GPLCCR0",740,0)
+ ;;</Type>
+"RTN","GPLCCR0",741,0)
+ ;;<ID>@@ID@@</ID>
+"RTN","GPLCCR0",742,0)
+ ;;<IssuedBy>
+"RTN","GPLCCR0",743,0)
+ ;;<Description>
+"RTN","GPLCCR0",744,0)
+ ;;<Text>@@IDDESC@@</Text>
+"RTN","GPLCCR0",745,0)
+ ;;</Description>
+"RTN","GPLCCR0",746,0)
+ ;;</IssuedBy>
+"RTN","GPLCCR0",747,0)
+ ;;</IDs>
+"RTN","GPLCCR0",748,0)
+ ;;<Specialty>
+"RTN","GPLCCR0",749,0)
+ ;;<Text>@@ACTORSPECIALITY@@</Text>
+"RTN","GPLCCR0",750,0)
+ ;;</Specialty>
+"RTN","GPLCCR0",751,0)
+ ;;<Address>
+"RTN","GPLCCR0",752,0)
+ ;;<Type>
+"RTN","GPLCCR0",753,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",754,0)
+ ;;</Type>
+"RTN","GPLCCR0",755,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",756,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",757,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",758,0)
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+"RTN","GPLCCR0",759,0)
+ ;;</Address>
+"RTN","GPLCCR0",760,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",761,0)
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+"RTN","GPLCCR0",762,0)
+ ;;<Type>
+"RTN","GPLCCR0",763,0)
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+"RTN","GPLCCR0",764,0)
+ ;;</Type>
+"RTN","GPLCCR0",765,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",766,0)
+ ;;<Email>
+"RTN","GPLCCR0",767,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",768,0)
+ ;;</Email>
+"RTN","GPLCCR0",769,0)
+ ;;<Source>
+"RTN","GPLCCR0",770,0)
+ ;;<Actor>
+"RTN","GPLCCR0",771,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",772,0)
+ ;;</Actor>
+"RTN","GPLCCR0",773,0)
+ ;;</Source>
+"RTN","GPLCCR0",774,0)
+ ;;</Actor>
+"RTN","GPLCCR0",775,0)
+ ;;</ACTOR-PROVIDER>
+"RTN","GPLCCR0",776,0)
+ ;;<ACTOR-ORG>
+"RTN","GPLCCR0",777,0)
+ ;;<Actor>
+"RTN","GPLCCR0",778,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",779,0)
+ ;;<Organization>
+"RTN","GPLCCR0",780,0)
+ ;;<Name>@@ORGANIZATIONNAME@@</Name>
+"RTN","GPLCCR0",781,0)
+ ;;</Organization>
+"RTN","GPLCCR0",782,0)
+ ;;<Source>
+"RTN","GPLCCR0",783,0)
+ ;;<Actor>
+"RTN","GPLCCR0",784,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",785,0)
+ ;;</Actor>
+"RTN","GPLCCR0",786,0)
+ ;;</Source>
+"RTN","GPLCCR0",787,0)
+ ;;</Actor>
+"RTN","GPLCCR0",788,0)
+ ;;</ACTOR-ORG>
+"RTN","GPLCCR0",789,0)
+ ;;</Actors>
+"RTN","GPLCCR0",790,0)
+ ;;<Signatures>
+"RTN","GPLCCR0",791,0)
+ ;;<CCRSignature>
+"RTN","GPLCCR0",792,0)
+ ;;<SignatureObjectID>S0001</SignatureObjectID>
+"RTN","GPLCCR0",793,0)
+ ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
+"RTN","GPLCCR0",794,0)
+ ;;<Source>
+"RTN","GPLCCR0",795,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",796,0)
+ ;;</Source>
+"RTN","GPLCCR0",797,0)
+ ;;<Signature>
+"RTN","GPLCCR0",798,0)
+ ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
+"RTN","GPLCCR0",799,0)
+ ;;<SignedInfo>
+"RTN","GPLCCR0",800,0)
+ ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
+"RTN","GPLCCR0",801,0)
+ ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
+"RTN","GPLCCR0",802,0)
+ ;;<Reference URI="">
+"RTN","GPLCCR0",803,0)
+ ;;<Transforms>
+"RTN","GPLCCR0",804,0)
+ ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
+"RTN","GPLCCR0",805,0)
+ ;;</Transforms>
+"RTN","GPLCCR0",806,0)
+ ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
+"RTN","GPLCCR0",807,0)
+ ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
+"RTN","GPLCCR0",808,0)
+ ;;</Reference>
+"RTN","GPLCCR0",809,0)
+ ;;</SignedInfo>
+"RTN","GPLCCR0",810,0)
+ ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
+"RTN","GPLCCR0",811,0)
+ ;;<KeyInfo>
+"RTN","GPLCCR0",812,0)
+ ;;<KeyValue>
+"RTN","GPLCCR0",813,0)
+ ;;<RSAKeyValue>
+"RTN","GPLCCR0",814,0)
+ ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
+"RTN","GPLCCR0",815,0)
+ ;;<Exponent>AQAB</Exponent>
+"RTN","GPLCCR0",816,0)
+ ;;</RSAKeyValue>
+"RTN","GPLCCR0",817,0)
+ ;;</KeyValue>
+"RTN","GPLCCR0",818,0)
+ ;;</KeyInfo>
+"RTN","GPLCCR0",819,0)
+ ;;</Signature>
+"RTN","GPLCCR0",820,0)
+ ;;</Signature>
+"RTN","GPLCCR0",821,0)
+ ;;</CCRSignature>
+"RTN","GPLCCR0",822,0)
+ ;;</Signatures>
+"RTN","GPLCCR0",823,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCR0",824,0)
+ ;</TEMPLATE>
+"RTN","GPLMEDS")
+0^18^B27486154
+"RTN","GPLMEDS",1,0)
+GPLMEDS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
+"RTN","GPLMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 5
+"RTN","GPLMEDS",3,0)
+   ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLMEDS",4,0)
+   ;General Public License See attached copy of the License.
+"RTN","GPLMEDS",5,0)
+   ;
+"RTN","GPLMEDS",6,0)
+   ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLMEDS",7,0)
+   ;it under the terms of the GNU General Public License as published by
+"RTN","GPLMEDS",8,0)
+   ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLMEDS",9,0)
+   ;(at your option) any later version.
+"RTN","GPLMEDS",10,0)
+   ;
+"RTN","GPLMEDS",11,0)
+   ;This program is distributed in the hope that it will be useful,
+"RTN","GPLMEDS",12,0)
+   ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLMEDS",13,0)
+   ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLMEDS",14,0)
+   ;GNU General Public License for more details.
+"RTN","GPLMEDS",15,0)
+   ;
+"RTN","GPLMEDS",16,0)
+   ;You should have received a copy of the GNU General Public License along
+"RTN","GPLMEDS",17,0)
+   ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLMEDS",18,0)
+   ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLMEDS",19,0)
+   ;
+"RTN","GPLMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","GPLMEDS",21,0)
+   Q
+"RTN","GPLMEDS",22,0)
+   ;
+"RTN","GPLMEDS",23,0)
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","GPLMEDS",24,0)
+   ;
+"RTN","GPLMEDS",25,0)
+   ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLMEDS",26,0)
+   ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLMEDS",27,0)
+   ;
+"RTN","GPLMEDS",28,0)
+   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+"RTN","GPLMEDS",29,0)
+   D ACTIVE^ORWPS(.MEDRSLT,DFN)
+"RTN","GPLMEDS",30,0)
+   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+"RTN","GPLMEDS",31,0)
+   . W "ERROR RUNNINIG MEDICATIONS RPC",!
+"RTN","GPLMEDS",32,0)
+   . S @MEDOUTXML@(0)=0
+"RTN","GPLMEDS",33,0)
+   . Q
+"RTN","GPLMEDS",34,0)
+   ; I DEBUG ZWR MEDRSLT
+"RTN","GPLMEDS",35,0)
+   M GPLMEDS=MEDRSLT
+"RTN","GPLMEDS",36,0)
+   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
+"RTN","GPLMEDS",37,0)
+   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+"RTN","GPLMEDS",38,0)
+   K @MEDTVMAP,@MEDTARYTMP
+"RTN","GPLMEDS",39,0)
+   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
+"RTN","GPLMEDS",40,0)
+   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
+"RTN","GPLMEDS",41,0)
+   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
+"RTN","GPLMEDS",42,0)
+   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
+"RTN","GPLMEDS",43,0)
+   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
+"RTN","GPLMEDS",44,0)
+   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
+"RTN","GPLMEDS",45,0)
+   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
+"RTN","GPLMEDS",46,0)
+   . . S ZI=ZI+1 ; INCREMENT MED COUNT
+"RTN","GPLMEDS",47,0)
+   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
+"RTN","GPLMEDS",48,0)
+   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
+"RTN","GPLMEDS",49,0)
+   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
+"RTN","GPLMEDS",50,0)
+   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
+"RTN","GPLMEDS",51,0)
+   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
+"RTN","GPLMEDS",52,0)
+   ;ZWR ZA
+"RTN","GPLMEDS",53,0)
+   F ZI=1:1:ZA(0) D  ; FOR EACH MED
+"RTN","GPLMEDS",54,0)
+   . I DEBUG W "ZI IS ",ZI,!
+"RTN","GPLMEDS",55,0)
+   . S MEDVMAP=$NA(@MEDTVMAP@(ZI))
+"RTN","GPLMEDS",56,0)
+   . K @MEDVMAP
+"RTN","GPLMEDS",57,0)
+   . I DEBUG W "VMAP= ",MEDVMAP,!
+"RTN","GPLMEDS",58,0)
+   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
+"RTN","GPLMEDS",59,0)
+   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
+"RTN","GPLMEDS",60,0)
+   . S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS
+"RTN","GPLMEDS",61,0)
+   . S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+"RTN","GPLMEDS",62,0)
+   . S @MEDVMAP@("MEDDATETIMEAGE")=""
+"RTN","GPLMEDS",63,0)
+   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
+"RTN","GPLMEDS",64,0)
+   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
+"RTN","GPLMEDS",65,0)
+   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+"RTN","GPLMEDS",66,0)
+   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLMEDS",67,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+"RTN","GPLMEDS",68,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=""
+"RTN","GPLMEDS",69,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+"RTN","GPLMEDS",70,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
+"RTN","GPLMEDS",71,0)
+   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
+"RTN","GPLMEDS",72,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
+"RTN","GPLMEDS",73,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
+"RTN","GPLMEDS",74,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
+"RTN","GPLMEDS",75,0)
+   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
+"RTN","GPLMEDS",76,0)
+   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
+"RTN","GPLMEDS",77,0)
+   . S @MEDVMAP@("MEDFORMTEXT")=""
+"RTN","GPLMEDS",78,0)
+   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
+"RTN","GPLMEDS",79,0)
+   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
+"RTN","GPLMEDS",80,0)
+   . S @MEDVMAP@("MEDRFNO")=""
+"RTN","GPLMEDS",81,0)
+   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
+"RTN","GPLMEDS",82,0)
+   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
+"RTN","GPLMEDS",83,0)
+   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
+"RTN","GPLMEDS",84,0)
+   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
+"RTN","GPLMEDS",85,0)
+   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
+"RTN","GPLMEDS",86,0)
+   . . S ZN=0 ; DON'T KNOW WHY
+"RTN","GPLMEDS",87,0)
+   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
+"RTN","GPLMEDS",88,0)
+   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
+"RTN","GPLMEDS",89,0)
+   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
+"RTN","GPLMEDS",90,0)
+   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
+"RTN","GPLMEDS",91,0)
+   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
+"RTN","GPLMEDS",92,0)
+   . S @MEDVMAP@("MEDDOSEVALUE")=""
+"RTN","GPLMEDS",93,0)
+   . S @MEDVMAP@("MEDDOSEUNIT")=""
+"RTN","GPLMEDS",94,0)
+   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
+"RTN","GPLMEDS",95,0)
+   . S @MEDVMAP@("MEDDURATIONVALUE")=""
+"RTN","GPLMEDS",96,0)
+   . S @MEDVMAP@("MEDDURATIONUNIT")=""
+"RTN","GPLMEDS",97,0)
+   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
+"RTN","GPLMEDS",98,0)
+   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
+"RTN","GPLMEDS",99,0)
+   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
+"RTN","GPLMEDS",100,0)
+   . K @MEDARYTMP
+"RTN","GPLMEDS",101,0)
+   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+"RTN","GPLMEDS",102,0)
+   . I ZI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLMEDS",103,0)
+   . . ; W "FIRST ONE",!
+"RTN","GPLMEDS",104,0)
+   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
+"RTN","GPLMEDS",105,0)
+   . I ZI>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLMEDS",106,0)
+   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+"RTN","GPLMEDS",107,0)
+   N MEDTMP,MEDI
+"RTN","GPLMEDS",108,0)
+   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLMEDS",109,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLMEDS",110,0)
+   . W "MEDICATION MISSING ",!
+"RTN","GPLMEDS",111,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","GPLMEDS",112,0)
+   Q
+"RTN","GPLMEDS",113,0)
+   ;
+"RTN","GPLPROBS")
+0^11^B24846496
+"RTN","GPLPROBS",1,0)
+GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
+"RTN","GPLPROBS",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLPROBS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLPROBS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLPROBS",5,0)
+ ;
+"RTN","GPLPROBS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLPROBS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLPROBS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLPROBS",9,0)
+ ;(at your option) any later version.
+"RTN","GPLPROBS",10,0)
+ ;
+"RTN","GPLPROBS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLPROBS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLPROBS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLPROBS",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLPROBS",15,0)
+ ;
+"RTN","GPLPROBS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLPROBS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLPROBS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLPROBS",19,0)
+ ;
+"RTN","GPLPROBS",20,0)
+           ;
+"RTN","GPLPROBS",21,0)
+           ;  PROCESS THE PROBLEMS SECTION OF THE CCR
+"RTN","GPLPROBS",22,0)
+           ;
+"RTN","GPLPROBS",23,0)
+EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+"RTN","GPLPROBS",24,0)
+          ;
+"RTN","GPLPROBS",25,0)
+          ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLPROBS",26,0)
+          ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLPROBS",27,0)
+          ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+"RTN","GPLPROBS",28,0)
+          ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+"RTN","GPLPROBS",29,0)
+          ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+"RTN","GPLPROBS",30,0)
+          ;
+"RTN","GPLPROBS",31,0)
+          N RPCRSLT,J,K,PTMP,X,VMAP,TBU
+"RTN","GPLPROBS",32,0)
+          S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
+"RTN","GPLPROBS",33,0)
+          S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
+"RTN","GPLPROBS",34,0)
+          K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLPROBS",35,0)
+          D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+"RTN","GPLPROBS",36,0)
+          I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
+"RTN","GPLPROBS",37,0)
+          . W "NULL RESULT FROM LIST^ORQQPL3 ",!
+"RTN","GPLPROBS",38,0)
+          . S @OUTXML@(0)=0
+"RTN","GPLPROBS",39,0)
+          . ; Q
+"RTN","GPLPROBS",40,0)
+          ; I DEBUG ZWR RPCRSLT
+"RTN","GPLPROBS",41,0)
+          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
+"RTN","GPLPROBS",42,0)
+          . S VMAP=$NA(@TVMAP@(J))
+"RTN","GPLPROBS",43,0)
+          . K @VMAP
+"RTN","GPLPROBS",44,0)
+          . W "VMAP= ",VMAP,!
+"RTN","GPLPROBS",45,0)
+          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+"RTN","GPLPROBS",46,0)
+          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
+"RTN","GPLPROBS",47,0)
+          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
+"RTN","GPLPROBS",48,0)
+          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
+"RTN","GPLPROBS",49,0)
+          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+"RTN","GPLPROBS",50,0)
+          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+"RTN","GPLPROBS",51,0)
+          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
+"RTN","GPLPROBS",52,0)
+          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
+"RTN","GPLPROBS",53,0)
+          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
+"RTN","GPLPROBS",54,0)
+          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
+"RTN","GPLPROBS",55,0)
+          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
+"RTN","GPLPROBS",56,0)
+          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
+"RTN","GPLPROBS",57,0)
+          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
+"RTN","GPLPROBS",58,0)
+          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
+"RTN","GPLPROBS",59,0)
+          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+"RTN","GPLPROBS",60,0)
+          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
+"RTN","GPLPROBS",61,0)
+          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
+"RTN","GPLPROBS",62,0)
+          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
+"RTN","GPLPROBS",63,0)
+          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
+"RTN","GPLPROBS",64,0)
+          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
+"RTN","GPLPROBS",65,0)
+          . S ARYTMP=$NA(@TARYTMP@(J))
+"RTN","GPLPROBS",66,0)
+          . ; W "ARYTMP= ",ARYTMP,!
+"RTN","GPLPROBS",67,0)
+          . K @ARYTMP
+"RTN","GPLPROBS",68,0)
+          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
+"RTN","GPLPROBS",69,0)
+          . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",70,0)
+          . . ; W "FIRST ONE",!
+"RTN","GPLPROBS",71,0)
+          . . D CP^GPLXPATH(ARYTMP,OUTXML)
+"RTN","GPLPROBS",72,0)
+          . . ; W "OUTXML ",OUTXML,!
+"RTN","GPLPROBS",73,0)
+          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLPROBS",74,0)
+          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
+"RTN","GPLPROBS",75,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
+"RTN","GPLPROBS",76,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLPROBS",77,0)
+          ; ZWR @OUTXML
+"RTN","GPLPROBS",78,0)
+          ; $$HTML^DILF(
+"RTN","GPLPROBS",79,0)
+          ; GENERATE THE NARITIVE HTML FOR THE CCD
+"RTN","GPLPROBS",80,0)
+          I CCD D  ; IF THIS IS FOR A CCD
+"RTN","GPLPROBS",81,0)
+          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
+"RTN","GPLPROBS",82,0)
+          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
+"RTN","GPLPROBS",83,0)
+          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
+"RTN","GPLPROBS",84,0)
+          . . W "VMAP =",VMAP,!
+"RTN","GPLPROBS",85,0)
+          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
+"RTN","GPLPROBS",86,0)
+          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
+"RTN","GPLPROBS",87,0)
+          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
+"RTN","GPLPROBS",88,0)
+          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
+"RTN","GPLPROBS",89,0)
+          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
+"RTN","GPLPROBS",90,0)
+          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",91,0)
+          . . . D CP^GPLXPATH("HOUT","HTMLO")
+"RTN","GPLPROBS",92,0)
+          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
+"RTN","GPLPROBS",93,0)
+          . . . W "DOING INNER",!
+"RTN","GPLPROBS",94,0)
+          . . . N HTMLBLD,HTMLTMP
+"RTN","GPLPROBS",95,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
+"RTN","GPLPROBS",96,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
+"RTN","GPLPROBS",97,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
+"RTN","GPLPROBS",98,0)
+          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
+"RTN","GPLPROBS",99,0)
+          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
+"RTN","GPLPROBS",100,0)
+          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
+"RTN","GPLPROBS",101,0)
+          . I DEBUG D PARY^GPLXPATH("HTMLO")
+"RTN","GPLPROBS",102,0)
+          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+"RTN","GPLPROBS",103,0)
+          N PROBSTMP,I
+"RTN","GPLPROBS",104,0)
+          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLPROBS",105,0)
+          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLPROBS",106,0)
+          . ; STRINGS MARKED AS @@X@@
+"RTN","GPLPROBS",107,0)
+          . W "PROBLEMS Missing list: ",!
+"RTN","GPLPROBS",108,0)
+          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
+"RTN","GPLPROBS",109,0)
+          Q
+"RTN","GPLPROBS",110,0)
+          ;
+"RTN","GPLRIMA")
+0^13^B96435476
+"RTN","GPLRIMA",1,0)
+GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+"RTN","GPLRIMA",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLRIMA",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLRIMA",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLRIMA",5,0)
+ ;
+"RTN","GPLRIMA",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLRIMA",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLRIMA",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLRIMA",9,0)
+ ;(at your option) any later version.
+"RTN","GPLRIMA",10,0)
+ ;
+"RTN","GPLRIMA",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLRIMA",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLRIMA",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLRIMA",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLRIMA",15,0)
+ ;
+"RTN","GPLRIMA",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLRIMA",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLRIMA",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLRIMA",19,0)
+ ;
+"RTN","GPLRIMA",20,0)
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+"RTN","GPLRIMA",21,0)
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+"RTN","GPLRIMA",22,0)
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+"RTN","GPLRIMA",23,0)
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+"RTN","GPLRIMA",24,0)
+ ; CONVEYED VIA THE CCR OR CCD.
+"RTN","GPLRIMA",25,0)
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+"RTN","GPLRIMA",26,0)
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+"RTN","GPLRIMA",27,0)
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+"RTN","GPLRIMA",28,0)
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+"RTN","GPLRIMA",29,0)
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+"RTN","GPLRIMA",30,0)
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+"RTN","GPLRIMA",31,0)
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+"RTN","GPLRIMA",32,0)
+ ;
+"RTN","GPLRIMA",33,0)
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+"RTN","GPLRIMA",34,0)
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+"RTN","GPLRIMA",35,0)
+ ;    CONVEYANCE TO THE RIM APPLICATION.
+"RTN","GPLRIMA",36,0)
+ ;
+"RTN","GPLRIMA",37,0)
+ ;
+"RTN","GPLRIMA",38,0)
+ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
+"RTN","GPLRIMA",39,0)
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+"RTN","GPLRIMA",40,0)
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+"RTN","GPLRIMA",41,0)
+    ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
+"RTN","GPLRIMA",42,0)
+    ;
+"RTN","GPLRIMA",43,0)
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+"RTN","GPLRIMA",44,0)
+    N CCRGLO
+"RTN","GPLRIMA",45,0)
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
+"RTN","GPLRIMA",46,0)
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+"RTN","GPLRIMA",47,0)
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+"RTN","GPLRIMA",48,0)
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+"RTN","GPLRIMA",49,0)
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+"RTN","GPLRIMA",50,0)
+    I RIMDFN="" S RIMDFN=RESUME
+"RTN","GPLRIMA",51,0)
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+"RTN","GPLRIMA",52,0)
+    . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
+"RTN","GPLRIMA",53,0)
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+"RTN","GPLRIMA",54,0)
+    . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
+"RTN","GPLRIMA",55,0)
+    . W RIMDFN,!
+"RTN","GPLRIMA",56,0)
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+"RTN","GPLRIMA",57,0)
+    . ;
+"RTN","GPLRIMA",58,0)
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
+"RTN","GPLRIMA",59,0)
+    . ;
+"RTN","GPLRIMA",60,0)
+    . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+"RTN","GPLRIMA",61,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
+"RTN","GPLRIMA",62,0)
+    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+"RTN","GPLRIMA",63,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
+"RTN","GPLRIMA",64,0)
+    . I $D(^TMP("GPLCCR",$J,"MEDICATIONS",1)) D  ; MEDS VARS EXISTS
+"RTN","GPLRIMA",65,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDICATIONS")
+"RTN","GPLRIMA",66,0)
+    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+"RTN","GPLRIMA",67,0)
+    . ;
+"RTN","GPLRIMA",68,0)
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+"RTN","GPLRIMA",69,0)
+    . ;
+"RTN","GPLRIMA",70,0)
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+"RTN","GPLRIMA",71,0)
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+"RTN","GPLRIMA",72,0)
+    . ;
+"RTN","GPLRIMA",73,0)
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
+"RTN","GPLRIMA",74,0)
+    . ;
+"RTN","GPLRIMA",75,0)
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+"RTN","GPLRIMA",76,0)
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+"RTN","GPLRIMA",77,0)
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+"RTN","GPLRIMA",78,0)
+    . ;
+"RTN","GPLRIMA",79,0)
+    . N CATNAME,CATTBL
+"RTN","GPLRIMA",80,0)
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+"RTN","GPLRIMA",81,0)
+    . S CATNAME=""
+"RTN","GPLRIMA",82,0)
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+"RTN","GPLRIMA",83,0)
+    . W "CATEGORY NAME: ",CATNAME,!
+"RTN","GPLRIMA",84,0)
+    . ;
+"RTN","GPLRIMA",85,0)
+    . S RIMDFN=$O(^DPT(RIMDFN)) ; NEXT PATIENT
+"RTN","GPLRIMA",86,0)
+    S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+"RTN","GPLRIMA",87,0)
+    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
+"RTN","GPLRIMA",88,0)
+    Q
+"RTN","GPLRIMA",89,0)
+    ;
+"RTN","GPLRIMA",90,0)
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+"RTN","GPLRIMA",91,0)
+    N SBASE,SATTR
+"RTN","GPLRIMA",92,0)
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+"RTN","GPLRIMA",93,0)
+    D APOST("SATTR","RIMTBL","HEADER")
+"RTN","GPLRIMA",94,0)
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+"RTN","GPLRIMA",95,0)
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+"RTN","GPLRIMA",96,0)
+    . W "POSTING PROBLEMS",!
+"RTN","GPLRIMA",97,0)
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+"RTN","GPLRIMA",98,0)
+    I $D(@SBASE@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS")
+"RTN","GPLRIMA",99,0)
+    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+"RTN","GPLRIMA",100,0)
+    W "ATTRIBUTES: ",SATTR,!
+"RTN","GPLRIMA",101,0)
+    Q SATTR
+"RTN","GPLRIMA",102,0)
+    ;
+"RTN","GPLRIMA",103,0)
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+"RTN","GPLRIMA",104,0)
+    K ^TMP("GPLRIM","RESUME")
+"RTN","GPLRIMA",105,0)
+    K ^TMP("GPLRIM")
+"RTN","GPLRIMA",106,0)
+    Q
+"RTN","GPLRIMA",107,0)
+    ;
+"RTN","GPLRIMA",108,0)
+CLIST ; LIST THE CATEGORIES
+"RTN","GPLRIMA",109,0)
+    ;
+"RTN","GPLRIMA",110,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",111,0)
+    N CLBASE,CLNUM,ZI,CLIDX
+"RTN","GPLRIMA",112,0)
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+"RTN","GPLRIMA",113,0)
+    S CLNUM=@CLBASE@(0)
+"RTN","GPLRIMA",114,0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+"RTN","GPLRIMA",115,0)
+    . S CLIDX=@CLBASE@(ZI)
+"RTN","GPLRIMA",116,0)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+"RTN","GPLRIMA",117,0)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+"RTN","GPLRIMA",118,0)
+    . W CLIDX,!
+"RTN","GPLRIMA",119,0)
+    ; D PARY^GPLXPATH(CLBASE)
+"RTN","GPLRIMA",120,0)
+    Q
+"RTN","GPLRIMA",121,0)
+    ;
+"RTN","GPLRIMA",122,0)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+"RTN","GPLRIMA",123,0)
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+"RTN","GPLRIMA",124,0)
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+"RTN","GPLRIMA",125,0)
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+"RTN","GPLRIMA",126,0)
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+"RTN","GPLRIMA",127,0)
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+"RTN","GPLRIMA",128,0)
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+"RTN","GPLRIMA",129,0)
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+"RTN","GPLRIMA",130,0)
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+"RTN","GPLRIMA",131,0)
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+"RTN","GPLRIMA",132,0)
+    ; NUMBER IE CTBL_X(CDFN)=""
+"RTN","GPLRIMA",133,0)
+    ;
+"RTN","GPLRIMA",134,0)
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+"RTN","GPLRIMA",135,0)
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+"RTN","GPLRIMA",136,0)
+    W "CBASE: ",CCTBL,!
+"RTN","GPLRIMA",137,0)
+    ;
+"RTN","GPLRIMA",138,0)
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+"RTN","GPLRIMA",139,0)
+    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+"RTN","GPLRIMA",140,0)
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+"RTN","GPLRIMA",141,0)
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+"RTN","GPLRIMA",142,0)
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+"RTN","GPLRIMA",143,0)
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+"RTN","GPLRIMA",144,0)
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+"RTN","GPLRIMA",145,0)
+    ;
+"RTN","GPLRIMA",146,0)
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+"RTN","GPLRIMA",147,0)
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",148,0)
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+"RTN","GPLRIMA",149,0)
+    ;
+"RTN","GPLRIMA",150,0)
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+"RTN","GPLRIMA",151,0)
+    ;
+"RTN","GPLRIMA",152,0)
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+"RTN","GPLRIMA",153,0)
+    W "PATS BASE: ",CPATLIST,!
+"RTN","GPLRIMA",154,0)
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+"RTN","GPLRIMA",155,0)
+    ;
+"RTN","GPLRIMA",156,0)
+    Q
+"RTN","GPLRIMA",157,0)
+    ;
+"RTN","GPLRIMA",158,0)
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+"RTN","GPLRIMA",159,0)
+    ;
+"RTN","GPLRIMA",160,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",161,0)
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+"RTN","GPLRIMA",162,0)
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+"RTN","GPLRIMA",163,0)
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+"RTN","GPLRIMA",164,0)
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+"RTN","GPLRIMA",165,0)
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+"RTN","GPLRIMA",166,0)
+    . S ZCNT=0
+"RTN","GPLRIMA",167,0)
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+"RTN","GPLRIMA",168,0)
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+"RTN","GPLRIMA",169,0)
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+"RTN","GPLRIMA",170,0)
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+"RTN","GPLRIMA",171,0)
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",172,0)
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+"RTN","GPLRIMA",173,0)
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+"RTN","GPLRIMA",174,0)
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+"RTN","GPLRIMA",175,0)
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+"RTN","GPLRIMA",176,0)
+    . S ZTOT=ZTOT+ZCNT
+"RTN","GPLRIMA",177,0)
+    W "TOTAL: ",ZTOT,!
+"RTN","GPLRIMA",178,0)
+    Q
+"RTN","GPLRIMA",179,0)
+    ;
+"RTN","GPLRIMA",180,0)
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+"RTN","GPLRIMA",181,0)
+    ; INLST IS PASSED BY NAME
+"RTN","GPLRIMA",182,0)
+    N ZI,ZDX,ZCOUNT
+"RTN","GPLRIMA",183,0)
+    W INLST,!
+"RTN","GPLRIMA",184,0)
+    S ZCOUNT=0
+"RTN","GPLRIMA",185,0)
+    S ZDX=""
+"RTN","GPLRIMA",186,0)
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+"RTN","GPLRIMA",187,0)
+    . S ZCOUNT=ZCOUNT+1
+"RTN","GPLRIMA",188,0)
+    . S ZDX=$O(@INLST@(ZDX))
+"RTN","GPLRIMA",189,0)
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+"RTN","GPLRIMA",190,0)
+    Q ZCOUNT
+"RTN","GPLRIMA",191,0)
+    ;
+"RTN","GPLRIMA",192,0)
+XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+"RTN","GPLRIMA",193,0)
+    ;
+"RTN","GPLRIMA",194,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",195,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",196,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",197,0)
+    S ZI=""
+"RTN","GPLRIMA",198,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",199,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",200,0)
+    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
+"RTN","GPLRIMA",201,0)
+    Q
+"RTN","GPLRIMA",202,0)
+    ;
+"RTN","GPLRIMA",203,0)
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+"RTN","GPLRIMA",204,0)
+    ;
+"RTN","GPLRIMA",205,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",206,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",207,0)
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+"RTN","GPLRIMA",208,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",209,0)
+    S ZI=""
+"RTN","GPLRIMA",210,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",211,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",212,0)
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+"RTN","GPLRIMA",213,0)
+    . W ZI," "
+"RTN","GPLRIMA",214,0)
+    . I ZC=10 D  ; NEW LINE
+"RTN","GPLRIMA",215,0)
+    . . S ZC=0
+"RTN","GPLRIMA",216,0)
+    . . W !
+"RTN","GPLRIMA",217,0)
+    Q
+"RTN","GPLRIMA",218,0)
+    ;
+"RTN","GPLRIMA",219,0)
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+"RTN","GPLRIMA",220,0)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+"RTN","GPLRIMA",221,0)
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+"RTN","GPLRIMA",222,0)
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+"RTN","GPLRIMA",223,0)
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+"RTN","GPLRIMA",224,0)
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+"RTN","GPLRIMA",225,0)
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+"RTN","GPLRIMA",226,0)
+    ;
+"RTN","GPLRIMA",227,0)
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+"RTN","GPLRIMA",228,0)
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+"RTN","GPLRIMA",229,0)
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+"RTN","GPLRIMA",230,0)
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+"RTN","GPLRIMA",231,0)
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+"RTN","GPLRIMA",232,0)
+    Q
+"RTN","GPLRIMA",233,0)
+    ;
+"RTN","GPLRIMA",234,0)
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+"RTN","GPLRIMA",235,0)
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
+"RTN","GPLRIMA",236,0)
+      I '$D(@RIMBASE) S @RIMBASE=""
+"RTN","GPLRIMA",237,0)
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
+"RTN","GPLRIMA",238,0)
+      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+"RTN","GPLRIMA",239,0)
+      Q
+"RTN","GPLRIMA",240,0)
+      ;
+"RTN","GPLRIMA",241,0)
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+"RTN","GPLRIMA",242,0)
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",243,0)
+      K @RIMTBL
+"RTN","GPLRIMA",244,0)
+      D APUSH(RIMTBL,"EXTRACTED")
+"RTN","GPLRIMA",245,0)
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+"RTN","GPLRIMA",246,0)
+      D APUSH(RIMTBL,"HEADER")
+"RTN","GPLRIMA",247,0)
+      D APUSH(RIMTBL,"NOPCP")
+"RTN","GPLRIMA",248,0)
+      D APUSH(RIMTBL,"PCP")
+"RTN","GPLRIMA",249,0)
+      D APUSH(RIMTBL,"PROBLEMS")
+"RTN","GPLRIMA",250,0)
+      D APUSH(RIMTBL,"PROBCODE")
+"RTN","GPLRIMA",251,0)
+      D APUSH(RIMTBL,"PROBNOCODE")
+"RTN","GPLRIMA",252,0)
+      D APUSH(RIMTBL,"PROBDATE")
+"RTN","GPLRIMA",253,0)
+      D APUSH(RIMTBL,"PROBNODATE")
+"RTN","GPLRIMA",254,0)
+      D APUSH(RIMTBL,"VITALS")
+"RTN","GPLRIMA",255,0)
+      D APUSH(RIMTBL,"VITALSCODE")
+"RTN","GPLRIMA",256,0)
+      D APUSH(RIMTBL,"VITALSNOCODE")
+"RTN","GPLRIMA",257,0)
+      D APUSH(RIMTBL,"VITALSDATE")
+"RTN","GPLRIMA",258,0)
+      D APUSH(RIMTBL,"VITALSNODATE")
+"RTN","GPLRIMA",259,0)
+      D APUSH(RIMTBL,"MEDS")
+"RTN","GPLRIMA",260,0)
+      D APUSH(RIMTBL,"MEDSCODE")
+"RTN","GPLRIMA",261,0)
+      D APUSH(RIMTBL,"MEDSNOCODE")
+"RTN","GPLRIMA",262,0)
+      D APUSH(RIMTBL,"MEDSDATE")
+"RTN","GPLRIMA",263,0)
+      D APUSH(RIMTBL,"MEDSNODATE")
+"RTN","GPLRIMA",264,0)
+      Q
+"RTN","GPLRIMA",265,0)
+      ;
+"RTN","GPLRIMA",266,0)
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+"RTN","GPLRIMA",267,0)
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+"RTN","GPLRIMA",268,0)
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+"RTN","GPLRIMA",269,0)
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+"RTN","GPLRIMA",270,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+"RTN","GPLRIMA",271,0)
+    N USETBL
+"RTN","GPLRIMA",272,0)
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+"RTN","GPLRIMA",273,0)
+    . W "ERROR NO SUCH TABLE",!
+"RTN","GPLRIMA",274,0)
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+"RTN","GPLRIMA",275,0)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+"RTN","GPLRIMA",276,0)
+    Q
+"RTN","GPLUNIT")
+0^10^B31630479
+"RTN","GPLUNIT",1,0)
+GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
+"RTN","GPLUNIT",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLUNIT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLUNIT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLUNIT",5,0)
+ ;
+"RTN","GPLUNIT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLUNIT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLUNIT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLUNIT",9,0)
+ ;(at your option) any later version.
+"RTN","GPLUNIT",10,0)
+ ;
+"RTN","GPLUNIT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLUNIT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLUNIT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLUNIT",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLUNIT",15,0)
+ ;
+"RTN","GPLUNIT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLUNIT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLUNIT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLUNIT",19,0)
+ ;
+"RTN","GPLUNIT",20,0)
+          W "This is a unit testing library",!
+"RTN","GPLUNIT",21,0)
+          W !
+"RTN","GPLUNIT",22,0)
+          Q
+"RTN","GPLUNIT",23,0)
+          ;
+"RTN","GPLUNIT",24,0)
+ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
+"RTN","GPLUNIT",25,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",26,0)
+          ; BAT is a string identifying the test battery
+"RTN","GPLUNIT",27,0)
+          ; TST is a test which will evaluate to true or false
+"RTN","GPLUNIT",28,0)
+          ; I '$G(ZARY) D
+"RTN","GPLUNIT",29,0)
+          ; . S ZARY(0)=0 ; initially there are no elements
+"RTN","GPLUNIT",30,0)
+          ; W "GOT HERE LOADING "_TST,!
+"RTN","GPLUNIT",31,0)
+          N CNT ; count of array elements
+"RTN","GPLUNIT",32,0)
+          S CNT=ZARY(0) ; contains array count
+"RTN","GPLUNIT",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLUNIT",34,0)
+          S ZARY(CNT)=TST ; put the test in the array
+"RTN","GPLUNIT",35,0)
+          I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
+"RTN","GPLUNIT",36,0)
+          . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+"RTN","GPLUNIT",37,0)
+          . S II=$P(ZARY(BAT),"^",2)
+"RTN","GPLUNIT",38,0)
+          . S $P(ZARY(BAT),"^",2)=II+1
+"RTN","GPLUNIT",39,0)
+          I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
+"RTN","GPLUNIT",40,0)
+          . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+"RTN","GPLUNIT",41,0)
+          . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+"RTN","GPLUNIT",42,0)
+          . ; S TN=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",43,0)
+          . ; D PUSH^GPLXPATH(TN,BAT)
+"RTN","GPLUNIT",44,0)
+          S ZARY(0)=CNT ; update the array counter
+"RTN","GPLUNIT",45,0)
+          Q
+"RTN","GPLUNIT",46,0)
+          ;
+"RTN","GPLUNIT",47,0)
+ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
+"RTN","GPLUNIT",48,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLUNIT",49,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLUNIT",50,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLUNIT",51,0)
+          K @ZARY
+"RTN","GPLUNIT",52,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLUNIT",53,0)
+          N LINE,LABEL,BODY
+"RTN","GPLUNIT",54,0)
+          N INTEST S INTEST=0 ; switch for in the test case section
+"RTN","GPLUNIT",55,0)
+          N SECTION S SECTION="[anonymous]" ; test case section
+"RTN","GPLUNIT",56,0)
+          ;
+"RTN","GPLUNIT",57,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLUNIT",58,0)
+          . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
+"RTN","GPLUNIT",59,0)
+          . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+"RTN","GPLUNIT",60,0)
+          . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+"RTN","GPLUNIT",61,0)
+          . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
+"RTN","GPLUNIT",62,0)
+          . I INTEST  D  ; within the testing section
+"RTN","GPLUNIT",63,0)
+          . . I LINE?." "1";;><".E  D  ; section name found
+"RTN","GPLUNIT",64,0)
+          . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+"RTN","GPLUNIT",65,0)
+          . . I LINE?." "1";;>>".E  D  ; test case found
+"RTN","GPLUNIT",66,0)
+          . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+"RTN","GPLUNIT",67,0)
+          S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+"RTN","GPLUNIT",68,0)
+          Q
+"RTN","GPLUNIT",69,0)
+          ;
+"RTN","GPLUNIT",70,0)
+ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+"RTN","GPLUNIT",71,0)
+          N ZI,ZX,ZR,ZP
+"RTN","GPLUNIT",72,0)
+          S DEBUG=0
+"RTN","GPLUNIT",73,0)
+          ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+"RTN","GPLUNIT",74,0)
+          ; . W "DOING ALL",!
+"RTN","GPLUNIT",75,0)
+          ; . N J,NT
+"RTN","GPLUNIT",76,0)
+          ; . S NT=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",77,0)
+          ; . W NT,@NT@(0),!
+"RTN","GPLUNIT",78,0)
+          ; . F J=1:1:@NT@(0) D  ;
+"RTN","GPLUNIT",79,0)
+          ; . . W @NT@(J),!
+"RTN","GPLUNIT",80,0)
+          ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
+"RTN","GPLUNIT",81,0)
+          I '$D(ZARY(WHICH))  D  ; TEST SECTION DOESN'T EXIST
+"RTN","GPLUNIT",82,0)
+          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+"RTN","GPLUNIT",83,0)
+          . Q  ; EXIT
+"RTN","GPLUNIT",84,0)
+          N FIRST,LAST
+"RTN","GPLUNIT",85,0)
+          S FIRST=$P(ZARY(WHICH),"^",1)
+"RTN","GPLUNIT",86,0)
+          S LAST=$P(ZARY(WHICH),"^",2)
+"RTN","GPLUNIT",87,0)
+          F ZI=FIRST:1:LAST  D
+"RTN","GPLUNIT",88,0)
+          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+"RTN","GPLUNIT",89,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",90,0)
+          . . ;  W ZP,!
+"RTN","GPLUNIT",91,0)
+          . . S ZX=ZP
+"RTN","GPLUNIT",92,0)
+          . . W "RUNNING: "_ZP
+"RTN","GPLUNIT",93,0)
+          . . X ZX
+"RTN","GPLUNIT",94,0)
+          . . W "..SUCCESS: ",WHICH,!
+"RTN","GPLUNIT",95,0)
+          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+"RTN","GPLUNIT",96,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",97,0)
+          . . S ZX="S ZR="_ZP
+"RTN","GPLUNIT",98,0)
+          . . W "TRYING: "_ZP
+"RTN","GPLUNIT",99,0)
+          . . X ZX
+"RTN","GPLUNIT",100,0)
+          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+"RTN","GPLUNIT",101,0)
+          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+"RTN","GPLUNIT",102,0)
+          . . . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",103,0)
+          . . I ZR S TPASSED=TPASSED+1
+"RTN","GPLUNIT",104,0)
+          . . I 'ZR S TFAILED=TFAILED+1
+"RTN","GPLUNIT",105,0)
+          Q
+"RTN","GPLUNIT",106,0)
+          ;
+"RTN","GPLUNIT",107,0)
+TEST   ; RUN ALL THE TEST CASES
+"RTN","GPLUNIT",108,0)
+          N ZTMP
+"RTN","GPLUNIT",109,0)
+          D ZLOAD(.ZTMP)
+"RTN","GPLUNIT",110,0)
+          D ZTEST(.ZTMP,"ALL")
+"RTN","GPLUNIT",111,0)
+          W "PASSED: ",TPASSED,!
+"RTN","GPLUNIT",112,0)
+          W "FAILED: ",TFAILED,!
+"RTN","GPLUNIT",113,0)
+          W !
+"RTN","GPLUNIT",114,0)
+          W "THE TESTS!",!
+"RTN","GPLUNIT",115,0)
+          ; I DEBUG ZWR ZTMP
+"RTN","GPLUNIT",116,0)
+          Q
+"RTN","GPLUNIT",117,0)
+          ;
+"RTN","GPLUNIT",118,0)
+GTSTS(GTZARY,RTN) ; return an array of test names
+"RTN","GPLUNIT",119,0)
+          N I,J S I="" S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",120,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",121,0)
+          . D PUSH^GPLXPATH(RTN,I)
+"RTN","GPLUNIT",122,0)
+          . S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",123,0)
+          Q
+"RTN","GPLUNIT",124,0)
+          ;
+"RTN","GPLUNIT",125,0)
+TESTALL(RNM) ; RUN ALL THE TESTS
+"RTN","GPLUNIT",126,0)
+          N ZI,J,TZTMP,TSTS,TOTP,TOTF
+"RTN","GPLUNIT",127,0)
+          S TOTP=0 S TOTF=0
+"RTN","GPLUNIT",128,0)
+          D ZLOAD^GPLUNIT("TZTMP",RNM)
+"RTN","GPLUNIT",129,0)
+          D GTSTS(.TZTMP,"TSTS")
+"RTN","GPLUNIT",130,0)
+          F ZI=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",131,0)
+          . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",132,0)
+          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
+"RTN","GPLUNIT",133,0)
+          . S TOTP=TOTP+TPASSED
+"RTN","GPLUNIT",134,0)
+          . S TOTF=TOTF+TFAILED
+"RTN","GPLUNIT",135,0)
+          . S $P(TSTS(ZI),"^",2)=TPASSED
+"RTN","GPLUNIT",136,0)
+          . S $P(TSTS(ZI),"^",3)=TFAILED
+"RTN","GPLUNIT",137,0)
+          F I=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",138,0)
+          . W "TEST=> ",$P(TSTS(ZI),"^",1)
+"RTN","GPLUNIT",139,0)
+          . W " PASSED=>",$P(TSTS(ZI),"^",2)
+"RTN","GPLUNIT",140,0)
+          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+"RTN","GPLUNIT",141,0)
+          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+"RTN","GPLUNIT",142,0)
+          Q
+"RTN","GPLUNIT",143,0)
+          ;
+"RTN","GPLUNIT",144,0)
+TLIST(ZARY) ; LIST ALL THE TESTS
+"RTN","GPLUNIT",145,0)
+          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
+"RTN","GPLUNIT",146,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",147,0)
+          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",148,0)
+          S K=1
+"RTN","GPLUNIT",149,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",150,0)
+          . ; W "I IS NOW=",I,!
+"RTN","GPLUNIT",151,0)
+          . W I," "
+"RTN","GPLUNIT",152,0)
+          . S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",153,0)
+          . S K=K+1 I K=6  D
+"RTN","GPLUNIT",154,0)
+          . . W !
+"RTN","GPLUNIT",155,0)
+          . . S K=1
+"RTN","GPLUNIT",156,0)
+          Q
+"RTN","GPLUNIT",157,0)
+          ;
+"RTN","GPLVITAL")
+0^12^B98849168
+"RTN","GPLVITAL",1,0)
+GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+"RTN","GPLVITAL",2,0)
+          ;;0.1;CCDCCR;;JUL 16,2008;Build 5
+"RTN","GPLVITAL",3,0)
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLVITAL",4,0)
+          ;General Public License See attached copy of the License.
+"RTN","GPLVITAL",5,0)
+          ;
+"RTN","GPLVITAL",6,0)
+          ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLVITAL",7,0)
+          ;it under the terms of the GNU General Public License as published by
+"RTN","GPLVITAL",8,0)
+          ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLVITAL",9,0)
+          ;(at your option) any later version.
+"RTN","GPLVITAL",10,0)
+          ;
+"RTN","GPLVITAL",11,0)
+          ;This program is distributed in the hope that it will be useful,
+"RTN","GPLVITAL",12,0)
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLVITAL",13,0)
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLVITAL",14,0)
+          ;GNU General Public License for more details.
+"RTN","GPLVITAL",15,0)
+          ;
+"RTN","GPLVITAL",16,0)
+          ;You should have received a copy of the GNU General Public License along
+"RTN","GPLVITAL",17,0)
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLVITAL",18,0)
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLVITAL",19,0)
+          ;
+"RTN","GPLVITAL",20,0)
+          W "NO ENTRY FROM TOP",!
+"RTN","GPLVITAL",21,0)
+          Q
+"RTN","GPLVITAL",22,0)
+          ;
+"RTN","GPLVITAL",23,0)
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+"RTN","GPLVITAL",24,0)
+          ;
+"RTN","GPLVITAL",25,0)
+          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLVITAL",26,0)
+          ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLVITAL",27,0)
+          ;
+"RTN","GPLVITAL",28,0)
+          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
+"RTN","GPLVITAL",29,0)
+          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+"RTN","GPLVITAL",30,0)
+          I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
+"RTN","GPLVITAL",31,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." D  Q  ; NULL RESULT FROM RPC
+"RTN","GPLVITAL",32,0)
+          . W "NO VITALS FOUND FROM VITALS RPC",!
+"RTN","GPLVITAL",33,0)
+          . S @VITOUTXML@(0)=0
+"RTN","GPLVITAL",34,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
+"RTN","GPLVITAL",35,0)
+          ; ZWR RPCRSLT
+"RTN","GPLVITAL",36,0)
+          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
+"RTN","GPLVITAL",37,0)
+          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
+"RTN","GPLVITAL",38,0)
+          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLVITAL",39,0)
+          N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+"RTN","GPLVITAL",40,0)
+          D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","GPLVITAL",41,0)
+          ; I DEBUG ZWR VDATES ;DEBUG
+"RTN","GPLVITAL",42,0)
+          S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+"RTN","GPLVITAL",43,0)
+          ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+"RTN","GPLVITAL",44,0)
+          F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+"RTN","GPLVITAL",45,0)
+          . I $D(VITRSLT(VSORT(J))) D
+"RTN","GPLVITAL",46,0)
+          . . S VITVMAP=$NA(@VITTVMAP@(J))
+"RTN","GPLVITAL",47,0)
+          . . K @VITVMAP
+"RTN","GPLVITAL",48,0)
+          . . I DEBUG W "VMAP= ",VITVMAP,!
+"RTN","GPLVITAL",49,0)
+          . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
+"RTN","GPLVITAL",50,0)
+          . . I DEBUG W "VITAL ",VSORT(J),!
+"RTN","GPLVITAL",51,0)
+          . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
+"RTN","GPLVITAL",52,0)
+          . . I DEBUG W $P(VITPTMP,U,4),!
+"RTN","GPLVITAL",53,0)
+          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+"RTN","GPLVITAL",54,0)
+          . . I $P(VITPTMP,U,2)="HT" D
+"RTN","GPLVITAL",55,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",56,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",57,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",58,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",59,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",60,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",61,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",62,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
+"RTN","GPLVITAL",63,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",64,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",65,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",66,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",67,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+"RTN","GPLVITAL",68,0)
+          . . E  I $P(VITPTMP,U,2)="WT" D
+"RTN","GPLVITAL",69,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",70,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",71,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",72,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",73,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",74,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",75,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",76,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
+"RTN","GPLVITAL",77,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",78,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",79,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",80,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",81,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+"RTN","GPLVITAL",82,0)
+          . . E  I $P(VITPTMP,U,2)="BP" D
+"RTN","GPLVITAL",83,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",84,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",85,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",86,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",87,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",88,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",89,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",90,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
+"RTN","GPLVITAL",91,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",92,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",93,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",94,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",95,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",96,0)
+          . . E  I $P(VITPTMP,U,2)="T" D
+"RTN","GPLVITAL",97,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",98,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",99,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",100,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",101,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",102,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",103,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",104,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
+"RTN","GPLVITAL",105,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",106,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",107,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",108,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",109,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+"RTN","GPLVITAL",110,0)
+          . . E  I $P(VITPTMP,U,2)="R" D
+"RTN","GPLVITAL",111,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",112,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",113,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",114,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",115,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",116,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",117,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",118,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
+"RTN","GPLVITAL",119,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",120,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",121,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",122,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",123,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",124,0)
+          . . E  I $P(VITPTMP,U,2)="P" D
+"RTN","GPLVITAL",125,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",126,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",127,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",128,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",129,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",130,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",131,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",132,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
+"RTN","GPLVITAL",133,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",134,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",135,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",136,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",137,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",138,0)
+          . . E  I $P(VITPTMP,U,2)="PN" D
+"RTN","GPLVITAL",139,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",140,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",141,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",142,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",143,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",144,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",145,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",146,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
+"RTN","GPLVITAL",147,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",148,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",149,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",150,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",151,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",152,0)
+          . . E  D
+"RTN","GPLVITAL",153,0)
+          . . . ;W "IN VITAL:  OTHER",!
+"RTN","GPLVITAL",154,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",155,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",156,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+"RTN","GPLVITAL",157,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",158,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",159,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+"RTN","GPLVITAL",160,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+"RTN","GPLVITAL",161,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+"RTN","GPLVITAL",162,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+"RTN","GPLVITAL",163,0)
+          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",164,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",165,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",166,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+"RTN","GPLVITAL",167,0)
+          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+"RTN","GPLVITAL",168,0)
+          . . K @VITARYTMP
+"RTN","GPLVITAL",169,0)
+          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
+"RTN","GPLVITAL",170,0)
+          . . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLVITAL",171,0)
+          . . . ; W "FIRST ONE",!
+"RTN","GPLVITAL",172,0)
+          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
+"RTN","GPLVITAL",173,0)
+          . . . W "VITOUTXML ",VITOUTXML,!
+"RTN","GPLVITAL",174,0)
+          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLVITAL",175,0)
+          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
+"RTN","GPLVITAL",176,0)
+          ; ZWR ^TMP($J,"VITALS",*)
+"RTN","GPLVITAL",177,0)
+          ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLVITAL",178,0)
+          I DEBUG D PARY^GPLXPATH(VITOUTXML)
+"RTN","GPLVITAL",179,0)
+          N VITTMP,I
+"RTN","GPLVITAL",180,0)
+          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLVITAL",181,0)
+          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLVITAL",182,0)
+          . W "VITALS MISSING ",!
+"RTN","GPLVITAL",183,0)
+          . F I=1:1:VITTMP(0) W VITTMP(I),!
+"RTN","GPLVITAL",184,0)
+          Q
+"RTN","GPLVITAL",185,0)
+          ;
+"RTN","GPLVITAL",186,0)
+VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+"RTN","GPLVITAL",187,0)
+         ; OF DATES IN THE VITALS RESULTS
+"RTN","GPLVITAL",188,0)
+         N VDTI,VDTJ,VTDCNT
+"RTN","GPLVITAL",189,0)
+         S VTDCNT=0 ; COUNT TO BUILD ARRAY
+"RTN","GPLVITAL",190,0)
+         S VDTJ="" ; USED TO VISIT THE RESULTS
+"RTN","GPLVITAL",191,0)
+         F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","GPLVITAL",192,0)
+         . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
+"RTN","GPLVITAL",193,0)
+         . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+"RTN","GPLVITAL",194,0)
+         . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","GPLVITAL",195,0)
+         Q
+"RTN","GPLVITAL",196,0)
+         ;
+"RTN","GPLXPAT0")
+0^19^B44173297
+"RTN","GPLXPAT0",1,0)
+GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
+"RTN","GPLXPAT0",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLXPAT0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPAT0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPAT0",5,0)
+ ;
+"RTN","GPLXPAT0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPAT0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPAT0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPAT0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPAT0",10,0)
+ ;
+"RTN","GPLXPAT0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPAT0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPAT0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPAT0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPAT0",15,0)
+ ;
+"RTN","GPLXPAT0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPAT0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPAT0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPAT0",19,0)
+ ;
+"RTN","GPLXPAT0",20,0)
+        W "NO ENTRY",!
+"RTN","GPLXPAT0",21,0)
+        Q
+"RTN","GPLXPAT0",22,0)
+        ;
+"RTN","GPLXPAT0",23,0)
+ ;;><TEST>
+"RTN","GPLXPAT0",24,0)
+ ;;><INIT>
+"RTN","GPLXPAT0",25,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLXPAT0",26,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FIRST")
+"RTN","GPLXPAT0",27,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","SECOND")
+"RTN","GPLXPAT0",28,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","THIRD")
+"RTN","GPLXPAT0",29,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
+"RTN","GPLXPAT0",30,0)
+ ;;>>?GPL(0)=4
+"RTN","GPLXPAT0",31,0)
+ ;;><INITXML>
+"RTN","GPLXPAT0",32,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",33,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",34,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",35,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",36,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
+"RTN","GPLXPAT0",37,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
+"RTN","GPLXPAT0",38,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
+"RTN","GPLXPAT0",39,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
+"RTN","GPLXPAT0",40,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
+"RTN","GPLXPAT0",41,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",42,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",43,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",44,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",45,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",46,0)
+ ;;><INITXML2>
+"RTN","GPLXPAT0",47,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",48,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",49,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",50,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",51,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
+"RTN","GPLXPAT0",52,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
+"RTN","GPLXPAT0",53,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","DATA2")
+"RTN","GPLXPAT0",54,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
+"RTN","GPLXPAT0",55,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",56,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
+"RTN","GPLXPAT0",57,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
+"RTN","GPLXPAT0",58,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
+"RTN","GPLXPAT0",59,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",60,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",61,0)
+ ;;><PUSHPOP>
+"RTN","GPLXPAT0",62,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",63,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",64,0)
+ ;;>>?GPL(GPL(0))="FOURTH"
+"RTN","GPLXPAT0",65,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",66,0)
+ ;;>>?GX="FOURTH"
+"RTN","GPLXPAT0",67,0)
+ ;;>>?GPL(GPL(0))="THIRD"
+"RTN","GPLXPAT0",68,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",69,0)
+ ;;>>?GX="THIRD"
+"RTN","GPLXPAT0",70,0)
+ ;;>>?GPL(GPL(0))="SECOND"
+"RTN","GPLXPAT0",71,0)
+ ;;><MKMDX>
+"RTN","GPLXPAT0",72,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",73,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",74,0)
+ ;;>>>S GX=""
+"RTN","GPLXPAT0",75,0)
+ ;;>>>D MKMDX^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",76,0)
+ ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
+"RTN","GPLXPAT0",77,0)
+ ;;><XNAME>
+"RTN","GPLXPAT0",78,0)
+ ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
+"RTN","GPLXPAT0",79,0)
+ ;;>>?$$XNAME^GPLXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
+"RTN","GPLXPAT0",80,0)
+ ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
+"RTN","GPLXPAT0",81,0)
+ ;;><INDEX>
+"RTN","GPLXPAT0",82,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",83,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
+"RTN","GPLXPAT0",84,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",85,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",86,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
+"RTN","GPLXPAT0",87,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
+"RTN","GPLXPAT0",88,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
+"RTN","GPLXPAT0",89,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
+"RTN","GPLXPAT0",90,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",91,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",92,0)
+ ;;><INDEX2>
+"RTN","GPLXPAT0",93,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML2")
+"RTN","GPLXPAT0",94,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",95,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",96,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
+"RTN","GPLXPAT0",97,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
+"RTN","GPLXPAT0",98,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
+"RTN","GPLXPAT0",99,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
+"RTN","GPLXPAT0",100,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",101,0)
+ ;;><MISSING>
+"RTN","GPLXPAT0",102,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",103,0)
+ ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
+"RTN","GPLXPAT0",104,0)
+ ;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
+"RTN","GPLXPAT0",105,0)
+ ;;>>?@OUTARY@(1)="DATA1"
+"RTN","GPLXPAT0",106,0)
+ ;;>>?@OUTARY@(2)="DATA2"
+"RTN","GPLXPAT0",107,0)
+ ;;><MAP>
+"RTN","GPLXPAT0",108,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",109,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",110,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",111,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",112,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",113,0)
+ ;;>>?@OUTARY@(6)="VALUE2"
+"RTN","GPLXPAT0",114,0)
+ ;;><MAP2>
+"RTN","GPLXPAT0",115,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",116,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",117,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",118,0)
+ ;;>>>S @MAPARY@("DATA1")="VALUE1"
+"RTN","GPLXPAT0",119,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",120,0)
+ ;;>>>S @MAPARY@("DATA3")="VALUE3"
+"RTN","GPLXPAT0",121,0)
+ ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
+"RTN","GPLXPAT0",122,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",123,0)
+ ;;>>>D PARY^GPLXPATH(OUTARY)
+"RTN","GPLXPAT0",124,0)
+ ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
+"RTN","GPLXPAT0",125,0)
+ ;;><QUEUE>
+"RTN","GPLXPAT0",126,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
+"RTN","GPLXPAT0",127,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
+"RTN","GPLXPAT0",128,0)
+ ;;>>?$P(BTLIST(2),";",2)=4
+"RTN","GPLXPAT0",129,0)
+ ;;><BUILD>
+"RTN","GPLXPAT0",130,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",131,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
+"RTN","GPLXPAT0",132,0)
+ ;;>>>D ZTEST^GPLXPATH("QUEUE")
+"RTN","GPLXPAT0",133,0)
+ ;;>>>D BUILD^GPLXPATH("BTLIST","G3")
+"RTN","GPLXPAT0",134,0)
+ ;;><CP>
+"RTN","GPLXPAT0",135,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",136,0)
+ ;;>>>D CP^GPLXPATH("GXML","G2")
+"RTN","GPLXPAT0",137,0)
+ ;;>>?G2(0)=13
+"RTN","GPLXPAT0",138,0)
+ ;;><QOPEN>
+"RTN","GPLXPAT0",139,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",140,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",141,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",142,0)
+ ;;>>?$P(GBL(1),";",3)=12
+"RTN","GPLXPAT0",143,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",144,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",145,0)
+ ;;><QOPEN2>
+"RTN","GPLXPAT0",146,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",147,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",148,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
+"RTN","GPLXPAT0",149,0)
+ ;;>>?$P(GBL(1),";",3)=11
+"RTN","GPLXPAT0",150,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",151,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",152,0)
+ ;;><QCLOSE>
+"RTN","GPLXPAT0",153,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",154,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",155,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",156,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",157,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",158,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",159,0)
+ ;;><QCLOSE2>
+"RTN","GPLXPAT0",160,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",161,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",162,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",163,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",164,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",165,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",166,0)
+ ;;>>?G2(1)="</THIRD>"
+"RTN","GPLXPAT0",167,0)
+ ;;><INSERT>
+"RTN","GPLXPAT0",168,0)
+ ;;>>>K G2,GBL,G3,G4
+"RTN","GPLXPAT0",169,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",170,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",171,0)
+ ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",172,0)
+ ;;>>>D INSERT^GPLXPATH("G3","G2","//")
+"RTN","GPLXPAT0",173,0)
+ ;;>>?G2(1)=GXML(9)
+"RTN","GPLXPAT0",174,0)
+ ;;><REPLACE>
+"RTN","GPLXPAT0",175,0)
+ ;;>>>K G2,GBL,G3
+"RTN","GPLXPAT0",176,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",177,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",178,0)
+ ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
+"RTN","GPLXPAT0",179,0)
+ ;;>>?GXML(2)="<FIFTH>"
+"RTN","GPLXPAT0",180,0)
+ ;;><INSINNER>
+"RTN","GPLXPAT0",181,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",182,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",183,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",184,0)
+ ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",185,0)
+ ;;>>?GXML(10)="<FIFTH>"
+"RTN","GPLXPAT0",186,0)
+ ;;><INSINNER2>
+"RTN","GPLXPAT0",187,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",188,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",189,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",190,0)
+ ;;>>>D INSINNER^GPLXPATH("G2","G2")
+"RTN","GPLXPAT0",191,0)
+ ;;>>?G2(8)="<FIFTH>"
+"RTN","GPLXPAT0",192,0)
+ ;;></TEST>
+"RTN","GPLXPATH")
+0^9^B261673629
+"RTN","GPLXPATH",1,0)
+GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
+"RTN","GPLXPATH",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 5
+"RTN","GPLXPATH",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPATH",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPATH",5,0)
+ ;
+"RTN","GPLXPATH",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPATH",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPATH",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPATH",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPATH",10,0)
+ ;
+"RTN","GPLXPATH",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPATH",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPATH",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPATH",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPATH",15,0)
+ ;
+"RTN","GPLXPATH",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPATH",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPATH",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPATH",19,0)
+ ;
+"RTN","GPLXPATH",20,0)
+          W "This is an XML XPATH utility library",!
+"RTN","GPLXPATH",21,0)
+          W !
+"RTN","GPLXPATH",22,0)
+          Q
+"RTN","GPLXPATH",23,0)
+          ;
+"RTN","GPLXPATH",24,0)
+OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+"RTN","GPLXPATH",25,0)
+          ;
+"RTN","GPLXPATH",26,0)
+          N Y
+"RTN","GPLXPATH",27,0)
+          S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
+"RTN","GPLXPATH",28,0)
+          I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
+"RTN","GPLXPATH",29,0)
+          ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
+"RTN","GPLXPATH",30,0)
+          Q
+"RTN","GPLXPATH",31,0)
+          ;
+"RTN","GPLXPATH",32,0)
+PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+"RTN","GPLXPATH",33,0)
+          ;  VAL IS A STRING AND STK IS PASSED BY NAME
+"RTN","GPLXPATH",34,0)
+          ;
+"RTN","GPLXPATH",35,0)
+          I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
+"RTN","GPLXPATH",36,0)
+          S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
+"RTN","GPLXPATH",37,0)
+          S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+"RTN","GPLXPATH",38,0)
+          Q
+"RTN","GPLXPATH",39,0)
+          ;
+"RTN","GPLXPATH",40,0)
+POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+"RTN","GPLXPATH",41,0)
+          ; VAL AND STK ARE PASSED BY REFERENCE
+"RTN","GPLXPATH",42,0)
+          ;
+"RTN","GPLXPATH",43,0)
+          I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
+"RTN","GPLXPATH",44,0)
+          . S VAL=""
+"RTN","GPLXPATH",45,0)
+          . S @STK@(0)=0
+"RTN","GPLXPATH",46,0)
+          I @STK@(0)>0  D  ;
+"RTN","GPLXPATH",47,0)
+          . S VAL=@STK@(@STK@(0))
+"RTN","GPLXPATH",48,0)
+          . K @STK@(@STK@(0))
+"RTN","GPLXPATH",49,0)
+          . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+"RTN","GPLXPATH",50,0)
+          Q
+"RTN","GPLXPATH",51,0)
+          ;
+"RTN","GPLXPATH",52,0)
+MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+"RTN","GPLXPATH",53,0)
+          ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
+"RTN","GPLXPATH",54,0)
+          S RTN=""
+"RTN","GPLXPATH",55,0)
+          N I
+"RTN","GPLXPATH",56,0)
+          ; W "STK= ",STK,!
+"RTN","GPLXPATH",57,0)
+          I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",58,0)
+          . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
+"RTN","GPLXPATH",59,0)
+          . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
+"RTN","GPLXPATH",60,0)
+          . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
+"RTN","GPLXPATH",61,0)
+          Q
+"RTN","GPLXPATH",62,0)
+          ;
+"RTN","GPLXPATH",63,0)
+XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+"RTN","GPLXPATH",64,0)
+          ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
+"RTN","GPLXPATH",65,0)
+          ; ISTR IS PASSED BY VALUE
+"RTN","GPLXPATH",66,0)
+          N CUR,TMP
+"RTN","GPLXPATH",67,0)
+          I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
+"RTN","GPLXPATH",68,0)
+          . S TMP=$P(ISTR,"<",2)
+"RTN","GPLXPATH",69,0)
+          I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
+"RTN","GPLXPATH",70,0)
+          . S TMP=$P(TMP,"/",2)
+"RTN","GPLXPATH",71,0)
+          S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
+"RTN","GPLXPATH",72,0)
+          ; W "CUR= ",CUR,!
+"RTN","GPLXPATH",73,0)
+          I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
+"RTN","GPLXPATH",74,0)
+           . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
+"RTN","GPLXPATH",75,0)
+          ; W "CUR2= ",CUR,!
+"RTN","GPLXPATH",76,0)
+          Q CUR
+"RTN","GPLXPATH",77,0)
+          ;
+"RTN","GPLXPATH",78,0)
+INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
+"RTN","GPLXPATH",79,0)
+          ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
+"RTN","GPLXPATH",80,0)
+          ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
+"RTN","GPLXPATH",81,0)
+          ; XML SECTION
+"RTN","GPLXPATH",82,0)
+          ; ZXML IS PASSED BY NAME
+"RTN","GPLXPATH",83,0)
+          N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
+"RTN","GPLXPATH",84,0)
+          N GPLSTK ; LEAVE OUT FOR DEBUGGING
+"RTN","GPLXPATH",85,0)
+          I '$D(@ZXML@(0))  D  ; NO XML PASSED
+"RTN","GPLXPATH",86,0)
+          . W "ERROR IN XML FILE",!
+"RTN","GPLXPATH",87,0)
+          S GPLSTK(0)=0 ; INITIALIZE STACK
+"RTN","GPLXPATH",88,0)
+          F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
+"RTN","GPLXPATH",89,0)
+          . S LINE=@ZXML@(I)
+"RTN","GPLXPATH",90,0)
+          . ;W LINE,!
+"RTN","GPLXPATH",91,0)
+          . S FOUND=0  ; INTIALIZED FOUND FLAG
+"RTN","GPLXPATH",92,0)
+          . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
+"RTN","GPLXPATH",93,0)
+          . I FOUND'=1  D
+"RTN","GPLXPATH",94,0)
+          . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
+"RTN","GPLXPATH",95,0)
+          . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
+"RTN","GPLXPATH",96,0)
+          . . . ; ON THE SAME LINE
+"RTN","GPLXPATH",97,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",98,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",99,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",100,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",101,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",102,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",103,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",104,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",105,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",106,0)
+          . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
+"RTN","GPLXPATH",107,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",108,0)
+          . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
+"RTN","GPLXPATH",109,0)
+          . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
+"RTN","GPLXPATH",110,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",111,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",112,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",113,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",114,0)
+          . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",115,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",116,0)
+          . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
+"RTN","GPLXPATH",117,0)
+          . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
+"RTN","GPLXPATH",118,0)
+          . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
+"RTN","GPLXPATH",119,0)
+          . . . . Q
+"RTN","GPLXPATH",120,0)
+          . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
+"RTN","GPLXPATH",121,0)
+          . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
+"RTN","GPLXPATH",122,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",123,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",124,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",125,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",126,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",127,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",128,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",129,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",130,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",131,0)
+          . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
+"RTN","GPLXPATH",132,0)
+          S @ZXML@("INDEXED")=""
+"RTN","GPLXPATH",133,0)
+          S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
+"RTN","GPLXPATH",134,0)
+          Q
+"RTN","GPLXPATH",135,0)
+          ;
+"RTN","GPLXPATH",136,0)
+QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+"RTN","GPLXPATH",137,0)
+         ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
+"RTN","GPLXPATH",138,0)
+         ; IARY AND OARY ARE PASSED BY NAME
+"RTN","GPLXPATH",139,0)
+         I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
+"RTN","GPLXPATH",140,0)
+         . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
+"RTN","GPLXPATH",141,0)
+         N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
+"RTN","GPLXPATH",142,0)
+         N TMP,I,J,QXPATH
+"RTN","GPLXPATH",143,0)
+         S FIRST=1
+"RTN","GPLXPATH",144,0)
+         S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
+"RTN","GPLXPATH",145,0)
+         I XPATH'="//" D  ; NOT A ROOT QUERY
+"RTN","GPLXPATH",146,0)
+         . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
+"RTN","GPLXPATH",147,0)
+         . S FIRST=$P(TMP,"^",1)
+"RTN","GPLXPATH",148,0)
+         . S LAST=$P(TMP,"^",2)
+"RTN","GPLXPATH",149,0)
+         K @OARY
+"RTN","GPLXPATH",150,0)
+         S @OARY@(0)=+LAST-FIRST+1
+"RTN","GPLXPATH",151,0)
+         S J=1
+"RTN","GPLXPATH",152,0)
+         FOR I=FIRST:1:LAST  D
+"RTN","GPLXPATH",153,0)
+         . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
+"RTN","GPLXPATH",154,0)
+         . S J=J+1
+"RTN","GPLXPATH",155,0)
+         ; ZWR OARY
+"RTN","GPLXPATH",156,0)
+         Q
+"RTN","GPLXPATH",157,0)
+         ;
+"RTN","GPLXPATH",158,0)
+XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+"RTN","GPLXPATH",159,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",160,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",161,0)
+         Q $P(@IDX@(XPATH),"^",1)
+"RTN","GPLXPATH",162,0)
+         ;
+"RTN","GPLXPATH",163,0)
+XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+"RTN","GPLXPATH",164,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",165,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",166,0)
+         Q $P(@IDX@(XPATH),"^",2)
+"RTN","GPLXPATH",167,0)
+         ;
+"RTN","GPLXPATH",168,0)
+START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+"RTN","GPLXPATH",169,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",170,0)
+         ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",171,0)
+         Q $P(ISTR,";",2)
+"RTN","GPLXPATH",172,0)
+         ;
+"RTN","GPLXPATH",173,0)
+FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+"RTN","GPLXPATH",174,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",175,0)
+         Q $P(ISTR,";",3)
+"RTN","GPLXPATH",176,0)
+         ;
+"RTN","GPLXPATH",177,0)
+ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+"RTN","GPLXPATH",178,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",179,0)
+         Q $P(ISTR,";",1)
+"RTN","GPLXPATH",180,0)
+         ;
+"RTN","GPLXPATH",181,0)
+BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+"RTN","GPLXPATH",182,0)
+         ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+"RTN","GPLXPATH",183,0)
+         ; DEST IS CLEARED TO START
+"RTN","GPLXPATH",184,0)
+         ; USES PUSH TO DO THE COPY
+"RTN","GPLXPATH",185,0)
+         N I
+"RTN","GPLXPATH",186,0)
+         K @BDEST
+"RTN","GPLXPATH",187,0)
+         F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
+"RTN","GPLXPATH",188,0)
+         . N J,ATMP
+"RTN","GPLXPATH",189,0)
+         . S ATMP=$$ARRAY(@BLIST@(I))
+"RTN","GPLXPATH",190,0)
+         . I DEBUG W "ATMP=",ATMP,!
+"RTN","GPLXPATH",191,0)
+         . I DEBUG W @BLIST@(I),!
+"RTN","GPLXPATH",192,0)
+         . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
+"RTN","GPLXPATH",193,0)
+         . . ; FOR EACH LINE IN THIS INSTR
+"RTN","GPLXPATH",194,0)
+         . . I DEBUG W "BDEST= ",BDEST,!
+"RTN","GPLXPATH",195,0)
+         . . I DEBUG W "ATMP= ",@ATMP@(J),!
+"RTN","GPLXPATH",196,0)
+         . . D PUSH(BDEST,@ATMP@(J))
+"RTN","GPLXPATH",197,0)
+         Q
+"RTN","GPLXPATH",198,0)
+         ;
+"RTN","GPLXPATH",199,0)
+QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+"RTN","GPLXPATH",200,0)
+         ;
+"RTN","GPLXPATH",201,0)
+         I DEBUG W "QUEUEING ",BLST,!
+"RTN","GPLXPATH",202,0)
+         D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+"RTN","GPLXPATH",203,0)
+         Q
+"RTN","GPLXPATH",204,0)
+         ;
+"RTN","GPLXPATH",205,0)
+CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+"RTN","GPLXPATH",206,0)
+         ; KILLS CPDEST FIRST
+"RTN","GPLXPATH",207,0)
+         N CPINSTR
+"RTN","GPLXPATH",208,0)
+         I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
+"RTN","GPLXPATH",209,0)
+         I @CPSRC@(0)<1 D  ; BAD LENGTH
+"RTN","GPLXPATH",210,0)
+         . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
+"RTN","GPLXPATH",211,0)
+         . Q
+"RTN","GPLXPATH",212,0)
+         ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
+"RTN","GPLXPATH",213,0)
+         D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
+"RTN","GPLXPATH",214,0)
+         D BUILD("CPINSTR",CPDEST)
+"RTN","GPLXPATH",215,0)
+         Q
+"RTN","GPLXPATH",216,0)
+         ;
+"RTN","GPLXPATH",217,0)
+QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+"RTN","GPLXPATH",218,0)
+         ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
+"RTN","GPLXPATH",219,0)
+         ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
+"RTN","GPLXPATH",220,0)
+         ; USED TO INSERT CHILDREN NODES
+"RTN","GPLXPATH",221,0)
+         I @QOXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",222,0)
+         . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
+"RTN","GPLXPATH",223,0)
+         . Q
+"RTN","GPLXPATH",224,0)
+         I DEBUG W "DOING QOPEN",!
+"RTN","GPLXPATH",225,0)
+         N S1,E1,QOT,QOTMP
+"RTN","GPLXPATH",226,0)
+         S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
+"RTN","GPLXPATH",227,0)
+         I $D(QOXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",228,0)
+         . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
+"RTN","GPLXPATH",229,0)
+         . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
+"RTN","GPLXPATH",230,0)
+         I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",231,0)
+         . S E1=@QOXML@(0)-1
+"RTN","GPLXPATH",232,0)
+         D QUEUE(QOBLIST,QOXML,S1,E1)
+"RTN","GPLXPATH",233,0)
+         ; S QOTMP=QOXML_"^"_S1_"^"_E1
+"RTN","GPLXPATH",234,0)
+         ; D PUSH(QOBLIST,QOTMP)
+"RTN","GPLXPATH",235,0)
+         Q
+"RTN","GPLXPATH",236,0)
+         ;
+"RTN","GPLXPATH",237,0)
+QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+"RTN","GPLXPATH",238,0)
+         ; ADDS THE LIST LINE OF QCXML TO QCBLIST
+"RTN","GPLXPATH",239,0)
+         ; USED TO FINISH INSERTING CHILDERN NODES
+"RTN","GPLXPATH",240,0)
+         ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
+"RTN","GPLXPATH",241,0)
+         ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
+"RTN","GPLXPATH",242,0)
+         I @QCXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",243,0)
+         . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
+"RTN","GPLXPATH",244,0)
+         I DEBUG W "GOING TO CLOSE",!
+"RTN","GPLXPATH",245,0)
+         N S1,E1,QCT,QCTMP
+"RTN","GPLXPATH",246,0)
+         S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
+"RTN","GPLXPATH",247,0)
+         I $D(QCXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",248,0)
+         . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
+"RTN","GPLXPATH",249,0)
+         . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
+"RTN","GPLXPATH",250,0)
+         I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",251,0)
+         . S S1=@QCXML@(0)
+"RTN","GPLXPATH",252,0)
+         D QUEUE(QCBLIST,QCXML,S1,E1)
+"RTN","GPLXPATH",253,0)
+         ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+"RTN","GPLXPATH",254,0)
+         Q
+"RTN","GPLXPATH",255,0)
+         ;
+"RTN","GPLXPATH",256,0)
+INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+"RTN","GPLXPATH",257,0)
+         ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
+"RTN","GPLXPATH",258,0)
+         ; OMITTED, INSERTION WILL BE AT THE ROOT
+"RTN","GPLXPATH",259,0)
+         ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
+"RTN","GPLXPATH",260,0)
+         ; XML AT THE END OF THE XPATH POINT
+"RTN","GPLXPATH",261,0)
+         ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
+"RTN","GPLXPATH",262,0)
+         N INSBLD,INSTMP
+"RTN","GPLXPATH",263,0)
+         I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+"RTN","GPLXPATH",264,0)
+         I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+"RTN","GPLXPATH",265,0)
+         I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
+"RTN","GPLXPATH",266,0)
+         . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
+"RTN","GPLXPATH",267,0)
+         I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",268,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",269,0)
+         . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
+"RTN","GPLXPATH",270,0)
+         . . I DEBUG D PARY^GPLXPATH("INSBLD")
+"RTN","GPLXPATH",271,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",272,0)
+         . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
+"RTN","GPLXPATH",273,0)
+         . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
+"RTN","GPLXPATH",274,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",275,0)
+         . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
+"RTN","GPLXPATH",276,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",277,0)
+         . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
+"RTN","GPLXPATH",278,0)
+         . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+"RTN","GPLXPATH",279,0)
+         . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+"RTN","GPLXPATH",280,0)
+         Q
+"RTN","GPLXPATH",281,0)
+         ;
+"RTN","GPLXPATH",282,0)
+INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+"RTN","GPLXPATH",283,0)
+         ; INTO INNXML AT THE INNXPATH XPATH POINT
+"RTN","GPLXPATH",284,0)
+         ;
+"RTN","GPLXPATH",285,0)
+         N INNBLD,UXPATH
+"RTN","GPLXPATH",286,0)
+         N INNTBUF
+"RTN","GPLXPATH",287,0)
+         S INNTBUF=$NA(^TMP($J,"INNTBUF"))
+"RTN","GPLXPATH",288,0)
+         I '$D(INNXPATH) D  ; XPATH NOT PASSED
+"RTN","GPLXPATH",289,0)
+         . S UXPATH="//" ; USE ROOT XPATH
+"RTN","GPLXPATH",290,0)
+         I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
+"RTN","GPLXPATH",291,0)
+         I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
+"RTN","GPLXPATH",292,0)
+         . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
+"RTN","GPLXPATH",293,0)
+         . D BUILD("INNBLD",INNXML)
+"RTN","GPLXPATH",294,0)
+         I @INNXML@(0)>0  D  ; NOT EMPTY
+"RTN","GPLXPATH",295,0)
+         . D QOPEN("INNBLD",INNXML,UXPATH) ;
+"RTN","GPLXPATH",296,0)
+         . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
+"RTN","GPLXPATH",297,0)
+         . D QCLOSE("INNBLD",INNXML,UXPATH)
+"RTN","GPLXPATH",298,0)
+         . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
+"RTN","GPLXPATH",299,0)
+         . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+"RTN","GPLXPATH",300,0)
+         Q
+"RTN","GPLXPATH",301,0)
+         ;
+"RTN","GPLXPATH",302,0)
+INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+"RTN","GPLXPATH",303,0)
+        ; BUT XDEST AN XNEW ARE PASSED BY NAME
+"RTN","GPLXPATH",304,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",305,0)
+        D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
+"RTN","GPLXPATH",306,0)
+        D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
+"RTN","GPLXPATH",307,0)
+        D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
+"RTN","GPLXPATH",308,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",309,0)
+        D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
+"RTN","GPLXPATH",310,0)
+        I DEBUG D PARY("XDEST")
+"RTN","GPLXPATH",311,0)
+        Q
+"RTN","GPLXPATH",312,0)
+        ;
+"RTN","GPLXPATH",313,0)
+REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+"RTN","GPLXPATH",314,0)
+         ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
+"RTN","GPLXPATH",315,0)
+         ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
+"RTN","GPLXPATH",316,0)
+         ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
+"RTN","GPLXPATH",317,0)
+         N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+"RTN","GPLXPATH",318,0)
+         S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+"RTN","GPLXPATH",319,0)
+         D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+"RTN","GPLXPATH",320,0)
+         S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+"RTN","GPLXPATH",321,0)
+         S XFIRST=$P(XNODE,"^",1)
+"RTN","GPLXPATH",322,0)
+         S XLAST=$P(XNODE,"^",2)
+"RTN","GPLXPATH",323,0)
+         I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
+"RTN","GPLXPATH",324,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
+"RTN","GPLXPATH",325,0)
+         . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",326,0)
+         I RENEW'="" D  ; NEW XML IS NOT NULL
+"RTN","GPLXPATH",327,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+"RTN","GPLXPATH",328,0)
+         . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
+"RTN","GPLXPATH",329,0)
+         . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",330,0)
+         I DEBUG W "REPLACE PREBUILD",!
+"RTN","GPLXPATH",331,0)
+         I DEBUG D PARY("REBLD")
+"RTN","GPLXPATH",332,0)
+         D BUILD("REBLD","RTMP")
+"RTN","GPLXPATH",333,0)
+         K @REXML ; KILL WHAT WAS THERE
+"RTN","GPLXPATH",334,0)
+         D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","GPLXPATH",335,0)
+         Q
+"RTN","GPLXPATH",336,0)
+         ;
+"RTN","GPLXPATH",337,0)
+MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+"RTN","GPLXPATH",338,0)
+         ; W "Reporting on the missing",!
+"RTN","GPLXPATH",339,0)
+         ; W OARY
+"RTN","GPLXPATH",340,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
+"RTN","GPLXPATH",341,0)
+         N I
+"RTN","GPLXPATH",342,0)
+         S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
+"RTN","GPLXPATH",343,0)
+         F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",344,0)
+         . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
+"RTN","GPLXPATH",345,0)
+         . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
+"RTN","GPLXPATH",346,0)
+         . . Q
+"RTN","GPLXPATH",347,0)
+         Q
+"RTN","GPLXPATH",348,0)
+         ;
+"RTN","GPLXPATH",349,0)
+MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+"RTN","GPLXPATH",350,0)
+     ; AND PUT THE RESULTS IN OXML
+"RTN","GPLXPATH",351,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
+"RTN","GPLXPATH",352,0)
+         I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
+"RTN","GPLXPATH",353,0)
+         N I,J,TNAM,TVAL,TSTR
+"RTN","GPLXPATH",354,0)
+         S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
+"RTN","GPLXPATH",355,0)
+         F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",356,0)
+         . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
+"RTN","GPLXPATH",357,0)
+         . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
+"RTN","GPLXPATH",358,0)
+         . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+"RTN","GPLXPATH",359,0)
+         . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
+"RTN","GPLXPATH",360,0)
+         . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
+"RTN","GPLXPATH",361,0)
+         . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+"RTN","GPLXPATH",362,0)
+         . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+"RTN","GPLXPATH",363,0)
+         . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
+"RTN","GPLXPATH",364,0)
+         . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+"RTN","GPLXPATH",365,0)
+         . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+"RTN","GPLXPATH",366,0)
+         . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+"RTN","GPLXPATH",367,0)
+         . . I DEBUG W TSTR
+"RTN","GPLXPATH",368,0)
+         W "MAPPED",!
+"RTN","GPLXPATH",369,0)
+         Q
+"RTN","GPLXPATH",370,0)
+         ;
+"RTN","GPLXPATH",371,0)
+TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+"RTN","GPLXPATH",372,0)
+       ; THEXML IS PASSED BY NAME
+"RTN","GPLXPATH",373,0)
+       N I,J,TMPXML,DEL,FOUND,INTXT
+"RTN","GPLXPATH",374,0)
+       S FOUND=0
+"RTN","GPLXPATH",375,0)
+       S INTXT=0
+"RTN","GPLXPATH",376,0)
+       W "DELETING EMPTY ELEMENTS",!
+"RTN","GPLXPATH",377,0)
+       F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
+"RTN","GPLXPATH",378,0)
+       . S J=@THEXML@(I)
+"RTN","GPLXPATH",379,0)
+       . I J["<text>" D
+"RTN","GPLXPATH",380,0)
+       . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
+"RTN","GPLXPATH",381,0)
+       . . W "IN HTML SECTION",!
+"RTN","GPLXPATH",382,0)
+       . N JM,JP,JPX ; JMINUS AND JPLUS
+"RTN","GPLXPATH",383,0)
+       . S JM=@THEXML@(I-1) ; LINE BEFORE
+"RTN","GPLXPATH",384,0)
+       . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
+"RTN","GPLXPATH",385,0)
+       . S JP=@THEXML@(I+1) ; LINE AFTER
+"RTN","GPLXPATH",386,0)
+       . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
+"RTN","GPLXPATH",387,0)
+       . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
+"RTN","GPLXPATH",388,0)
+       . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
+"RTN","GPLXPATH",389,0)
+       . . . W I,J,JP,!
+"RTN","GPLXPATH",390,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",391,0)
+       . . . S DEL(I)="" ; SET LINE TO DELETE
+"RTN","GPLXPATH",392,0)
+       . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
+"RTN","GPLXPATH",393,0)
+       . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
+"RTN","GPLXPATH",394,0)
+       . . . W I,J,!
+"RTN","GPLXPATH",395,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",396,0)
+       . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
+"RTN","GPLXPATH",397,0)
+       . . . I JM=JPX D  ;
+"RTN","GPLXPATH",398,0)
+       . . . . W I,JM_J_JPX,!
+"RTN","GPLXPATH",399,0)
+       . . . . S DEL(I-1)=""
+"RTN","GPLXPATH",400,0)
+       . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
+"RTN","GPLXPATH",401,0)
+       ; . I J'["><" D PUSH("TMPXML",J)
+"RTN","GPLXPATH",402,0)
+       I FOUND D  ; NEED TO DELETE THINGS
+"RTN","GPLXPATH",403,0)
+       . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
+"RTN","GPLXPATH",404,0)
+       . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
+"RTN","GPLXPATH",405,0)
+       . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
+"RTN","GPLXPATH",406,0)
+       . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
+"RTN","GPLXPATH",407,0)
+       Q FOUND
+"RTN","GPLXPATH",408,0)
+       ;
+"RTN","GPLXPATH",409,0)
+UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+"RTN","GPLXPATH",410,0)
+        ; XSEC IS A SECTION PASSED BY NAME
+"RTN","GPLXPATH",411,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",412,0)
+        D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
+"RTN","GPLXPATH",413,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",414,0)
+        D CP("XTMP",XSEC) ; REPLACE PASSED XML
+"RTN","GPLXPATH",415,0)
+        Q
+"RTN","GPLXPATH",416,0)
+        ;
+"RTN","GPLXPATH",417,0)
+PARY(GLO)       ;PRINT AN ARRAY
+"RTN","GPLXPATH",418,0)
+        N I
+"RTN","GPLXPATH",419,0)
+        F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
+"RTN","GPLXPATH",420,0)
+        Q
+"RTN","GPLXPATH",421,0)
+        ;
+"RTN","GPLXPATH",422,0)
+TEST     ; Run all the test cases
+"RTN","GPLXPATH",423,0)
+        D TESTALL^GPLUNIT("GPLXPAT0")
+"RTN","GPLXPATH",424,0)
+        Q
+"RTN","GPLXPATH",425,0)
+        ;
+"RTN","GPLXPATH",426,0)
+ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+"RTN","GPLXPATH",427,0)
+          N ZTMP
+"RTN","GPLXPATH",428,0)
+          S DEBUG=1
+"RTN","GPLXPATH",429,0)
+          D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",430,0)
+          D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLXPATH",431,0)
+          Q
+"RTN","GPLXPATH",432,0)
+          ;
+"RTN","GPLXPATH",433,0)
+TLIST   ; LIST THE TESTS
+"RTN","GPLXPATH",434,0)
+        N ZTMP
+"RTN","GPLXPATH",435,0)
+        D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",436,0)
+        D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLXPATH",437,0)
+        Q
+"RTN","GPLXPATH",438,0)
+        ;
+"VER")
+8.0^22.0
+**END**
+**END**
Index: ccr/tags/CCR_1_0_4/p/CCR_1_0_3_T1_CACHE.KID
===================================================================
--- ccr/tags/CCR_1_0_4/p/CCR_1_0_3_T1_CACHE.KID	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/CCR_1_0_3_T1_CACHE.KID	(revision 169)
@@ -0,0 +1,9130 @@
+KIDS Distribution saved on Sep 05, 2008@15:25:07
+Removed debuggins Writes and 
+**KIDS**:CCR*1.0*3^
+
+**INSTALL NAME**
+CCR*1.0*3
+"BLD",6955,0)
+CCR*1.0*3^^0^3080905^n
+"BLD",6955,1,0)
+^^22^22^3080902^
+"BLD",6955,1,1,0)
+CCR AND CCD EXPORT TOOLS 
+"BLD",6955,1,2,0)
+ 
+"BLD",6955,1,3,0)
+SINGLE XML EXPORT TO A HOST DIRECTORY AT 
+"BLD",6955,1,4,0)
+ 
+"BLD",6955,1,5,0)
+BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
+"BLD",6955,1,6,0)
+DIRECTORY
+"BLD",6955,1,7,0)
+ 
+"BLD",6955,1,8,0)
+EXPORT^GPLCRR FOR THE CCR
+"BLD",6955,1,9,0)
+EXPORT^GPLCCD FOR THE CCD
+"BLD",6955,1,10,0)
+XPAT^GPLCCR(DFN,"","") 
+"BLD",6955,1,11,0)
+ 
+"BLD",6955,1,12,0)
+BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
+"BLD",6955,1,13,0)
+ 
+"BLD",6955,1,14,0)
+ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
+"BLD",6955,1,15,0)
+RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
+"BLD",6955,1,16,0)
+ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
+"BLD",6955,1,17,0)
+ 
+"BLD",6955,1,18,0)
+CLIST^GPLRIMA TO LIST CATEGORY TOTALS
+"BLD",6955,1,19,0)
+CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
+"BLD",6955,1,20,0)
+XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
+"BLD",6955,1,21,0)
+ 
+"BLD",6955,1,22,0)
+TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
+"BLD",6955,4,0)
+^9.64PA^^
+"BLD",6955,6.3)
+6
+"BLD",6955,"KRN",0)
+^9.67PA^8989.52^19
+"BLD",6955,"KRN",.4,0)
+.4
+"BLD",6955,"KRN",.401,0)
+.401
+"BLD",6955,"KRN",.402,0)
+.402
+"BLD",6955,"KRN",.403,0)
+.403
+"BLD",6955,"KRN",.5,0)
+.5
+"BLD",6955,"KRN",.84,0)
+.84
+"BLD",6955,"KRN",3.6,0)
+3.6
+"BLD",6955,"KRN",3.8,0)
+3.8
+"BLD",6955,"KRN",9.2,0)
+9.2
+"BLD",6955,"KRN",9.8,0)
+9.8
+"BLD",6955,"KRN",9.8,"NM",0)
+^9.68A^19^19
+"BLD",6955,"KRN",9.8,"NM",1,0)
+CCRDPT^^0^B312345713
+"BLD",6955,"KRN",9.8,"NM",2,0)
+CCRDPTT^^0^B4863621
+"BLD",6955,"KRN",9.8,"NM",3,0)
+CCRMEDS^^0^B46429484
+"BLD",6955,"KRN",9.8,"NM",4,0)
+CCRSYS^^0^B5010782
+"BLD",6955,"KRN",9.8,"NM",5,0)
+CCRUNIT^^0^B8574
+"BLD",6955,"KRN",9.8,"NM",6,0)
+CCRUTIL^^0^B17726385
+"BLD",6955,"KRN",9.8,"NM",7,0)
+CCRVA200^^0^B35847405
+"BLD",6955,"KRN",9.8,"NM",8,0)
+GPLACTOR^^0^B58454780
+"BLD",6955,"KRN",9.8,"NM",9,0)
+GPLXPATH^^0^B262915025
+"BLD",6955,"KRN",9.8,"NM",10,0)
+GPLUNIT^^0^B31630479
+"BLD",6955,"KRN",9.8,"NM",11,0)
+GPLPROBS^^0^B25407103
+"BLD",6955,"KRN",9.8,"NM",12,0)
+GPLVITAL^^0^B99003044
+"BLD",6955,"KRN",9.8,"NM",13,0)
+GPLRIMA^^0^B105704798
+"BLD",6955,"KRN",9.8,"NM",14,0)
+GPLCCR^^0^B68077868
+"BLD",6955,"KRN",9.8,"NM",15,0)
+GPLCCR0^^0^B658213703
+"BLD",6955,"KRN",9.8,"NM",16,0)
+GPLCCD^^0^B114413975
+"BLD",6955,"KRN",9.8,"NM",17,0)
+GPLCCD1^^0^B100039732
+"BLD",6955,"KRN",9.8,"NM",18,0)
+GPLMEDS^^0^B47701207
+"BLD",6955,"KRN",9.8,"NM",19,0)
+GPLXPAT0^^0^B44173297
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPT",1)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRDPTT",2)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS",3)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRSYS",4)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUNIT",5)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRUTIL",6)
+
+"BLD",6955,"KRN",9.8,"NM","B","CCRVA200",7)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLACTOR",8)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",16)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",17)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",14)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",15)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLMEDS",18)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",11)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",13)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",10)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",12)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",19)
+
+"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
+
+"BLD",6955,"KRN",19,0)
+19
+"BLD",6955,"KRN",19.1,0)
+19.1
+"BLD",6955,"KRN",101,0)
+101
+"BLD",6955,"KRN",409.61,0)
+409.61
+"BLD",6955,"KRN",771,0)
+771
+"BLD",6955,"KRN",870,0)
+870
+"BLD",6955,"KRN",8989.51,0)
+8989.51
+"BLD",6955,"KRN",8989.52,0)
+8989.52
+"BLD",6955,"KRN",8994,0)
+8994
+"BLD",6955,"KRN","B",.4,.4)
+
+"BLD",6955,"KRN","B",.401,.401)
+
+"BLD",6955,"KRN","B",.402,.402)
+
+"BLD",6955,"KRN","B",.403,.403)
+
+"BLD",6955,"KRN","B",.5,.5)
+
+"BLD",6955,"KRN","B",.84,.84)
+
+"BLD",6955,"KRN","B",3.6,3.6)
+
+"BLD",6955,"KRN","B",3.8,3.8)
+
+"BLD",6955,"KRN","B",9.2,9.2)
+
+"BLD",6955,"KRN","B",9.8,9.8)
+
+"BLD",6955,"KRN","B",19,19)
+
+"BLD",6955,"KRN","B",19.1,19.1)
+
+"BLD",6955,"KRN","B",101,101)
+
+"BLD",6955,"KRN","B",409.61,409.61)
+
+"BLD",6955,"KRN","B",771,771)
+
+"BLD",6955,"KRN","B",870,870)
+
+"BLD",6955,"KRN","B",8989.51,8989.51)
+
+"BLD",6955,"KRN","B",8989.52,8989.52)
+
+"BLD",6955,"KRN","B",8994,8994)
+
+"BLD",6955,"QUES",0)
+^9.62^^
+"BLD",6955,"REQB",0)
+^9.611^^
+"MBREQ")
+0
+"QUES","XPF1",0)
+Y
+"QUES","XPF1","??")
+^D REP^XPDH
+"QUES","XPF1","A")
+Shall I write over your |FLAG| File
+"QUES","XPF1","B")
+YES
+"QUES","XPF1","M")
+D XPF1^XPDIQ
+"QUES","XPF2",0)
+Y
+"QUES","XPF2","??")
+^D DTA^XPDH
+"QUES","XPF2","A")
+Want my data |FLAG| yours
+"QUES","XPF2","B")
+YES
+"QUES","XPF2","M")
+D XPF2^XPDIQ
+"QUES","XPI1",0)
+YO
+"QUES","XPI1","??")
+^D INHIBIT^XPDH
+"QUES","XPI1","A")
+Want KIDS to INHIBIT LOGONs during the install
+"QUES","XPI1","B")
+NO
+"QUES","XPI1","M")
+D XPI1^XPDIQ
+"QUES","XPM1",0)
+PO^VA(200,:EM
+"QUES","XPM1","??")
+^D MG^XPDH
+"QUES","XPM1","A")
+Enter the Coordinator for Mail Group '|FLAG|'
+"QUES","XPM1","B")
+
+"QUES","XPM1","M")
+D XPM1^XPDIQ
+"QUES","XPO1",0)
+Y
+"QUES","XPO1","??")
+^D MENU^XPDH
+"QUES","XPO1","A")
+Want KIDS to Rebuild Menu Trees Upon Completion of Install
+"QUES","XPO1","B")
+NO
+"QUES","XPO1","M")
+D XPO1^XPDIQ
+"QUES","XPZ1",0)
+Y
+"QUES","XPZ1","??")
+^D OPT^XPDH
+"QUES","XPZ1","A")
+Want to DISABLE Scheduled Options, Menu Options, and Protocols
+"QUES","XPZ1","B")
+NO
+"QUES","XPZ1","M")
+D XPZ1^XPDIQ
+"QUES","XPZ2",0)
+Y
+"QUES","XPZ2","??")
+^D RTN^XPDH
+"QUES","XPZ2","A")
+Want to MOVE routines to other CPUs
+"QUES","XPZ2","B")
+NO
+"QUES","XPZ2","M")
+D XPZ2^XPDIQ
+"RTN")
+19
+"RTN","CCRDPT")
+0^1^B312345713
+"RTN","CCRDPT",1,0)
+CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
+"RTN","CCRDPT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 6
+"RTN","CCRDPT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPT",5,0)
+ ;
+"RTN","CCRDPT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPT",9,0)
+ ;(at your option) any later version.
+"RTN","CCRDPT",10,0)
+ ;
+"RTN","CCRDPT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPT",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPT",15,0)
+ ;
+"RTN","CCRDPT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPT",19,0)
+    ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
+"RTN","CCRDPT",20,0)
+    ; DESTROY to clean-up.
+"RTN","CCRDPT",21,0)
+    ; The first line of every routine tests if the global exists.
+"RTN","CCRDPT",22,0)
+    ;
+"RTN","CCRDPT",23,0)
+    ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
+"RTN","CCRDPT",24,0)
+    ; INIT        9 lines  Copy DFN global to a local variable
+"RTN","CCRDPT",25,0)
+    ; DESTROY     6 lines  Kill local variable
+"RTN","CCRDPT",26,0)
+    ; FAMILY      6 lines  Family Name
+"RTN","CCRDPT",27,0)
+    ; GIVEN       6 lines  Given Name
+"RTN","CCRDPT",28,0)
+    ; MIDDLE      6 lines  Middle Name
+"RTN","CCRDPT",29,0)
+    ; SUFFIX      6 lines  Suffix Name
+"RTN","CCRDPT",30,0)
+    ; DISPNAME    5 lines  Display Name
+"RTN","CCRDPT",31,0)
+    ; DOB         6 lines  Date of Birth
+"RTN","CCRDPT",32,0)
+    ; GENDER      4 lines  Get Gender
+"RTN","CCRDPT",33,0)
+    ; SSN         4 lines  Get SSN for ID
+"RTN","CCRDPT",34,0)
+    ; ADDRTYPE    4 lines  Get Home Address
+"RTN","CCRDPT",35,0)
+    ; ADDR1       4 lines  Get Home Address line 1
+"RTN","CCRDPT",36,0)
+    ; ADDR2       5 lines  Get Home Address line 2
+"RTN","CCRDPT",37,0)
+    ; CITY        4 lines  Get City for Home Address
+"RTN","CCRDPT",38,0)
+    ; STATE      11 lines  Get State for Home Address
+"RTN","CCRDPT",39,0)
+    ; ZIP         4 lines  Get Zip code for Home Address
+"RTN","CCRDPT",40,0)
+    ; COUNTY      4 lines  Get County for our Address
+"RTN","CCRDPT",41,0)
+    ; COUNTRY     4 lines  Get Country for our Address
+"RTN","CCRDPT",42,0)
+    ; RESTEL      4 lines  Residential Telephone
+"RTN","CCRDPT",43,0)
+    ; WORKTEL     4 lines  Work Telephone
+"RTN","CCRDPT",44,0)
+    ; EMAIL       4 lines  Email Adddress
+"RTN","CCRDPT",45,0)
+    ; CELLTEL     4 lines  Cell Phone
+"RTN","CCRDPT",46,0)
+    ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
+"RTN","CCRDPT",47,0)
+    ; NOK1GIV     6 lines  NOK1 Given Name
+"RTN","CCRDPT",48,0)
+    ; NOK1MID     6 lines  NOK1 Middle Name
+"RTN","CCRDPT",49,0)
+    ; NOK1SUF     6 lines  NOK1 Suffi Name
+"RTN","CCRDPT",50,0)
+    ; NOK1DISP    5 lines  NOK1 Display Name
+"RTN","CCRDPT",51,0)
+    ; NOK1REL     4 lines  NOK1 Relationship to the patient
+"RTN","CCRDPT",52,0)
+    ; NOK1ADD1    4 lines  NOK1 Address 1
+"RTN","CCRDPT",53,0)
+    ; NOK1ADD2    5 lines  NOK1 Address 2
+"RTN","CCRDPT",54,0)
+    ; NOK1CITY    4 lines  NOK1 City
+"RTN","CCRDPT",55,0)
+    ; NOK1STAT    5 lines  NOK1 State
+"RTN","CCRDPT",56,0)
+    ; NOK1ZIP     4 lines  NOK1 Zip Code
+"RTN","CCRDPT",57,0)
+    ; NOK1HTEL;   4 lines  NOK1 Home Telephone
+"RTN","CCRDPT",58,0)
+    ; NOK1WTEL;   4 lines  NOK1 Work Telephone
+"RTN","CCRDPT",59,0)
+    ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
+"RTN","CCRDPT",60,0)
+    ; NOK2FAM     6 lines  NOK2 Family Name
+"RTN","CCRDPT",61,0)
+    ; NOK2GIV     6 lines  NOK2 Given Name
+"RTN","CCRDPT",62,0)
+    ; NOK2MID     6 lines  NOK2 Middle Name
+"RTN","CCRDPT",63,0)
+    ; NOK2SUF     5 lines  NOK2 Suffi Name
+"RTN","CCRDPT",64,0)
+    ; NOK2DISP    5 lines  NOK2 Display Name
+"RTN","CCRDPT",65,0)
+    ; NOK2REL     4 lines  NOK2 Relationship to the patient
+"RTN","CCRDPT",66,0)
+    ; NOK2ADD1    4 lines  NOK2 Address 1
+"RTN","CCRDPT",67,0)
+    ; NOK2ADD2    5 lines  NOK2 Address 2
+"RTN","CCRDPT",68,0)
+    ; NOK2CITY    4 lines  NOK2 City
+"RTN","CCRDPT",69,0)
+    ; NOK2STAT    5 lines  NOK2 State
+"RTN","CCRDPT",70,0)
+    ; NOK2ZIP     4 lines  NOK2 Zip Code
+"RTN","CCRDPT",71,0)
+    ; NOK2HTEL;   4 lines  NOK2 Home Telephone
+"RTN","CCRDPT",72,0)
+    ; NOK2WTEL;   4 lines  NOK2 Work Telephone
+"RTN","CCRDPT",73,0)
+    ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
+"RTN","CCRDPT",74,0)
+    ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
+"RTN","CCRDPT",75,0)
+    ; EMERGIV     6 lines  EMER Given Name
+"RTN","CCRDPT",76,0)
+    ; EMERMID     6 lines  EMER Middle Name
+"RTN","CCRDPT",77,0)
+    ; EMERSUF     5 lines  EMER Suffi Name
+"RTN","CCRDPT",78,0)
+    ; EMERDISP    5 lines  EMER Display Name
+"RTN","CCRDPT",79,0)
+    ; EMERREL     4 lines  EMER Relationship to the patient
+"RTN","CCRDPT",80,0)
+    ; EMERADD1    4 lines  EMER Address 1
+"RTN","CCRDPT",81,0)
+    ; EMERADD2    5 lines  EMER Address 2
+"RTN","CCRDPT",82,0)
+    ; EMERCITY    4 lines  EMER City
+"RTN","CCRDPT",83,0)
+    ; EMERSTAT    5 lines  EMER State
+"RTN","CCRDPT",84,0)
+    ; EMERZIP     4 lines  EMER Zip Code
+"RTN","CCRDPT",85,0)
+    ; EMERHTEL;   4 lines  EMER Home Telephone
+"RTN","CCRDPT",86,0)
+    ; EMERWTEL;   4 lines  EMER Work Telephone
+"RTN","CCRDPT",87,0)
+    ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
+"RTN","CCRDPT",88,0)
+    ;
+"RTN","CCRDPT",89,0)
+          W "No Entry at top!" Q
+"RTN","CCRDPT",90,0)
+   ; The following is a map of the relevant data in the patient global.
+"RTN","CCRDPT",91,0)
+    ;
+"RTN","CCRDPT",92,0)
+    ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
+"RTN","CCRDPT",93,0)
+    ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
+"RTN","CCRDPT",94,0)
+    ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
+"RTN","CCRDPT",95,0)
+    ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
+"RTN","CCRDPT",96,0)
+    ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
+"RTN","CCRDPT",97,0)
+    ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
+"RTN","CCRDPT",98,0)
+    ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
+"RTN","CCRDPT",99,0)
+    ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
+"RTN","CCRDPT",100,0)
+    ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
+"RTN","CCRDPT",101,0)
+    ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
+"RTN","CCRDPT",102,0)
+    ; ==>[21S] ^
+"RTN","CCRDPT",103,0)
+    ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
+"RTN","CCRDPT",104,0)
+    ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
+"RTN","CCRDPT",105,0)
+    ; ==>COMPONENTS [3P:20] ^
+"RTN","CCRDPT",106,0)
+    ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
+"RTN","CCRDPT",107,0)
+    ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
+"RTN","CCRDPT",108,0)
+    ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
+"RTN","CCRDPT",109,0)
+    ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
+"RTN","CCRDPT",110,0)
+    ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
+"RTN","CCRDPT",111,0)
+    ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
+"RTN","CCRDPT",112,0)
+    ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
+"RTN","CCRDPT",113,0)
+    ; ==>^
+"RTN","CCRDPT",114,0)
+    ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
+"RTN","CCRDPT",115,0)
+    ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
+"RTN","CCRDPT",116,0)
+    ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
+"RTN","CCRDPT",117,0)
+    ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
+"RTN","CCRDPT",118,0)
+    ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
+"RTN","CCRDPT",119,0)
+    ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
+"RTN","CCRDPT",120,0)
+    ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
+"RTN","CCRDPT",121,0)
+    ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
+"RTN","CCRDPT",122,0)
+    ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
+"RTN","CCRDPT",123,0)
+    ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
+"RTN","CCRDPT",124,0)
+    ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
+"RTN","CCRDPT",125,0)
+    ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
+"RTN","CCRDPT",126,0)
+    ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
+"RTN","CCRDPT",127,0)
+    ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
+"RTN","CCRDPT",128,0)
+    ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
+"RTN","CCRDPT",129,0)
+    ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
+"RTN","CCRDPT",130,0)
+    ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
+"RTN","CCRDPT",131,0)
+    ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
+"RTN","CCRDPT",132,0)
+    ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
+"RTN","CCRDPT",133,0)
+    ; ==>SITE [14P:4] ^
+"RTN","CCRDPT",134,0)
+    ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
+"RTN","CCRDPT",135,0)
+    ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
+"RTN","CCRDPT",136,0)
+    ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
+"RTN","CCRDPT",137,0)
+    ; ==>3] [5F] ^
+"RTN","CCRDPT",138,0)
+    ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
+"RTN","CCRDPT",139,0)
+    ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
+"RTN","CCRDPT",140,0)
+    ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
+"RTN","CCRDPT",141,0)
+    ; ==>^
+"RTN","CCRDPT",142,0)
+    ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
+"RTN","CCRDPT",143,0)
+    ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
+"RTN","CCRDPT",144,0)
+    ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
+"RTN","CCRDPT",145,0)
+    ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
+"RTN","CCRDPT",146,0)
+    ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
+"RTN","CCRDPT",147,0)
+    ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
+"RTN","CCRDPT",148,0)
+    ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
+"RTN","CCRDPT",149,0)
+    ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
+"RTN","CCRDPT",150,0)
+    ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
+"RTN","CCRDPT",151,0)
+    ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
+"RTN","CCRDPT",152,0)
+    ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
+"RTN","CCRDPT",153,0)
+    ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
+"RTN","CCRDPT",154,0)
+    ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
+"RTN","CCRDPT",155,0)
+    ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
+"RTN","CCRDPT",156,0)
+    ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
+"RTN","CCRDPT",157,0)
+    ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
+"RTN","CCRDPT",158,0)
+    ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
+"RTN","CCRDPT",159,0)
+    ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
+"RTN","CCRDPT",160,0)
+    ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
+"RTN","CCRDPT",161,0)
+    ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
+"RTN","CCRDPT",162,0)
+    ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
+"RTN","CCRDPT",163,0)
+    ; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
+"RTN","CCRDPT",164,0)
+    ; INPUT: Patient IEN (DFN)
+"RTN","CCRDPT",165,0)
+    ; OUTPUT: PT in the Symbol Table, representing the patient global
+"RTN","CCRDPT",166,0)
+    ; Instead of accessing a global each single read (SLOOOOW)
+"RTN","CCRDPT",167,0)
+    ; read it off a local variable stored in Memory.
+"RTN","CCRDPT",168,0)
+INIT(DFN) ;
+"RTN","CCRDPT",169,0)
+          M PT=^DPT(DFN)
+"RTN","CCRDPT",170,0)
+          Q
+"RTN","CCRDPT",171,0)
+          ;
+"RTN","CCRDPT",172,0)
+DESTROY ; Kill local variable; PUBLIC
+"RTN","CCRDPT",173,0)
+          ; INPUT: None
+"RTN","CCRDPT",174,0)
+          ; OUTPUT: Kill PT from the Symbol Table after you are done
+"RTN","CCRDPT",175,0)
+          K PT
+"RTN","CCRDPT",176,0)
+          Q
+"RTN","CCRDPT",177,0)
+          ;
+"RTN","CCRDPT",178,0)
+FAMILY() ; Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",179,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",180,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",181,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",182,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",183,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",184,0)
+          ;
+"RTN","CCRDPT",185,0)
+GIVEN() ; Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",186,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",187,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",188,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",189,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",190,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",191,0)
+          ;
+"RTN","CCRDPT",192,0)
+MIDDLE() ; Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",193,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",194,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",195,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",196,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",197,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",198,0)
+          ;
+"RTN","CCRDPT",199,0)
+SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",200,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",201,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",202,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",203,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",204,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",205,0)
+          ;
+"RTN","CCRDPT",206,0)
+DISPNAME() ; Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",207,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",208,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",209,0)
+          N NAME S NAME=$P(PT(0),"^",1)
+"RTN","CCRDPT",210,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",211,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",212,0)
+DOB() ; Date of Birth; PUBLIC; Extrinsic
+"RTN","CCRDPT",213,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",214,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",215,0)
+          N DOB S DOB=$P(PT(0),"^",3)
+"RTN","CCRDPT",216,0)
+          ; Date in FM Date Format. Convert to UTC/ISO 8601.
+"RTN","CCRDPT",217,0)
+          Q $$FMDTOUTC^CCRUTIL(DOB,"D")
+"RTN","CCRDPT",218,0)
+          ;
+"RTN","CCRDPT",219,0)
+GENDER() ; Get Gender; PUBLIC; Extrinsic
+"RTN","CCRDPT",220,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",221,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",222,0)
+          Q $P(PT(0),"^",2)
+"RTN","CCRDPT",223,0)
+          ;
+"RTN","CCRDPT",224,0)
+SSN() ; Get SSN for ID; PUBLIC; Extrinsic
+"RTN","CCRDPT",225,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",226,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",227,0)
+          Q $P(PT(0),"^",9)
+"RTN","CCRDPT",228,0)
+          ;
+"RTN","CCRDPT",229,0)
+ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",230,0)
+          ; Vista only stores a home address for the patient.
+"RTN","CCRDPT",231,0)
+          Q:$G(PT(0))="" ""
+"RTN","CCRDPT",232,0)
+          Q "Home"
+"RTN","CCRDPT",233,0)
+          ;
+"RTN","CCRDPT",234,0)
+ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",235,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",236,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",237,0)
+          Q $P(PT(.11),"^",1)
+"RTN","CCRDPT",238,0)
+          ;
+"RTN","CCRDPT",239,0)
+ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",240,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",241,0)
+          ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
+"RTN","CCRDPT",242,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",243,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",244,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",245,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",246,0)
+          Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2)
+"RTN","CCRDPT",247,0)
+          Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3)
+"RTN","CCRDPT",248,0)
+          ;
+"RTN","CCRDPT",249,0)
+CITY() ; Get City for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",250,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",251,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",252,0)
+          Q $P(PT(.11),"^",4)
+"RTN","CCRDPT",253,0)
+          ;
+"RTN","CCRDPT",254,0)
+STATE() ; Get State for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",255,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",256,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",257,0)
+          ; State is stored as a pointer
+"RTN","CCRDPT",258,0)
+          N STATENUM S STATENUM=$P(PT(.11),"^",5)
+"RTN","CCRDPT",259,0)
+          ;
+"RTN","CCRDPT",260,0)
+          ; State File Global is below
+"RTN","CCRDPT",261,0)
+          ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE
+"RTN","CCRDPT",262,0)
+          ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2)
+"RTN","CCRDPT",263,0)
+          ; ==>US STATE OR POSSESSION [6S] ^
+"RTN","CCRDPT",264,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",265,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",266,0)
+          ;
+"RTN","CCRDPT",267,0)
+ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",268,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",269,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",270,0)
+          Q $P(PT(.11),"^",6)
+"RTN","CCRDPT",271,0)
+          ;
+"RTN","CCRDPT",272,0)
+COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",273,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",274,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",275,0)
+          Q $P(PT(.11),"^",7)
+"RTN","CCRDPT",276,0)
+          ;
+"RTN","CCRDPT",277,0)
+COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
+"RTN","CCRDPT",278,0)
+          ; Unfortunately, I can't find where that is stored, so the inevitable...
+"RTN","CCRDPT",279,0)
+          Q:$G(PT(.11))="" ""
+"RTN","CCRDPT",280,0)
+          Q "USA"
+"RTN","CCRDPT",281,0)
+          ;
+"RTN","CCRDPT",282,0)
+RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",283,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",284,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",285,0)
+          Q $P(PT(.13),"^",1)
+"RTN","CCRDPT",286,0)
+          ;
+"RTN","CCRDPT",287,0)
+WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",288,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",289,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",290,0)
+          Q $P(PT(.13),"^",2)
+"RTN","CCRDPT",291,0)
+          ;
+"RTN","CCRDPT",292,0)
+EMAIL() ; Email Adddress; PUBLIC; Extrinsic
+"RTN","CCRDPT",293,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",294,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",295,0)
+          Q $P(PT(.13),"^",3)
+"RTN","CCRDPT",296,0)
+          ;
+"RTN","CCRDPT",297,0)
+CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
+"RTN","CCRDPT",298,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",299,0)
+          Q:$G(PT(.13))="" ""
+"RTN","CCRDPT",300,0)
+          Q $P(PT(.13),"^",4)
+"RTN","CCRDPT",301,0)
+          ;
+"RTN","CCRDPT",302,0)
+NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",303,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",304,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",305,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",306,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",307,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",308,0)
+          ;
+"RTN","CCRDPT",309,0)
+NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",310,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",311,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",312,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",313,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",314,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",315,0)
+          ;
+"RTN","CCRDPT",316,0)
+NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",317,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",318,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",319,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",320,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",321,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",322,0)
+          ;
+"RTN","CCRDPT",323,0)
+NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",324,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",325,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",326,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",327,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",328,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",329,0)
+          ;
+"RTN","CCRDPT",330,0)
+NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",331,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",332,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",333,0)
+          N NAME S NAME=$P(PT(.21),"^",1)
+"RTN","CCRDPT",334,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",335,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",336,0)
+NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",337,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",338,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",339,0)
+          Q $P(PT(.21),"^",2)
+"RTN","CCRDPT",340,0)
+          ;
+"RTN","CCRDPT",341,0)
+NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",342,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",343,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",344,0)
+          Q $P(PT(.21),"^",3)
+"RTN","CCRDPT",345,0)
+          ;
+"RTN","CCRDPT",346,0)
+NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",347,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",348,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",349,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",350,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",351,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",352,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",353,0)
+          Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
+"RTN","CCRDPT",354,0)
+          Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
+"RTN","CCRDPT",355,0)
+          ;
+"RTN","CCRDPT",356,0)
+NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",357,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",358,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",359,0)
+          Q $P(PT(.21),"^",6)
+"RTN","CCRDPT",360,0)
+          ;
+"RTN","CCRDPT",361,0)
+NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",362,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",363,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",364,0)
+          N STATENUM S STATENUM=$P(PT(.21),"^",7)
+"RTN","CCRDPT",365,0)
+          Q:STATENUM="" ""
+"RTN","CCRDPT",366,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1)
+"RTN","CCRDPT",367,0)
+          ;
+"RTN","CCRDPT",368,0)
+NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",369,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",370,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",371,0)
+          Q $P(PT(.21),"^",8)
+"RTN","CCRDPT",372,0)
+          ;
+"RTN","CCRDPT",373,0)
+NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",374,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",375,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",376,0)
+          Q $P(PT(.21),"^",9)
+"RTN","CCRDPT",377,0)
+          ;
+"RTN","CCRDPT",378,0)
+NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",379,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",380,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",381,0)
+          Q $P(PT(.21),"^",11)
+"RTN","CCRDPT",382,0)
+          ;
+"RTN","CCRDPT",383,0)
+NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",384,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",385,0)
+          Q:$G(PT(.21))="" ""
+"RTN","CCRDPT",386,0)
+          Q $P(PT(.21),"^",10)
+"RTN","CCRDPT",387,0)
+          ;
+"RTN","CCRDPT",388,0)
+NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",389,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",390,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",391,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",392,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",393,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",394,0)
+          ;
+"RTN","CCRDPT",395,0)
+NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
+"RTN","CCRDPT",396,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",397,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",398,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",399,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",400,0)
+          ;
+"RTN","CCRDPT",401,0)
+NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",402,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",403,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",404,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",405,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",406,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",407,0)
+          ;
+"RTN","CCRDPT",408,0)
+NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",409,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",410,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",411,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",412,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",413,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",414,0)
+NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",415,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",416,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",417,0)
+          N NAME S NAME=$P(PT(.211),"^",1)
+"RTN","CCRDPT",418,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",419,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",420,0)
+NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",421,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",422,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",423,0)
+          Q $P(PT(.211),"^",2)
+"RTN","CCRDPT",424,0)
+          ;
+"RTN","CCRDPT",425,0)
+NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",426,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",427,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",428,0)
+          Q $P(PT(.211),"^",3)
+"RTN","CCRDPT",429,0)
+          ;
+"RTN","CCRDPT",430,0)
+NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",431,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",432,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",433,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",434,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",435,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",436,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",437,0)
+          Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
+"RTN","CCRDPT",438,0)
+          Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
+"RTN","CCRDPT",439,0)
+          ;
+"RTN","CCRDPT",440,0)
+NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
+"RTN","CCRDPT",441,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",442,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",443,0)
+          Q $P(PT(.211),"^",6)
+"RTN","CCRDPT",444,0)
+          ;
+"RTN","CCRDPT",445,0)
+NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
+"RTN","CCRDPT",446,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",447,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",448,0)
+          N STATENUM S STATENUM=$P(PT(.211),"^",7)
+"RTN","CCRDPT",449,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",450,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",451,0)
+          ;
+"RTN","CCRDPT",452,0)
+NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",453,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",454,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",455,0)
+          Q $P(PT(.211),"^",8)
+"RTN","CCRDPT",456,0)
+          ;
+"RTN","CCRDPT",457,0)
+NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",458,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",459,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",460,0)
+          Q $P(PT(.211),"^",9)
+"RTN","CCRDPT",461,0)
+          ;
+"RTN","CCRDPT",462,0)
+NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",463,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",464,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",465,0)
+          Q $P(PT(.211),"^",11)
+"RTN","CCRDPT",466,0)
+          ;
+"RTN","CCRDPT",467,0)
+NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
+"RTN","CCRDPT",468,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",469,0)
+          Q:$G(PT(.211))="" ""
+"RTN","CCRDPT",470,0)
+          Q $P(PT(.211),"^",10)
+"RTN","CCRDPT",471,0)
+          ;
+"RTN","CCRDPT",472,0)
+EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",473,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",474,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",475,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",476,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",477,0)
+          Q NAME("FAMILY")
+"RTN","CCRDPT",478,0)
+          ;
+"RTN","CCRDPT",479,0)
+EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",480,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",481,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",482,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",483,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",484,0)
+          Q NAME("GIVEN")
+"RTN","CCRDPT",485,0)
+          ;
+"RTN","CCRDPT",486,0)
+EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",487,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",488,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",489,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",490,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",491,0)
+          Q NAME("MIDDLE")
+"RTN","CCRDPT",492,0)
+          ;
+"RTN","CCRDPT",493,0)
+EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",494,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",495,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",496,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",497,0)
+          D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRDPT",498,0)
+          Q NAME("SUFFIX")
+"RTN","CCRDPT",499,0)
+EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
+"RTN","CCRDPT",500,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",501,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",502,0)
+          N NAME S NAME=$P(PT(.33),"^",1)
+"RTN","CCRDPT",503,0)
+          Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+"RTN","CCRDPT",504,0)
+          ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+"RTN","CCRDPT",505,0)
+EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
+"RTN","CCRDPT",506,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",507,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",508,0)
+          Q $P(PT(.33),"^",2)
+"RTN","CCRDPT",509,0)
+          ;
+"RTN","CCRDPT",510,0)
+EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
+"RTN","CCRDPT",511,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",512,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",513,0)
+          Q $P(PT(.33),"^",3)
+"RTN","CCRDPT",514,0)
+          ;
+"RTN","CCRDPT",515,0)
+EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
+"RTN","CCRDPT",516,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",517,0)
+          ; As before, CCR only allows two fileds for the address, so we have to compromise
+"RTN","CCRDPT",518,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",519,0)
+          ; If the thrid address is empty, just return the 2nd.
+"RTN","CCRDPT",520,0)
+          ; If the 2nd is empty, we don't lose, b/c it will return ""
+"RTN","CCRDPT",521,0)
+          ; This is so that we won't produce a comma if there is no 3rd addr.
+"RTN","CCRDPT",522,0)
+          Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
+"RTN","CCRDPT",523,0)
+          Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
+"RTN","CCRDPT",524,0)
+          ;
+"RTN","CCRDPT",525,0)
+EMERCITY() ; EMER City; PUBLIC; Extrinsic
+"RTN","CCRDPT",526,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",527,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",528,0)
+          Q $P(PT(.33),"^",6)
+"RTN","CCRDPT",529,0)
+          ;
+"RTN","CCRDPT",530,0)
+EMERSTAT() ; EMER State; PUBLIC; Extrinsic
+"RTN","CCRDPT",531,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",532,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",533,0)
+          N STATENUM S STATENUM=$P(PT(.33),"^",7)
+"RTN","CCRDPT",534,0)
+          Q:STATENUM="" ""  ; To prevent global undefined below if no state
+"RTN","CCRDPT",535,0)
+          Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+"RTN","CCRDPT",536,0)
+          ;
+"RTN","CCRDPT",537,0)
+EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
+"RTN","CCRDPT",538,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",539,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",540,0)
+          Q $P(PT(.33),"^",8)
+"RTN","CCRDPT",541,0)
+          ;
+"RTN","CCRDPT",542,0)
+EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",543,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",544,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",545,0)
+          Q $P(PT(.33),"^",9)
+"RTN","CCRDPT",546,0)
+          ;
+"RTN","CCRDPT",547,0)
+EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
+"RTN","CCRDPT",548,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",549,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",550,0)
+          Q $P(PT(.33),"^",11)
+"RTN","CCRDPT",551,0)
+          ;
+"RTN","CCRDPT",552,0)
+EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
+"RTN","CCRDPT",553,0)
+          ; PREREQ: PT Defined
+"RTN","CCRDPT",554,0)
+          Q:$G(PT(.33))="" ""
+"RTN","CCRDPT",555,0)
+          Q $P(PT(.33),"^",10)
+"RTN","CCRDPT",556,0)
+          ;
+"RTN","CCRDPTT")
+0^2^B4863621
+"RTN","CCRDPTT",1,0)
+CCRDPTT ; Unit Tester...
+"RTN","CCRDPTT",2,0)
+  ;;0.1;CCRCCD;;Jun 15, 2008;Build 6
+"RTN","CCRDPTT",3,0)
+ ;
+"RTN","CCRDPTT",4,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRDPTT",5,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRDPTT",6,0)
+ ;
+"RTN","CCRDPTT",7,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRDPTT",8,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRDPTT",9,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRDPTT",10,0)
+ ;(at your option) any later version.
+"RTN","CCRDPTT",11,0)
+ ;
+"RTN","CCRDPTT",12,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRDPTT",13,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRDPTT",14,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRDPTT",15,0)
+ ;GNU General Public License for more details.
+"RTN","CCRDPTT",16,0)
+ ;
+"RTN","CCRDPTT",17,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRDPTT",18,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRDPTT",19,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRDPTT",20,0)
+          ; Get the functions in the routine using Rick's routine
+"RTN","CCRDPTT",21,0)
+          ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860"
+"RTN","CCRDPTT",22,0)
+          ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08"
+"RTN","CCRDPTT",23,0)
+          ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;"
+"RTN","CCRDPTT",24,0)
+          ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC"
+"RTN","CCRDPTT",25,0)
+          ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC"
+"RTN","CCRDPTT",26,0)
+          ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",27,0)
+          ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic"
+"RTN","CCRDPTT",28,0)
+          ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
+"RTN","CCRDPTT",29,0)
+          ; etc.
+"RTN","CCRDPTT",30,0)
+          ;
+"RTN","CCRDPTT",31,0)
+          ; Load Routine Entry points; We get a sweeeeeet array
+"RTN","CCRDPTT",32,0)
+          D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
+"RTN","CCRDPTT",33,0)
+          N X,Y
+"RTN","CCRDPTT",34,0)
+          ; Select Patient
+"RTN","CCRDPTT",35,0)
+          S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","CCRDPTT",36,0)
+          ;
+"RTN","CCRDPTT",37,0)
+          W "You have selected patient "_Y,!!
+"RTN","CCRDPTT",38,0)
+          D INIT^CCRDPT($P(Y,"^"))
+"RTN","CCRDPTT",39,0)
+          ; ZWR PT
+"RTN","CCRDPTT",40,0)
+          N I S I=165 F  S I=$O(OUT(I)) Q:I=""  D
+"RTN","CCRDPTT",41,0)
+          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
+"RTN","CCRDPTT",42,0)
+          . W "valued at "
+"RTN","CCRDPTT",43,0)
+          . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()")
+"RTN","CCRDPTT",44,0)
+          . W !
+"RTN","CCRDPTT",45,0)
+          Q
+"RTN","CCRMEDS")
+0^3^B46429484
+"RTN","CCRMEDS",1,0)
+CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
+"RTN","CCRMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 6
+"RTN","CCRMEDS",3,0)
+   ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRMEDS",4,0)
+   ; General Public License See attached copy of the License.
+"RTN","CCRMEDS",5,0)
+   ; 
+"RTN","CCRMEDS",6,0)
+   ; This program is free software; you can redistribute it and/or modify
+"RTN","CCRMEDS",7,0)
+   ; it under the terms of the GNU General Public License as published by
+"RTN","CCRMEDS",8,0)
+   ; the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRMEDS",9,0)
+   ; (at your option) any later version.
+"RTN","CCRMEDS",10,0)
+   ; 
+"RTN","CCRMEDS",11,0)
+   ; This program is distributed in the hope that it will be useful,
+"RTN","CCRMEDS",12,0)
+   ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRMEDS",13,0)
+   ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRMEDS",14,0)
+   ; GNU General Public License for more details.
+"RTN","CCRMEDS",15,0)
+   ; 
+"RTN","CCRMEDS",16,0)
+   ; You should have received a copy of the GNU General Public License along
+"RTN","CCRMEDS",17,0)
+   ; with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRMEDS",18,0)
+   ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRMEDS",19,0)
+   ;
+"RTN","CCRMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","CCRMEDS",21,0)
+   Q
+"RTN","CCRMEDS",22,0)
+   ;
+"RTN","CCRMEDS",23,0)
+EXTRACT(INXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","CCRMEDS",24,0)
+   ;
+"RTN","CCRMEDS",25,0)
+   ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","CCRMEDS",26,0)
+   ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","CCRMEDS",27,0)
+   ; 
+"RTN","CCRMEDS",28,0)
+   ; MEDS is return array from RPC.
+"RTN","CCRMEDS",29,0)
+   ; MAP is a mapping variable map (store result) for each med
+"RTN","CCRMEDS",30,0)
+   ; MED is holds each array element from MEDS(J), one medicine
+"RTN","CCRMEDS",31,0)
+   ; J is a counter.
+"RTN","CCRMEDS",32,0)
+   ;
+"RTN","CCRMEDS",33,0)
+   ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+"RTN","CCRMEDS",34,0)
+   ; med data available.
+"RTN","CCRMEDS",35,0)
+   ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+"RTN","CCRMEDS",36,0)
+   ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+"RTN","CCRMEDS",37,0)
+ 
+"RTN","CCRMEDS",38,0)
+   N MEDS,MAP
+"RTN","CCRMEDS",39,0)
+   K ^TMP($J)
+"RTN","CCRMEDS",40,0)
+   D RX^PSO52API(DFN,"CCDCCR")
+"RTN","CCRMEDS",41,0)
+   M MEDS=^TMP($J,"CCDCCR",DFN)
+"RTN","CCRMEDS",42,0)
+   ; @(0) contains the number of meds or -1^NO DATA FOUND
+"RTN","CCRMEDS",43,0)
+   ; If it is -1, we quit.
+"RTN","CCRMEDS",44,0)
+   I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT  
+"RTN","CCRMEDS",45,0)
+   I DEBUG ZWR MEDS
+"RTN","CCRMEDS",46,0)
+   N RXIEN S RXIEN=0
+"RTN","CCRMEDS",47,0)
+   F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+"RTN","CCRMEDS",48,0)
+   . I DEBUG W "RXIEN IS ",RXIEN,!
+"RTN","CCRMEDS",49,0)
+   . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",J))
+"RTN","CCRMEDS",50,0)
+   . K @MAP
+"RTN","CCRMEDS",51,0)
+   . I DEBUG W "MAP= ",MAP,!
+"RTN","CCRMEDS",52,0)
+   . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+"RTN","CCRMEDS",53,0)
+   . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+"RTN","CCRMEDS",54,0)
+   . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+"RTN","CCRMEDS",55,0)
+   . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
+"RTN","CCRMEDS",56,0)
+   . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+"RTN","CCRMEDS",57,0)
+   . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
+"RTN","CCRMEDS",58,0)
+   . S @MAP@("MEDRXNOTXT")="Prescription Number"
+"RTN","CCRMEDS",59,0)
+   . S @MAP@("MEDRXNO")=MED(.01)
+"RTN","CCRMEDS",60,0)
+   . S @MAP@("MEDTYPETEXT")="Medication"
+"RTN","CCRMEDS",61,0)
+   . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+"RTN","CCRMEDS",62,0)
+   . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+"RTN","CCRMEDS",63,0)
+   . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+"RTN","CCRMEDS",64,0)
+   . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+"RTN","CCRMEDS",65,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
+"RTN","CCRMEDS",66,0)
+   . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+"RTN","CCRMEDS",67,0)
+   . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
+"RTN","CCRMEDS",68,0)
+   . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+"RTN","CCRMEDS",69,0)
+   . N MEDIEN S MEDIEN=$P(MED(6),U)
+"RTN","CCRMEDS",70,0)
+   . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+"RTN","CCRMEDS",71,0)
+   . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+"RTN","CCRMEDS",72,0)
+   . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+"RTN","CCRMEDS",73,0)
+   . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+"RTN","CCRMEDS",74,0)
+   . ; Units, concentration, etc, come from another call
+"RTN","CCRMEDS",75,0)
+   . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+"RTN","CCRMEDS",76,0)
+   . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+"RTN","CCRMEDS",77,0)
+   . ; NDF Entry IEN, and VA Product Name
+"RTN","CCRMEDS",78,0)
+   . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",79,0)
+   . ; Documented in the same manual.
+"RTN","CCRMEDS",80,0)
+   . N IEN S IEN=^PSDRUG($P(MED(6),U))
+"RTN","CCRMEDS",81,0)
+   . D NDF^PSS50(IEN,,,,,"CONC")
+"RTN","CCRMEDS",82,0)
+   . N NDFDATA M NDFDATA=^TMP($J,"CONC",IEN)
+"RTN","CCRMEDS",83,0)
+   . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+"RTN","CCRMEDS",84,0)
+   . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+"RTN","CCRMEDS",85,0)
+   . N CONCDATA S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+"RTN","CCRMEDS",86,0)
+   . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+"RTN","CCRMEDS",87,0)
+   . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+"RTN","CCRMEDS",88,0)
+   . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+"RTN","CCRMEDS",89,0)
+   . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
+"RTN","CCRMEDS",90,0)
+   . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+"RTN","CCRMEDS",91,0)
+   . ; Oddly, there is no easy place to find the dispense unit.
+"RTN","CCRMEDS",92,0)
+   . ; It's not included in the original call, so we have to go to the drug file.
+"RTN","CCRMEDS",93,0)
+   . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+"RTN","CCRMEDS",94,0)
+   . ; Node 14.5 is the Dispense Unit
+"RTN","CCRMEDS",95,0)
+   . D DATA^PSS50(IEN,,,,,"QTY")
+"RTN","CCRMEDS",96,0)
+   . N QTYDATA M QTYDATA=^TMP($J,"QTY",IEN)
+"RTN","CCRMEDS",97,0)
+   . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+"RTN","CCRMEDS",98,0)
+   . ;
+"RTN","CCRMEDS",99,0)
+   . ; --- START OF DIRECTIONS ---
+"RTN","CCRMEDS",100,0)
+   . ;
+"RTN","CCRMEDS",101,0)
+   . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+"RTN","CCRMEDS",102,0)
+   . S @MAP@("MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+"RTN","CCRMEDS",103,0)
+   . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+"RTN","CCRMEDS",104,0)
+   . ; we want the compoenents.
+"RTN","CCRMEDS",105,0)
+   . ; It's in node 6 of ^PSRX(IEN)
+"RTN","CCRMEDS",106,0)
+   . ; So, here we go again
+"RTN","CCRMEDS",107,0)
+   . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
+"RTN","CCRMEDS",108,0)
+     ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
+"RTN","CCRMEDS",109,0)
+     ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
+"RTN","CCRMEDS",110,0)
+     ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
+"RTN","CCRMEDS",111,0)
+     N SIGDATA S SIGDATA=^PSRX(IEN,6,1,0)
+"RTN","CCRMEDS",112,0)
+   . S @MAP@("MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
+"RTN","CCRMEDS",113,0)
+   . S @MAP@("MEDDOSEVALUE")=$P(SIGDATA,U,1)
+"RTN","CCRMEDS",114,0)
+   . S @MAP@("MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+"RTN","CCRMEDS",115,0)
+   . S @MAP@("MEDRATEVALUE")=""  ; For inpatient
+"RTN","CCRMEDS",116,0)
+   . S @MAP@("MEDRATEUNIT")=""  ; For inpatient
+"RTN","CCRMEDS",117,0)
+   . S @MAP@("MEDVEHICLETEXT")=""  ; For inpatient
+"RTN","CCRMEDS",118,0)
+   . S @MAP@("MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
+"RTN","CCRMEDS",119,0)
+   . S @MAP@("MEDFREQUENCYVALUE")=$P(SIGDATA,U,7)
+"RTN","CCRMEDS",120,0)
+   . S @MAP@("MEDFREQUENCYUNIT")
+"RTN","CCRMEDS",121,0)
+   . S @MAP@("MEDINTERVALVALUE")
+"RTN","CCRMEDS",122,0)
+   . S @MAP@("MEDINTERVALUNIT")
+"RTN","CCRMEDS",123,0)
+   . S @MAP@("MEDDURATIONVALUE")=$P(SIGDATA,U,5)
+"RTN","CCRMEDS",124,0)
+   . S @MAP@("MEDDURATIONUNIT")
+"RTN","CCRMEDS",125,0)
+   . S @MAP@("MEDPRNFLAG")
+"RTN","CCRMEDS",126,0)
+   . S @MAP@("MEDPROBLEMOBJECTID")=""
+"RTN","CCRMEDS",127,0)
+   . S @MAP@("MEDPROBLEMDESCRIPTION")=""
+"RTN","CCRMEDS",128,0)
+   . S @MAP@("MEDPROBLEMCODEVALUE")=""
+"RTN","CCRMEDS",129,0)
+   . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
+"RTN","CCRMEDS",130,0)
+   . S @MAP@("MEDPROBLEMCODINGVERSION")=""
+"RTN","CCRMEDS",131,0)
+   . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
+"RTN","CCRMEDS",132,0)
+   . S @MAP@("MEDSTOPINDICATOR")=""
+"RTN","CCRMEDS",133,0)
+   . S @MAP@("MEDDIRSEQ")=""
+"RTN","CCRMEDS",134,0)
+   . S @MAP@("MEDMULDIRMOD")=""
+"RTN","CCRMEDS",135,0)
+   . ;
+"RTN","CCRMEDS",136,0)
+   . ; --- END OF DIRECTIONS ---
+"RTN","CCRMEDS",137,0)
+   . ;
+"RTN","CCRMEDS",138,0)
+   . S @MAP@("MEDPTINSTRUCTIONS")
+"RTN","CCRMEDS",139,0)
+   . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")
+"RTN","CCRMEDS",140,0)
+   . S @MAP@("MEDRFNO")=MED(9)
+"RTN","CCRMEDS",141,0)
+   . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT",J))
+"RTN","CCRMEDS",142,0)
+   . K @RESULT
+"RTN","CCRMEDS",143,0)
+   . D MAP^GPLXPATH(INXML,MAP,RESULT)
+"RTN","CCRMEDS",144,0)
+   . D:J=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
+"RTN","CCRMEDS",145,0)
+   . D:J>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+"RTN","CCRMEDS",146,0)
+   N MEDTMP,MEDI
+"RTN","CCRMEDS",147,0)
+   D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","CCRMEDS",148,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","CCRMEDS",149,0)
+   . W "MEDICATION MISSING ",!
+"RTN","CCRMEDS",150,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","CCRMEDS",151,0)
+   Q
+"RTN","CCRMEDS",152,0)
+   ;
+"RTN","CCRSYS")
+0^4^B5010782
+"RTN","CCRSYS",1,0)
+CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
+"RTN","CCRSYS",2,0)
+        ;;0.1;CCDCCR;;;Build 6
+"RTN","CCRSYS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRSYS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRSYS",5,0)
+ ;
+"RTN","CCRSYS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRSYS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRSYS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRSYS",9,0)
+ ;(at your option) any later version.
+"RTN","CCRSYS",10,0)
+ ;
+"RTN","CCRSYS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRSYS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRSYS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRSYS",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRSYS",15,0)
+ ;
+"RTN","CCRSYS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRSYS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRSYS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRSYS",19,0)
+    ;
+"RTN","CCRSYS",20,0)
+        W "Enter at appropriate points." Q
+"RTN","CCRSYS",21,0)
+        ;
+"RTN","CCRSYS",22,0)
+        ; Originally, I was going to use VEPERVER, but VEPERVER
+"RTN","CCRSYS",23,0)
+        ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
+"RTN","CCRSYS",24,0)
+        ; manner (press any key to continue),
+"RTN","CCRSYS",25,0)
+        ; and is really a very half finished routine
+"RTN","CCRSYS",26,0)
+        ;
+"RTN","CCRSYS",27,0)
+        ; So for now, I am hard-coding the values.
+"RTN","CCRSYS",28,0)
+        ;
+"RTN","CCRSYS",29,0)
+SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
+"RTN","CCRSYS",30,0)
+        Q "WorldVistA EHR/VOE"
+"RTN","CCRSYS",31,0)
+        ;
+"RTN","CCRSYS",32,0)
+SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
+"RTN","CCRSYS",33,0)
+        Q "1.0"
+"RTN","CCRSYS",34,0)
+        ;
+"RTN","CCRSYS",35,0)
+PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
+"RTN","CCRSYS",36,0)
+         ; DFN = IEN of the Patient to be tested
+"RTN","CCRSYS",37,0)
+         ; 1 = Merged or Test Patient
+"RTN","CCRSYS",38,0)
+         ; 0 = Non-test Patient
+"RTN","CCRSYS",39,0)
+         ;
+"RTN","CCRSYS",40,0)
+         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
+"RTN","CCRSYS",41,0)
+         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
+"RTN","CCRSYS",42,0)
+         ;
+"RTN","CCRSYS",43,0)
+         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
+"RTN","CCRSYS",44,0)
+         I 'CCRTEST D  ; IF WE ARE NOT TESTING, SKIP TEST PATIENTS
+"RTN","CCRSYS",45,0)
+         . N DIERR,DATA
+"RTN","CCRSYS",46,0)
+         . S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
+"RTN","CCRSYS",47,0)
+         . ; 1 = Test Patient
+"RTN","CCRSYS",48,0)
+         . ; 0 = Non-test Patient
+"RTN","CCRSYS",49,0)
+         . I DATA Q DATA
+"RTN","CCRSYS",50,0)
+         . S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
+"RTN","CCRSYS",51,0)
+         . D CLEAN^DILF
+"RTN","CCRSYS",52,0)
+         . I $E(DATA,1,3)="000" Q 1
+"RTN","CCRSYS",53,0)
+         . I $E(DATA,1,3)="666" Q 1
+"RTN","CCRSYS",54,0)
+         Q 0
+"RTN","CCRSYS",55,0)
+         ;
+"RTN","CCRUNIT")
+0^5^B8574
+"RTN","CCRUNIT",1,0)
+CCRUNIT ; A routine that tests some crap
+"RTN","CCRUNIT",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 6
+"RTN","CCRUNIT",3,0)
+        Q
+"RTN","CCRUNIT",4,0)
+        ;
+"RTN","CCRUNIT",5,0)
+MEDS
+"RTN","CCRUNIT",6,0)
+        N DEBUG S DEBUG=0
+"RTN","CCRUNIT",7,0)
+        N DFN S DFN=1
+"RTN","CCRUNIT",8,0)
+        K ^TMP($J)
+"RTN","CCRUNIT",9,0)
+        W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
+"RTN","CCRUNIT",10,0)
+        N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
+"RTN","CCRUNIT",11,0)
+        B
+"RTN","CCRUNIT",12,0)
+        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
+"RTN","CCRUNIT",13,0)
+        W "XPATH is: "_XPATH,!
+"RTN","CCRUNIT",14,0)
+        W "Getting Med Template into INXML using",!
+"RTN","CCRUNIT",15,0)
+        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
+"RTN","CCRUNIT",16,0)
+        N INXML
+"RTN","CCRUNIT",17,0)
+        D QUERY^GPLXPATH(T,XPATH,"INXML")
+"RTN","CCRUNIT",18,0)
+        B
+"RTN","CCRUNIT",19,0)
+        W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
+"RTN","CCRUNIT",20,0)
+        W "OUTXML will be ^TMP($J,""OUT"")",!
+"RTN","CCRUNIT",21,0)
+        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
+"RTN","CCRUNIT",22,0)
+        D EXTRACT^GPLMEDS("INXML",DFN,OUTXML)
+"RTN","CCRUNIT",23,0)
+        Q
+"RTN","CCRUTIL")
+0^6^B17726385
+"RTN","CCRUTIL",1,0)
+CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08
+"RTN","CCRUTIL",2,0)
+          ;;0.1;CCRCCD;;Jun 15, 2008;Build 6
+"RTN","CCRUTIL",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRUTIL",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRUTIL",5,0)
+ ;
+"RTN","CCRUTIL",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRUTIL",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRUTIL",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRUTIL",9,0)
+ ;(at your option) any later version.
+"RTN","CCRUTIL",10,0)
+ ;
+"RTN","CCRUTIL",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRUTIL",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRUTIL",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRUTIL",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRUTIL",15,0)
+ ;
+"RTN","CCRUTIL",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRUTIL",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRUTIL",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRUTIL",19,0)
+    ;
+"RTN","CCRUTIL",20,0)
+          W "No Entry at Top!"
+"RTN","CCRUTIL",21,0)
+          Q
+"RTN","CCRUTIL",22,0)
+          ;
+"RTN","CCRUTIL",23,0)
+FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
+"RTN","CCRUTIL",24,0)
+          ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+"RTN","CCRUTIL",25,0)
+          ; If not passed, or passed incorrectly, it's assumed that it is D.
+"RTN","CCRUTIL",26,0)
+          ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+"RTN","CCRUTIL",27,0)
+          ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+"RTN","CCRUTIL",28,0)
+          ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+"RTN","CCRUTIL",29,0)
+          N UTC,Y,M,D,H,MM,S,OFF
+"RTN","CCRUTIL",30,0)
+          S Y=1700+$E(DATE,1,3)
+"RTN","CCRUTIL",31,0)
+          S M=$E(DATE,4,5)
+"RTN","CCRUTIL",32,0)
+          S D=$E(DATE,6,7)
+"RTN","CCRUTIL",33,0)
+          S H=$E(DATE,9,10)
+"RTN","CCRUTIL",34,0)
+          I $L(H)=1 S H="0"_H
+"RTN","CCRUTIL",35,0)
+          S MM=$E(DATE,11,12)
+"RTN","CCRUTIL",36,0)
+          I $L(MM)=1 S MM="0"_MM
+"RTN","CCRUTIL",37,0)
+          S S=$E(DATE,13,14)
+"RTN","CCRUTIL",38,0)
+          I $L(S)=1 S S="0"_S
+"RTN","CCRUTIL",39,0)
+          S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+"RTN","CCRUTIL",40,0)
+          ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+"RTN","CCRUTIL",41,0)
+          ; In this case, set H, MM and S to "00"
+"RTN","CCRUTIL",42,0)
+          ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
+"RTN","CCRUTIL",43,0)
+          S:'$L(H) H="00"
+"RTN","CCRUTIL",44,0)
+          S:'$L(MM) MM="00"
+"RTN","CCRUTIL",45,0)
+          S:'$L(S) S="00"
+"RTN","CCRUTIL",46,0)
+          S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+"RTN","CCRUTIL",47,0)
+          I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+"RTN","CCRUTIL",48,0)
+          E  Q $P(UTC,"T")
+"RTN","CCRUTIL",49,0)
+          ;
+"RTN","CCRUTIL",50,0)
+SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
+"RTN","CCRUTIL",51,0)
+               ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+"RTN","CCRUTIL",52,0)
+               ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+"RTN","CCRUTIL",53,0)
+               ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+"RTN","CCRUTIL",54,0)
+               ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+"RTN","CCRUTIL",55,0)
+               ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+"RTN","CCRUTIL",56,0)
+               ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+"RTN","CCRUTIL",57,0)
+               ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+"RTN","CCRUTIL",58,0)
+          N VSRT ; TEMP FOR HASHING DATES
+"RTN","CCRUTIL",59,0)
+          N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+"RTN","CCRUTIL",60,0)
+          S ZCNT=0 ; COUNTING NUMBER OF DATES
+"RTN","CCRUTIL",61,0)
+          S ZTMP="" ;
+"RTN","CCRUTIL",62,0)
+          F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
+"RTN","CCRUTIL",63,0)
+          . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","CCRUTIL",64,0)
+          . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
+"RTN","CCRUTIL",65,0)
+          . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
+"RTN","CCRUTIL",66,0)
+          . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
+"RTN","CCRUTIL",67,0)
+          . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
+"RTN","CCRUTIL",68,0)
+          . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
+"RTN","CCRUTIL",69,0)
+          . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
+"RTN","CCRUTIL",70,0)
+          . I DEBUG W "ZTMP=",ZTMP," "
+"RTN","CCRUTIL",71,0)
+          S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
+"RTN","CCRUTIL",72,0)
+          ; I DEBUG ZWR V2
+"RTN","CCRUTIL",73,0)
+          ; I DEBUG ZWR VSRT
+"RTN","CCRUTIL",74,0)
+          N ZD,ZT ; DATA AND TIME ITERATORS
+"RTN","CCRUTIL",75,0)
+          N ZDONE ; DONE FLAG
+"RTN","CCRUTIL",76,0)
+          S (ZD,ZT)=""
+"RTN","CCRUTIL",77,0)
+          S ZDONE=0
+"RTN","CCRUTIL",78,0)
+          N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
+"RTN","CCRUTIL",79,0)
+          S UORDR=ORDR ; DIRECTION TO SORT
+"RTN","CCRUTIL",80,0)
+          I ORDR="" S UORDR=1
+"RTN","CCRUTIL",81,0)
+          N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
+"RTN","CCRUTIL",82,0)
+          F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
+"RTN","CCRUTIL",83,0)
+          . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE
+"RTN","CCRUTIL",84,0)
+          . I ZD="" S ZDONE=1
+"RTN","CCRUTIL",85,0)
+          . I 'ZDONE D  ; MORE DATES
+"RTN","CCRUTIL",86,0)
+          . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
+"RTN","CCRUTIL",87,0)
+          . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
+"RTN","CCRUTIL",88,0)
+          . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
+"RTN","CCRUTIL",89,0)
+          . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
+"RTN","CCRUTIL",90,0)
+          . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
+"RTN","CCRUTIL",91,0)
+          Q ZCNT
+"RTN","CCRUTIL",92,0)
+          ;
+"RTN","CCRVA200")
+0^7^B35847405
+"RTN","CCRVA200",1,0)
+CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
+"RTN","CCRVA200",2,0)
+        ;;0.1;CCDCCR;;JUL 13, 2007;Build 6
+"RTN","CCRVA200",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","CCRVA200",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","CCRVA200",5,0)
+ ;
+"RTN","CCRVA200",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","CCRVA200",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","CCRVA200",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","CCRVA200",9,0)
+ ;(at your option) any later version.
+"RTN","CCRVA200",10,0)
+ ;
+"RTN","CCRVA200",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","CCRVA200",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","CCRVA200",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","CCRVA200",14,0)
+ ;GNU General Public License for more details.
+"RTN","CCRVA200",15,0)
+ ;
+"RTN","CCRVA200",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","CCRVA200",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","CCRVA200",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","CCRVA200",19,0)
+        Q
+"RTN","CCRVA200",20,0)
+        ; This routine uses Kernel APIs and Direct Global Access to get
+"RTN","CCRVA200",21,0)
+        ; Proivder Data from File 200.
+"RTN","CCRVA200",22,0)
+        ;
+"RTN","CCRVA200",23,0)
+        ; The Global is VA(200,*)
+"RTN","CCRVA200",24,0)
+        ;
+"RTN","CCRVA200",25,0)
+FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",26,0)
+        ; INPUT: DUZ (i.e. File 200 IEN) ByVal
+"RTN","CCRVA200",27,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",28,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",29,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",30,0)
+        Q NAME("FAMILY")
+"RTN","CCRVA200",31,0)
+        ;
+"RTN","CCRVA200",32,0)
+GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",33,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",34,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",35,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",36,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",37,0)
+        Q NAME("GIVEN")
+"RTN","CCRVA200",38,0)
+        ;
+"RTN","CCRVA200",39,0)
+MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",40,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",41,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",42,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",43,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",44,0)
+        Q NAME("MIDDLE")
+"RTN","CCRVA200",45,0)
+        ;
+"RTN","CCRVA200",46,0)
+SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",47,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",48,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",49,0)
+        N NAME S NAME=$P(^VA(200,DUZ,0),U)
+"RTN","CCRVA200",50,0)
+        D NAMECOMP^XLFNAME(.NAME)
+"RTN","CCRVA200",51,0)
+        Q NAME("SUFFIX")
+"RTN","CCRVA200",52,0)
+        ;
+"RTN","CCRVA200",53,0)
+TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",54,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",55,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",56,0)
+        ; Gets External Value of Title field in New Person File.
+"RTN","CCRVA200",57,0)
+        ; It's actually a pointer to file 3.1
+"RTN","CCRVA200",58,0)
+        ; 200=New Person File; 8 is Title Field
+"RTN","CCRVA200",59,0)
+        Q $$GET1^DIQ(200,DUZ_",",8)
+"RTN","CCRVA200",60,0)
+        ;
+"RTN","CCRVA200",61,0)
+NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",62,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",63,0)
+        ; OUTPUT: Delimited String in format:
+"RTN","CCRVA200",64,0)
+        ;       IDType^ID^IDDescription
+"RTN","CCRVA200",65,0)
+        ; If the NPI doesn't exist, "" is returned.
+"RTN","CCRVA200",66,0)
+        ; This routine uses a call documented in the Kernel dev guide
+"RTN","CCRVA200",67,0)
+        ; This call returns as "NPI^TimeEntered^ActiveInactive"
+"RTN","CCRVA200",68,0)
+        ; It returns -1 for NPI if NPI doesn't exist.
+"RTN","CCRVA200",69,0)
+        N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+"RTN","CCRVA200",70,0)
+        Q:NPI=-1 ""
+"RTN","CCRVA200",71,0)
+        Q "NPI^"_NPI_"^HHS"
+"RTN","CCRVA200",72,0)
+        ;
+"RTN","CCRVA200",73,0)
+SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",74,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",75,0)
+        ; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
+"RTN","CCRVA200",76,0)
+        ; Uses a Kernel API. Returns -1 if a specialty is not specified
+"RTN","CCRVA200",77,0)
+        ;       in file 200.
+"RTN","CCRVA200",78,0)
+        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
+"RTN","CCRVA200",79,0)
+        N STR S STR=$$GET^XUA4A72(DUZ)
+"RTN","CCRVA200",80,0)
+        Q:+STR<0 ""
+"RTN","CCRVA200",81,0)
+        ; Sometimes we have 3 pieces, or 2. Deal with that.
+"RTN","CCRVA200",82,0)
+        Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+"RTN","CCRVA200",83,0)
+        Q $P(STR,U,2)_"-"_$P(STR,U,3)
+"RTN","CCRVA200",84,0)
+        ;
+"RTN","CCRVA200",85,0)
+ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
+"RTN","CCRVA200",86,0)
+        ; INPUT: DUZ, but not needed really... here for future expansion
+"RTN","CCRVA200",87,0)
+        ; OUTPUT: At this point "Work"
+"RTN","CCRVA200",88,0)
+        Q "Work"
+"RTN","CCRVA200",89,0)
+        ;
+"RTN","CCRVA200",90,0)
+ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
+"RTN","CCRVA200",91,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",92,0)
+        ; Output: String.
+"RTN","CCRVA200",93,0)
+        ;
+"RTN","CCRVA200",94,0)
+        ; First, get site number from the institution file.
+"RTN","CCRVA200",95,0)
+        ; 1st piece returned by $$SITE^VASITE, which gets the system institution
+"RTN","CCRVA200",96,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",97,0)
+        ;
+"RTN","CCRVA200",98,0)
+        ; Second, get mailing address
+"RTN","CCRVA200",99,0)
+        ; There are two APIs to get the address, one for physical and one for
+"RTN","CCRVA200",100,0)
+        ; mailing. We will check if mailing exists first, since that's the
+"RTN","CCRVA200",101,0)
+        ; one we want to use; then check for physical. If neither exists,
+"RTN","CCRVA200",102,0)
+        ; then we return nothing. We check for the existence of an address
+"RTN","CCRVA200",103,0)
+        ; by the length of the returned string.
+"RTN","CCRVA200",104,0)
+        ; NOTE: API doesn't support Address 2, so I won't even include it
+"RTN","CCRVA200",105,0)
+        ; in the template.
+"RTN","CCRVA200",106,0)
+        N ADD
+"RTN","CCRVA200",107,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",108,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",109,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",110,0)
+        Q:$L(ADD) $P(ADD,U)
+"RTN","CCRVA200",111,0)
+        Q ""
+"RTN","CCRVA200",112,0)
+        ;
+"RTN","CCRVA200",113,0)
+CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",114,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",115,0)
+        ; Output: String.
+"RTN","CCRVA200",116,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",117,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",118,0)
+        N ADD
+"RTN","CCRVA200",119,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",120,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",121,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",122,0)
+        Q:$L(ADD) $P(ADD,U,2)
+"RTN","CCRVA200",123,0)
+        Q ""
+"RTN","CCRVA200",124,0)
+        ;
+"RTN","CCRVA200",125,0)
+STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",126,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",127,0)
+        ; Output: String.
+"RTN","CCRVA200",128,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",129,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",130,0)
+        N ADD
+"RTN","CCRVA200",131,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",132,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",133,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",134,0)
+        Q:$L(ADD) $P(ADD,U,3)
+"RTN","CCRVA200",135,0)
+        Q ""
+"RTN","CCRVA200",136,0)
+        ;
+"RTN","CCRVA200",137,0)
+POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",138,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",139,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",140,0)
+        ; See ADD1 for comments
+"RTN","CCRVA200",141,0)
+        N INST S INST=$P($$SITE^VASITE(),U)
+"RTN","CCRVA200",142,0)
+        N ADD
+"RTN","CCRVA200",143,0)
+        S ADD=$$MADD^XUAF4(INST) ; mailing address
+"RTN","CCRVA200",144,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",145,0)
+        S ADD=$$PADD^XUAF4(INST) ; physical address
+"RTN","CCRVA200",146,0)
+        Q:$L(ADD) $P(ADD,U,4)
+"RTN","CCRVA200",147,0)
+        Q ""
+"RTN","CCRVA200",148,0)
+        ;
+"RTN","CCRVA200",149,0)
+TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",150,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",151,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",152,0)
+        ; Direct global access
+"RTN","CCRVA200",153,0)
+        N TEL S TEL=$G(^VA(200,DUZ,.13))
+"RTN","CCRVA200",154,0)
+        Q $P(TEL,U,2)
+"RTN","CCRVA200",155,0)
+        ;
+"RTN","CCRVA200",156,0)
+TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",157,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",158,0)
+        ; OUTPUT: String.
+"RTN","CCRVA200",159,0)
+        Q "Office"
+"RTN","CCRVA200",160,0)
+        ;
+"RTN","CCRVA200",161,0)
+EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
+"RTN","CCRVA200",162,0)
+        ; INPUT: DUZ ByVal
+"RTN","CCRVA200",163,0)
+        ; OUTPUT: String
+"RTN","CCRVA200",164,0)
+        ; Direct global access
+"RTN","CCRVA200",165,0)
+        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+"RTN","CCRVA200",166,0)
+        Q $P(EMAIL,U)
+"RTN","CCRVA200",167,0)
+        ;
+"RTN","GPLACTOR")
+0^8^B58454780
+"RTN","GPLACTOR",1,0)
+GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+"RTN","GPLACTOR",2,0)
+ ;;0.3;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLACTOR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLACTOR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLACTOR",5,0)
+ ;
+"RTN","GPLACTOR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLACTOR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLACTOR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLACTOR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLACTOR",10,0)
+ ;
+"RTN","GPLACTOR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLACTOR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLACTOR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLACTOR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLACTOR",15,0)
+ ;
+"RTN","GPLACTOR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLACTOR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLACTOR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLACTOR",19,0)
+    ;
+"RTN","GPLACTOR",20,0)
+    ;  PROCESS THE ACTORS SECTION OF THE CCR
+"RTN","GPLACTOR",21,0)
+    ;
+"RTN","GPLACTOR",22,0)
+    ; ===Revision History===
+"RTN","GPLACTOR",23,0)
+    ; 0.1 Initial Writing of Skeleton--GPL
+"RTN","GPLACTOR",24,0)
+    ; 0.2 Patient Data Extraction--SMH
+"RTN","GPLACTOR",25,0)
+    ; 0.3 Information System Info Extraction--SMH
+"RTN","GPLACTOR",26,0)
+    ;
+"RTN","GPLACTOR",27,0)
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+"RTN","GPLACTOR",28,0)
+  ; IPXML is the Input Actor Template into which we  substitute values
+"RTN","GPLACTOR",29,0)
+  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+"RTN","GPLACTOR",30,0)
+  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
+"RTN","GPLACTOR",31,0)
+  ; ^TMP(7542,1,"ACTORS",0)=Count
+"RTN","GPLACTOR",32,0)
+  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+"RTN","GPLACTOR",33,0)
+  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+"RTN","GPLACTOR",34,0)
+  ; AXML is the output arrary, to contain XML.
+"RTN","GPLACTOR",35,0)
+  ;
+"RTN","GPLACTOR",36,0)
+           N I,J,AMAP,AOID,ATYP,AIEN
+"RTN","GPLACTOR",37,0)
+           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+"RTN","GPLACTOR",38,0)
+           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+"RTN","GPLACTOR",39,0)
+           I DEBUG W "PROCESSING ACTORS ",!
+"RTN","GPLACTOR",40,0)
+           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+"RTN","GPLACTOR",41,0)
+           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",42,0)
+           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+"RTN","GPLACTOR",43,0)
+           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+"RTN","GPLACTOR",44,0)
+           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+"RTN","GPLACTOR",45,0)
+           . I ATYP="" Q  ; NOT A VALID ACTOR
+"RTN","GPLACTOR",46,0)
+           . ;
+"RTN","GPLACTOR",47,0)
+           . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
+"RTN","GPLACTOR",48,0)
+           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+"RTN","GPLACTOR",49,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+"RTN","GPLACTOR",50,0)
+           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",51,0)
+           . ;
+"RTN","GPLACTOR",52,0)
+           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+"RTN","GPLACTOR",53,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+"RTN","GPLACTOR",54,0)
+           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",55,0)
+           . ;
+"RTN","GPLACTOR",56,0)
+           . I ATYP="NOK" D  ; NOK ACTOR TYPE
+"RTN","GPLACTOR",57,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+"RTN","GPLACTOR",58,0)
+           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",59,0)
+           . ;
+"RTN","GPLACTOR",60,0)
+           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",61,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+"RTN","GPLACTOR",62,0)
+           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",63,0)
+           . ;
+"RTN","GPLACTOR",64,0)
+           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+"RTN","GPLACTOR",65,0)
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+"RTN","GPLACTOR",66,0)
+           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+"RTN","GPLACTOR",67,0)
+           . ;
+"RTN","GPLACTOR",68,0)
+           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+"RTN","GPLACTOR",69,0)
+           ;
+"RTN","GPLACTOR",70,0)
+           N ACTTMP
+"RTN","GPLACTOR",71,0)
+           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLACTOR",72,0)
+           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLACTOR",73,0)
+           . ; STRINGS MARKED AS @@X@@
+"RTN","GPLACTOR",74,0)
+           . W "ACTORS Missing list: ",!
+"RTN","GPLACTOR",75,0)
+           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+"RTN","GPLACTOR",76,0)
+           Q
+"RTN","GPLACTOR",77,0)
+           ;
+"RTN","GPLACTOR",78,0)
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+"RTN","GPLACTOR",79,0)
+     ;
+"RTN","GPLACTOR",80,0)
+     I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
+"RTN","GPLACTOR",81,0)
+     N AMAP,ZX
+"RTN","GPLACTOR",82,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",83,0)
+     K @AMAP
+"RTN","GPLACTOR",84,0)
+     D INIT^CCRDPT(AIEN)
+"RTN","GPLACTOR",85,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",86,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
+"RTN","GPLACTOR",87,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
+"RTN","GPLACTOR",88,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
+"RTN","GPLACTOR",89,0)
+     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
+"RTN","GPLACTOR",90,0)
+     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
+"RTN","GPLACTOR",91,0)
+     S @AMAP@("ACTORSSN")=""
+"RTN","GPLACTOR",92,0)
+     S @AMAP@("ACTORSSNTEXT")=""
+"RTN","GPLACTOR",93,0)
+     S @AMAP@("ACTORSSNSOURCEID")=""
+"RTN","GPLACTOR",94,0)
+     S ZX=$$SSN^CCRDPT
+"RTN","GPLACTOR",95,0)
+     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+"RTN","GPLACTOR",96,0)
+     . S @AMAP@("ACTORSSN")=ZX
+"RTN","GPLACTOR",97,0)
+     . S @AMAP@("ACTORSSNTEXT")="SSN"
+"RTN","GPLACTOR",98,0)
+     . S @AMAP@("ACTORSSNSOURCEID")=AOID
+"RTN","GPLACTOR",99,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
+"RTN","GPLACTOR",100,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
+"RTN","GPLACTOR",101,0)
+     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
+"RTN","GPLACTOR",102,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
+"RTN","GPLACTOR",103,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
+"RTN","GPLACTOR",104,0)
+     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
+"RTN","GPLACTOR",105,0)
+     S @AMAP@("ACTORRESTEL")=""
+"RTN","GPLACTOR",106,0)
+     S @AMAP@("ACTORRESTELTEXT")=""
+"RTN","GPLACTOR",107,0)
+     S ZX=$$RESTEL^CCRDPT
+"RTN","GPLACTOR",108,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",109,0)
+     . S @AMAP@("ACTORRESTEL")=ZX
+"RTN","GPLACTOR",110,0)
+     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+"RTN","GPLACTOR",111,0)
+     S @AMAP@("ACTORWORKTEL")=""
+"RTN","GPLACTOR",112,0)
+     S @AMAP@("ACTORWORKTELTEXT")=""
+"RTN","GPLACTOR",113,0)
+     S ZX=$$WORKTEL^CCRDPT
+"RTN","GPLACTOR",114,0)
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+"RTN","GPLACTOR",115,0)
+     . S @AMAP@("ACTORWORKTEL")=ZX
+"RTN","GPLACTOR",116,0)
+     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+"RTN","GPLACTOR",117,0)
+     S @AMAP@("ACTORCELLTEL")=""
+"RTN","GPLACTOR",118,0)
+     S @AMAP@("ACTORCELLTELTEXT")=""
+"RTN","GPLACTOR",119,0)
+     S ZX=$$CELLTEL^CCRDPT
+"RTN","GPLACTOR",120,0)
+     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+"RTN","GPLACTOR",121,0)
+     . S @AMAP@("ACTORCELLTEL")=ZX
+"RTN","GPLACTOR",122,0)
+     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+"RTN","GPLACTOR",123,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
+"RTN","GPLACTOR",124,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+"RTN","GPLACTOR",125,0)
+     S @AMAP@("ACTORIEN")=AIEN
+"RTN","GPLACTOR",126,0)
+     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+"RTN","GPLACTOR",127,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",128,0)
+         D DESTROY^CCRDPT
+"RTN","GPLACTOR",129,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",130,0)
+     Q
+"RTN","GPLACTOR",131,0)
+     ;
+"RTN","GPLACTOR",132,0)
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+"RTN","GPLACTOR",133,0)
+     ;
+"RTN","GPLACTOR",134,0)
+     ; N AMAP
+"RTN","GPLACTOR",135,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",136,0)
+     K @AMAP
+"RTN","GPLACTOR",137,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",138,0)
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
+"RTN","GPLACTOR",139,0)
+         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
+"RTN","GPLACTOR",140,0)
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+"RTN","GPLACTOR",141,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",142,0)
+     Q
+"RTN","GPLACTOR",143,0)
+     ;
+"RTN","GPLACTOR",144,0)
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+"RTN","GPLACTOR",145,0)
+     ;
+"RTN","GPLACTOR",146,0)
+     ; N AMAP
+"RTN","GPLACTOR",147,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",148,0)
+     K @AMAP
+"RTN","GPLACTOR",149,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",150,0)
+     S @AMAP@("ACTORDISPLAYNAME")=""
+"RTN","GPLACTOR",151,0)
+     S @AMAP@("ACTORRELATION")=""
+"RTN","GPLACTOR",152,0)
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+"RTN","GPLACTOR",153,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",154,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",155,0)
+     Q
+"RTN","GPLACTOR",156,0)
+     ;
+"RTN","GPLACTOR",157,0)
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+"RTN","GPLACTOR",158,0)
+     ;
+"RTN","GPLACTOR",159,0)
+     ; N AMAP
+"RTN","GPLACTOR",160,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",161,0)
+     K @AMAP
+"RTN","GPLACTOR",162,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",163,0)
+     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
+"RTN","GPLACTOR",164,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",165,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",166,0)
+     Q
+"RTN","GPLACTOR",167,0)
+     ;
+"RTN","GPLACTOR",168,0)
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+"RTN","GPLACTOR",169,0)
+     ;
+"RTN","GPLACTOR",170,0)
+     ; N AMAP
+"RTN","GPLACTOR",171,0)
+     S AMAP=$NA(^TMP($J,"AMAP"))
+"RTN","GPLACTOR",172,0)
+     K @AMAP
+"RTN","GPLACTOR",173,0)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+"RTN","GPLACTOR",174,0)
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
+"RTN","GPLACTOR",175,0)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",176,0)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
+"RTN","GPLACTOR",177,0)
+         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
+"RTN","GPLACTOR",178,0)
+         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
+"RTN","GPLACTOR",179,0)
+         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
+"RTN","GPLACTOR",180,0)
+         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
+"RTN","GPLACTOR",181,0)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
+"RTN","GPLACTOR",182,0)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",183,0)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
+"RTN","GPLACTOR",184,0)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
+"RTN","GPLACTOR",185,0)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
+"RTN","GPLACTOR",186,0)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
+"RTN","GPLACTOR",187,0)
+     S @AMAP@("ACTORTELEPHONE")=""
+"RTN","GPLACTOR",188,0)
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+"RTN","GPLACTOR",189,0)
+     S ZX=$$TEL^CCRVA200(AIEN)
+"RTN","GPLACTOR",190,0)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+"RTN","GPLACTOR",191,0)
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+"RTN","GPLACTOR",192,0)
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
+"RTN","GPLACTOR",193,0)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
+"RTN","GPLACTOR",194,0)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+"RTN","GPLACTOR",195,0)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+"RTN","GPLACTOR",196,0)
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+"RTN","GPLACTOR",197,0)
+     Q
+"RTN","GPLACTOR",198,0)
+     ;
+"RTN","GPLCCD")
+0^16^B114413975
+"RTN","GPLCCD",1,0)
+GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
+"RTN","GPLCCD",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLCCD",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD",5,0)
+ ;
+"RTN","GPLCCD",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD",10,0)
+ ;
+"RTN","GPLCCD",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD",15,0)
+ ;
+"RTN","GPLCCD",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD",19,0)
+ ;
+"RTN","GPLCCD",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCD",21,0)
+ ;
+"RTN","GPLCCD",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCD",23,0)
+       ; Select a patient.
+"RTN","GPLCCD",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCD",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCD",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCD",27,0)
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+"RTN","GPLCCD",28,0)
+       Q
+"RTN","GPLCCD",29,0)
+       ;
+"RTN","GPLCCD",30,0)
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","GPLCCD",31,0)
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+"RTN","GPLCCD",32,0)
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+"RTN","GPLCCD",33,0)
+       ; N CCDGLO
+"RTN","GPLCCD",34,0)
+       D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+"RTN","GPLCCD",35,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
+"RTN","GPLCCD",36,0)
+       S ONAM=FN
+"RTN","GPLCCD",37,0)
+       I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+"RTN","GPLCCD",38,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCD",39,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCD",40,0)
+       . S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCD",41,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCD",42,0)
+       . ;S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCD",43,0)
+       S ODIR=DIR
+"RTN","GPLCCD",44,0)
+       I DIR="" S ODIR=@ODIRGLB
+"RTN","GPLCCD",45,0)
+       N ZY
+"RTN","GPLCCD",46,0)
+       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCD",47,0)
+       W $P(ZY,U,2)
+"RTN","GPLCCD",48,0)
+       Q
+"RTN","GPLCCD",49,0)
+       ;
+"RTN","GPLCCD",50,0)
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCD",51,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCD",52,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCD",53,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCD",54,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCD",55,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCD",56,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCD",57,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCD",58,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCD",59,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCD",60,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+"RTN","GPLCCD",61,0)
+    I '$D(DEBUG) S DEBUG=0
+"RTN","GPLCCD",62,0)
+    N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+"RTN","GPLCCD",63,0)
+    I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+"RTN","GPLCCD",64,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCD",65,0)
+    I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+"RTN","GPLCCD",66,0)
+    E  S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCD",67,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCD",68,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCD",69,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCD",70,0)
+    I CCD D LOAD^GPLCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",71,0)
+    E  D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCD",72,0)
+    D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCD",73,0)
+    N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+"RTN","GPLCCD",74,0)
+    S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+"RTN","GPLCCD",75,0)
+    S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+"RTN","GPLCCD",76,0)
+    S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+"RTN","GPLCCD",77,0)
+    S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+"RTN","GPLCCD",78,0)
+    S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+"RTN","GPLCCD",79,0)
+    S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+"RTN","GPLCCD",80,0)
+    ;
+"RTN","GPLCCD",81,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCD",82,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCD",83,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",84,0)
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",85,0)
+    I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCD",86,0)
+    I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+"RTN","GPLCCD",87,0)
+    ;
+"RTN","GPLCCD",88,0)
+    I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCD",89,0)
+    ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+"RTN","GPLCCD",90,0)
+    S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+"RTN","GPLCCD",91,0)
+    D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
+"RTN","GPLCCD",92,0)
+    D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+"RTN","GPLCCD",93,0)
+    I DEBUG D PARY^GPLXPATH("ACTT2")
+"RTN","GPLCCD",94,0)
+    D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
+"RTN","GPLCCD",95,0)
+    I DEBUG D PARY^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",96,0)
+    K ACTT1 K ACCT2
+"RTN","GPLCCD",97,0)
+    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+"RTN","GPLCCD",98,0)
+    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+"RTN","GPLCCD",99,0)
+    D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+"RTN","GPLCCD",100,0)
+    D CP^GPLXPATH("ACTT2",CCDGLO)
+"RTN","GPLCCD",101,0)
+    ;
+"RTN","GPLCCD",102,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCD",103,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCD",104,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCD",105,0)
+    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCD",106,0)
+    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCD",107,0)
+    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCD",108,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCD",109,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCD",110,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCD",111,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCD",112,0)
+    . S IXML="INXML"
+"RTN","GPLCCD",113,0)
+    . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+"RTN","GPLCCD",114,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCD",115,0)
+    . ; W OXML,!
+"RTN","GPLCCD",116,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCD",117,0)
+    . W "RUNNING ",CALL,!
+"RTN","GPLCCD",118,0)
+    . X CALL
+"RTN","GPLCCD",119,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCD",120,0)
+    . . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+"RTN","GPLCCD",121,0)
+    . . I CCD D UNSHAVE("ITMP",OXML)
+"RTN","GPLCCD",122,0)
+    . . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+"RTN","GPLCCD",123,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCD",124,0)
+    . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCD",125,0)
+    . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCD",126,0)
+    ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+"RTN","GPLCCD",127,0)
+    ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCD",128,0)
+    ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCD",129,0)
+    ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCD",130,0)
+    ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCD",131,0)
+    N I,J,DONE S DONE=0
+"RTN","GPLCCD",132,0)
+    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCD",133,0)
+    . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCD",134,0)
+    . W "TRIMMED",J,!
+"RTN","GPLCCD",135,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCD",136,0)
+    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+"RTN","GPLCCD",137,0)
+    . N I
+"RTN","GPLCCD",138,0)
+    . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+"RTN","GPLCCD",139,0)
+    . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",140,0)
+    . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+"RTN","GPLCCD",141,0)
+    . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+"RTN","GPLCCD",142,0)
+    . . . S @CCDGLO@(I)="</structuredBody></component>"
+"RTN","GPLCCD",143,0)
+    S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+"RTN","GPLCCD",144,0)
+    S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+"RTN","GPLCCD",145,0)
+    Q
+"RTN","GPLCCD",146,0)
+    ;
+"RTN","GPLCCD",147,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCD",148,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCD",149,0)
+    W "TAB= ",TAB,!
+"RTN","GPLCCD",150,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCD",151,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCD",152,0)
+    ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCD",153,0)
+    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCD",154,0)
+    Q
+"RTN","GPLCCD",155,0)
+    ;
+"RTN","GPLCCD",156,0)
+SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+"RTN","GPLCCD",157,0)
+    ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+"RTN","GPLCCD",158,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",159,0)
+    W SHXML,!
+"RTN","GPLCCD",160,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",161,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+"RTN","GPLCCD",162,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+"RTN","GPLCCD",163,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+"RTN","GPLCCD",164,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",165,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",166,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",167,0)
+    Q
+"RTN","GPLCCD",168,0)
+    ;
+"RTN","GPLCCD",169,0)
+UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+"RTN","GPLCCD",170,0)
+    ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+"RTN","GPLCCD",171,0)
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+"RTN","GPLCCD",172,0)
+    W SHXML,!
+"RTN","GPLCCD",173,0)
+    W @SHXML@(1),!
+"RTN","GPLCCD",174,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+"RTN","GPLCCD",175,0)
+    D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+"RTN","GPLCCD",176,0)
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+"RTN","GPLCCD",177,0)
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+"RTN","GPLCCD",178,0)
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+"RTN","GPLCCD",179,0)
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+"RTN","GPLCCD",180,0)
+    Q
+"RTN","GPLCCD",181,0)
+    ;
+"RTN","GPLCCD",182,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCD",183,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCD",184,0)
+    ; K @VMAP
+"RTN","GPLCCD",185,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCD",186,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCD",187,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCD",188,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCD",189,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCD",190,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCD",191,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",192,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCD",193,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCD",194,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCD",195,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCD",196,0)
+    N CTMP
+"RTN","GPLCCD",197,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCD",198,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCD",199,0)
+    Q
+"RTN","GPLCCD",200,0)
+    ;
+"RTN","GPLCCD",201,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCD",202,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCD",203,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCD",204,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCD",205,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCD",206,0)
+    ;OR INSTITUTION
+"RTN","GPLCCD",207,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCD",208,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCD",209,0)
+    N I,J,K,L
+"RTN","GPLCCD",210,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCD",211,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCD",212,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCD",213,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCD",214,0)
+    . . W "<ActorID>=>",J,!
+"RTN","GPLCCD",215,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCD",216,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCD",217,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCD",218,0)
+    F J=0:0 D  Q:$O(K(I))=""  ;
+"RTN","GPLCCD",219,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCD",220,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCD",221,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCD",222,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCD",223,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCD",224,0)
+    Q
+"RTN","GPLCCD",225,0)
+    ;
+"RTN","GPLCCD",226,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCD",227,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCD",228,0)
+  Q
+"RTN","GPLCCD",229,0)
+  ;
+"RTN","GPLCCD",230,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCD",231,0)
+  N ZTMP
+"RTN","GPLCCD",232,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",233,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCD",234,0)
+  Q
+"RTN","GPLCCD",235,0)
+  ;
+"RTN","GPLCCD",236,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCD",237,0)
+  N ZTMP
+"RTN","GPLCCD",238,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCD",239,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCD",240,0)
+  Q
+"RTN","GPLCCD",241,0)
+  ;
+"RTN","GPLCCD",242,0)
+ ;;><TEST>
+"RTN","GPLCCD",243,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCD",244,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",245,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCD",246,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCD",247,0)
+ ;;><VITALS>
+"RTN","GPLCCD",248,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",249,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCD",250,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCD",251,0)
+ ;;><CCR>
+"RTN","GPLCCD",252,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",253,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",254,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",255,0)
+ ;;><ACTLST>
+"RTN","GPLCCD",256,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",257,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCD",258,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCD",259,0)
+ ;;><ACTORS>
+"RTN","GPLCCD",260,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCD",261,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCD",262,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCD",263,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCD",264,0)
+ ;;><TRIM>
+"RTN","GPLCCD",265,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCD",266,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCDGLO)
+"RTN","GPLCCD",267,0)
+ ;;><CCD>
+"RTN","GPLCCD",268,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCD",269,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
+"RTN","GPLCCD",270,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCD",271,0)
+ ;;></TEST>
+"RTN","GPLCCD1")
+0^17^B100039732
+"RTN","GPLCCD1",1,0)
+GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
+"RTN","GPLCCD1",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLCCD1",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCD1",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCD1",5,0)
+ ;
+"RTN","GPLCCD1",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCD1",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCD1",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCD1",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCD1",10,0)
+ ;
+"RTN","GPLCCD1",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCD1",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCD1",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCD1",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCD1",15,0)
+ ;
+"RTN","GPLCCD1",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCD1",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCD1",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCD1",19,0)
+ ;
+"RTN","GPLCCD1",20,0)
+          W "This is a CCD TEMPLATE with processing routines",!
+"RTN","GPLCCD1",21,0)
+          W !
+"RTN","GPLCCD1",22,0)
+          Q
+"RTN","GPLCCD1",23,0)
+          ;
+"RTN","GPLCCD1",24,0)
+ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
+"RTN","GPLCCD1",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCD1",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCD1",28,0)
+          ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
+"RTN","GPLCCD1",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCD1",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCD1",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCD1",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCD1",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCD1",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCD1",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCD1",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCD1",37,0)
+          Q
+"RTN","GPLCCD1",38,0)
+          ;
+"RTN","GPLCCD1",39,0)
+ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+"RTN","GPLCCD1",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCD1",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCD1",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCD1",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCD1",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCD1",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCD1",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCD1",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCD1",48,0)
+          ;
+"RTN","GPLCCD1",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCD1",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCD1",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCD1",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCD1",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCD1",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCD1",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCD1",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCD1",57,0)
+          Q
+"RTN","GPLCCD1",58,0)
+          ;
+"RTN","GPLCCD1",59,0)
+LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCD1",60,0)
+          D ZLOAD(ARY,"GPLCCD1")
+"RTN","GPLCCD1",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCD1",62,0)
+          Q
+"RTN","GPLCCD1",63,0)
+          ;
+"RTN","GPLCCD1",64,0)
+TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+"RTN","GPLCCD1",65,0)
+          Q
+"RTN","GPLCCD1",66,0)
+MARKUP ;<MARKUP>
+"RTN","GPLCCD1",67,0)
+ ;;<Body>
+"RTN","GPLCCD1",68,0)
+ ;;<Problems>
+"RTN","GPLCCD1",69,0)
+ ;;</Problems>
+"RTN","GPLCCD1",70,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",71,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",72,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",73,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",74,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",75,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",76,0)
+ ;;<Medications>
+"RTN","GPLCCD1",77,0)
+ ;;</Medications>
+"RTN","GPLCCD1",78,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",79,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",80,0)
+ ;;<Results>
+"RTN","GPLCCD1",81,0)
+ ;;</Results>
+"RTN","GPLCCD1",82,0)
+ ;;</Body>
+"RTN","GPLCCD1",83,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCD1",84,0)
+ ;</MARKUP>
+"RTN","GPLCCD1",85,0)
+ ;;<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">
+"RTN","GPLCCD1",86,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",87,0)
+ Q
+"RTN","GPLCCD1",88,0)
+ ;
+"RTN","GPLCCD1",89,0)
+ ;<TEMPLATE>
+"RTN","GPLCCD1",90,0)
+ ;;<?xml version="1.0"?>
+"RTN","GPLCCD1",91,0)
+ ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
+"RTN","GPLCCD1",92,0)
+ ;;<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">
+"RTN","GPLCCD1",93,0)
+ ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
+"RTN","GPLCCD1",94,0)
+ ;;<templateId root="2.16.840.1.113883.10.20.1"/>
+"RTN","GPLCCD1",95,0)
+ ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
+"RTN","GPLCCD1",96,0)
+ ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
+"RTN","GPLCCD1",97,0)
+ ;;<title>Continuity of Care Document</title>
+"RTN","GPLCCD1",98,0)
+ ;;<effectiveTime value="20000407130000+0500"/>
+"RTN","GPLCCD1",99,0)
+ ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+"RTN","GPLCCD1",100,0)
+ ;;<languageCode code="en-US"/>
+"RTN","GPLCCD1",101,0)
+ ;;<recordTarget>
+"RTN","GPLCCD1",102,0)
+ ;;<patientRole>
+"RTN","GPLCCD1",103,0)
+ ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",104,0)
+ ;;<patient>
+"RTN","GPLCCD1",105,0)
+ ;;<name>
+"RTN","GPLCCD1",106,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",107,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",108,0)
+ ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
+"RTN","GPLCCD1",109,0)
+ ;;</name>
+"RTN","GPLCCD1",110,0)
+ ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
+"RTN","GPLCCD1",111,0)
+ ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
+"RTN","GPLCCD1",112,0)
+ ;;</patient>
+"RTN","GPLCCD1",113,0)
+ ;;<providerOrganization>
+"RTN","GPLCCD1",114,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",115,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",116,0)
+ ;;</providerOrganization>
+"RTN","GPLCCD1",117,0)
+ ;;</patientRole>
+"RTN","GPLCCD1",118,0)
+ ;;</recordTarget>
+"RTN","GPLCCD1",119,0)
+ ;;<author>
+"RTN","GPLCCD1",120,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",121,0)
+ ;;<assignedAuthor>
+"RTN","GPLCCD1",122,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",123,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",124,0)
+ ;;<name>
+"RTN","GPLCCD1",125,0)
+ ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
+"RTN","GPLCCD1",126,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",127,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",128,0)
+ ;;</name>
+"RTN","GPLCCD1",129,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",130,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",131,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",132,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",133,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",134,0)
+ ;;</assignedAuthor>
+"RTN","GPLCCD1",135,0)
+ ;;</author>
+"RTN","GPLCCD1",136,0)
+ ;;<informant>
+"RTN","GPLCCD1",137,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",138,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",139,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",140,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",141,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",142,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",143,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",144,0)
+ ;;</informant>
+"RTN","GPLCCD1",145,0)
+ ;;<custodian>
+"RTN","GPLCCD1",146,0)
+ ;;<assignedCustodian>
+"RTN","GPLCCD1",147,0)
+ ;;<representedCustodianOrganization>
+"RTN","GPLCCD1",148,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",149,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",150,0)
+ ;;</representedCustodianOrganization>
+"RTN","GPLCCD1",151,0)
+ ;;</assignedCustodian>
+"RTN","GPLCCD1",152,0)
+ ;;</custodian>
+"RTN","GPLCCD1",153,0)
+ ;;<legalAuthenticator>
+"RTN","GPLCCD1",154,0)
+ ;;<time value="20000407130000+0500"/>
+"RTN","GPLCCD1",155,0)
+ ;;<signatureCode code="S"/>
+"RTN","GPLCCD1",156,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",157,0)
+ ;;<id nullFlavor="NI"/>
+"RTN","GPLCCD1",158,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",159,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",160,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",161,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",162,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",163,0)
+ ;;</legalAuthenticator>
+"RTN","GPLCCD1",164,0)
+ ;;<Actors>
+"RTN","GPLCCD1",165,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCD1",166,0)
+ ;;<participant typeCode="IND">
+"RTN","GPLCCD1",167,0)
+ ;;<associatedEntity classCode="NOK">
+"RTN","GPLCCD1",168,0)
+ ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
+"RTN","GPLCCD1",169,0)
+ ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
+"RTN","GPLCCD1",170,0)
+ ;;<telecom value="tel:(999)555-1212"/>
+"RTN","GPLCCD1",171,0)
+ ;;<associatedPerson>
+"RTN","GPLCCD1",172,0)
+ ;;<name>
+"RTN","GPLCCD1",173,0)
+ ;;<given>Henrietta</given>
+"RTN","GPLCCD1",174,0)
+ ;;<family>Levin</family>
+"RTN","GPLCCD1",175,0)
+ ;;</name>
+"RTN","GPLCCD1",176,0)
+ ;;</associatedPerson>
+"RTN","GPLCCD1",177,0)
+ ;;</associatedEntity>
+"RTN","GPLCCD1",178,0)
+ ;;</participant>
+"RTN","GPLCCD1",179,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCD1",180,0)
+ ;;</Actors>
+"RTN","GPLCCD1",181,0)
+ ;;<documentationOf>
+"RTN","GPLCCD1",182,0)
+ ;;<serviceEvent classCode="PCPR">
+"RTN","GPLCCD1",183,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",184,0)
+ ;;<high value="@@DATETIME@@"/>
+"RTN","GPLCCD1",185,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",186,0)
+ ;;<performer typeCode="PRF">
+"RTN","GPLCCD1",187,0)
+ ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+"RTN","GPLCCD1",188,0)
+ ;;<time>
+"RTN","GPLCCD1",189,0)
+ ;;<low value="1990"/>
+"RTN","GPLCCD1",190,0)
+ ;;<high value='20000407'/>
+"RTN","GPLCCD1",191,0)
+ ;;</time>
+"RTN","GPLCCD1",192,0)
+ ;;<assignedEntity>
+"RTN","GPLCCD1",193,0)
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+"RTN","GPLCCD1",194,0)
+ ;;<assignedPerson>
+"RTN","GPLCCD1",195,0)
+ ;;<name>
+"RTN","GPLCCD1",196,0)
+ ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
+"RTN","GPLCCD1",197,0)
+ ;;<given>@@ACTORGIVENNAME@@</given>
+"RTN","GPLCCD1",198,0)
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+"RTN","GPLCCD1",199,0)
+ ;;</name>
+"RTN","GPLCCD1",200,0)
+ ;;</assignedPerson>
+"RTN","GPLCCD1",201,0)
+ ;;<representedOrganization>
+"RTN","GPLCCD1",202,0)
+ ;;<id root="2.16.840.1.113883.19.5"/>
+"RTN","GPLCCD1",203,0)
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+"RTN","GPLCCD1",204,0)
+ ;;</representedOrganization>
+"RTN","GPLCCD1",205,0)
+ ;;</assignedEntity>
+"RTN","GPLCCD1",206,0)
+ ;;</performer>
+"RTN","GPLCCD1",207,0)
+ ;;</serviceEvent>
+"RTN","GPLCCD1",208,0)
+ ;;</documentationOf>
+"RTN","GPLCCD1",209,0)
+ ;;<Body>
+"RTN","GPLCCD1",210,0)
+ ;;<PROBLEMS-HTML>
+"RTN","GPLCCD1",211,0)
+ ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
+"RTN","GPLCCD1",212,0)
+ ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
+"RTN","GPLCCD1",213,0)
+ ;;<td>@@PROBLEMDATEOFONSET@@</td>
+"RTN","GPLCCD1",214,0)
+ ;;<td>Active</td></tr>
+"RTN","GPLCCD1",215,0)
+ ;;</tbody></table></text>
+"RTN","GPLCCD1",216,0)
+ ;;</PROBLEMS-HTML>
+"RTN","GPLCCD1",217,0)
+ ;;<Problems>
+"RTN","GPLCCD1",218,0)
+ ;;<component>
+"RTN","GPLCCD1",219,0)
+ ;;<section>
+"RTN","GPLCCD1",220,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
+"RTN","GPLCCD1",221,0)
+ ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
+"RTN","GPLCCD1",222,0)
+ ;;<title>Problems</title>
+"RTN","GPLCCD1",223,0)
+ ;;<entry typeCode="DRIV">
+"RTN","GPLCCD1",224,0)
+ ;;<act classCode="ACT" moodCode="EVN">
+"RTN","GPLCCD1",225,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
+"RTN","GPLCCD1",226,0)
+ ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
+"RTN","GPLCCD1",227,0)
+ ;;<code nullFlavor="NA"/>
+"RTN","GPLCCD1",228,0)
+ ;;<entryRelationship typeCode="SUBJ">
+"RTN","GPLCCD1",229,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",230,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
+"RTN","GPLCCD1",231,0)
+ ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
+"RTN","GPLCCD1",232,0)
+ ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
+"RTN","GPLCCD1",233,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",234,0)
+ ;;<effectiveTime>
+"RTN","GPLCCD1",235,0)
+ ;;<low value="@@PROBLEMDATEOFONSET@@"/>
+"RTN","GPLCCD1",236,0)
+ ;;</effectiveTime>
+"RTN","GPLCCD1",237,0)
+ ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
+"RTN","GPLCCD1",238,0)
+ ;;<entryRelationship typeCode="REFR">
+"RTN","GPLCCD1",239,0)
+ ;;<observation classCode="OBS" moodCode="EVN">
+"RTN","GPLCCD1",240,0)
+ ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
+"RTN","GPLCCD1",241,0)
+ ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+"RTN","GPLCCD1",242,0)
+ ;;<statusCode code="completed"/>
+"RTN","GPLCCD1",243,0)
+ ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
+"RTN","GPLCCD1",244,0)
+ ;;</observation>
+"RTN","GPLCCD1",245,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",246,0)
+ ;;</observation>
+"RTN","GPLCCD1",247,0)
+ ;;</entryRelationship>
+"RTN","GPLCCD1",248,0)
+ ;;</act>
+"RTN","GPLCCD1",249,0)
+ ;;</entry>
+"RTN","GPLCCD1",250,0)
+ ;;</section>
+"RTN","GPLCCD1",251,0)
+ ;;</component>
+"RTN","GPLCCD1",252,0)
+ ;;</Problems>
+"RTN","GPLCCD1",253,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCD1",254,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCD1",255,0)
+ ;;<SocialHistory>
+"RTN","GPLCCD1",256,0)
+ ;;</SocialHistory>
+"RTN","GPLCCD1",257,0)
+ ;;<Alerts>
+"RTN","GPLCCD1",258,0)
+ ;;</Alerts>
+"RTN","GPLCCD1",259,0)
+ ;;<Medications>
+"RTN","GPLCCD1",260,0)
+ ;;</Medications>
+"RTN","GPLCCD1",261,0)
+ ;;<VitalSigns>
+"RTN","GPLCCD1",262,0)
+ ;;</VitalSigns>
+"RTN","GPLCCD1",263,0)
+ ;;<Results>
+"RTN","GPLCCD1",264,0)
+ ;;</Results>
+"RTN","GPLCCD1",265,0)
+ ;;</Body>
+"RTN","GPLCCD1",266,0)
+ ;;</ClinicalDocument>
+"RTN","GPLCCD1",267,0)
+ ;</TEMPLATE>
+"RTN","GPLCCR")
+0^14^B68077868
+"RTN","GPLCCR",1,0)
+GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
+"RTN","GPLCCR",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLCCR",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR",5,0)
+ ;
+"RTN","GPLCCR",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR",10,0)
+ ;
+"RTN","GPLCCR",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR",15,0)
+ ;
+"RTN","GPLCCR",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR",19,0)
+ ;
+"RTN","GPLCCR",20,0)
+ ; EXPORT A CCR
+"RTN","GPLCCR",21,0)
+ ;
+"RTN","GPLCCR",22,0)
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+"RTN","GPLCCR",23,0)
+       ; Select a patient.
+"RTN","GPLCCR",24,0)
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+"RTN","GPLCCR",25,0)
+       I Y<1 Q  ; EXIT
+"RTN","GPLCCR",26,0)
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+"RTN","GPLCCR",27,0)
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+"RTN","GPLCCR",28,0)
+       Q
+"RTN","GPLCCR",29,0)
+       ;
+"RTN","GPLCCR",30,0)
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+"RTN","GPLCCR",31,0)
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+"RTN","GPLCCR",32,0)
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+"RTN","GPLCCR",33,0)
+       N CCRGLO
+"RTN","GPLCCR",34,0)
+       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
+"RTN","GPLCCR",35,0)
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
+"RTN","GPLCCR",36,0)
+       S ONAM=FN
+"RTN","GPLCCR",37,0)
+       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
+"RTN","GPLCCR",38,0)
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+"RTN","GPLCCR",39,0)
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+"RTN","GPLCCR",40,0)
+       . ;S @ODIRGLB="/home/glilly/CCROUT"
+"RTN","GPLCCR",41,0)
+       . ;S @ODIRGLB="/home/cedwards/"
+"RTN","GPLCCR",42,0)
+       . S @ODIRGLB="/opt/wv/p/"
+"RTN","GPLCCR",43,0)
+       S ODIR=DIR
+"RTN","GPLCCR",44,0)
+       I DIR="" S ODIR=@ODIRGLB
+"RTN","GPLCCR",45,0)
+       N ZY
+"RTN","GPLCCR",46,0)
+       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+"RTN","GPLCCR",47,0)
+       W !,$P(ZY,U,2),!
+"RTN","GPLCCR",48,0)
+       Q
+"RTN","GPLCCR",49,0)
+       ;
+"RTN","GPLCCR",50,0)
+CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+"RTN","GPLCCR",51,0)
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+"RTN","GPLCCR",52,0)
+    ; DFN IS PATIENT IEN
+"RTN","GPLCCR",53,0)
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+"RTN","GPLCCR",54,0)
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+"RTN","GPLCCR",55,0)
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+"RTN","GPLCCR",56,0)
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+"RTN","GPLCCR",57,0)
+    ; - NULL MEANS NOW
+"RTN","GPLCCR",58,0)
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+"RTN","GPLCCR",59,0)
+    ;    "TO" VARIABLES
+"RTN","GPLCCR",60,0)
+    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
+"RTN","GPLCCR",61,0)
+    I '$D(DEBUG) S DEBUG=0
+"RTN","GPLCCR",62,0)
+    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
+"RTN","GPLCCR",63,0)
+    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
+"RTN","GPLCCR",64,0)
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+"RTN","GPLCCR",65,0)
+    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+"RTN","GPLCCR",66,0)
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+"RTN","GPLCCR",67,0)
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+"RTN","GPLCCR",68,0)
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+"RTN","GPLCCR",69,0)
+    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+"RTN","GPLCCR",70,0)
+    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+"RTN","GPLCCR",71,0)
+    ;
+"RTN","GPLCCR",72,0)
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+"RTN","GPLCCR",73,0)
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+"RTN","GPLCCR",74,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",75,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",76,0)
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+"RTN","GPLCCR",77,0)
+    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+"RTN","GPLCCR",78,0)
+    ;
+"RTN","GPLCCR",79,0)
+    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+"RTN","GPLCCR",80,0)
+    ;
+"RTN","GPLCCR",81,0)
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+"RTN","GPLCCR",82,0)
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+"RTN","GPLCCR",83,0)
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+"RTN","GPLCCR",84,0)
+    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+"RTN","GPLCCR",85,0)
+    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+"RTN","GPLCCR",86,0)
+    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
+"RTN","GPLCCR",87,0)
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+"RTN","GPLCCR",88,0)
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+"RTN","GPLCCR",89,0)
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+"RTN","GPLCCR",90,0)
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+"RTN","GPLCCR",91,0)
+    . S IXML="INXML"
+"RTN","GPLCCR",92,0)
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+"RTN","GPLCCR",93,0)
+    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
+"RTN","GPLCCR",94,0)
+    . ; W OXML,!
+"RTN","GPLCCR",95,0)
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+"RTN","GPLCCR",96,0)
+    . I DEBUG W "RUNNING ",CALL,!
+"RTN","GPLCCR",97,0)
+    . X CALL
+"RTN","GPLCCR",98,0)
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+"RTN","GPLCCR",99,0)
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+"RTN","GPLCCR",100,0)
+    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+"RTN","GPLCCR",101,0)
+    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+"RTN","GPLCCR",102,0)
+    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+"RTN","GPLCCR",103,0)
+    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+"RTN","GPLCCR",104,0)
+    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+"RTN","GPLCCR",105,0)
+    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+"RTN","GPLCCR",106,0)
+    N TRIMI,J,DONE S DONE=0
+"RTN","GPLCCR",107,0)
+    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+"RTN","GPLCCR",108,0)
+    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
+"RTN","GPLCCR",109,0)
+    . I DEBUG W "TRIMMED",J,!
+"RTN","GPLCCR",110,0)
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+"RTN","GPLCCR",111,0)
+    Q
+"RTN","GPLCCR",112,0)
+    ;
+"RTN","GPLCCR",113,0)
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+"RTN","GPLCCR",114,0)
+    ; TAB IS PASSED BY NAME
+"RTN","GPLCCR",115,0)
+    I DEBUG W "TAB= ",TAB,!
+"RTN","GPLCCR",116,0)
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+"RTN","GPLCCR",117,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+"RTN","GPLCCR",118,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+"RTN","GPLCCR",119,0)
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+"RTN","GPLCCR",120,0)
+    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
+"RTN","GPLCCR",121,0)
+    Q
+"RTN","GPLCCR",122,0)
+    ;
+"RTN","GPLCCR",123,0)
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+"RTN","GPLCCR",124,0)
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+"RTN","GPLCCR",125,0)
+    ; K @VMAP
+"RTN","GPLCCR",126,0)
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+"RTN","GPLCCR",127,0)
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+"RTN","GPLCCR",128,0)
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+"RTN","GPLCCR",129,0)
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+"RTN","GPLCCR",130,0)
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+"RTN","GPLCCR",131,0)
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+"RTN","GPLCCR",132,0)
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",133,0)
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+"RTN","GPLCCR",134,0)
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+"RTN","GPLCCR",135,0)
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+"RTN","GPLCCR",136,0)
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+"RTN","GPLCCR",137,0)
+    N CTMP
+"RTN","GPLCCR",138,0)
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+"RTN","GPLCCR",139,0)
+    D CP^GPLXPATH("CTMP",CXML)
+"RTN","GPLCCR",140,0)
+    Q
+"RTN","GPLCCR",141,0)
+    ;
+"RTN","GPLCCR",142,0)
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+"RTN","GPLCCR",143,0)
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+"RTN","GPLCCR",144,0)
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+"RTN","GPLCCR",145,0)
+    ; P1= OBJECTID - ACTORPATIENT_2
+"RTN","GPLCCR",146,0)
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+"RTN","GPLCCR",147,0)
+    ;OR INSTITUTION
+"RTN","GPLCCR",148,0)
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+"RTN","GPLCCR",149,0)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+"RTN","GPLCCR",150,0)
+    N I,J,K,L
+"RTN","GPLCCR",151,0)
+    K @ACTRTN ; CLEAR RETURN ARRAY
+"RTN","GPLCCR",152,0)
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+"RTN","GPLCCR",153,0)
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+"RTN","GPLCCR",154,0)
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+"RTN","GPLCCR",155,0)
+    . . I DEBUG W "<ActorID>=>",J,!
+"RTN","GPLCCR",156,0)
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+"RTN","GPLCCR",157,0)
+    . . ;  TO GET RID OF DUPLICATES
+"RTN","GPLCCR",158,0)
+    S I="" ; GOING TO $O THROUGH THE HASH
+"RTN","GPLCCR",159,0)
+    F J=0:0 D  Q:$O(K(I))=""
+"RTN","GPLCCR",160,0)
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+"RTN","GPLCCR",161,0)
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+"RTN","GPLCCR",162,0)
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+"RTN","GPLCCR",163,0)
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+"RTN","GPLCCR",164,0)
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+"RTN","GPLCCR",165,0)
+    Q
+"RTN","GPLCCR",166,0)
+    ;
+"RTN","GPLCCR",167,0)
+TEST ; RUN ALL THE TEST CASES
+"RTN","GPLCCR",168,0)
+  D TESTALL^GPLUNIT("GPLCCR")
+"RTN","GPLCCR",169,0)
+  Q
+"RTN","GPLCCR",170,0)
+  ;
+"RTN","GPLCCR",171,0)
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+"RTN","GPLCCR",172,0)
+  N ZTMP
+"RTN","GPLCCR",173,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",174,0)
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLCCR",175,0)
+  Q
+"RTN","GPLCCR",176,0)
+  ;
+"RTN","GPLCCR",177,0)
+TLIST  ; LIST THE TESTS
+"RTN","GPLCCR",178,0)
+  N ZTMP
+"RTN","GPLCCR",179,0)
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+"RTN","GPLCCR",180,0)
+  D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLCCR",181,0)
+  Q
+"RTN","GPLCCR",182,0)
+  ;
+"RTN","GPLCCR",183,0)
+ ;;><TEST>
+"RTN","GPLCCR",184,0)
+ ;;><PROBLEMS>
+"RTN","GPLCCR",185,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",186,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+"RTN","GPLCCR",187,0)
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+"RTN","GPLCCR",188,0)
+ ;;><VITALS>
+"RTN","GPLCCR",189,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",190,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+"RTN","GPLCCR",191,0)
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+"RTN","GPLCCR",192,0)
+ ;;><CCR>
+"RTN","GPLCCR",193,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",194,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",195,0)
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+"RTN","GPLCCR",196,0)
+ ;;><ACTLST>
+"RTN","GPLCCR",197,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLCCR",198,0)
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+"RTN","GPLCCR",199,0)
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+"RTN","GPLCCR",200,0)
+ ;;><ACTORS>
+"RTN","GPLCCR",201,0)
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+"RTN","GPLCCR",202,0)
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+"RTN","GPLCCR",203,0)
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+"RTN","GPLCCR",204,0)
+ ;;>>?G3(G3(0))["</Actors>"
+"RTN","GPLCCR",205,0)
+ ;;><TRIM>
+"RTN","GPLCCR",206,0)
+ ;;>>>D ZTEST^GPLCCR("CCR")
+"RTN","GPLCCR",207,0)
+ ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
+"RTN","GPLCCR0")
+0^15^B658213703
+"RTN","GPLCCR0",1,0)
+GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+"RTN","GPLCCR0",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLCCR0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLCCR0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLCCR0",5,0)
+ ;
+"RTN","GPLCCR0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLCCR0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLCCR0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLCCR0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLCCR0",10,0)
+ ;
+"RTN","GPLCCR0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLCCR0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLCCR0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLCCR0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLCCR0",15,0)
+ ;
+"RTN","GPLCCR0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLCCR0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLCCR0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLCCR0",19,0)
+ ;
+"RTN","GPLCCR0",20,0)
+          W "This is a CCR TEMPLATE with processing routines",!
+"RTN","GPLCCR0",21,0)
+          W !
+"RTN","GPLCCR0",22,0)
+          Q
+"RTN","GPLCCR0",23,0)
+          ;
+"RTN","GPLCCR0",24,0)
+ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
+"RTN","GPLCCR0",25,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",26,0)
+          ; BAT is a string identifying the section
+"RTN","GPLCCR0",27,0)
+          ; LINE is a test which will evaluate to true or false
+"RTN","GPLCCR0",28,0)
+          ; I '$G(@ZARY) D  ;
+"RTN","GPLCCR0",29,0)
+          ; . S @ZARY@(0)=0 ; initially there are no elements
+"RTN","GPLCCR0",30,0)
+          ; . W "GOT HERE LOADING "_LINE,!
+"RTN","GPLCCR0",31,0)
+          N CNT ; count of array elements
+"RTN","GPLCCR0",32,0)
+          S CNT=@ZARY@(0) ; contains array count
+"RTN","GPLCCR0",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLCCR0",34,0)
+          S @ZARY@(CNT)=LINE ; put the line in the array
+"RTN","GPLCCR0",35,0)
+          ; S @ZARY@(BAT,CNT)="" ; index the test by battery
+"RTN","GPLCCR0",36,0)
+          S @ZARY@(0)=CNT ; update the array counter
+"RTN","GPLCCR0",37,0)
+          Q
+"RTN","GPLCCR0",38,0)
+          ;
+"RTN","GPLCCR0",39,0)
+ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
+"RTN","GPLCCR0",40,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLCCR0",41,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLCCR0",42,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLCCR0",43,0)
+          K @ZARY S @ZARY=""
+"RTN","GPLCCR0",44,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLCCR0",45,0)
+          N LINE,LABEL,BODY
+"RTN","GPLCCR0",46,0)
+          N INTEST S INTEST=0 ; switch for in the TEMPLATE section
+"RTN","GPLCCR0",47,0)
+          N SECTION S SECTION="[anonymous]" ; NO section LABEL
+"RTN","GPLCCR0",48,0)
+          ;
+"RTN","GPLCCR0",49,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLCCR0",50,0)
+          . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
+"RTN","GPLCCR0",51,0)
+          . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
+"RTN","GPLCCR0",52,0)
+          . I INTEST  D  ; within the section
+"RTN","GPLCCR0",53,0)
+          . . I LINE?." "1";><".E  D  ; sub-section name found
+"RTN","GPLCCR0",54,0)
+          . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
+"RTN","GPLCCR0",55,0)
+          . . I LINE?." "1";;".E  D  ; line found
+"RTN","GPLCCR0",56,0)
+          . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
+"RTN","GPLCCR0",57,0)
+          Q
+"RTN","GPLCCR0",58,0)
+          ;
+"RTN","GPLCCR0",59,0)
+LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+"RTN","GPLCCR0",60,0)
+          D ZLOAD(ARY,"GPLCCR0")
+"RTN","GPLCCR0",61,0)
+          ; ZWR @ARY
+"RTN","GPLCCR0",62,0)
+          Q
+"RTN","GPLCCR0",63,0)
+          ;
+"RTN","GPLCCR0",64,0)
+ ;<TEMPLATE>
+"RTN","GPLCCR0",65,0)
+ ;;<?xml version="1.0" encoding="UTF-8"?>
+"RTN","GPLCCR0",66,0)
+ ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
+"RTN","GPLCCR0",67,0)
+ ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
+"RTN","GPLCCR0",68,0)
+ ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
+"RTN","GPLCCR0",69,0)
+ ;;<Language>
+"RTN","GPLCCR0",70,0)
+ ;;<Text>English</Text>
+"RTN","GPLCCR0",71,0)
+ ;;</Language>
+"RTN","GPLCCR0",72,0)
+ ;;<Version>V1.0</Version>
+"RTN","GPLCCR0",73,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",74,0)
+ ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",75,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",76,0)
+ ;;<Patient>
+"RTN","GPLCCR0",77,0)
+ ;;<ActorID>@@ACTORPATIENT@@</ActorID>
+"RTN","GPLCCR0",78,0)
+ ;;</Patient>
+"RTN","GPLCCR0",79,0)
+ ;;<From>
+"RTN","GPLCCR0",80,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",81,0)
+ ;;<ActorID>@@ACTORFROM@@</ActorID>
+"RTN","GPLCCR0",82,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",83,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",84,0)
+ ;;<ActorID>@@ACTORFROM2@@</ActorID>
+"RTN","GPLCCR0",85,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",86,0)
+ ;;</From>
+"RTN","GPLCCR0",87,0)
+ ;;<To>
+"RTN","GPLCCR0",88,0)
+ ;;<ActorLink>
+"RTN","GPLCCR0",89,0)
+ ;;<ActorID>@@ACTORTO@@</ActorID>
+"RTN","GPLCCR0",90,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",91,0)
+ ;;<Text>@@ACTORTOTEXT@@</Text>
+"RTN","GPLCCR0",92,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",93,0)
+ ;;</ActorLink>
+"RTN","GPLCCR0",94,0)
+ ;;</To>
+"RTN","GPLCCR0",95,0)
+ ;;<Purpose>
+"RTN","GPLCCR0",96,0)
+ ;;<Description>
+"RTN","GPLCCR0",97,0)
+ ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
+"RTN","GPLCCR0",98,0)
+ ;;</Description>
+"RTN","GPLCCR0",99,0)
+ ;;</Purpose>
+"RTN","GPLCCR0",100,0)
+ ;;<Body>
+"RTN","GPLCCR0",101,0)
+ ;;<Problems>
+"RTN","GPLCCR0",102,0)
+ ;;<Problem>
+"RTN","GPLCCR0",103,0)
+ ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",104,0)
+ ;;<Type>
+"RTN","GPLCCR0",105,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",106,0)
+ ;;</Type>
+"RTN","GPLCCR0",107,0)
+ ;;<Description>
+"RTN","GPLCCR0",108,0)
+ ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",109,0)
+ ;;<Code>
+"RTN","GPLCCR0",110,0)
+ ;;<Value>@@PROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",111,0)
+ ;;<CodingSystem>ICD9CM</CodingSystem>
+"RTN","GPLCCR0",112,0)
+ ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",113,0)
+ ;;</Code>
+"RTN","GPLCCR0",114,0)
+ ;;</Description>
+"RTN","GPLCCR0",115,0)
+ ;;<Source>
+"RTN","GPLCCR0",116,0)
+ ;;<Actor>
+"RTN","GPLCCR0",117,0)
+ ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",118,0)
+ ;;</Actor>
+"RTN","GPLCCR0",119,0)
+ ;;</Source>
+"RTN","GPLCCR0",120,0)
+ ;;</Problem>
+"RTN","GPLCCR0",121,0)
+ ;;</Problems>
+"RTN","GPLCCR0",122,0)
+ ;;<FamilyHistory>
+"RTN","GPLCCR0",123,0)
+ ;;<FamilyProblemHistory>
+"RTN","GPLCCR0",124,0)
+ ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",125,0)
+ ;;<Source>
+"RTN","GPLCCR0",126,0)
+ ;;<Actor>
+"RTN","GPLCCR0",127,0)
+ ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
+"RTN","GPLCCR0",128,0)
+ ;;</Actor>
+"RTN","GPLCCR0",129,0)
+ ;;</Source>
+"RTN","GPLCCR0",130,0)
+ ;;<FamilyMember>
+"RTN","GPLCCR0",131,0)
+ ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
+"RTN","GPLCCR0",132,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",133,0)
+ ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
+"RTN","GPLCCR0",134,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",135,0)
+ ;;<Source>
+"RTN","GPLCCR0",136,0)
+ ;;<Actor>
+"RTN","GPLCCR0",137,0)
+ ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",138,0)
+ ;;</Actor>
+"RTN","GPLCCR0",139,0)
+ ;;</Source>
+"RTN","GPLCCR0",140,0)
+ ;;</FamilyMember>
+"RTN","GPLCCR0",141,0)
+ ;;<Problem>
+"RTN","GPLCCR0",142,0)
+ ;;<Type>
+"RTN","GPLCCR0",143,0)
+ ;;<Text>Problem</Text>
+"RTN","GPLCCR0",144,0)
+ ;;</Type>
+"RTN","GPLCCR0",145,0)
+ ;;<Description>
+"RTN","GPLCCR0",146,0)
+ ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",147,0)
+ ;;<Code>
+"RTN","GPLCCR0",148,0)
+ ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
+"RTN","GPLCCR0",149,0)
+ ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",150,0)
+ ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
+"RTN","GPLCCR0",151,0)
+ ;;</Code>
+"RTN","GPLCCR0",152,0)
+ ;;</Description>
+"RTN","GPLCCR0",153,0)
+ ;;<Source>
+"RTN","GPLCCR0",154,0)
+ ;;<Actor>
+"RTN","GPLCCR0",155,0)
+ ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
+"RTN","GPLCCR0",156,0)
+ ;;</Actor>
+"RTN","GPLCCR0",157,0)
+ ;;</Source>
+"RTN","GPLCCR0",158,0)
+ ;;</Problem>
+"RTN","GPLCCR0",159,0)
+ ;;</FamilyProblemHistory>
+"RTN","GPLCCR0",160,0)
+ ;;</FamilyHistory>
+"RTN","GPLCCR0",161,0)
+ ;;<SocialHistory>
+"RTN","GPLCCR0",162,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",163,0)
+ ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",164,0)
+ ;;<Type>
+"RTN","GPLCCR0",165,0)
+ ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
+"RTN","GPLCCR0",166,0)
+ ;;</Type>
+"RTN","GPLCCR0",167,0)
+ ;;<Description>
+"RTN","GPLCCR0",168,0)
+ ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",169,0)
+ ;;</Description>
+"RTN","GPLCCR0",170,0)
+ ;;<Source>
+"RTN","GPLCCR0",171,0)
+ ;;<Actor>
+"RTN","GPLCCR0",172,0)
+ ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
+"RTN","GPLCCR0",173,0)
+ ;;</Actor>
+"RTN","GPLCCR0",174,0)
+ ;;</Source>
+"RTN","GPLCCR0",175,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",176,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",177,0)
+ ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
+"RTN","GPLCCR0",178,0)
+ ;;<Type>
+"RTN","GPLCCR0",179,0)
+ ;;<Text>Ethnic Origin</Text>
+"RTN","GPLCCR0",180,0)
+ ;;</Type>
+"RTN","GPLCCR0",181,0)
+ ;;<Description>
+"RTN","GPLCCR0",182,0)
+ ;;<Text>Not Hispanic or Latino</Text>
+"RTN","GPLCCR0",183,0)
+ ;;</Description>
+"RTN","GPLCCR0",184,0)
+ ;;<Source>
+"RTN","GPLCCR0",185,0)
+ ;;<Actor>
+"RTN","GPLCCR0",186,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",187,0)
+ ;;</Actor>
+"RTN","GPLCCR0",188,0)
+ ;;</Source>
+"RTN","GPLCCR0",189,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",190,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",191,0)
+ ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
+"RTN","GPLCCR0",192,0)
+ ;;<Type>
+"RTN","GPLCCR0",193,0)
+ ;;<Text>Race</Text>
+"RTN","GPLCCR0",194,0)
+ ;;</Type>
+"RTN","GPLCCR0",195,0)
+ ;;<Description>
+"RTN","GPLCCR0",196,0)
+ ;;<Text>White</Text>
+"RTN","GPLCCR0",197,0)
+ ;;</Description>
+"RTN","GPLCCR0",198,0)
+ ;;<Source>
+"RTN","GPLCCR0",199,0)
+ ;;<Actor>
+"RTN","GPLCCR0",200,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",201,0)
+ ;;</Actor>
+"RTN","GPLCCR0",202,0)
+ ;;</Source>
+"RTN","GPLCCR0",203,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",204,0)
+ ;;<SocialHistoryElement>
+"RTN","GPLCCR0",205,0)
+ ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
+"RTN","GPLCCR0",206,0)
+ ;;<Type>
+"RTN","GPLCCR0",207,0)
+ ;;<Text>Occupation</Text>
+"RTN","GPLCCR0",208,0)
+ ;;</Type>
+"RTN","GPLCCR0",209,0)
+ ;;<Description>
+"RTN","GPLCCR0",210,0)
+ ;;<Text>Physician</Text>
+"RTN","GPLCCR0",211,0)
+ ;;</Description>
+"RTN","GPLCCR0",212,0)
+ ;;<Source>
+"RTN","GPLCCR0",213,0)
+ ;;<Actor>
+"RTN","GPLCCR0",214,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",215,0)
+ ;;</Actor>
+"RTN","GPLCCR0",216,0)
+ ;;</Source>
+"RTN","GPLCCR0",217,0)
+ ;;</SocialHistoryElement>
+"RTN","GPLCCR0",218,0)
+ ;;</SocialHistory>
+"RTN","GPLCCR0",219,0)
+ ;;<Alerts>
+"RTN","GPLCCR0",220,0)
+ ;;<Alert>
+"RTN","GPLCCR0",221,0)
+ ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",222,0)
+ ;;<Description>
+"RTN","GPLCCR0",223,0)
+ ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",224,0)
+ ;;<Code>
+"RTN","GPLCCR0",225,0)
+ ;;<Value>@@ALERTCODEVALUE@@</Value>
+"RTN","GPLCCR0",226,0)
+ ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",227,0)
+ ;;</Code>
+"RTN","GPLCCR0",228,0)
+ ;;</Description>
+"RTN","GPLCCR0",229,0)
+ ;;<Status>
+"RTN","GPLCCR0",230,0)
+ ;;<Text>@@ALERTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",231,0)
+ ;;</Status>
+"RTN","GPLCCR0",232,0)
+ ;;<Source>
+"RTN","GPLCCR0",233,0)
+ ;;<Actor>
+"RTN","GPLCCR0",234,0)
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",235,0)
+ ;;</Actor>
+"RTN","GPLCCR0",236,0)
+ ;;</Source>
+"RTN","GPLCCR0",237,0)
+ ;;<Agent>
+"RTN","GPLCCR0",238,0)
+ ;;<Products>
+"RTN","GPLCCR0",239,0)
+ ;;<Product>
+"RTN","GPLCCR0",240,0)
+ ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",241,0)
+ ;;<Source>
+"RTN","GPLCCR0",242,0)
+ ;;<Actor>
+"RTN","GPLCCR0",243,0)
+ ;;<ActorID>@@ALERTAGENTPRODUCTSOURCEID@@</ActorID>
+"RTN","GPLCCR0",244,0)
+ ;;</Actor>
+"RTN","GPLCCR0",245,0)
+ ;;</Source>
+"RTN","GPLCCR0",246,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",247,0)
+ ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",248,0)
+ ;;<Code>
+"RTN","GPLCCR0",249,0)
+ ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
+"RTN","GPLCCR0",250,0)
+ ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",251,0)
+ ;;</Code>
+"RTN","GPLCCR0",252,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",253,0)
+ ;;</Product>
+"RTN","GPLCCR0",254,0)
+ ;;</Products>
+"RTN","GPLCCR0",255,0)
+ ;;</Agent>
+"RTN","GPLCCR0",256,0)
+ ;;<Reaction>
+"RTN","GPLCCR0",257,0)
+ ;;<Description>
+"RTN","GPLCCR0",258,0)
+ ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",259,0)
+ ;;<Code>
+"RTN","GPLCCR0",260,0)
+ ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",261,0)
+ ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",262,0)
+ ;;</Code>
+"RTN","GPLCCR0",263,0)
+ ;;</Description>
+"RTN","GPLCCR0",264,0)
+ ;;</Reaction>
+"RTN","GPLCCR0",265,0)
+ ;;</Alert>
+"RTN","GPLCCR0",266,0)
+ ;;</Alerts>
+"RTN","GPLCCR0",267,0)
+ ;;<Medications>
+"RTN","GPLCCR0",268,0)
+ ;;<Medication>
+"RTN","GPLCCR0",269,0)
+ ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",270,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",271,0)
+ ;;<Type>
+"RTN","GPLCCR0",272,0)
+ ;;<Text>@@MEDISSUEDATETXT@@</Text>
+"RTN","GPLCCR0",273,0)
+ ;;</Type>
+"RTN","GPLCCR0",274,0)
+ ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
+"RTN","GPLCCR0",275,0)
+ ;;<Type>
+"RTN","GPLCCR0",276,0)
+ ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
+"RTN","GPLCCR0",277,0)
+ ;;</Type>
+"RTN","GPLCCR0",278,0)
+ ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
+"RTN","GPLCCR0",279,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",280,0)
+ ;;<IDs>
+"RTN","GPLCCR0",281,0)
+ ;;<Type>
+"RTN","GPLCCR0",282,0)
+ ;;<Text>@@MEDRXNOTXT@@</Text>
+"RTN","GPLCCR0",283,0)
+ ;;</Type>
+"RTN","GPLCCR0",284,0)
+ ;;<ID>@@MEDRXNO@@</ID>
+"RTN","GPLCCR0",285,0)
+ ;;</IDs>
+"RTN","GPLCCR0",286,0)
+ ;;<Type>
+"RTN","GPLCCR0",287,0)
+ ;;<Text>@@MEDTYPETEXT@@</Text>
+"RTN","GPLCCR0",288,0)
+ ;;</Type>
+"RTN","GPLCCR0",289,0)
+ ;;<Description>
+"RTN","GPLCCR0",290,0)
+ ;;<Text>@@MEDDETAILUNADORNED@@</Text>
+"RTN","GPLCCR0",291,0)
+ ;;</Description>
+"RTN","GPLCCR0",292,0)
+ ;;<Status>
+"RTN","GPLCCR0",293,0)
+ ;;<Text>@@MEDSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",294,0)
+ ;;</Status>
+"RTN","GPLCCR0",295,0)
+ ;;<Source>
+"RTN","GPLCCR0",296,0)
+ ;;<Actor>
+"RTN","GPLCCR0",297,0)
+ ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",298,0)
+ ;;</Actor>
+"RTN","GPLCCR0",299,0)
+ ;;</Source>
+"RTN","GPLCCR0",300,0)
+ ;;<Product>
+"RTN","GPLCCR0",301,0)
+ ;;<ProductName>
+"RTN","GPLCCR0",302,0)
+ ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
+"RTN","GPLCCR0",303,0)
+ ;;<Code>
+"RTN","GPLCCR0",304,0)
+ ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
+"RTN","GPLCCR0",305,0)
+ ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",306,0)
+ ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
+"RTN","GPLCCR0",307,0)
+ ;;</Code>
+"RTN","GPLCCR0",308,0)
+ ;;</ProductName>
+"RTN","GPLCCR0",309,0)
+ ;;<BrandName>
+"RTN","GPLCCR0",310,0)
+ ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
+"RTN","GPLCCR0",311,0)
+ ;;</BrandName>
+"RTN","GPLCCR0",312,0)
+ ;;<Strength>
+"RTN","GPLCCR0",313,0)
+ ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
+"RTN","GPLCCR0",314,0)
+ ;;<Units>
+"RTN","GPLCCR0",315,0)
+ ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
+"RTN","GPLCCR0",316,0)
+ ;;</Units>
+"RTN","GPLCCR0",317,0)
+ ;;</Strength>
+"RTN","GPLCCR0",318,0)
+ ;;<Form>
+"RTN","GPLCCR0",319,0)
+ ;;<Text>@@MEDFORMTEXT@@</Text>
+"RTN","GPLCCR0",320,0)
+ ;;</Form>
+"RTN","GPLCCR0",321,0)
+ ;;<Concentration>
+"RTN","GPLCCR0",322,0)
+ ;;<Value>@@MEDCONCVALUE@@</Value>
+"RTN","GPLCCR0",323,0)
+ ;;<Units>
+"RTN","GPLCCR0",324,0)
+ ;;<Unit>@@MEDCONCUNIT@@</Unit>
+"RTN","GPLCCR0",325,0)
+ ;;</Units>
+"RTN","GPLCCR0",326,0)
+ ;;</Concentration>
+"RTN","GPLCCR0",327,0)
+ ;;<Size>
+"RTN","GPLCCR0",328,0)
+ ;;<Text>@@MEDSIZETEXT@@</Text>
+"RTN","GPLCCR0",329,0)
+ ;;</Size>
+"RTN","GPLCCR0",330,0)
+ ;;</Product>
+"RTN","GPLCCR0",331,0)
+ ;;<Quantity>
+"RTN","GPLCCR0",332,0)
+ ;;<Value>@@MEDQUANTITYVALUE@@</Value>
+"RTN","GPLCCR0",333,0)
+ ;;<Units>
+"RTN","GPLCCR0",334,0)
+ ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
+"RTN","GPLCCR0",335,0)
+ ;;</Units>
+"RTN","GPLCCR0",336,0)
+ ;;</Quantity>
+"RTN","GPLCCR0",337,0)
+ ;;<Directions>
+"RTN","GPLCCR0",338,0)
+ ;;<Direction>
+"RTN","GPLCCR0",339,0)
+ ;;<Description>
+"RTN","GPLCCR0",340,0)
+ ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",341,0)
+ ;;</Description>
+"RTN","GPLCCR0",342,0)
+ ;;<DoseIndicator>
+"RTN","GPLCCR0",343,0)
+ ;;<Text>@@MEDDOSEINDICATOR@@</Text>
+"RTN","GPLCCR0",344,0)
+ ;;</DoseIndicator>
+"RTN","GPLCCR0",345,0)
+ ;;<DeliveryMethod>
+"RTN","GPLCCR0",346,0)
+ ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
+"RTN","GPLCCR0",347,0)
+ ;;</DeliveryMethod>
+"RTN","GPLCCR0",348,0)
+ ;;<Dose>
+"RTN","GPLCCR0",349,0)
+ ;;<Value>@@MEDDOSEVALUE@@</Value>
+"RTN","GPLCCR0",350,0)
+ ;;<Units>
+"RTN","GPLCCR0",351,0)
+ ;;<Unit>@@MEDDOSEUNIT@@</Unit>
+"RTN","GPLCCR0",352,0)
+ ;;</Units>
+"RTN","GPLCCR0",353,0)
+ ;;<Rate>
+"RTN","GPLCCR0",354,0)
+ ;;<Value>@@MEDRATEVALUE@@</Value>
+"RTN","GPLCCR0",355,0)
+ ;;<Units>
+"RTN","GPLCCR0",356,0)
+ ;;<Unit>@@MEDRATEUNIT@@</Unit>
+"RTN","GPLCCR0",357,0)
+ ;;</Units>
+"RTN","GPLCCR0",358,0)
+ ;;</Rate>
+"RTN","GPLCCR0",359,0)
+ ;;</Dose>
+"RTN","GPLCCR0",360,0)
+ ;;<Vehicle>
+"RTN","GPLCCR0",361,0)
+ ;;<Text>@@MEDVEHICLETEXT@@</Text>
+"RTN","GPLCCR0",362,0)
+ ;;</Vehicle>
+"RTN","GPLCCR0",363,0)
+ ;;<Route>
+"RTN","GPLCCR0",364,0)
+ ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
+"RTN","GPLCCR0",365,0)
+ ;;</Route>
+"RTN","GPLCCR0",366,0)
+ ;;<Frequency>
+"RTN","GPLCCR0",367,0)
+ ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
+"RTN","GPLCCR0",368,0)
+ ;;<Units>
+"RTN","GPLCCR0",369,0)
+ ;;<Unit>@@MEDFREQUENCYUNIT@@</Unit>
+"RTN","GPLCCR0",370,0)
+ ;;</Units>
+"RTN","GPLCCR0",371,0)
+ ;;</Frequency>
+"RTN","GPLCCR0",372,0)
+ ;;<Interval>
+"RTN","GPLCCR0",373,0)
+ ;;<Value>@@MEDINTERVALVALUE@@</Value>
+"RTN","GPLCCR0",374,0)
+ ;;<Units>
+"RTN","GPLCCR0",375,0)
+ ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
+"RTN","GPLCCR0",376,0)
+ ;;</Units>
+"RTN","GPLCCR0",377,0)
+ ;;</Interval>
+"RTN","GPLCCR0",378,0)
+ ;;<Duration>
+"RTN","GPLCCR0",379,0)
+ ;;<Value>@@MEDDURATIONVALUE@@</Value>
+"RTN","GPLCCR0",380,0)
+ ;;<Units>
+"RTN","GPLCCR0",381,0)
+ ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
+"RTN","GPLCCR0",382,0)
+ ;;</Units>
+"RTN","GPLCCR0",383,0)
+ ;;</Duration>
+"RTN","GPLCCR0",384,0)
+ ;;<Indication>
+"RTN","GPLCCR0",385,0)
+ ;;<PRNFlag>
+"RTN","GPLCCR0",386,0)
+ ;;<Text>@@MEDPRNFLAG@@</Text>
+"RTN","GPLCCR0",387,0)
+ ;;</PRNFlag>
+"RTN","GPLCCR0",388,0)
+ ;;<Problem>
+"RTN","GPLCCR0",389,0)
+ ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",390,0)
+ ;;<Type>
+"RTN","GPLCCR0",391,0)
+ ;;<Text>@@PROBLEM@@</Text>
+"RTN","GPLCCR0",392,0)
+ ;;</Type>
+"RTN","GPLCCR0",393,0)
+ ;;<Description>
+"RTN","GPLCCR0",394,0)
+ ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
+"RTN","GPLCCR0",395,0)
+ ;;<Code>
+"RTN","GPLCCR0",396,0)
+ ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
+"RTN","GPLCCR0",397,0)
+ ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",398,0)
+ ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
+"RTN","GPLCCR0",399,0)
+ ;;</Code>
+"RTN","GPLCCR0",400,0)
+ ;;</Description>
+"RTN","GPLCCR0",401,0)
+ ;;<Source>
+"RTN","GPLCCR0",402,0)
+ ;;<Actor>
+"RTN","GPLCCR0",403,0)
+ ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",404,0)
+ ;;</Actor>
+"RTN","GPLCCR0",405,0)
+ ;;</Source>
+"RTN","GPLCCR0",406,0)
+ ;;</Problem>
+"RTN","GPLCCR0",407,0)
+ ;;</Indication>
+"RTN","GPLCCR0",408,0)
+ ;;<StopIndicator>
+"RTN","GPLCCR0",409,0)
+ ;;<Text>@@MEDSTOPINDICATOR@@</Text>
+"RTN","GPLCCR0",410,0)
+ ;;</StopIndicator>
+"RTN","GPLCCR0",411,0)
+ ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
+"RTN","GPLCCR0",412,0)
+ ;;<MultipleDirectionModifier>
+"RTN","GPLCCR0",413,0)
+ ;;<Text>@@MEDMULDIRMOD@@</Text>
+"RTN","GPLCCR0",414,0)
+ ;;</MultipleDirectionModifier>
+"RTN","GPLCCR0",415,0)
+ ;;</Direction>
+"RTN","GPLCCR0",416,0)
+ ;;</Directions>
+"RTN","GPLCCR0",417,0)
+ ;;<PatientInstructions>
+"RTN","GPLCCR0",418,0)
+ ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",419,0)
+ ;;</PatientInstructions>
+"RTN","GPLCCR0",420,0)
+ ;;<FullfillmentInstructions>
+"RTN","GPLCCR0",421,0)
+ ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
+"RTN","GPLCCR0",422,0)
+ ;;</FullfillmentInstructions>
+"RTN","GPLCCR0",423,0)
+ ;;<Refills>
+"RTN","GPLCCR0",424,0)
+ ;;<Refill>
+"RTN","GPLCCR0",425,0)
+ ;;<Number>@@MEDRFNO@@</Number>
+"RTN","GPLCCR0",426,0)
+ ;;</Refill>
+"RTN","GPLCCR0",427,0)
+ ;;</Refills>
+"RTN","GPLCCR0",428,0)
+ ;;</Medication>
+"RTN","GPLCCR0",429,0)
+ ;;</Medications>
+"RTN","GPLCCR0",430,0)
+ ;;<VitalSigns>
+"RTN","GPLCCR0",431,0)
+ ;;<Result>
+"RTN","GPLCCR0",432,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",433,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",434,0)
+ ;;<Type>
+"RTN","GPLCCR0",435,0)
+ ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
+"RTN","GPLCCR0",436,0)
+ ;;</Type>
+"RTN","GPLCCR0",437,0)
+ ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",438,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",439,0)
+ ;;<Description>
+"RTN","GPLCCR0",440,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",441,0)
+ ;;</Description>
+"RTN","GPLCCR0",442,0)
+ ;;<Source>
+"RTN","GPLCCR0",443,0)
+ ;;<Actor>
+"RTN","GPLCCR0",444,0)
+ ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",445,0)
+ ;;</Actor>
+"RTN","GPLCCR0",446,0)
+ ;;</Source>
+"RTN","GPLCCR0",447,0)
+ ;;<Test>
+"RTN","GPLCCR0",448,0)
+ ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",449,0)
+ ;;<Type>
+"RTN","GPLCCR0",450,0)
+ ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
+"RTN","GPLCCR0",451,0)
+ ;;</Type>
+"RTN","GPLCCR0",452,0)
+ ;;<Description>
+"RTN","GPLCCR0",453,0)
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",454,0)
+ ;;<Code>
+"RTN","GPLCCR0",455,0)
+ ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
+"RTN","GPLCCR0",456,0)
+ ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",457,0)
+ ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
+"RTN","GPLCCR0",458,0)
+ ;;</Code>
+"RTN","GPLCCR0",459,0)
+ ;;</Description>
+"RTN","GPLCCR0",460,0)
+ ;;<Source>
+"RTN","GPLCCR0",461,0)
+ ;;<Actor>
+"RTN","GPLCCR0",462,0)
+ ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",463,0)
+ ;;</Actor>
+"RTN","GPLCCR0",464,0)
+ ;;</Source>
+"RTN","GPLCCR0",465,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",466,0)
+ ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
+"RTN","GPLCCR0",467,0)
+ ;;<Units>
+"RTN","GPLCCR0",468,0)
+ ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
+"RTN","GPLCCR0",469,0)
+ ;;</Units>
+"RTN","GPLCCR0",470,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",471,0)
+ ;;</Test>
+"RTN","GPLCCR0",472,0)
+ ;;</Result>
+"RTN","GPLCCR0",473,0)
+ ;;</VitalSigns>
+"RTN","GPLCCR0",474,0)
+ ;;<Results>
+"RTN","GPLCCR0",475,0)
+ ;;<Result>
+"RTN","GPLCCR0",476,0)
+ ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",477,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",478,0)
+ ;;<Type>
+"RTN","GPLCCR0",479,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",480,0)
+ ;;</Type>
+"RTN","GPLCCR0",481,0)
+ ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",482,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",483,0)
+ ;;<Description>
+"RTN","GPLCCR0",484,0)
+ ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",485,0)
+ ;;<Code>
+"RTN","GPLCCR0",486,0)
+ ;;<Value>@@RESULTCODE@@</Value>
+"RTN","GPLCCR0",487,0)
+ ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",488,0)
+ ;;</Code>
+"RTN","GPLCCR0",489,0)
+ ;;</Description>
+"RTN","GPLCCR0",490,0)
+ ;;<Status>
+"RTN","GPLCCR0",491,0)
+ ;;<Text>@@RESULTSTATUS@@</Text>
+"RTN","GPLCCR0",492,0)
+ ;;</Status>
+"RTN","GPLCCR0",493,0)
+ ;;<Source>
+"RTN","GPLCCR0",494,0)
+ ;;<Actor>
+"RTN","GPLCCR0",495,0)
+ ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",496,0)
+ ;;</Actor>
+"RTN","GPLCCR0",497,0)
+ ;;</Source>
+"RTN","GPLCCR0",498,0)
+ ;;<TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",499,0)
+ ;;<Test>
+"RTN","GPLCCR0",500,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",501,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",502,0)
+ ;;<Type>
+"RTN","GPLCCR0",503,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",504,0)
+ ;;</Type>
+"RTN","GPLCCR0",505,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",506,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",507,0)
+ ;;<Description>
+"RTN","GPLCCR0",508,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",509,0)
+ ;;<Code>
+"RTN","GPLCCR0",510,0)
+ ;;<Value>@@RESULTTESTCODE@@</Value>
+"RTN","GPLCCR0",511,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",512,0)
+ ;;</Code>
+"RTN","GPLCCR0",513,0)
+ ;;</Description>
+"RTN","GPLCCR0",514,0)
+ ;;<Status>
+"RTN","GPLCCR0",515,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",516,0)
+ ;;</Status>
+"RTN","GPLCCR0",517,0)
+ ;;<Source>
+"RTN","GPLCCR0",518,0)
+ ;;<Actor>
+"RTN","GPLCCR0",519,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",520,0)
+ ;;</Actor>
+"RTN","GPLCCR0",521,0)
+ ;;</Source>
+"RTN","GPLCCR0",522,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",523,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",524,0)
+ ;;<Units>
+"RTN","GPLCCR0",525,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",526,0)
+ ;;</Units>
+"RTN","GPLCCR0",527,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",528,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",529,0)
+ ;;<Normal>
+"RTN","GPLCCR0",530,0)
+ ;;<Description>
+"RTN","GPLCCR0",531,0)
+ ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",532,0)
+ ;;</Description>
+"RTN","GPLCCR0",533,0)
+ ;;<Source>
+"RTN","GPLCCR0",534,0)
+ ;;<Actor>
+"RTN","GPLCCR0",535,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",536,0)
+ ;;</Actor>
+"RTN","GPLCCR0",537,0)
+ ;;</Source>
+"RTN","GPLCCR0",538,0)
+ ;;</Normal>
+"RTN","GPLCCR0",539,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",540,0)
+ ;;<Flag>
+"RTN","GPLCCR0",541,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",542,0)
+ ;;</Flag>
+"RTN","GPLCCR0",543,0)
+ ;;</Test>
+"RTN","GPLCCR0",544,0)
+ ;;</TEST_NORMALDESCRIPTION>
+"RTN","GPLCCR0",545,0)
+ ;;<TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",546,0)
+ ;;<Test>
+"RTN","GPLCCR0",547,0)
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+"RTN","GPLCCR0",548,0)
+ ;;<DateTime>
+"RTN","GPLCCR0",549,0)
+ ;;<Type>
+"RTN","GPLCCR0",550,0)
+ ;;<Text>Assessment Time</Text>
+"RTN","GPLCCR0",551,0)
+ ;;</Type>
+"RTN","GPLCCR0",552,0)
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+"RTN","GPLCCR0",553,0)
+ ;;</DateTime>
+"RTN","GPLCCR0",554,0)
+ ;;<Description>
+"RTN","GPLCCR0",555,0)
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+"RTN","GPLCCR0",556,0)
+ ;;<Code>
+"RTN","GPLCCR0",557,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",558,0)
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+"RTN","GPLCCR0",559,0)
+ ;;</Code>
+"RTN","GPLCCR0",560,0)
+ ;;</Description>
+"RTN","GPLCCR0",561,0)
+ ;;<Status>
+"RTN","GPLCCR0",562,0)
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+"RTN","GPLCCR0",563,0)
+ ;;</Status>
+"RTN","GPLCCR0",564,0)
+ ;;<Source>
+"RTN","GPLCCR0",565,0)
+ ;;<Actor>
+"RTN","GPLCCR0",566,0)
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",567,0)
+ ;;</Actor>
+"RTN","GPLCCR0",568,0)
+ ;;</Source>
+"RTN","GPLCCR0",569,0)
+ ;;<TestResult>
+"RTN","GPLCCR0",570,0)
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+"RTN","GPLCCR0",571,0)
+ ;;<Units>
+"RTN","GPLCCR0",572,0)
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+"RTN","GPLCCR0",573,0)
+ ;;</Units>
+"RTN","GPLCCR0",574,0)
+ ;;</TestResult>
+"RTN","GPLCCR0",575,0)
+ ;;<NormalResult>
+"RTN","GPLCCR0",576,0)
+ ;;<Normal>
+"RTN","GPLCCR0",577,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
+"RTN","GPLCCR0",578,0)
+ ;;<Units>
+"RTN","GPLCCR0",579,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
+"RTN","GPLCCR0",580,0)
+ ;;</Units>
+"RTN","GPLCCR0",581,0)
+ ;;<ValueSequencePosition>1</ValueSequencePosition>
+"RTN","GPLCCR0",582,0)
+ ;;<Source>
+"RTN","GPLCCR0",583,0)
+ ;;<Actor>
+"RTN","GPLCCR0",584,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",585,0)
+ ;;</Actor>
+"RTN","GPLCCR0",586,0)
+ ;;</Source>
+"RTN","GPLCCR0",587,0)
+ ;;</Normal>
+"RTN","GPLCCR0",588,0)
+ ;;<Normal>
+"RTN","GPLCCR0",589,0)
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
+"RTN","GPLCCR0",590,0)
+ ;;<Units>
+"RTN","GPLCCR0",591,0)
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
+"RTN","GPLCCR0",592,0)
+ ;;</Units>
+"RTN","GPLCCR0",593,0)
+ ;;<ValueSequencePosition>2</ValueSequencePosition>
+"RTN","GPLCCR0",594,0)
+ ;;<VariableNomalModifier>
+"RTN","GPLCCR0",595,0)
+ ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
+"RTN","GPLCCR0",596,0)
+ ;;</VariableNomalModifier>
+"RTN","GPLCCR0",597,0)
+ ;;<Source>
+"RTN","GPLCCR0",598,0)
+ ;;<Actor>
+"RTN","GPLCCR0",599,0)
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+"RTN","GPLCCR0",600,0)
+ ;;</Actor>
+"RTN","GPLCCR0",601,0)
+ ;;</Source>
+"RTN","GPLCCR0",602,0)
+ ;;</Normal>
+"RTN","GPLCCR0",603,0)
+ ;;</NormalResult>
+"RTN","GPLCCR0",604,0)
+ ;;<Flag>
+"RTN","GPLCCR0",605,0)
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+"RTN","GPLCCR0",606,0)
+ ;;</Flag>
+"RTN","GPLCCR0",607,0)
+ ;;</Test>
+"RTN","GPLCCR0",608,0)
+ ;;</TEST_NORMALSEQUENCE>
+"RTN","GPLCCR0",609,0)
+ ;;</Result>
+"RTN","GPLCCR0",610,0)
+ ;;</Results>
+"RTN","GPLCCR0",611,0)
+ ;;<HealthCareProviders>
+"RTN","GPLCCR0",612,0)
+ ;;<Provider>
+"RTN","GPLCCR0",613,0)
+ ;;<ActorID>AA0005</ActorID>
+"RTN","GPLCCR0",614,0)
+ ;;<ActorRole>
+"RTN","GPLCCR0",615,0)
+ ;;<Text>Primary Provider</Text>
+"RTN","GPLCCR0",616,0)
+ ;;</ActorRole>
+"RTN","GPLCCR0",617,0)
+ ;;</Provider>
+"RTN","GPLCCR0",618,0)
+ ;;</HealthCareProviders>
+"RTN","GPLCCR0",619,0)
+ ;;</Body>
+"RTN","GPLCCR0",620,0)
+ ;;<Actors>
+"RTN","GPLCCR0",621,0)
+ ;;<ACTOR-PATIENT>
+"RTN","GPLCCR0",622,0)
+ ;;<Actor>
+"RTN","GPLCCR0",623,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",624,0)
+ ;;<Person>
+"RTN","GPLCCR0",625,0)
+ ;;<Name>
+"RTN","GPLCCR0",626,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",627,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",628,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",629,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",630,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",631,0)
+ ;;</Name>
+"RTN","GPLCCR0",632,0)
+ ;;<DateOfBirth>
+"RTN","GPLCCR0",633,0)
+ ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
+"RTN","GPLCCR0",634,0)
+ ;;</DateOfBirth>
+"RTN","GPLCCR0",635,0)
+ ;;<Gender>
+"RTN","GPLCCR0",636,0)
+ ;;<Text>@@ACTORGENDER@@</Text>
+"RTN","GPLCCR0",637,0)
+ ;;<Code>
+"RTN","GPLCCR0",638,0)
+ ;;<Value>@@ACTORGENDER@@</Value>
+"RTN","GPLCCR0",639,0)
+ ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
+"RTN","GPLCCR0",640,0)
+ ;;</Code>
+"RTN","GPLCCR0",641,0)
+ ;;</Gender>
+"RTN","GPLCCR0",642,0)
+ ;;</Person>
+"RTN","GPLCCR0",643,0)
+ ;;<IDs>
+"RTN","GPLCCR0",644,0)
+ ;;<Type>
+"RTN","GPLCCR0",645,0)
+ ;;<Text>@@ACTORSSNTEXT@@</Text>
+"RTN","GPLCCR0",646,0)
+ ;;</Type>
+"RTN","GPLCCR0",647,0)
+ ;;<ID>@@ACTORSSN@@</ID>
+"RTN","GPLCCR0",648,0)
+ ;;<Source>
+"RTN","GPLCCR0",649,0)
+ ;;<Actor>
+"RTN","GPLCCR0",650,0)
+ ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
+"RTN","GPLCCR0",651,0)
+ ;;</Actor>
+"RTN","GPLCCR0",652,0)
+ ;;</Source>
+"RTN","GPLCCR0",653,0)
+ ;;</IDs>
+"RTN","GPLCCR0",654,0)
+ ;;<Address>
+"RTN","GPLCCR0",655,0)
+ ;;<Type>
+"RTN","GPLCCR0",656,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",657,0)
+ ;;</Type>
+"RTN","GPLCCR0",658,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",659,0)
+ ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
+"RTN","GPLCCR0",660,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",661,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",662,0)
+ ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
+"RTN","GPLCCR0",663,0)
+ ;;</Address>
+"RTN","GPLCCR0",664,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",665,0)
+ ;;<Value>@@ACTORRESTEL@@</Value>
+"RTN","GPLCCR0",666,0)
+ ;;<Type>
+"RTN","GPLCCR0",667,0)
+ ;;<Text>@@ACTORRESTELTEXT@@</Text>
+"RTN","GPLCCR0",668,0)
+ ;;</Type>
+"RTN","GPLCCR0",669,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",670,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",671,0)
+ ;;<Value>@@ACTORWORKTEL@@</Value>
+"RTN","GPLCCR0",672,0)
+ ;;<Type>
+"RTN","GPLCCR0",673,0)
+ ;;<Text>@@ACTORWORKTELTEXT@@</Text>
+"RTN","GPLCCR0",674,0)
+ ;;</Type>
+"RTN","GPLCCR0",675,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",676,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",677,0)
+ ;;<Value>@@ACTORCELLTEL@@</Value>
+"RTN","GPLCCR0",678,0)
+ ;;<Type>
+"RTN","GPLCCR0",679,0)
+ ;;<Text>@@ACTORCELLTELTEXT@@</Text>
+"RTN","GPLCCR0",680,0)
+ ;;</Type>
+"RTN","GPLCCR0",681,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",682,0)
+ ;;<EMail>
+"RTN","GPLCCR0",683,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",684,0)
+ ;;</EMail>
+"RTN","GPLCCR0",685,0)
+ ;;<Source>
+"RTN","GPLCCR0",686,0)
+ ;;<Actor>
+"RTN","GPLCCR0",687,0)
+ ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",688,0)
+ ;;</Actor>
+"RTN","GPLCCR0",689,0)
+ ;;</Source>
+"RTN","GPLCCR0",690,0)
+ ;;</Actor>
+"RTN","GPLCCR0",691,0)
+ ;;</ACTOR-PATIENT>
+"RTN","GPLCCR0",692,0)
+ ;;<ACTOR-SYSTEM>
+"RTN","GPLCCR0",693,0)
+ ;;<Actor>
+"RTN","GPLCCR0",694,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",695,0)
+ ;;<InformationSystem>
+"RTN","GPLCCR0",696,0)
+ ;;<Name>@@ACTORINFOSYSNAME@@</Name>
+"RTN","GPLCCR0",697,0)
+ ;;<Version>@@ACTORINFOSYSVER@@</Version>
+"RTN","GPLCCR0",698,0)
+ ;;</InformationSystem>
+"RTN","GPLCCR0",699,0)
+ ;;<Source>
+"RTN","GPLCCR0",700,0)
+ ;;<Actor>
+"RTN","GPLCCR0",701,0)
+ ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
+"RTN","GPLCCR0",702,0)
+ ;;</Actor>
+"RTN","GPLCCR0",703,0)
+ ;;</Source>
+"RTN","GPLCCR0",704,0)
+ ;;</Actor>
+"RTN","GPLCCR0",705,0)
+ ;;</ACTOR-SYSTEM>
+"RTN","GPLCCR0",706,0)
+ ;;<ACTOR-NOK>
+"RTN","GPLCCR0",707,0)
+ ;;<Actor>
+"RTN","GPLCCR0",708,0)
+ ;;<ActorObjectID>AA0003</ActorObjectID>
+"RTN","GPLCCR0",709,0)
+ ;;<Person>
+"RTN","GPLCCR0",710,0)
+ ;;<Name>
+"RTN","GPLCCR0",711,0)
+ ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
+"RTN","GPLCCR0",712,0)
+ ;;</Name>
+"RTN","GPLCCR0",713,0)
+ ;;</Person>
+"RTN","GPLCCR0",714,0)
+ ;;<Relation>
+"RTN","GPLCCR0",715,0)
+ ;;<Text>@@ACTORRELATION@@</Text>
+"RTN","GPLCCR0",716,0)
+ ;;</Relation>
+"RTN","GPLCCR0",717,0)
+ ;;<Source>
+"RTN","GPLCCR0",718,0)
+ ;;<Actor>
+"RTN","GPLCCR0",719,0)
+ ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
+"RTN","GPLCCR0",720,0)
+ ;;</Actor>
+"RTN","GPLCCR0",721,0)
+ ;;</Source>
+"RTN","GPLCCR0",722,0)
+ ;;</Actor>
+"RTN","GPLCCR0",723,0)
+ ;;</ACTOR-NOK>
+"RTN","GPLCCR0",724,0)
+ ;;<ACTOR-PROVIDER>
+"RTN","GPLCCR0",725,0)
+ ;;<Actor>
+"RTN","GPLCCR0",726,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",727,0)
+ ;;<Person>
+"RTN","GPLCCR0",728,0)
+ ;;<Name>
+"RTN","GPLCCR0",729,0)
+ ;;<CurrentName>
+"RTN","GPLCCR0",730,0)
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+"RTN","GPLCCR0",731,0)
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+"RTN","GPLCCR0",732,0)
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+"RTN","GPLCCR0",733,0)
+ ;;<Title>@@ACTORTITLE@@</Title>
+"RTN","GPLCCR0",734,0)
+ ;;</CurrentName>
+"RTN","GPLCCR0",735,0)
+ ;;</Name>
+"RTN","GPLCCR0",736,0)
+ ;;</Person>
+"RTN","GPLCCR0",737,0)
+ ;;<IDs>
+"RTN","GPLCCR0",738,0)
+ ;;<Type>
+"RTN","GPLCCR0",739,0)
+ ;;<Text>@@IDTYPE@@</Text>
+"RTN","GPLCCR0",740,0)
+ ;;</Type>
+"RTN","GPLCCR0",741,0)
+ ;;<ID>@@ID@@</ID>
+"RTN","GPLCCR0",742,0)
+ ;;<IssuedBy>
+"RTN","GPLCCR0",743,0)
+ ;;<Description>
+"RTN","GPLCCR0",744,0)
+ ;;<Text>@@IDDESC@@</Text>
+"RTN","GPLCCR0",745,0)
+ ;;</Description>
+"RTN","GPLCCR0",746,0)
+ ;;</IssuedBy>
+"RTN","GPLCCR0",747,0)
+ ;;</IDs>
+"RTN","GPLCCR0",748,0)
+ ;;<Specialty>
+"RTN","GPLCCR0",749,0)
+ ;;<Text>@@ACTORSPECIALITY@@</Text>
+"RTN","GPLCCR0",750,0)
+ ;;</Specialty>
+"RTN","GPLCCR0",751,0)
+ ;;<Address>
+"RTN","GPLCCR0",752,0)
+ ;;<Type>
+"RTN","GPLCCR0",753,0)
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+"RTN","GPLCCR0",754,0)
+ ;;</Type>
+"RTN","GPLCCR0",755,0)
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+"RTN","GPLCCR0",756,0)
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+"RTN","GPLCCR0",757,0)
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+"RTN","GPLCCR0",758,0)
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+"RTN","GPLCCR0",759,0)
+ ;;</Address>
+"RTN","GPLCCR0",760,0)
+ ;;<Telephone>
+"RTN","GPLCCR0",761,0)
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+"RTN","GPLCCR0",762,0)
+ ;;<Type>
+"RTN","GPLCCR0",763,0)
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+"RTN","GPLCCR0",764,0)
+ ;;</Type>
+"RTN","GPLCCR0",765,0)
+ ;;</Telephone>
+"RTN","GPLCCR0",766,0)
+ ;;<Email>
+"RTN","GPLCCR0",767,0)
+ ;;<Value>@@ACTOREMAIL@@</Value>
+"RTN","GPLCCR0",768,0)
+ ;;</Email>
+"RTN","GPLCCR0",769,0)
+ ;;<Source>
+"RTN","GPLCCR0",770,0)
+ ;;<Actor>
+"RTN","GPLCCR0",771,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",772,0)
+ ;;</Actor>
+"RTN","GPLCCR0",773,0)
+ ;;</Source>
+"RTN","GPLCCR0",774,0)
+ ;;</Actor>
+"RTN","GPLCCR0",775,0)
+ ;;</ACTOR-PROVIDER>
+"RTN","GPLCCR0",776,0)
+ ;;<ACTOR-ORG>
+"RTN","GPLCCR0",777,0)
+ ;;<Actor>
+"RTN","GPLCCR0",778,0)
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+"RTN","GPLCCR0",779,0)
+ ;;<Organization>
+"RTN","GPLCCR0",780,0)
+ ;;<Name>@@ORGANIZATIONNAME@@</Name>
+"RTN","GPLCCR0",781,0)
+ ;;</Organization>
+"RTN","GPLCCR0",782,0)
+ ;;<Source>
+"RTN","GPLCCR0",783,0)
+ ;;<Actor>
+"RTN","GPLCCR0",784,0)
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+"RTN","GPLCCR0",785,0)
+ ;;</Actor>
+"RTN","GPLCCR0",786,0)
+ ;;</Source>
+"RTN","GPLCCR0",787,0)
+ ;;</Actor>
+"RTN","GPLCCR0",788,0)
+ ;;</ACTOR-ORG>
+"RTN","GPLCCR0",789,0)
+ ;;</Actors>
+"RTN","GPLCCR0",790,0)
+ ;;<Signatures>
+"RTN","GPLCCR0",791,0)
+ ;;<CCRSignature>
+"RTN","GPLCCR0",792,0)
+ ;;<SignatureObjectID>S0001</SignatureObjectID>
+"RTN","GPLCCR0",793,0)
+ ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
+"RTN","GPLCCR0",794,0)
+ ;;<Source>
+"RTN","GPLCCR0",795,0)
+ ;;<ActorID>AA0001</ActorID>
+"RTN","GPLCCR0",796,0)
+ ;;</Source>
+"RTN","GPLCCR0",797,0)
+ ;;<Signature>
+"RTN","GPLCCR0",798,0)
+ ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
+"RTN","GPLCCR0",799,0)
+ ;;<SignedInfo>
+"RTN","GPLCCR0",800,0)
+ ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
+"RTN","GPLCCR0",801,0)
+ ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
+"RTN","GPLCCR0",802,0)
+ ;;<Reference URI="">
+"RTN","GPLCCR0",803,0)
+ ;;<Transforms>
+"RTN","GPLCCR0",804,0)
+ ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
+"RTN","GPLCCR0",805,0)
+ ;;</Transforms>
+"RTN","GPLCCR0",806,0)
+ ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
+"RTN","GPLCCR0",807,0)
+ ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
+"RTN","GPLCCR0",808,0)
+ ;;</Reference>
+"RTN","GPLCCR0",809,0)
+ ;;</SignedInfo>
+"RTN","GPLCCR0",810,0)
+ ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
+"RTN","GPLCCR0",811,0)
+ ;;<KeyInfo>
+"RTN","GPLCCR0",812,0)
+ ;;<KeyValue>
+"RTN","GPLCCR0",813,0)
+ ;;<RSAKeyValue>
+"RTN","GPLCCR0",814,0)
+ ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
+"RTN","GPLCCR0",815,0)
+ ;;<Exponent>AQAB</Exponent>
+"RTN","GPLCCR0",816,0)
+ ;;</RSAKeyValue>
+"RTN","GPLCCR0",817,0)
+ ;;</KeyValue>
+"RTN","GPLCCR0",818,0)
+ ;;</KeyInfo>
+"RTN","GPLCCR0",819,0)
+ ;;</Signature>
+"RTN","GPLCCR0",820,0)
+ ;;</Signature>
+"RTN","GPLCCR0",821,0)
+ ;;</CCRSignature>
+"RTN","GPLCCR0",822,0)
+ ;;</Signatures>
+"RTN","GPLCCR0",823,0)
+ ;;</ContinuityOfCareRecord>
+"RTN","GPLCCR0",824,0)
+ ;</TEMPLATE>
+"RTN","GPLMEDS")
+0^18^B47701207
+"RTN","GPLMEDS",1,0)
+GPLMEDS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
+"RTN","GPLMEDS",2,0)
+   ;;0.1;CCDCCR;;JUL 16,2008;Build 6
+"RTN","GPLMEDS",3,0)
+   ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLMEDS",4,0)
+   ;General Public License See attached copy of the License.
+"RTN","GPLMEDS",5,0)
+   ;
+"RTN","GPLMEDS",6,0)
+   ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLMEDS",7,0)
+   ;it under the terms of the GNU General Public License as published by
+"RTN","GPLMEDS",8,0)
+   ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLMEDS",9,0)
+   ;(at your option) any later version.
+"RTN","GPLMEDS",10,0)
+   ;
+"RTN","GPLMEDS",11,0)
+   ;This program is distributed in the hope that it will be useful,
+"RTN","GPLMEDS",12,0)
+   ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLMEDS",13,0)
+   ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLMEDS",14,0)
+   ;GNU General Public License for more details.
+"RTN","GPLMEDS",15,0)
+   ;
+"RTN","GPLMEDS",16,0)
+   ;You should have received a copy of the GNU General Public License along
+"RTN","GPLMEDS",17,0)
+   ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLMEDS",18,0)
+   ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLMEDS",19,0)
+   ;
+"RTN","GPLMEDS",20,0)
+   W "NO ENTRY FROM TOP",!
+"RTN","GPLMEDS",21,0)
+   Q
+"RTN","GPLMEDS",22,0)
+   ;
+"RTN","GPLMEDS",23,0)
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+"RTN","GPLMEDS",24,0)
+   ;
+"RTN","GPLMEDS",25,0)
+   ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLMEDS",26,0)
+   ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLMEDS",27,0)
+   ;
+"RTN","GPLMEDS",28,0)
+   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+"RTN","GPLMEDS",29,0)
+   D ACTIVE^ORWPS(.MEDRSLT,DFN)
+"RTN","GPLMEDS",30,0)
+   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+"RTN","GPLMEDS",31,0)
+   . W "ERROR RUNNINIG MEDICATIONS RPC",!
+"RTN","GPLMEDS",32,0)
+   . S @MEDOUTXML@(0)=0
+"RTN","GPLMEDS",33,0)
+   . Q
+"RTN","GPLMEDS",34,0)
+   ; I DEBUG ZWR MEDRSLT
+"RTN","GPLMEDS",35,0)
+   M GPLMEDS=MEDRSLT
+"RTN","GPLMEDS",36,0)
+   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
+"RTN","GPLMEDS",37,0)
+   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+"RTN","GPLMEDS",38,0)
+   K @MEDTVMAP,@MEDTARYTMP
+"RTN","GPLMEDS",39,0)
+   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
+"RTN","GPLMEDS",40,0)
+   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
+"RTN","GPLMEDS",41,0)
+   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
+"RTN","GPLMEDS",42,0)
+   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
+"RTN","GPLMEDS",43,0)
+   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
+"RTN","GPLMEDS",44,0)
+   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
+"RTN","GPLMEDS",45,0)
+   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
+"RTN","GPLMEDS",46,0)
+   . . S ZI=ZI+1 ; INCREMENT MED COUNT
+"RTN","GPLMEDS",47,0)
+   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
+"RTN","GPLMEDS",48,0)
+   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
+"RTN","GPLMEDS",49,0)
+   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
+"RTN","GPLMEDS",50,0)
+   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
+"RTN","GPLMEDS",51,0)
+   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
+"RTN","GPLMEDS",52,0)
+   ;ZWR ZA
+"RTN","GPLMEDS",53,0)
+   F ZI=1:1:ZA(0) D  ; FOR EACH MED
+"RTN","GPLMEDS",54,0)
+   . I DEBUG W "ZI IS ",ZI,!
+"RTN","GPLMEDS",55,0)
+   . S MEDVMAP=$NA(@MEDTVMAP@(ZI))
+"RTN","GPLMEDS",56,0)
+   . K @MEDVMAP
+"RTN","GPLMEDS",57,0)
+   . I DEBUG W "VMAP= ",MEDVMAP,!
+"RTN","GPLMEDS",58,0)
+   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
+"RTN","GPLMEDS",59,0)
+   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
+"RTN","GPLMEDS",60,0)
+   . S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS
+"RTN","GPLMEDS",61,0)
+   . S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+"RTN","GPLMEDS",62,0)
+   . S @MEDVMAP@("MEDISSUEDATE")=""
+"RTN","GPLMEDS",63,0)
+   . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
+"RTN","GPLMEDS",64,0)
+   . S @MEDVMAP@("MEDLASTFILLDATE")=""
+"RTN","GPLMEDS",65,0)
+   . S @MEDVMAP@("MEDRXNOTXT")=""
+"RTN","GPLMEDS",66,0)
+   . S @MEDVMAP@("MEDRXNO")=""
+"RTN","GPLMEDS",67,0)
+   . S @MEDVMAP@("MEDDETAILUNADORNED")=""
+"RTN","GPLMEDS",68,0)
+   . S @MEDVMAP@("MEDCONCVALUE")=""
+"RTN","GPLMEDS",69,0)
+   . S @MEDVMAP@("MEDCONCUNIT")=""
+"RTN","GPLMEDS",70,0)
+   . S @MEDVMAP@("MEDSIZETEXT")=""
+"RTN","GPLMEDS",71,0)
+   . S @MEDVMAP@("MEDDOSEINDICATOR")=""
+"RTN","GPLMEDS",72,0)
+   . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
+"RTN","GPLMEDS",73,0)
+   . S @MEDVMAP@("MEDRATEVALUE")=""
+"RTN","GPLMEDS",74,0)
+   . S @MEDVMAP@("MEDRATEUNIT")=""
+"RTN","GPLMEDS",75,0)
+   . S @MEDVMAP@("MEDVEHICLETEXT")=""
+"RTN","GPLMEDS",76,0)
+   . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
+"RTN","GPLMEDS",77,0)
+   . S @MEDVMAP@("MEDINTERVALVALUE")=""
+"RTN","GPLMEDS",78,0)
+   . S @MEDVMAP@("MEDINTERVALUNIT")=""
+"RTN","GPLMEDS",79,0)
+   . S @MEDVMAP@("MEDPRNFLAG")=""
+"RTN","GPLMEDS",80,0)
+   . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
+"RTN","GPLMEDS",81,0)
+   . S @MEDVMAP@("PROBLEM")=""
+"RTN","GPLMEDS",82,0)
+   . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
+"RTN","GPLMEDS",83,0)
+   . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
+"RTN","GPLMEDS",84,0)
+   . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
+"RTN","GPLMEDS",85,0)
+   . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
+"RTN","GPLMEDS",86,0)
+   . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
+"RTN","GPLMEDS",87,0)
+   . S @MEDVMAP@("MEDSTOPINDICATOR")=""
+"RTN","GPLMEDS",88,0)
+   . S @MEDVMAP@("MEDDIRSEQ")=""
+"RTN","GPLMEDS",89,0)
+   . S @MEDVMAP@("MEDMULDIRMOD")=""
+"RTN","GPLMEDS",90,0)
+   . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
+"RTN","GPLMEDS",91,0)
+   . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
+"RTN","GPLMEDS",92,0)
+   . S @MEDVMAP@("MEDDATETIMEAGE")=""
+"RTN","GPLMEDS",93,0)
+   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
+"RTN","GPLMEDS",94,0)
+   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
+"RTN","GPLMEDS",95,0)
+   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+"RTN","GPLMEDS",96,0)
+   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLMEDS",97,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+"RTN","GPLMEDS",98,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
+"RTN","GPLMEDS",99,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+"RTN","GPLMEDS",100,0)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
+"RTN","GPLMEDS",101,0)
+   . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
+"RTN","GPLMEDS",102,0)
+   . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
+"RTN","GPLMEDS",103,0)
+   . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
+"RTN","GPLMEDS",104,0)
+   . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
+"RTN","GPLMEDS",105,0)
+   . . . I DEBUG W "RXIEN=",RXIEN,! ;
+"RTN","GPLMEDS",106,0)
+   . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
+"RTN","GPLMEDS",107,0)
+   . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
+"RTN","GPLMEDS",108,0)
+   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
+"RTN","GPLMEDS",109,0)
+   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+"RTN","GPLMEDS",110,0)
+   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
+"RTN","GPLMEDS",111,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
+"RTN","GPLMEDS",112,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
+"RTN","GPLMEDS",113,0)
+   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
+"RTN","GPLMEDS",114,0)
+   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
+"RTN","GPLMEDS",115,0)
+   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
+"RTN","GPLMEDS",116,0)
+   . S @MEDVMAP@("MEDFORMTEXT")=""
+"RTN","GPLMEDS",117,0)
+   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
+"RTN","GPLMEDS",118,0)
+   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
+"RTN","GPLMEDS",119,0)
+   . S @MEDVMAP@("MEDRFNO")=""
+"RTN","GPLMEDS",120,0)
+   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
+"RTN","GPLMEDS",121,0)
+   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
+"RTN","GPLMEDS",122,0)
+   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
+"RTN","GPLMEDS",123,0)
+   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
+"RTN","GPLMEDS",124,0)
+   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
+"RTN","GPLMEDS",125,0)
+   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
+"RTN","GPLMEDS",126,0)
+   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
+"RTN","GPLMEDS",127,0)
+   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
+"RTN","GPLMEDS",128,0)
+   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
+"RTN","GPLMEDS",129,0)
+   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
+"RTN","GPLMEDS",130,0)
+   . S @MEDVMAP@("MEDDOSEVALUE")=""
+"RTN","GPLMEDS",131,0)
+   . S @MEDVMAP@("MEDDOSEUNIT")=""
+"RTN","GPLMEDS",132,0)
+   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
+"RTN","GPLMEDS",133,0)
+   . S @MEDVMAP@("MEDDURATIONVALUE")=""
+"RTN","GPLMEDS",134,0)
+   . S @MEDVMAP@("MEDDURATIONUNIT")=""
+"RTN","GPLMEDS",135,0)
+   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
+"RTN","GPLMEDS",136,0)
+   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
+"RTN","GPLMEDS",137,0)
+   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
+"RTN","GPLMEDS",138,0)
+   . K @MEDARYTMP
+"RTN","GPLMEDS",139,0)
+   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+"RTN","GPLMEDS",140,0)
+   . I ZI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLMEDS",141,0)
+   . . ; W "FIRST ONE",!
+"RTN","GPLMEDS",142,0)
+   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
+"RTN","GPLMEDS",143,0)
+   . I ZI>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLMEDS",144,0)
+   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+"RTN","GPLMEDS",145,0)
+   N MEDTMP,MEDI
+"RTN","GPLMEDS",146,0)
+   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLMEDS",147,0)
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLMEDS",148,0)
+   . W "MEDICATION MISSING ",!
+"RTN","GPLMEDS",149,0)
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+"RTN","GPLMEDS",150,0)
+   Q
+"RTN","GPLMEDS",151,0)
+   ;
+"RTN","GPLMEDS",152,0)
+DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
+"RTN","GPLMEDS",153,0)
+   ; EXAMPLE: $$DIGITS("13R") RETURNS 13
+"RTN","GPLMEDS",154,0)
+   N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
+"RTN","GPLMEDS",155,0)
+   S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
+"RTN","GPLMEDS",156,0)
+   Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
+"RTN","GPLMEDS",157,0)
+   ;
+"RTN","GPLPROBS")
+0^11^B25407103
+"RTN","GPLPROBS",1,0)
+GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
+"RTN","GPLPROBS",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLPROBS",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLPROBS",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLPROBS",5,0)
+ ;
+"RTN","GPLPROBS",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLPROBS",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLPROBS",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLPROBS",9,0)
+ ;(at your option) any later version.
+"RTN","GPLPROBS",10,0)
+ ;
+"RTN","GPLPROBS",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLPROBS",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLPROBS",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLPROBS",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLPROBS",15,0)
+ ;
+"RTN","GPLPROBS",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLPROBS",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLPROBS",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLPROBS",19,0)
+ ;
+"RTN","GPLPROBS",20,0)
+           ;
+"RTN","GPLPROBS",21,0)
+           ;  PROCESS THE PROBLEMS SECTION OF THE CCR
+"RTN","GPLPROBS",22,0)
+           ;
+"RTN","GPLPROBS",23,0)
+EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+"RTN","GPLPROBS",24,0)
+          ;
+"RTN","GPLPROBS",25,0)
+          ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLPROBS",26,0)
+          ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLPROBS",27,0)
+          ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
+"RTN","GPLPROBS",28,0)
+          ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
+"RTN","GPLPROBS",29,0)
+          ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
+"RTN","GPLPROBS",30,0)
+          ;
+"RTN","GPLPROBS",31,0)
+          N RPCRSLT,J,K,PTMP,X,VMAP,TBU
+"RTN","GPLPROBS",32,0)
+          S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
+"RTN","GPLPROBS",33,0)
+          S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
+"RTN","GPLPROBS",34,0)
+          K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLPROBS",35,0)
+          D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+"RTN","GPLPROBS",36,0)
+          I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
+"RTN","GPLPROBS",37,0)
+          . W "NULL RESULT FROM LIST^ORQQPL3 ",!
+"RTN","GPLPROBS",38,0)
+          . S @OUTXML@(0)=0
+"RTN","GPLPROBS",39,0)
+          . ; Q
+"RTN","GPLPROBS",40,0)
+          ; I DEBUG ZWR RPCRSLT
+"RTN","GPLPROBS",41,0)
+          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
+"RTN","GPLPROBS",42,0)
+          . S VMAP=$NA(@TVMAP@(J))
+"RTN","GPLPROBS",43,0)
+          . K @VMAP
+"RTN","GPLPROBS",44,0)
+          . I DEBUG W "VMAP= ",VMAP,!
+"RTN","GPLPROBS",45,0)
+          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
+"RTN","GPLPROBS",46,0)
+          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
+"RTN","GPLPROBS",47,0)
+          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
+"RTN","GPLPROBS",48,0)
+          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
+"RTN","GPLPROBS",49,0)
+          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
+"RTN","GPLPROBS",50,0)
+          . S @VMAP@("PROBLEMCODINGVERSION")=""
+"RTN","GPLPROBS",51,0)
+          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+"RTN","GPLPROBS",52,0)
+          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
+"RTN","GPLPROBS",53,0)
+          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
+"RTN","GPLPROBS",54,0)
+          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
+"RTN","GPLPROBS",55,0)
+          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
+"RTN","GPLPROBS",56,0)
+          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
+"RTN","GPLPROBS",57,0)
+          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
+"RTN","GPLPROBS",58,0)
+          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
+"RTN","GPLPROBS",59,0)
+          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
+"RTN","GPLPROBS",60,0)
+          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
+"RTN","GPLPROBS",61,0)
+          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
+"RTN","GPLPROBS",62,0)
+          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
+"RTN","GPLPROBS",63,0)
+          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
+"RTN","GPLPROBS",64,0)
+          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
+"RTN","GPLPROBS",65,0)
+          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
+"RTN","GPLPROBS",66,0)
+          . S ARYTMP=$NA(@TARYTMP@(J))
+"RTN","GPLPROBS",67,0)
+          . ; W "ARYTMP= ",ARYTMP,!
+"RTN","GPLPROBS",68,0)
+          . K @ARYTMP
+"RTN","GPLPROBS",69,0)
+          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
+"RTN","GPLPROBS",70,0)
+          . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",71,0)
+          . . ; W "FIRST ONE",!
+"RTN","GPLPROBS",72,0)
+          . . D CP^GPLXPATH(ARYTMP,OUTXML)
+"RTN","GPLPROBS",73,0)
+          . . ; W "OUTXML ",OUTXML,!
+"RTN","GPLPROBS",74,0)
+          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLPROBS",75,0)
+          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
+"RTN","GPLPROBS",76,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
+"RTN","GPLPROBS",77,0)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLPROBS",78,0)
+          ; ZWR @OUTXML
+"RTN","GPLPROBS",79,0)
+          ; $$HTML^DILF(
+"RTN","GPLPROBS",80,0)
+          ; GENERATE THE NARITIVE HTML FOR THE CCD
+"RTN","GPLPROBS",81,0)
+          I CCD D  ; IF THIS IS FOR A CCD
+"RTN","GPLPROBS",82,0)
+          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
+"RTN","GPLPROBS",83,0)
+          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
+"RTN","GPLPROBS",84,0)
+          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
+"RTN","GPLPROBS",85,0)
+          . . I DEBUG W "VMAP =",VMAP,!
+"RTN","GPLPROBS",86,0)
+          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
+"RTN","GPLPROBS",87,0)
+          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
+"RTN","GPLPROBS",88,0)
+          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
+"RTN","GPLPROBS",89,0)
+          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
+"RTN","GPLPROBS",90,0)
+          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
+"RTN","GPLPROBS",91,0)
+          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLPROBS",92,0)
+          . . . D CP^GPLXPATH("HOUT","HTMLO")
+"RTN","GPLPROBS",93,0)
+          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
+"RTN","GPLPROBS",94,0)
+          . . . I DEBUG W "DOING INNER",!
+"RTN","GPLPROBS",95,0)
+          . . . N HTMLBLD,HTMLTMP
+"RTN","GPLPROBS",96,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
+"RTN","GPLPROBS",97,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
+"RTN","GPLPROBS",98,0)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
+"RTN","GPLPROBS",99,0)
+          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
+"RTN","GPLPROBS",100,0)
+          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
+"RTN","GPLPROBS",101,0)
+          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
+"RTN","GPLPROBS",102,0)
+          . I DEBUG D PARY^GPLXPATH("HTMLO")
+"RTN","GPLPROBS",103,0)
+          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+"RTN","GPLPROBS",104,0)
+          N PROBSTMP,I
+"RTN","GPLPROBS",105,0)
+          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLPROBS",106,0)
+          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+"RTN","GPLPROBS",107,0)
+          . ; STRINGS MARKED AS @@X@@
+"RTN","GPLPROBS",108,0)
+          . W !,"PROBLEMS Missing list: ",!
+"RTN","GPLPROBS",109,0)
+          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
+"RTN","GPLPROBS",110,0)
+          Q
+"RTN","GPLPROBS",111,0)
+          ;
+"RTN","GPLRIMA")
+0^13^B105704798
+"RTN","GPLRIMA",1,0)
+GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+"RTN","GPLRIMA",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLRIMA",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLRIMA",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLRIMA",5,0)
+ ;
+"RTN","GPLRIMA",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLRIMA",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLRIMA",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLRIMA",9,0)
+ ;(at your option) any later version.
+"RTN","GPLRIMA",10,0)
+ ;
+"RTN","GPLRIMA",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLRIMA",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLRIMA",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLRIMA",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLRIMA",15,0)
+ ;
+"RTN","GPLRIMA",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLRIMA",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLRIMA",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLRIMA",19,0)
+ ;
+"RTN","GPLRIMA",20,0)
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+"RTN","GPLRIMA",21,0)
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+"RTN","GPLRIMA",22,0)
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+"RTN","GPLRIMA",23,0)
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+"RTN","GPLRIMA",24,0)
+ ; CONVEYED VIA THE CCR OR CCD.
+"RTN","GPLRIMA",25,0)
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+"RTN","GPLRIMA",26,0)
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+"RTN","GPLRIMA",27,0)
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+"RTN","GPLRIMA",28,0)
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+"RTN","GPLRIMA",29,0)
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+"RTN","GPLRIMA",30,0)
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+"RTN","GPLRIMA",31,0)
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+"RTN","GPLRIMA",32,0)
+ ;
+"RTN","GPLRIMA",33,0)
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+"RTN","GPLRIMA",34,0)
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+"RTN","GPLRIMA",35,0)
+ ;    CONVEYANCE TO THE RIM APPLICATION.
+"RTN","GPLRIMA",36,0)
+ ;
+"RTN","GPLRIMA",37,0)
+ ;
+"RTN","GPLRIMA",38,0)
+ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
+"RTN","GPLRIMA",39,0)
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+"RTN","GPLRIMA",40,0)
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+"RTN","GPLRIMA",41,0)
+    ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
+"RTN","GPLRIMA",42,0)
+    ;
+"RTN","GPLRIMA",43,0)
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+"RTN","GPLRIMA",44,0)
+    N CCRGLO
+"RTN","GPLRIMA",45,0)
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
+"RTN","GPLRIMA",46,0)
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+"RTN","GPLRIMA",47,0)
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+"RTN","GPLRIMA",48,0)
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+"RTN","GPLRIMA",49,0)
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+"RTN","GPLRIMA",50,0)
+    I RIMDFN="" S RIMDFN=RESUME
+"RTN","GPLRIMA",51,0)
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+"RTN","GPLRIMA",52,0)
+    . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
+"RTN","GPLRIMA",53,0)
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+"RTN","GPLRIMA",54,0)
+    . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
+"RTN","GPLRIMA",55,0)
+    . W RIMDFN,!
+"RTN","GPLRIMA",56,0)
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+"RTN","GPLRIMA",57,0)
+    . ;
+"RTN","GPLRIMA",58,0)
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
+"RTN","GPLRIMA",59,0)
+    . ;
+"RTN","GPLRIMA",60,0)
+    . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+"RTN","GPLRIMA",61,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
+"RTN","GPLRIMA",62,0)
+    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+"RTN","GPLRIMA",63,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
+"RTN","GPLRIMA",64,0)
+    . I $D(^TMP("GPLCCR",$J,"MEDICATIONS",1)) D  ; MEDS VARS EXISTS
+"RTN","GPLRIMA",65,0)
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDICATIONS")
+"RTN","GPLRIMA",66,0)
+    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+"RTN","GPLRIMA",67,0)
+    . ;
+"RTN","GPLRIMA",68,0)
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+"RTN","GPLRIMA",69,0)
+    . ;
+"RTN","GPLRIMA",70,0)
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+"RTN","GPLRIMA",71,0)
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+"RTN","GPLRIMA",72,0)
+    . ;
+"RTN","GPLRIMA",73,0)
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
+"RTN","GPLRIMA",74,0)
+    . ;
+"RTN","GPLRIMA",75,0)
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+"RTN","GPLRIMA",76,0)
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+"RTN","GPLRIMA",77,0)
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+"RTN","GPLRIMA",78,0)
+    . ;
+"RTN","GPLRIMA",79,0)
+    . N CATNAME,CATTBL
+"RTN","GPLRIMA",80,0)
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+"RTN","GPLRIMA",81,0)
+    . S CATNAME=""
+"RTN","GPLRIMA",82,0)
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+"RTN","GPLRIMA",83,0)
+    . W "CATEGORY NAME: ",CATNAME,!
+"RTN","GPLRIMA",84,0)
+    . ;
+"RTN","GPLRIMA",85,0)
+    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
+"RTN","GPLRIMA",86,0)
+    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
+"RTN","GPLRIMA",87,0)
+    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
+"RTN","GPLRIMA",88,0)
+    . ; AND WE SKIP IT
+"RTN","GPLRIMA",89,0)
+    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+"RTN","GPLRIMA",90,0)
+    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
+"RTN","GPLRIMA",91,0)
+    Q
+"RTN","GPLRIMA",92,0)
+    ;
+"RTN","GPLRIMA",93,0)
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+"RTN","GPLRIMA",94,0)
+    N SBASE,SATTR
+"RTN","GPLRIMA",95,0)
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+"RTN","GPLRIMA",96,0)
+    D APOST("SATTR","RIMTBL","HEADER")
+"RTN","GPLRIMA",97,0)
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+"RTN","GPLRIMA",98,0)
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+"RTN","GPLRIMA",99,0)
+    . W "POSTING PROBLEMS",!
+"RTN","GPLRIMA",100,0)
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+"RTN","GPLRIMA",101,0)
+    I $D(@SBASE@("MEDS",1)) D APOST("SATTR","RIMTBL","MEDS")
+"RTN","GPLRIMA",102,0)
+    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+"RTN","GPLRIMA",103,0)
+    W "ATTRIBUTES: ",SATTR,!
+"RTN","GPLRIMA",104,0)
+    Q SATTR
+"RTN","GPLRIMA",105,0)
+    ;
+"RTN","GPLRIMA",106,0)
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+"RTN","GPLRIMA",107,0)
+    K ^TMP("GPLRIM","RESUME")
+"RTN","GPLRIMA",108,0)
+    K ^TMP("GPLRIM")
+"RTN","GPLRIMA",109,0)
+    Q
+"RTN","GPLRIMA",110,0)
+    ;
+"RTN","GPLRIMA",111,0)
+CLIST ; LIST THE CATEGORIES
+"RTN","GPLRIMA",112,0)
+    ;
+"RTN","GPLRIMA",113,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",114,0)
+    N CLBASE,CLNUM,ZI,CLIDX
+"RTN","GPLRIMA",115,0)
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+"RTN","GPLRIMA",116,0)
+    S CLNUM=@CLBASE@(0)
+"RTN","GPLRIMA",117,0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+"RTN","GPLRIMA",118,0)
+    . S CLIDX=@CLBASE@(ZI)
+"RTN","GPLRIMA",119,0)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+"RTN","GPLRIMA",120,0)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+"RTN","GPLRIMA",121,0)
+    . W CLIDX,!
+"RTN","GPLRIMA",122,0)
+    ; D PARY^GPLXPATH(CLBASE)
+"RTN","GPLRIMA",123,0)
+    Q
+"RTN","GPLRIMA",124,0)
+    ;
+"RTN","GPLRIMA",125,0)
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+"RTN","GPLRIMA",126,0)
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+"RTN","GPLRIMA",127,0)
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+"RTN","GPLRIMA",128,0)
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+"RTN","GPLRIMA",129,0)
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+"RTN","GPLRIMA",130,0)
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+"RTN","GPLRIMA",131,0)
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+"RTN","GPLRIMA",132,0)
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+"RTN","GPLRIMA",133,0)
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+"RTN","GPLRIMA",134,0)
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+"RTN","GPLRIMA",135,0)
+    ; NUMBER IE CTBL_X(CDFN)=""
+"RTN","GPLRIMA",136,0)
+    ;
+"RTN","GPLRIMA",137,0)
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+"RTN","GPLRIMA",138,0)
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+"RTN","GPLRIMA",139,0)
+    W "CBASE: ",CCTBL,!
+"RTN","GPLRIMA",140,0)
+    ;
+"RTN","GPLRIMA",141,0)
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+"RTN","GPLRIMA",142,0)
+    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+"RTN","GPLRIMA",143,0)
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+"RTN","GPLRIMA",144,0)
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+"RTN","GPLRIMA",145,0)
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+"RTN","GPLRIMA",146,0)
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+"RTN","GPLRIMA",147,0)
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+"RTN","GPLRIMA",148,0)
+    ;
+"RTN","GPLRIMA",149,0)
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+"RTN","GPLRIMA",150,0)
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",151,0)
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+"RTN","GPLRIMA",152,0)
+    ;
+"RTN","GPLRIMA",153,0)
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+"RTN","GPLRIMA",154,0)
+    ;
+"RTN","GPLRIMA",155,0)
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+"RTN","GPLRIMA",156,0)
+    W "PATS BASE: ",CPATLIST,!
+"RTN","GPLRIMA",157,0)
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+"RTN","GPLRIMA",158,0)
+    ;
+"RTN","GPLRIMA",159,0)
+    Q
+"RTN","GPLRIMA",160,0)
+    ;
+"RTN","GPLRIMA",161,0)
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+"RTN","GPLRIMA",162,0)
+    ;
+"RTN","GPLRIMA",163,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",164,0)
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+"RTN","GPLRIMA",165,0)
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+"RTN","GPLRIMA",166,0)
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+"RTN","GPLRIMA",167,0)
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+"RTN","GPLRIMA",168,0)
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+"RTN","GPLRIMA",169,0)
+    . S ZCNT=0
+"RTN","GPLRIMA",170,0)
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+"RTN","GPLRIMA",171,0)
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+"RTN","GPLRIMA",172,0)
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+"RTN","GPLRIMA",173,0)
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+"RTN","GPLRIMA",174,0)
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+"RTN","GPLRIMA",175,0)
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+"RTN","GPLRIMA",176,0)
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+"RTN","GPLRIMA",177,0)
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+"RTN","GPLRIMA",178,0)
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+"RTN","GPLRIMA",179,0)
+    . S ZTOT=ZTOT+ZCNT
+"RTN","GPLRIMA",180,0)
+    W "TOTAL: ",ZTOT,!
+"RTN","GPLRIMA",181,0)
+    Q
+"RTN","GPLRIMA",182,0)
+    ;
+"RTN","GPLRIMA",183,0)
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+"RTN","GPLRIMA",184,0)
+    ; INLST IS PASSED BY NAME
+"RTN","GPLRIMA",185,0)
+    N ZI,ZDX,ZCOUNT
+"RTN","GPLRIMA",186,0)
+    W INLST,!
+"RTN","GPLRIMA",187,0)
+    S ZCOUNT=0
+"RTN","GPLRIMA",188,0)
+    S ZDX=""
+"RTN","GPLRIMA",189,0)
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+"RTN","GPLRIMA",190,0)
+    . S ZCOUNT=ZCOUNT+1
+"RTN","GPLRIMA",191,0)
+    . S ZDX=$O(@INLST@(ZDX))
+"RTN","GPLRIMA",192,0)
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+"RTN","GPLRIMA",193,0)
+    Q ZCOUNT
+"RTN","GPLRIMA",194,0)
+    ;
+"RTN","GPLRIMA",195,0)
+XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+"RTN","GPLRIMA",196,0)
+    ;
+"RTN","GPLRIMA",197,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",198,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",199,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",200,0)
+    S ZI=""
+"RTN","GPLRIMA",201,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",202,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",203,0)
+    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
+"RTN","GPLRIMA",204,0)
+    Q
+"RTN","GPLRIMA",205,0)
+    ;
+"RTN","GPLRIMA",206,0)
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+"RTN","GPLRIMA",207,0)
+    ;
+"RTN","GPLRIMA",208,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",209,0)
+    N ZI,ZJ,ZC,ZPATBASE
+"RTN","GPLRIMA",210,0)
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+"RTN","GPLRIMA",211,0)
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+"RTN","GPLRIMA",212,0)
+    S ZI=""
+"RTN","GPLRIMA",213,0)
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+"RTN","GPLRIMA",214,0)
+    . S ZI=$O(@ZPATBASE@(ZI))
+"RTN","GPLRIMA",215,0)
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+"RTN","GPLRIMA",216,0)
+    . W ZI," "
+"RTN","GPLRIMA",217,0)
+    . I ZC=10 D  ; NEW LINE
+"RTN","GPLRIMA",218,0)
+    . . S ZC=0
+"RTN","GPLRIMA",219,0)
+    . . W !
+"RTN","GPLRIMA",220,0)
+    Q
+"RTN","GPLRIMA",221,0)
+    ;
+"RTN","GPLRIMA",222,0)
+PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
+"RTN","GPLRIMA",223,0)
+    ;
+"RTN","GPLRIMA",224,0)
+    N ATTR S ATTR=""
+"RTN","GPLRIMA",225,0)
+    I $D(^TMP("GPLRIM","ATTR",DFN)) S ATTR=^TMP("GPLRIM","ATTR",DFN)
+"RTN","GPLRIMA",226,0)
+    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
+"RTN","GPLRIMA",227,0)
+    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
+"RTN","GPLRIMA",228,0)
+    . N CAT
+"RTN","GPLRIMA",229,0)
+    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
+"RTN","GPLRIMA",230,0)
+    . W CAT,": ",ATTR,!
+"RTN","GPLRIMA",231,0)
+    Q
+"RTN","GPLRIMA",232,0)
+    ;
+"RTN","GPLRIMA",233,0)
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+"RTN","GPLRIMA",234,0)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+"RTN","GPLRIMA",235,0)
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+"RTN","GPLRIMA",236,0)
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+"RTN","GPLRIMA",237,0)
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+"RTN","GPLRIMA",238,0)
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+"RTN","GPLRIMA",239,0)
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+"RTN","GPLRIMA",240,0)
+    ;
+"RTN","GPLRIMA",241,0)
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+"RTN","GPLRIMA",242,0)
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+"RTN","GPLRIMA",243,0)
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+"RTN","GPLRIMA",244,0)
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+"RTN","GPLRIMA",245,0)
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+"RTN","GPLRIMA",246,0)
+    Q
+"RTN","GPLRIMA",247,0)
+    ;
+"RTN","GPLRIMA",248,0)
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+"RTN","GPLRIMA",249,0)
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
+"RTN","GPLRIMA",250,0)
+      I '$D(@RIMBASE) S @RIMBASE=""
+"RTN","GPLRIMA",251,0)
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
+"RTN","GPLRIMA",252,0)
+      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+"RTN","GPLRIMA",253,0)
+      Q
+"RTN","GPLRIMA",254,0)
+      ;
+"RTN","GPLRIMA",255,0)
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+"RTN","GPLRIMA",256,0)
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+"RTN","GPLRIMA",257,0)
+      K @RIMTBL
+"RTN","GPLRIMA",258,0)
+      D APUSH(RIMTBL,"EXTRACTED")
+"RTN","GPLRIMA",259,0)
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+"RTN","GPLRIMA",260,0)
+      D APUSH(RIMTBL,"HEADER")
+"RTN","GPLRIMA",261,0)
+      D APUSH(RIMTBL,"NOPCP")
+"RTN","GPLRIMA",262,0)
+      D APUSH(RIMTBL,"PCP")
+"RTN","GPLRIMA",263,0)
+      D APUSH(RIMTBL,"PROBLEMS")
+"RTN","GPLRIMA",264,0)
+      D APUSH(RIMTBL,"PROBCODE")
+"RTN","GPLRIMA",265,0)
+      D APUSH(RIMTBL,"PROBNOCODE")
+"RTN","GPLRIMA",266,0)
+      D APUSH(RIMTBL,"PROBDATE")
+"RTN","GPLRIMA",267,0)
+      D APUSH(RIMTBL,"PROBNODATE")
+"RTN","GPLRIMA",268,0)
+      D APUSH(RIMTBL,"VITALS")
+"RTN","GPLRIMA",269,0)
+      D APUSH(RIMTBL,"VITALSCODE")
+"RTN","GPLRIMA",270,0)
+      D APUSH(RIMTBL,"VITALSNOCODE")
+"RTN","GPLRIMA",271,0)
+      D APUSH(RIMTBL,"VITALSDATE")
+"RTN","GPLRIMA",272,0)
+      D APUSH(RIMTBL,"VITALSNODATE")
+"RTN","GPLRIMA",273,0)
+      D APUSH(RIMTBL,"MEDS")
+"RTN","GPLRIMA",274,0)
+      D APUSH(RIMTBL,"MEDSCODE")
+"RTN","GPLRIMA",275,0)
+      D APUSH(RIMTBL,"MEDSNOCODE")
+"RTN","GPLRIMA",276,0)
+      D APUSH(RIMTBL,"MEDSDATE")
+"RTN","GPLRIMA",277,0)
+      D APUSH(RIMTBL,"MEDSNODATE")
+"RTN","GPLRIMA",278,0)
+      Q
+"RTN","GPLRIMA",279,0)
+      ;
+"RTN","GPLRIMA",280,0)
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+"RTN","GPLRIMA",281,0)
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+"RTN","GPLRIMA",282,0)
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+"RTN","GPLRIMA",283,0)
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+"RTN","GPLRIMA",284,0)
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+"RTN","GPLRIMA",285,0)
+    N USETBL
+"RTN","GPLRIMA",286,0)
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+"RTN","GPLRIMA",287,0)
+    . W "ERROR NO SUCH TABLE",!
+"RTN","GPLRIMA",288,0)
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+"RTN","GPLRIMA",289,0)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+"RTN","GPLRIMA",290,0)
+    Q
+"RTN","GPLUNIT")
+0^10^B31630479
+"RTN","GPLUNIT",1,0)
+GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
+"RTN","GPLUNIT",2,0)
+ ;;0.1;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLUNIT",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLUNIT",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLUNIT",5,0)
+ ;
+"RTN","GPLUNIT",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLUNIT",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLUNIT",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLUNIT",9,0)
+ ;(at your option) any later version.
+"RTN","GPLUNIT",10,0)
+ ;
+"RTN","GPLUNIT",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLUNIT",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLUNIT",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLUNIT",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLUNIT",15,0)
+ ;
+"RTN","GPLUNIT",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLUNIT",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLUNIT",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLUNIT",19,0)
+ ;
+"RTN","GPLUNIT",20,0)
+          W "This is a unit testing library",!
+"RTN","GPLUNIT",21,0)
+          W !
+"RTN","GPLUNIT",22,0)
+          Q
+"RTN","GPLUNIT",23,0)
+          ;
+"RTN","GPLUNIT",24,0)
+ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
+"RTN","GPLUNIT",25,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",26,0)
+          ; BAT is a string identifying the test battery
+"RTN","GPLUNIT",27,0)
+          ; TST is a test which will evaluate to true or false
+"RTN","GPLUNIT",28,0)
+          ; I '$G(ZARY) D
+"RTN","GPLUNIT",29,0)
+          ; . S ZARY(0)=0 ; initially there are no elements
+"RTN","GPLUNIT",30,0)
+          ; W "GOT HERE LOADING "_TST,!
+"RTN","GPLUNIT",31,0)
+          N CNT ; count of array elements
+"RTN","GPLUNIT",32,0)
+          S CNT=ZARY(0) ; contains array count
+"RTN","GPLUNIT",33,0)
+          S CNT=CNT+1 ; increment count
+"RTN","GPLUNIT",34,0)
+          S ZARY(CNT)=TST ; put the test in the array
+"RTN","GPLUNIT",35,0)
+          I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
+"RTN","GPLUNIT",36,0)
+          . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
+"RTN","GPLUNIT",37,0)
+          . S II=$P(ZARY(BAT),"^",2)
+"RTN","GPLUNIT",38,0)
+          . S $P(ZARY(BAT),"^",2)=II+1
+"RTN","GPLUNIT",39,0)
+          I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
+"RTN","GPLUNIT",40,0)
+          . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
+"RTN","GPLUNIT",41,0)
+          . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+"RTN","GPLUNIT",42,0)
+          . ; S TN=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",43,0)
+          . ; D PUSH^GPLXPATH(TN,BAT)
+"RTN","GPLUNIT",44,0)
+          S ZARY(0)=CNT ; update the array counter
+"RTN","GPLUNIT",45,0)
+          Q
+"RTN","GPLUNIT",46,0)
+          ;
+"RTN","GPLUNIT",47,0)
+ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
+"RTN","GPLUNIT",48,0)
+          ; ZARY IS PASSED BY NAME
+"RTN","GPLUNIT",49,0)
+          ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
+"RTN","GPLUNIT",50,0)
+          ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
+"RTN","GPLUNIT",51,0)
+          K @ZARY
+"RTN","GPLUNIT",52,0)
+          S @ZARY@(0)=0 ; initialize array count
+"RTN","GPLUNIT",53,0)
+          N LINE,LABEL,BODY
+"RTN","GPLUNIT",54,0)
+          N INTEST S INTEST=0 ; switch for in the test case section
+"RTN","GPLUNIT",55,0)
+          N SECTION S SECTION="[anonymous]" ; test case section
+"RTN","GPLUNIT",56,0)
+          ;
+"RTN","GPLUNIT",57,0)
+          N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
+"RTN","GPLUNIT",58,0)
+          . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
+"RTN","GPLUNIT",59,0)
+          . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
+"RTN","GPLUNIT",60,0)
+          . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
+"RTN","GPLUNIT",61,0)
+          . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
+"RTN","GPLUNIT",62,0)
+          . I INTEST  D  ; within the testing section
+"RTN","GPLUNIT",63,0)
+          . . I LINE?." "1";;><".E  D  ; section name found
+"RTN","GPLUNIT",64,0)
+          . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
+"RTN","GPLUNIT",65,0)
+          . . I LINE?." "1";;>>".E  D  ; test case found
+"RTN","GPLUNIT",66,0)
+          . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
+"RTN","GPLUNIT",67,0)
+          S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
+"RTN","GPLUNIT",68,0)
+          Q
+"RTN","GPLUNIT",69,0)
+          ;
+"RTN","GPLUNIT",70,0)
+ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+"RTN","GPLUNIT",71,0)
+          N ZI,ZX,ZR,ZP
+"RTN","GPLUNIT",72,0)
+          S DEBUG=0
+"RTN","GPLUNIT",73,0)
+          ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+"RTN","GPLUNIT",74,0)
+          ; . W "DOING ALL",!
+"RTN","GPLUNIT",75,0)
+          ; . N J,NT
+"RTN","GPLUNIT",76,0)
+          ; . S NT=$NA(ZARY("TESTS"))
+"RTN","GPLUNIT",77,0)
+          ; . W NT,@NT@(0),!
+"RTN","GPLUNIT",78,0)
+          ; . F J=1:1:@NT@(0) D  ;
+"RTN","GPLUNIT",79,0)
+          ; . . W @NT@(J),!
+"RTN","GPLUNIT",80,0)
+          ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
+"RTN","GPLUNIT",81,0)
+          I '$D(ZARY(WHICH))  D  ; TEST SECTION DOESN'T EXIST
+"RTN","GPLUNIT",82,0)
+          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+"RTN","GPLUNIT",83,0)
+          . Q  ; EXIT
+"RTN","GPLUNIT",84,0)
+          N FIRST,LAST
+"RTN","GPLUNIT",85,0)
+          S FIRST=$P(ZARY(WHICH),"^",1)
+"RTN","GPLUNIT",86,0)
+          S LAST=$P(ZARY(WHICH),"^",2)
+"RTN","GPLUNIT",87,0)
+          F ZI=FIRST:1:LAST  D
+"RTN","GPLUNIT",88,0)
+          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+"RTN","GPLUNIT",89,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",90,0)
+          . . ;  W ZP,!
+"RTN","GPLUNIT",91,0)
+          . . S ZX=ZP
+"RTN","GPLUNIT",92,0)
+          . . W "RUNNING: "_ZP
+"RTN","GPLUNIT",93,0)
+          . . X ZX
+"RTN","GPLUNIT",94,0)
+          . . W "..SUCCESS: ",WHICH,!
+"RTN","GPLUNIT",95,0)
+          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+"RTN","GPLUNIT",96,0)
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+"RTN","GPLUNIT",97,0)
+          . . S ZX="S ZR="_ZP
+"RTN","GPLUNIT",98,0)
+          . . W "TRYING: "_ZP
+"RTN","GPLUNIT",99,0)
+          . . X ZX
+"RTN","GPLUNIT",100,0)
+          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+"RTN","GPLUNIT",101,0)
+          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+"RTN","GPLUNIT",102,0)
+          . . . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",103,0)
+          . . I ZR S TPASSED=TPASSED+1
+"RTN","GPLUNIT",104,0)
+          . . I 'ZR S TFAILED=TFAILED+1
+"RTN","GPLUNIT",105,0)
+          Q
+"RTN","GPLUNIT",106,0)
+          ;
+"RTN","GPLUNIT",107,0)
+TEST   ; RUN ALL THE TEST CASES
+"RTN","GPLUNIT",108,0)
+          N ZTMP
+"RTN","GPLUNIT",109,0)
+          D ZLOAD(.ZTMP)
+"RTN","GPLUNIT",110,0)
+          D ZTEST(.ZTMP,"ALL")
+"RTN","GPLUNIT",111,0)
+          W "PASSED: ",TPASSED,!
+"RTN","GPLUNIT",112,0)
+          W "FAILED: ",TFAILED,!
+"RTN","GPLUNIT",113,0)
+          W !
+"RTN","GPLUNIT",114,0)
+          W "THE TESTS!",!
+"RTN","GPLUNIT",115,0)
+          ; I DEBUG ZWR ZTMP
+"RTN","GPLUNIT",116,0)
+          Q
+"RTN","GPLUNIT",117,0)
+          ;
+"RTN","GPLUNIT",118,0)
+GTSTS(GTZARY,RTN) ; return an array of test names
+"RTN","GPLUNIT",119,0)
+          N I,J S I="" S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",120,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",121,0)
+          . D PUSH^GPLXPATH(RTN,I)
+"RTN","GPLUNIT",122,0)
+          . S I=$O(GTZARY("TESTS",I))
+"RTN","GPLUNIT",123,0)
+          Q
+"RTN","GPLUNIT",124,0)
+          ;
+"RTN","GPLUNIT",125,0)
+TESTALL(RNM) ; RUN ALL THE TESTS
+"RTN","GPLUNIT",126,0)
+          N ZI,J,TZTMP,TSTS,TOTP,TOTF
+"RTN","GPLUNIT",127,0)
+          S TOTP=0 S TOTF=0
+"RTN","GPLUNIT",128,0)
+          D ZLOAD^GPLUNIT("TZTMP",RNM)
+"RTN","GPLUNIT",129,0)
+          D GTSTS(.TZTMP,"TSTS")
+"RTN","GPLUNIT",130,0)
+          F ZI=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",131,0)
+          . S TPASSED=0 S TFAILED=0
+"RTN","GPLUNIT",132,0)
+          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
+"RTN","GPLUNIT",133,0)
+          . S TOTP=TOTP+TPASSED
+"RTN","GPLUNIT",134,0)
+          . S TOTF=TOTF+TFAILED
+"RTN","GPLUNIT",135,0)
+          . S $P(TSTS(ZI),"^",2)=TPASSED
+"RTN","GPLUNIT",136,0)
+          . S $P(TSTS(ZI),"^",3)=TFAILED
+"RTN","GPLUNIT",137,0)
+          F I=1:1:TSTS(0) D  ;
+"RTN","GPLUNIT",138,0)
+          . W "TEST=> ",$P(TSTS(ZI),"^",1)
+"RTN","GPLUNIT",139,0)
+          . W " PASSED=>",$P(TSTS(ZI),"^",2)
+"RTN","GPLUNIT",140,0)
+          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
+"RTN","GPLUNIT",141,0)
+          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+"RTN","GPLUNIT",142,0)
+          Q
+"RTN","GPLUNIT",143,0)
+          ;
+"RTN","GPLUNIT",144,0)
+TLIST(ZARY) ; LIST ALL THE TESTS
+"RTN","GPLUNIT",145,0)
+          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
+"RTN","GPLUNIT",146,0)
+          ; ZARY IS PASSED BY REFERENCE
+"RTN","GPLUNIT",147,0)
+          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",148,0)
+          S K=1
+"RTN","GPLUNIT",149,0)
+          F J=0:0  Q:I=""  D
+"RTN","GPLUNIT",150,0)
+          . ; W "I IS NOW=",I,!
+"RTN","GPLUNIT",151,0)
+          . W I," "
+"RTN","GPLUNIT",152,0)
+          . S I=$O(ZARY("TESTS",I))
+"RTN","GPLUNIT",153,0)
+          . S K=K+1 I K=6  D
+"RTN","GPLUNIT",154,0)
+          . . W !
+"RTN","GPLUNIT",155,0)
+          . . S K=1
+"RTN","GPLUNIT",156,0)
+          Q
+"RTN","GPLUNIT",157,0)
+          ;
+"RTN","GPLVITAL")
+0^12^B99003044
+"RTN","GPLVITAL",1,0)
+GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+"RTN","GPLVITAL",2,0)
+          ;;0.1;CCDCCR;;JUL 16,2008;Build 6
+"RTN","GPLVITAL",3,0)
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLVITAL",4,0)
+          ;General Public License See attached copy of the License.
+"RTN","GPLVITAL",5,0)
+          ;
+"RTN","GPLVITAL",6,0)
+          ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLVITAL",7,0)
+          ;it under the terms of the GNU General Public License as published by
+"RTN","GPLVITAL",8,0)
+          ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLVITAL",9,0)
+          ;(at your option) any later version.
+"RTN","GPLVITAL",10,0)
+          ;
+"RTN","GPLVITAL",11,0)
+          ;This program is distributed in the hope that it will be useful,
+"RTN","GPLVITAL",12,0)
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLVITAL",13,0)
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLVITAL",14,0)
+          ;GNU General Public License for more details.
+"RTN","GPLVITAL",15,0)
+          ;
+"RTN","GPLVITAL",16,0)
+          ;You should have received a copy of the GNU General Public License along
+"RTN","GPLVITAL",17,0)
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLVITAL",18,0)
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLVITAL",19,0)
+          ;
+"RTN","GPLVITAL",20,0)
+          W "NO ENTRY FROM TOP",!
+"RTN","GPLVITAL",21,0)
+          Q
+"RTN","GPLVITAL",22,0)
+          ;
+"RTN","GPLVITAL",23,0)
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+"RTN","GPLVITAL",24,0)
+          ;
+"RTN","GPLVITAL",25,0)
+          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","GPLVITAL",26,0)
+          ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+"RTN","GPLVITAL",27,0)
+          ;
+"RTN","GPLVITAL",28,0)
+          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
+"RTN","GPLVITAL",29,0)
+          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+"RTN","GPLVITAL",30,0)
+          I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
+"RTN","GPLVITAL",31,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." D  Q  ; NULL RESULT FROM RPC
+"RTN","GPLVITAL",32,0)
+          . I DEBUG W "NO VITALS FOUND FROM VITALS RPC",!
+"RTN","GPLVITAL",33,0)
+          . S @VITOUTXML@(0)=0
+"RTN","GPLVITAL",34,0)
+          I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
+"RTN","GPLVITAL",35,0)
+          ; ZWR RPCRSLT
+"RTN","GPLVITAL",36,0)
+          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
+"RTN","GPLVITAL",37,0)
+          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
+"RTN","GPLVITAL",38,0)
+          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+"RTN","GPLVITAL",39,0)
+          N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+"RTN","GPLVITAL",40,0)
+          D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+"RTN","GPLVITAL",41,0)
+          ; I DEBUG ZWR VDATES ;DEBUG
+"RTN","GPLVITAL",42,0)
+          S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+"RTN","GPLVITAL",43,0)
+          ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+"RTN","GPLVITAL",44,0)
+          F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+"RTN","GPLVITAL",45,0)
+          . I $D(VITRSLT(VSORT(J))) D
+"RTN","GPLVITAL",46,0)
+          . . S VITVMAP=$NA(@VITTVMAP@(J))
+"RTN","GPLVITAL",47,0)
+          . . K @VITVMAP
+"RTN","GPLVITAL",48,0)
+          . . I DEBUG W "VMAP= ",VITVMAP,!
+"RTN","GPLVITAL",49,0)
+          . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
+"RTN","GPLVITAL",50,0)
+          . . I DEBUG W "VITAL ",VSORT(J),!
+"RTN","GPLVITAL",51,0)
+          . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
+"RTN","GPLVITAL",52,0)
+          . . I DEBUG W $P(VITPTMP,U,4),!
+"RTN","GPLVITAL",53,0)
+          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+"RTN","GPLVITAL",54,0)
+          . . I $P(VITPTMP,U,2)="HT" D
+"RTN","GPLVITAL",55,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",56,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",57,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",58,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",59,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",60,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",61,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+"RTN","GPLVITAL",62,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
+"RTN","GPLVITAL",63,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",64,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",65,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",66,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",67,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+"RTN","GPLVITAL",68,0)
+          . . E  I $P(VITPTMP,U,2)="WT" D
+"RTN","GPLVITAL",69,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",70,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",71,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",72,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",73,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",74,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",75,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+"RTN","GPLVITAL",76,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
+"RTN","GPLVITAL",77,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",78,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",79,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",80,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",81,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+"RTN","GPLVITAL",82,0)
+          . . E  I $P(VITPTMP,U,2)="BP" D
+"RTN","GPLVITAL",83,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",84,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",85,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",86,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",87,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",88,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",89,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+"RTN","GPLVITAL",90,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
+"RTN","GPLVITAL",91,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",92,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",93,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",94,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",95,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",96,0)
+          . . E  I $P(VITPTMP,U,2)="T" D
+"RTN","GPLVITAL",97,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",98,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",99,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",100,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",101,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",102,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",103,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+"RTN","GPLVITAL",104,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
+"RTN","GPLVITAL",105,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",106,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",107,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",108,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",109,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+"RTN","GPLVITAL",110,0)
+          . . E  I $P(VITPTMP,U,2)="R" D
+"RTN","GPLVITAL",111,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",112,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",113,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",114,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",115,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",116,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",117,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+"RTN","GPLVITAL",118,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
+"RTN","GPLVITAL",119,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",120,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",121,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",122,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",123,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",124,0)
+          . . E  I $P(VITPTMP,U,2)="P" D
+"RTN","GPLVITAL",125,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",126,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",127,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",128,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",129,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",130,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",131,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+"RTN","GPLVITAL",132,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
+"RTN","GPLVITAL",133,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",134,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",135,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",136,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",137,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",138,0)
+          . . E  I $P(VITPTMP,U,2)="PN" D
+"RTN","GPLVITAL",139,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",140,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",141,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",142,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",143,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",144,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",145,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+"RTN","GPLVITAL",146,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
+"RTN","GPLVITAL",147,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+"RTN","GPLVITAL",148,0)
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",149,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",150,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",151,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+"RTN","GPLVITAL",152,0)
+          . . E  D
+"RTN","GPLVITAL",153,0)
+          . . . ;W "IN VITAL:  OTHER",!
+"RTN","GPLVITAL",154,0)
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+"RTN","GPLVITAL",155,0)
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+"RTN","GPLVITAL",156,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+"RTN","GPLVITAL",157,0)
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+"RTN","GPLVITAL",158,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+"RTN","GPLVITAL",159,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+"RTN","GPLVITAL",160,0)
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+"RTN","GPLVITAL",161,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+"RTN","GPLVITAL",162,0)
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+"RTN","GPLVITAL",163,0)
+          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+"RTN","GPLVITAL",164,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+"RTN","GPLVITAL",165,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+"RTN","GPLVITAL",166,0)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+"RTN","GPLVITAL",167,0)
+          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+"RTN","GPLVITAL",168,0)
+          . . K @VITARYTMP
+"RTN","GPLVITAL",169,0)
+          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
+"RTN","GPLVITAL",170,0)
+          . . I J=1 D  ; FIRST ONE IS JUST A COPY
+"RTN","GPLVITAL",171,0)
+          . . . ; W "FIRST ONE",!
+"RTN","GPLVITAL",172,0)
+          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
+"RTN","GPLVITAL",173,0)
+          . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
+"RTN","GPLVITAL",174,0)
+          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+"RTN","GPLVITAL",175,0)
+          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
+"RTN","GPLVITAL",176,0)
+          ; ZWR ^TMP($J,"VITALS",*)
+"RTN","GPLVITAL",177,0)
+          ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+"RTN","GPLVITAL",178,0)
+          I DEBUG D PARY^GPLXPATH(VITOUTXML)
+"RTN","GPLVITAL",179,0)
+          N VITTMP,I
+"RTN","GPLVITAL",180,0)
+          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+"RTN","GPLVITAL",181,0)
+          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+"RTN","GPLVITAL",182,0)
+          . W "VITALS MISSING ",!
+"RTN","GPLVITAL",183,0)
+          . F I=1:1:VITTMP(0) W VITTMP(I),!
+"RTN","GPLVITAL",184,0)
+          Q
+"RTN","GPLVITAL",185,0)
+          ;
+"RTN","GPLVITAL",186,0)
+VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+"RTN","GPLVITAL",187,0)
+         ; OF DATES IN THE VITALS RESULTS
+"RTN","GPLVITAL",188,0)
+         N VDTI,VDTJ,VTDCNT
+"RTN","GPLVITAL",189,0)
+         S VTDCNT=0 ; COUNT TO BUILD ARRAY
+"RTN","GPLVITAL",190,0)
+         S VDTJ="" ; USED TO VISIT THE RESULTS
+"RTN","GPLVITAL",191,0)
+         F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
+"RTN","GPLVITAL",192,0)
+         . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
+"RTN","GPLVITAL",193,0)
+         . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+"RTN","GPLVITAL",194,0)
+         . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
+"RTN","GPLVITAL",195,0)
+         Q
+"RTN","GPLVITAL",196,0)
+         ;
+"RTN","GPLXPAT0")
+0^19^B44173297
+"RTN","GPLXPAT0",1,0)
+GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
+"RTN","GPLXPAT0",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLXPAT0",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPAT0",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPAT0",5,0)
+ ;
+"RTN","GPLXPAT0",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPAT0",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPAT0",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPAT0",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPAT0",10,0)
+ ;
+"RTN","GPLXPAT0",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPAT0",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPAT0",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPAT0",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPAT0",15,0)
+ ;
+"RTN","GPLXPAT0",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPAT0",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPAT0",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPAT0",19,0)
+ ;
+"RTN","GPLXPAT0",20,0)
+        W "NO ENTRY",!
+"RTN","GPLXPAT0",21,0)
+        Q
+"RTN","GPLXPAT0",22,0)
+        ;
+"RTN","GPLXPAT0",23,0)
+ ;;><TEST>
+"RTN","GPLXPAT0",24,0)
+ ;;><INIT>
+"RTN","GPLXPAT0",25,0)
+ ;;>>>K GPL S GPL=""
+"RTN","GPLXPAT0",26,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FIRST")
+"RTN","GPLXPAT0",27,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","SECOND")
+"RTN","GPLXPAT0",28,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","THIRD")
+"RTN","GPLXPAT0",29,0)
+ ;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
+"RTN","GPLXPAT0",30,0)
+ ;;>>?GPL(0)=4
+"RTN","GPLXPAT0",31,0)
+ ;;><INITXML>
+"RTN","GPLXPAT0",32,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",33,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",34,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",35,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",36,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
+"RTN","GPLXPAT0",37,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
+"RTN","GPLXPAT0",38,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
+"RTN","GPLXPAT0",39,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
+"RTN","GPLXPAT0",40,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
+"RTN","GPLXPAT0",41,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",42,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",43,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",44,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",45,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",46,0)
+ ;;><INITXML2>
+"RTN","GPLXPAT0",47,0)
+ ;;>>>K GXML S GXML=""
+"RTN","GPLXPAT0",48,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+"RTN","GPLXPAT0",49,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+"RTN","GPLXPAT0",50,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+"RTN","GPLXPAT0",51,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
+"RTN","GPLXPAT0",52,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
+"RTN","GPLXPAT0",53,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","DATA2")
+"RTN","GPLXPAT0",54,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
+"RTN","GPLXPAT0",55,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+"RTN","GPLXPAT0",56,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
+"RTN","GPLXPAT0",57,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
+"RTN","GPLXPAT0",58,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
+"RTN","GPLXPAT0",59,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+"RTN","GPLXPAT0",60,0)
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+"RTN","GPLXPAT0",61,0)
+ ;;><PUSHPOP>
+"RTN","GPLXPAT0",62,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",63,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",64,0)
+ ;;>>?GPL(GPL(0))="FOURTH"
+"RTN","GPLXPAT0",65,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",66,0)
+ ;;>>?GX="FOURTH"
+"RTN","GPLXPAT0",67,0)
+ ;;>>?GPL(GPL(0))="THIRD"
+"RTN","GPLXPAT0",68,0)
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",69,0)
+ ;;>>?GX="THIRD"
+"RTN","GPLXPAT0",70,0)
+ ;;>>?GPL(GPL(0))="SECOND"
+"RTN","GPLXPAT0",71,0)
+ ;;><MKMDX>
+"RTN","GPLXPAT0",72,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",73,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+"RTN","GPLXPAT0",74,0)
+ ;;>>>S GX=""
+"RTN","GPLXPAT0",75,0)
+ ;;>>>D MKMDX^GPLXPATH("GPL",.GX)
+"RTN","GPLXPAT0",76,0)
+ ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
+"RTN","GPLXPAT0",77,0)
+ ;;><XNAME>
+"RTN","GPLXPAT0",78,0)
+ ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
+"RTN","GPLXPAT0",79,0)
+ ;;>>?$$XNAME^GPLXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
+"RTN","GPLXPAT0",80,0)
+ ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
+"RTN","GPLXPAT0",81,0)
+ ;;><INDEX>
+"RTN","GPLXPAT0",82,0)
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPAT0",83,0)
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
+"RTN","GPLXPAT0",84,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",85,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",86,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
+"RTN","GPLXPAT0",87,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
+"RTN","GPLXPAT0",88,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
+"RTN","GPLXPAT0",89,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
+"RTN","GPLXPAT0",90,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",91,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",92,0)
+ ;;><INDEX2>
+"RTN","GPLXPAT0",93,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML2")
+"RTN","GPLXPAT0",94,0)
+ ;;>>>D INDEX^GPLXPATH("GXML")
+"RTN","GPLXPAT0",95,0)
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+"RTN","GPLXPAT0",96,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
+"RTN","GPLXPAT0",97,0)
+ ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
+"RTN","GPLXPAT0",98,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
+"RTN","GPLXPAT0",99,0)
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
+"RTN","GPLXPAT0",100,0)
+ ;;>>?GXML("//FIRST")="1^13"
+"RTN","GPLXPAT0",101,0)
+ ;;><MISSING>
+"RTN","GPLXPAT0",102,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",103,0)
+ ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
+"RTN","GPLXPAT0",104,0)
+ ;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
+"RTN","GPLXPAT0",105,0)
+ ;;>>?@OUTARY@(1)="DATA1"
+"RTN","GPLXPAT0",106,0)
+ ;;>>?@OUTARY@(2)="DATA2"
+"RTN","GPLXPAT0",107,0)
+ ;;><MAP>
+"RTN","GPLXPAT0",108,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",109,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",110,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",111,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",112,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",113,0)
+ ;;>>?@OUTARY@(6)="VALUE2"
+"RTN","GPLXPAT0",114,0)
+ ;;><MAP2>
+"RTN","GPLXPAT0",115,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",116,0)
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+"RTN","GPLXPAT0",117,0)
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+"RTN","GPLXPAT0",118,0)
+ ;;>>>S @MAPARY@("DATA1")="VALUE1"
+"RTN","GPLXPAT0",119,0)
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+"RTN","GPLXPAT0",120,0)
+ ;;>>>S @MAPARY@("DATA3")="VALUE3"
+"RTN","GPLXPAT0",121,0)
+ ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
+"RTN","GPLXPAT0",122,0)
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+"RTN","GPLXPAT0",123,0)
+ ;;>>>D PARY^GPLXPATH(OUTARY)
+"RTN","GPLXPAT0",124,0)
+ ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
+"RTN","GPLXPAT0",125,0)
+ ;;><QUEUE>
+"RTN","GPLXPAT0",126,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
+"RTN","GPLXPAT0",127,0)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
+"RTN","GPLXPAT0",128,0)
+ ;;>>?$P(BTLIST(2),";",2)=4
+"RTN","GPLXPAT0",129,0)
+ ;;><BUILD>
+"RTN","GPLXPAT0",130,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",131,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
+"RTN","GPLXPAT0",132,0)
+ ;;>>>D ZTEST^GPLXPATH("QUEUE")
+"RTN","GPLXPAT0",133,0)
+ ;;>>>D BUILD^GPLXPATH("BTLIST","G3")
+"RTN","GPLXPAT0",134,0)
+ ;;><CP>
+"RTN","GPLXPAT0",135,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",136,0)
+ ;;>>>D CP^GPLXPATH("GXML","G2")
+"RTN","GPLXPAT0",137,0)
+ ;;>>?G2(0)=13
+"RTN","GPLXPAT0",138,0)
+ ;;><QOPEN>
+"RTN","GPLXPAT0",139,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",140,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",141,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",142,0)
+ ;;>>?$P(GBL(1),";",3)=12
+"RTN","GPLXPAT0",143,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",144,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",145,0)
+ ;;><QOPEN2>
+"RTN","GPLXPAT0",146,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",147,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",148,0)
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
+"RTN","GPLXPAT0",149,0)
+ ;;>>?$P(GBL(1),";",3)=11
+"RTN","GPLXPAT0",150,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",151,0)
+ ;;>>?G2(G2(0))="</SECOND>"
+"RTN","GPLXPAT0",152,0)
+ ;;><QCLOSE>
+"RTN","GPLXPAT0",153,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",154,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",155,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
+"RTN","GPLXPAT0",156,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",157,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",158,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",159,0)
+ ;;><QCLOSE2>
+"RTN","GPLXPAT0",160,0)
+ ;;>>>K G2,GBL
+"RTN","GPLXPAT0",161,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",162,0)
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",163,0)
+ ;;>>?$P(GBL(1),";",3)=13
+"RTN","GPLXPAT0",164,0)
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+"RTN","GPLXPAT0",165,0)
+ ;;>>?G2(G2(0))="</FIRST>"
+"RTN","GPLXPAT0",166,0)
+ ;;>>?G2(1)="</THIRD>"
+"RTN","GPLXPAT0",167,0)
+ ;;><INSERT>
+"RTN","GPLXPAT0",168,0)
+ ;;>>>K G2,GBL,G3,G4
+"RTN","GPLXPAT0",169,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",170,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",171,0)
+ ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",172,0)
+ ;;>>>D INSERT^GPLXPATH("G3","G2","//")
+"RTN","GPLXPAT0",173,0)
+ ;;>>?G2(1)=GXML(9)
+"RTN","GPLXPAT0",174,0)
+ ;;><REPLACE>
+"RTN","GPLXPAT0",175,0)
+ ;;>>>K G2,GBL,G3
+"RTN","GPLXPAT0",176,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",177,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+"RTN","GPLXPAT0",178,0)
+ ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
+"RTN","GPLXPAT0",179,0)
+ ;;>>?GXML(2)="<FIFTH>"
+"RTN","GPLXPAT0",180,0)
+ ;;><INSINNER>
+"RTN","GPLXPAT0",181,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",182,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",183,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",184,0)
+ ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+"RTN","GPLXPAT0",185,0)
+ ;;>>?GXML(10)="<FIFTH>"
+"RTN","GPLXPAT0",186,0)
+ ;;><INSINNER2>
+"RTN","GPLXPAT0",187,0)
+ ;;>>>K GXML,G2,GBL,G3
+"RTN","GPLXPAT0",188,0)
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+"RTN","GPLXPAT0",189,0)
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+"RTN","GPLXPAT0",190,0)
+ ;;>>>D INSINNER^GPLXPATH("G2","G2")
+"RTN","GPLXPAT0",191,0)
+ ;;>>?G2(8)="<FIFTH>"
+"RTN","GPLXPAT0",192,0)
+ ;;></TEST>
+"RTN","GPLXPATH")
+0^9^B262915025
+"RTN","GPLXPATH",1,0)
+GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
+"RTN","GPLXPATH",2,0)
+ ;;0.2;CCDCCR;nopatch;noreleasedate;Build 6
+"RTN","GPLXPATH",3,0)
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+"RTN","GPLXPATH",4,0)
+ ;General Public License See attached copy of the License.
+"RTN","GPLXPATH",5,0)
+ ;
+"RTN","GPLXPATH",6,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","GPLXPATH",7,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","GPLXPATH",8,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","GPLXPATH",9,0)
+ ;(at your option) any later version.
+"RTN","GPLXPATH",10,0)
+ ;
+"RTN","GPLXPATH",11,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","GPLXPATH",12,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","GPLXPATH",13,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","GPLXPATH",14,0)
+ ;GNU General Public License for more details.
+"RTN","GPLXPATH",15,0)
+ ;
+"RTN","GPLXPATH",16,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","GPLXPATH",17,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","GPLXPATH",18,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","GPLXPATH",19,0)
+ ;
+"RTN","GPLXPATH",20,0)
+          W "This is an XML XPATH utility library",!
+"RTN","GPLXPATH",21,0)
+          W !
+"RTN","GPLXPATH",22,0)
+          Q
+"RTN","GPLXPATH",23,0)
+          ;
+"RTN","GPLXPATH",24,0)
+OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+"RTN","GPLXPATH",25,0)
+          ;
+"RTN","GPLXPATH",26,0)
+          N Y
+"RTN","GPLXPATH",27,0)
+          S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
+"RTN","GPLXPATH",28,0)
+          I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
+"RTN","GPLXPATH",29,0)
+          I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
+"RTN","GPLXPATH",30,0)
+          Q
+"RTN","GPLXPATH",31,0)
+          ;
+"RTN","GPLXPATH",32,0)
+PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+"RTN","GPLXPATH",33,0)
+          ;  VAL IS A STRING AND STK IS PASSED BY NAME
+"RTN","GPLXPATH",34,0)
+          ;
+"RTN","GPLXPATH",35,0)
+          I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
+"RTN","GPLXPATH",36,0)
+          S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
+"RTN","GPLXPATH",37,0)
+          S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+"RTN","GPLXPATH",38,0)
+          Q
+"RTN","GPLXPATH",39,0)
+          ;
+"RTN","GPLXPATH",40,0)
+POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+"RTN","GPLXPATH",41,0)
+          ; VAL AND STK ARE PASSED BY REFERENCE
+"RTN","GPLXPATH",42,0)
+          ;
+"RTN","GPLXPATH",43,0)
+          I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
+"RTN","GPLXPATH",44,0)
+          . S VAL=""
+"RTN","GPLXPATH",45,0)
+          . S @STK@(0)=0
+"RTN","GPLXPATH",46,0)
+          I @STK@(0)>0  D  ;
+"RTN","GPLXPATH",47,0)
+          . S VAL=@STK@(@STK@(0))
+"RTN","GPLXPATH",48,0)
+          . K @STK@(@STK@(0))
+"RTN","GPLXPATH",49,0)
+          . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+"RTN","GPLXPATH",50,0)
+          Q
+"RTN","GPLXPATH",51,0)
+          ;
+"RTN","GPLXPATH",52,0)
+MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+"RTN","GPLXPATH",53,0)
+          ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
+"RTN","GPLXPATH",54,0)
+          S RTN=""
+"RTN","GPLXPATH",55,0)
+          N I
+"RTN","GPLXPATH",56,0)
+          ; W "STK= ",STK,!
+"RTN","GPLXPATH",57,0)
+          I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",58,0)
+          . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
+"RTN","GPLXPATH",59,0)
+          . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
+"RTN","GPLXPATH",60,0)
+          . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
+"RTN","GPLXPATH",61,0)
+          Q
+"RTN","GPLXPATH",62,0)
+          ;
+"RTN","GPLXPATH",63,0)
+XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+"RTN","GPLXPATH",64,0)
+          ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
+"RTN","GPLXPATH",65,0)
+          ; ISTR IS PASSED BY VALUE
+"RTN","GPLXPATH",66,0)
+          N CUR,TMP
+"RTN","GPLXPATH",67,0)
+          I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
+"RTN","GPLXPATH",68,0)
+          . S TMP=$P(ISTR,"<",2)
+"RTN","GPLXPATH",69,0)
+          I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
+"RTN","GPLXPATH",70,0)
+          . S TMP=$P(TMP,"/",2)
+"RTN","GPLXPATH",71,0)
+          S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
+"RTN","GPLXPATH",72,0)
+          ; W "CUR= ",CUR,!
+"RTN","GPLXPATH",73,0)
+          I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
+"RTN","GPLXPATH",74,0)
+           . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
+"RTN","GPLXPATH",75,0)
+          ; W "CUR2= ",CUR,!
+"RTN","GPLXPATH",76,0)
+          Q CUR
+"RTN","GPLXPATH",77,0)
+          ;
+"RTN","GPLXPATH",78,0)
+INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
+"RTN","GPLXPATH",79,0)
+          ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
+"RTN","GPLXPATH",80,0)
+          ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
+"RTN","GPLXPATH",81,0)
+          ; XML SECTION
+"RTN","GPLXPATH",82,0)
+          ; ZXML IS PASSED BY NAME
+"RTN","GPLXPATH",83,0)
+          N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
+"RTN","GPLXPATH",84,0)
+          N GPLSTK ; LEAVE OUT FOR DEBUGGING
+"RTN","GPLXPATH",85,0)
+          I '$D(@ZXML@(0))  D  ; NO XML PASSED
+"RTN","GPLXPATH",86,0)
+          . W "ERROR IN XML FILE",!
+"RTN","GPLXPATH",87,0)
+          S GPLSTK(0)=0 ; INITIALIZE STACK
+"RTN","GPLXPATH",88,0)
+          F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
+"RTN","GPLXPATH",89,0)
+          . S LINE=@ZXML@(I)
+"RTN","GPLXPATH",90,0)
+          . ;W LINE,!
+"RTN","GPLXPATH",91,0)
+          . S FOUND=0  ; INTIALIZED FOUND FLAG
+"RTN","GPLXPATH",92,0)
+          . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
+"RTN","GPLXPATH",93,0)
+          . I FOUND'=1  D
+"RTN","GPLXPATH",94,0)
+          . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
+"RTN","GPLXPATH",95,0)
+          . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
+"RTN","GPLXPATH",96,0)
+          . . . ; ON THE SAME LINE
+"RTN","GPLXPATH",97,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",98,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",99,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",100,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",101,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",102,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",103,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",104,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",105,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",106,0)
+          . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
+"RTN","GPLXPATH",107,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",108,0)
+          . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
+"RTN","GPLXPATH",109,0)
+          . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
+"RTN","GPLXPATH",110,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",111,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",112,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",113,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",114,0)
+          . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",115,0)
+          . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+"RTN","GPLXPATH",116,0)
+          . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
+"RTN","GPLXPATH",117,0)
+          . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
+"RTN","GPLXPATH",118,0)
+          . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
+"RTN","GPLXPATH",119,0)
+          . . . . Q
+"RTN","GPLXPATH",120,0)
+          . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
+"RTN","GPLXPATH",121,0)
+          . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
+"RTN","GPLXPATH",122,0)
+          . . . ; W "FOUND ",LINE,!
+"RTN","GPLXPATH",123,0)
+          . . . S FOUND=1  ; SET FOUND FLAG
+"RTN","GPLXPATH",124,0)
+          . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+"RTN","GPLXPATH",125,0)
+          . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+"RTN","GPLXPATH",126,0)
+          . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+"RTN","GPLXPATH",127,0)
+          . . . ; W "MDX=",MDX,!
+"RTN","GPLXPATH",128,0)
+          . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+"RTN","GPLXPATH",129,0)
+          . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+"RTN","GPLXPATH",130,0)
+          . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+"RTN","GPLXPATH",131,0)
+          . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
+"RTN","GPLXPATH",132,0)
+          S @ZXML@("INDEXED")=""
+"RTN","GPLXPATH",133,0)
+          S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
+"RTN","GPLXPATH",134,0)
+          Q
+"RTN","GPLXPATH",135,0)
+          ;
+"RTN","GPLXPATH",136,0)
+QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+"RTN","GPLXPATH",137,0)
+         ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
+"RTN","GPLXPATH",138,0)
+         ; IARY AND OARY ARE PASSED BY NAME
+"RTN","GPLXPATH",139,0)
+         I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
+"RTN","GPLXPATH",140,0)
+         . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
+"RTN","GPLXPATH",141,0)
+         N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
+"RTN","GPLXPATH",142,0)
+         N TMP,I,J,QXPATH
+"RTN","GPLXPATH",143,0)
+         S FIRST=1
+"RTN","GPLXPATH",144,0)
+         S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
+"RTN","GPLXPATH",145,0)
+         I XPATH'="//" D  ; NOT A ROOT QUERY
+"RTN","GPLXPATH",146,0)
+         . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
+"RTN","GPLXPATH",147,0)
+         . S FIRST=$P(TMP,"^",1)
+"RTN","GPLXPATH",148,0)
+         . S LAST=$P(TMP,"^",2)
+"RTN","GPLXPATH",149,0)
+         K @OARY
+"RTN","GPLXPATH",150,0)
+         S @OARY@(0)=+LAST-FIRST+1
+"RTN","GPLXPATH",151,0)
+         S J=1
+"RTN","GPLXPATH",152,0)
+         FOR I=FIRST:1:LAST  D
+"RTN","GPLXPATH",153,0)
+         . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
+"RTN","GPLXPATH",154,0)
+         . S J=J+1
+"RTN","GPLXPATH",155,0)
+         ; ZWR OARY
+"RTN","GPLXPATH",156,0)
+         Q
+"RTN","GPLXPATH",157,0)
+         ;
+"RTN","GPLXPATH",158,0)
+XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+"RTN","GPLXPATH",159,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",160,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",161,0)
+         Q $P(@IDX@(XPATH),"^",1)
+"RTN","GPLXPATH",162,0)
+         ;
+"RTN","GPLXPATH",163,0)
+XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+"RTN","GPLXPATH",164,0)
+         ; INDEX WITH TWO PIECES START^FINISH
+"RTN","GPLXPATH",165,0)
+         ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",166,0)
+         Q $P(@IDX@(XPATH),"^",2)
+"RTN","GPLXPATH",167,0)
+         ;
+"RTN","GPLXPATH",168,0)
+START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+"RTN","GPLXPATH",169,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",170,0)
+         ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
+"RTN","GPLXPATH",171,0)
+         Q $P(ISTR,";",2)
+"RTN","GPLXPATH",172,0)
+         ;
+"RTN","GPLXPATH",173,0)
+FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+"RTN","GPLXPATH",174,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",175,0)
+         Q $P(ISTR,";",3)
+"RTN","GPLXPATH",176,0)
+         ;
+"RTN","GPLXPATH",177,0)
+ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+"RTN","GPLXPATH",178,0)
+         ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+"RTN","GPLXPATH",179,0)
+         Q $P(ISTR,";",1)
+"RTN","GPLXPATH",180,0)
+         ;
+"RTN","GPLXPATH",181,0)
+BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+"RTN","GPLXPATH",182,0)
+         ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+"RTN","GPLXPATH",183,0)
+         ; DEST IS CLEARED TO START
+"RTN","GPLXPATH",184,0)
+         ; USES PUSH TO DO THE COPY
+"RTN","GPLXPATH",185,0)
+         N I
+"RTN","GPLXPATH",186,0)
+         K @BDEST
+"RTN","GPLXPATH",187,0)
+         F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
+"RTN","GPLXPATH",188,0)
+         . N J,ATMP
+"RTN","GPLXPATH",189,0)
+         . S ATMP=$$ARRAY(@BLIST@(I))
+"RTN","GPLXPATH",190,0)
+         . I DEBUG W "ATMP=",ATMP,!
+"RTN","GPLXPATH",191,0)
+         . I DEBUG W @BLIST@(I),!
+"RTN","GPLXPATH",192,0)
+         . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
+"RTN","GPLXPATH",193,0)
+         . . ; FOR EACH LINE IN THIS INSTR
+"RTN","GPLXPATH",194,0)
+         . . I DEBUG W "BDEST= ",BDEST,!
+"RTN","GPLXPATH",195,0)
+         . . I DEBUG W "ATMP= ",@ATMP@(J),!
+"RTN","GPLXPATH",196,0)
+         . . D PUSH(BDEST,@ATMP@(J))
+"RTN","GPLXPATH",197,0)
+         Q
+"RTN","GPLXPATH",198,0)
+         ;
+"RTN","GPLXPATH",199,0)
+QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+"RTN","GPLXPATH",200,0)
+         ;
+"RTN","GPLXPATH",201,0)
+         I DEBUG W "QUEUEING ",BLST,!
+"RTN","GPLXPATH",202,0)
+         D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+"RTN","GPLXPATH",203,0)
+         Q
+"RTN","GPLXPATH",204,0)
+         ;
+"RTN","GPLXPATH",205,0)
+CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+"RTN","GPLXPATH",206,0)
+         ; KILLS CPDEST FIRST
+"RTN","GPLXPATH",207,0)
+         N CPINSTR
+"RTN","GPLXPATH",208,0)
+         I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
+"RTN","GPLXPATH",209,0)
+         I @CPSRC@(0)<1 D  ; BAD LENGTH
+"RTN","GPLXPATH",210,0)
+         . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
+"RTN","GPLXPATH",211,0)
+         . Q
+"RTN","GPLXPATH",212,0)
+         ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
+"RTN","GPLXPATH",213,0)
+         D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
+"RTN","GPLXPATH",214,0)
+         D BUILD("CPINSTR",CPDEST)
+"RTN","GPLXPATH",215,0)
+         Q
+"RTN","GPLXPATH",216,0)
+         ;
+"RTN","GPLXPATH",217,0)
+QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+"RTN","GPLXPATH",218,0)
+         ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
+"RTN","GPLXPATH",219,0)
+         ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
+"RTN","GPLXPATH",220,0)
+         ; USED TO INSERT CHILDREN NODES
+"RTN","GPLXPATH",221,0)
+         I @QOXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",222,0)
+         . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
+"RTN","GPLXPATH",223,0)
+         . Q
+"RTN","GPLXPATH",224,0)
+         I DEBUG W "DOING QOPEN",!
+"RTN","GPLXPATH",225,0)
+         N S1,E1,QOT,QOTMP
+"RTN","GPLXPATH",226,0)
+         S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
+"RTN","GPLXPATH",227,0)
+         I $D(QOXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",228,0)
+         . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
+"RTN","GPLXPATH",229,0)
+         . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
+"RTN","GPLXPATH",230,0)
+         I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",231,0)
+         . S E1=@QOXML@(0)-1
+"RTN","GPLXPATH",232,0)
+         D QUEUE(QOBLIST,QOXML,S1,E1)
+"RTN","GPLXPATH",233,0)
+         ; S QOTMP=QOXML_"^"_S1_"^"_E1
+"RTN","GPLXPATH",234,0)
+         ; D PUSH(QOBLIST,QOTMP)
+"RTN","GPLXPATH",235,0)
+         Q
+"RTN","GPLXPATH",236,0)
+         ;
+"RTN","GPLXPATH",237,0)
+QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+"RTN","GPLXPATH",238,0)
+         ; ADDS THE LIST LINE OF QCXML TO QCBLIST
+"RTN","GPLXPATH",239,0)
+         ; USED TO FINISH INSERTING CHILDERN NODES
+"RTN","GPLXPATH",240,0)
+         ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
+"RTN","GPLXPATH",241,0)
+         ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
+"RTN","GPLXPATH",242,0)
+         I @QCXML@(0)<1 D  ; MALFORMED XML
+"RTN","GPLXPATH",243,0)
+         . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
+"RTN","GPLXPATH",244,0)
+         I DEBUG W "GOING TO CLOSE",!
+"RTN","GPLXPATH",245,0)
+         N S1,E1,QCT,QCTMP
+"RTN","GPLXPATH",246,0)
+         S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
+"RTN","GPLXPATH",247,0)
+         I $D(QCXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",248,0)
+         . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
+"RTN","GPLXPATH",249,0)
+         . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
+"RTN","GPLXPATH",250,0)
+         I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",251,0)
+         . S S1=@QCXML@(0)
+"RTN","GPLXPATH",252,0)
+         D QUEUE(QCBLIST,QCXML,S1,E1)
+"RTN","GPLXPATH",253,0)
+         ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+"RTN","GPLXPATH",254,0)
+         Q
+"RTN","GPLXPATH",255,0)
+         ;
+"RTN","GPLXPATH",256,0)
+INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+"RTN","GPLXPATH",257,0)
+         ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
+"RTN","GPLXPATH",258,0)
+         ; OMITTED, INSERTION WILL BE AT THE ROOT
+"RTN","GPLXPATH",259,0)
+         ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
+"RTN","GPLXPATH",260,0)
+         ; XML AT THE END OF THE XPATH POINT
+"RTN","GPLXPATH",261,0)
+         ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
+"RTN","GPLXPATH",262,0)
+         N INSBLD,INSTMP
+"RTN","GPLXPATH",263,0)
+         I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+"RTN","GPLXPATH",264,0)
+         I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+"RTN","GPLXPATH",265,0)
+         I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
+"RTN","GPLXPATH",266,0)
+         . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
+"RTN","GPLXPATH",267,0)
+         I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
+"RTN","GPLXPATH",268,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",269,0)
+         . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
+"RTN","GPLXPATH",270,0)
+         . . I DEBUG D PARY^GPLXPATH("INSBLD")
+"RTN","GPLXPATH",271,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+"RTN","GPLXPATH",272,0)
+         . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
+"RTN","GPLXPATH",273,0)
+         . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
+"RTN","GPLXPATH",274,0)
+         . I $D(INSXPATH) D  ; XPATH PROVIDED
+"RTN","GPLXPATH",275,0)
+         . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
+"RTN","GPLXPATH",276,0)
+         . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+"RTN","GPLXPATH",277,0)
+         . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
+"RTN","GPLXPATH",278,0)
+         . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+"RTN","GPLXPATH",279,0)
+         . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+"RTN","GPLXPATH",280,0)
+         Q
+"RTN","GPLXPATH",281,0)
+         ;
+"RTN","GPLXPATH",282,0)
+INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+"RTN","GPLXPATH",283,0)
+         ; INTO INNXML AT THE INNXPATH XPATH POINT
+"RTN","GPLXPATH",284,0)
+         ;
+"RTN","GPLXPATH",285,0)
+         N INNBLD,UXPATH
+"RTN","GPLXPATH",286,0)
+         N INNTBUF
+"RTN","GPLXPATH",287,0)
+         S INNTBUF=$NA(^TMP($J,"INNTBUF"))
+"RTN","GPLXPATH",288,0)
+         I '$D(INNXPATH) D  ; XPATH NOT PASSED
+"RTN","GPLXPATH",289,0)
+         . S UXPATH="//" ; USE ROOT XPATH
+"RTN","GPLXPATH",290,0)
+         I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
+"RTN","GPLXPATH",291,0)
+         I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
+"RTN","GPLXPATH",292,0)
+         . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
+"RTN","GPLXPATH",293,0)
+         . D BUILD("INNBLD",INNXML)
+"RTN","GPLXPATH",294,0)
+         I @INNXML@(0)>0  D  ; NOT EMPTY
+"RTN","GPLXPATH",295,0)
+         . D QOPEN("INNBLD",INNXML,UXPATH) ;
+"RTN","GPLXPATH",296,0)
+         . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
+"RTN","GPLXPATH",297,0)
+         . D QCLOSE("INNBLD",INNXML,UXPATH)
+"RTN","GPLXPATH",298,0)
+         . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
+"RTN","GPLXPATH",299,0)
+         . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+"RTN","GPLXPATH",300,0)
+         Q
+"RTN","GPLXPATH",301,0)
+         ;
+"RTN","GPLXPATH",302,0)
+INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+"RTN","GPLXPATH",303,0)
+        ; BUT XDEST AN XNEW ARE PASSED BY NAME
+"RTN","GPLXPATH",304,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",305,0)
+        D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
+"RTN","GPLXPATH",306,0)
+        D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
+"RTN","GPLXPATH",307,0)
+        D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
+"RTN","GPLXPATH",308,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",309,0)
+        D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
+"RTN","GPLXPATH",310,0)
+        I DEBUG D PARY("XDEST")
+"RTN","GPLXPATH",311,0)
+        Q
+"RTN","GPLXPATH",312,0)
+        ;
+"RTN","GPLXPATH",313,0)
+REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+"RTN","GPLXPATH",314,0)
+         ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
+"RTN","GPLXPATH",315,0)
+         ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
+"RTN","GPLXPATH",316,0)
+         ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
+"RTN","GPLXPATH",317,0)
+         N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+"RTN","GPLXPATH",318,0)
+         S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+"RTN","GPLXPATH",319,0)
+         D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+"RTN","GPLXPATH",320,0)
+         S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+"RTN","GPLXPATH",321,0)
+         S XFIRST=$P(XNODE,"^",1)
+"RTN","GPLXPATH",322,0)
+         S XLAST=$P(XNODE,"^",2)
+"RTN","GPLXPATH",323,0)
+         I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
+"RTN","GPLXPATH",324,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
+"RTN","GPLXPATH",325,0)
+         . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",326,0)
+         I RENEW'="" D  ; NEW XML IS NOT NULL
+"RTN","GPLXPATH",327,0)
+         . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+"RTN","GPLXPATH",328,0)
+         . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
+"RTN","GPLXPATH",329,0)
+         . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+"RTN","GPLXPATH",330,0)
+         I DEBUG W "REPLACE PREBUILD",!
+"RTN","GPLXPATH",331,0)
+         I DEBUG D PARY("REBLD")
+"RTN","GPLXPATH",332,0)
+         D BUILD("REBLD","RTMP")
+"RTN","GPLXPATH",333,0)
+         K @REXML ; KILL WHAT WAS THERE
+"RTN","GPLXPATH",334,0)
+         D CP("RTMP",REXML) ; COPY IN THE RESULT
+"RTN","GPLXPATH",335,0)
+         Q
+"RTN","GPLXPATH",336,0)
+         ;
+"RTN","GPLXPATH",337,0)
+MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+"RTN","GPLXPATH",338,0)
+         ; W "Reporting on the missing",!
+"RTN","GPLXPATH",339,0)
+         ; W OARY
+"RTN","GPLXPATH",340,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
+"RTN","GPLXPATH",341,0)
+         N I
+"RTN","GPLXPATH",342,0)
+         S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
+"RTN","GPLXPATH",343,0)
+         F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",344,0)
+         . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
+"RTN","GPLXPATH",345,0)
+         . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
+"RTN","GPLXPATH",346,0)
+         . . Q
+"RTN","GPLXPATH",347,0)
+         Q
+"RTN","GPLXPATH",348,0)
+         ;
+"RTN","GPLXPATH",349,0)
+MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+"RTN","GPLXPATH",350,0)
+     ; AND PUT THE RESULTS IN OXML
+"RTN","GPLXPATH",351,0)
+         I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
+"RTN","GPLXPATH",352,0)
+         I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
+"RTN","GPLXPATH",353,0)
+         N I,J,TNAM,TVAL,TSTR
+"RTN","GPLXPATH",354,0)
+         S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
+"RTN","GPLXPATH",355,0)
+         F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+"RTN","GPLXPATH",356,0)
+         . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
+"RTN","GPLXPATH",357,0)
+         . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
+"RTN","GPLXPATH",358,0)
+         . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+"RTN","GPLXPATH",359,0)
+         . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
+"RTN","GPLXPATH",360,0)
+         . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
+"RTN","GPLXPATH",361,0)
+         . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+"RTN","GPLXPATH",362,0)
+         . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+"RTN","GPLXPATH",363,0)
+         . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
+"RTN","GPLXPATH",364,0)
+         . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+"RTN","GPLXPATH",365,0)
+         . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+"RTN","GPLXPATH",366,0)
+         . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+"RTN","GPLXPATH",367,0)
+         . . I DEBUG W TSTR
+"RTN","GPLXPATH",368,0)
+         I DEBUG W "MAPPED",!
+"RTN","GPLXPATH",369,0)
+         Q
+"RTN","GPLXPATH",370,0)
+         ;
+"RTN","GPLXPATH",371,0)
+TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+"RTN","GPLXPATH",372,0)
+       ; THEXML IS PASSED BY NAME
+"RTN","GPLXPATH",373,0)
+       N I,J,TMPXML,DEL,FOUND,INTXT
+"RTN","GPLXPATH",374,0)
+       S FOUND=0
+"RTN","GPLXPATH",375,0)
+       S INTXT=0
+"RTN","GPLXPATH",376,0)
+       I DEBUG W "DELETING EMPTY ELEMENTS",!
+"RTN","GPLXPATH",377,0)
+       F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
+"RTN","GPLXPATH",378,0)
+       . S J=@THEXML@(I)
+"RTN","GPLXPATH",379,0)
+       . I J["<text>" D
+"RTN","GPLXPATH",380,0)
+       . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
+"RTN","GPLXPATH",381,0)
+       . . I DEBUG W "IN HTML SECTION",!
+"RTN","GPLXPATH",382,0)
+       . N JM,JP,JPX ; JMINUS AND JPLUS
+"RTN","GPLXPATH",383,0)
+       . S JM=@THEXML@(I-1) ; LINE BEFORE
+"RTN","GPLXPATH",384,0)
+       . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
+"RTN","GPLXPATH",385,0)
+       . S JP=@THEXML@(I+1) ; LINE AFTER
+"RTN","GPLXPATH",386,0)
+       . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
+"RTN","GPLXPATH",387,0)
+       . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
+"RTN","GPLXPATH",388,0)
+       . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
+"RTN","GPLXPATH",389,0)
+       . . . I DEBUG W I,J,JP,!
+"RTN","GPLXPATH",390,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",391,0)
+       . . . S DEL(I)="" ; SET LINE TO DELETE
+"RTN","GPLXPATH",392,0)
+       . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
+"RTN","GPLXPATH",393,0)
+       . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
+"RTN","GPLXPATH",394,0)
+       . . . I DEBUG W I,J,!
+"RTN","GPLXPATH",395,0)
+       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+"RTN","GPLXPATH",396,0)
+       . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
+"RTN","GPLXPATH",397,0)
+       . . . I JM=JPX D  ;
+"RTN","GPLXPATH",398,0)
+       . . . . I DEBUG W I,JM_J_JPX,!
+"RTN","GPLXPATH",399,0)
+       . . . . S DEL(I-1)=""
+"RTN","GPLXPATH",400,0)
+       . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
+"RTN","GPLXPATH",401,0)
+       ; . I J'["><" D PUSH("TMPXML",J)
+"RTN","GPLXPATH",402,0)
+       I FOUND D  ; NEED TO DELETE THINGS
+"RTN","GPLXPATH",403,0)
+       . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
+"RTN","GPLXPATH",404,0)
+       . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
+"RTN","GPLXPATH",405,0)
+       . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
+"RTN","GPLXPATH",406,0)
+       . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
+"RTN","GPLXPATH",407,0)
+       Q FOUND
+"RTN","GPLXPATH",408,0)
+       ;
+"RTN","GPLXPATH",409,0)
+UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+"RTN","GPLXPATH",410,0)
+        ; XSEC IS A SECTION PASSED BY NAME
+"RTN","GPLXPATH",411,0)
+        N XBLD,XTMP
+"RTN","GPLXPATH",412,0)
+        D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
+"RTN","GPLXPATH",413,0)
+        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+"RTN","GPLXPATH",414,0)
+        D CP("XTMP",XSEC) ; REPLACE PASSED XML
+"RTN","GPLXPATH",415,0)
+        Q
+"RTN","GPLXPATH",416,0)
+        ;
+"RTN","GPLXPATH",417,0)
+PARY(GLO)       ;PRINT AN ARRAY
+"RTN","GPLXPATH",418,0)
+        N I
+"RTN","GPLXPATH",419,0)
+        F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
+"RTN","GPLXPATH",420,0)
+        Q
+"RTN","GPLXPATH",421,0)
+        ;
+"RTN","GPLXPATH",422,0)
+TEST     ; Run all the test cases
+"RTN","GPLXPATH",423,0)
+        D TESTALL^GPLUNIT("GPLXPAT0")
+"RTN","GPLXPATH",424,0)
+        Q
+"RTN","GPLXPATH",425,0)
+        ;
+"RTN","GPLXPATH",426,0)
+ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+"RTN","GPLXPATH",427,0)
+          N ZTMP
+"RTN","GPLXPATH",428,0)
+          S DEBUG=1
+"RTN","GPLXPATH",429,0)
+          D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",430,0)
+          D ZTEST^GPLUNIT(.ZTMP,WHICH)
+"RTN","GPLXPATH",431,0)
+          Q
+"RTN","GPLXPATH",432,0)
+          ;
+"RTN","GPLXPATH",433,0)
+TLIST   ; LIST THE TESTS
+"RTN","GPLXPATH",434,0)
+        N ZTMP
+"RTN","GPLXPATH",435,0)
+        D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+"RTN","GPLXPATH",436,0)
+        D TLIST^GPLUNIT(.ZTMP)
+"RTN","GPLXPATH",437,0)
+        Q
+"RTN","GPLXPATH",438,0)
+        ;
+"VER")
+8.0^22.0
+**END**
+**END**
Index: ccr/tags/CCR_1_0_4/p/GPLACTOR.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLACTOR.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLACTOR.m	(revision 169)
@@ -0,0 +1,198 @@
+GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+ ;;0.3;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+    ;
+    ;  PROCESS THE ACTORS SECTION OF THE CCR
+    ;
+    ; ===Revision History===
+    ; 0.1 Initial Writing of Skeleton--GPL
+    ; 0.2 Patient Data Extraction--SMH
+    ; 0.3 Information System Info Extraction--SMH
+    ;
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+  ; IPXML is the Input Actor Template into which we  substitute values
+  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
+  ; ^TMP(7542,1,"ACTORS",0)=Count
+  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+  ; AXML is the output arrary, to contain XML.
+  ;
+           N I,J,AMAP,AOID,ATYP,AIEN
+           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+           I DEBUG W "PROCESSING ACTORS ",!
+           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+           . I ATYP="" Q  ; NOT A VALID ACTOR
+           . ;
+           . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
+           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="NOK" D  ; NOK ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+           ;
+           N ACTTMP
+           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+           . ; STRINGS MARKED AS @@X@@
+           . W "ACTORS Missing list: ",!
+           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+           Q
+           ;
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+     ;
+     I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
+     N AMAP,ZX
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     D INIT^CCRDPT(AIEN)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
+     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
+     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
+     S @AMAP@("ACTORSSN")=""
+     S @AMAP@("ACTORSSNTEXT")=""
+     S @AMAP@("ACTORSSNSOURCEID")=""
+     S ZX=$$SSN^CCRDPT
+     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+     . S @AMAP@("ACTORSSN")=ZX
+     . S @AMAP@("ACTORSSNTEXT")="SSN"
+     . S @AMAP@("ACTORSSNSOURCEID")=AOID
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
+     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
+     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
+     S @AMAP@("ACTORRESTEL")=""
+     S @AMAP@("ACTORRESTELTEXT")=""
+     S ZX=$$RESTEL^CCRDPT
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+     . S @AMAP@("ACTORRESTEL")=ZX
+     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+     S @AMAP@("ACTORWORKTEL")=""
+     S @AMAP@("ACTORWORKTELTEXT")=""
+     S ZX=$$WORKTEL^CCRDPT
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+     . S @AMAP@("ACTORWORKTEL")=ZX
+     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+     S @AMAP@("ACTORCELLTEL")=""
+     S @AMAP@("ACTORCELLTELTEXT")=""
+     S ZX=$$CELLTEL^CCRDPT
+     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+     . S @AMAP@("ACTORCELLTEL")=ZX
+     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
+     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+     S @AMAP@("ACTORIEN")=AIEN
+     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+         D DESTROY^CCRDPT
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
+         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORDISPLAYNAME")=""
+     S @AMAP@("ACTORRELATION")=""
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
+         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
+         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
+         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
+         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
+     S @AMAP@("ACTORTELEPHONE")=""
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+     S ZX=$$TEL^CCRVA200(AIEN)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
Index: ccr/tags/CCR_1_0_4/p/GPLALERT.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLALERT.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLALERT.m	(revision 169)
@@ -0,0 +1,65 @@
+GPLALERT  ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
+          ;;0.1;CCDCCR;;SEP 11,2008;
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+          ;General Public License See attached copy of the License.
+          ;
+          ;This program is free software; you can redistribute it and/or modify
+          ;it under the terms of the GNU General Public License as published by
+          ;the Free Software Foundation; either version 2 of the License, or
+          ;(at your option) any later version.
+          ;
+          ;This program is distributed in the hope that it will be useful,
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+          ;GNU General Public License for more details.
+          ;
+          ;You should have received a copy of the GNU General Public License along
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+          ;
+          W "NO ENTRY FROM TOP",!
+          Q
+          ;
+EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
+          ;
+          ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+          ;
+	  ; GET ADVERSE REACTIONS AND ALLERGIES
+          N GMRA,GMRAL S GMRA="0^0^111"
+          D EN1^GMRADPT
+          I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
+	  . S @ALTOUTXML@(0)=0 
+
+	  ; DEFINE MAPPING
+	  N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
+	  S ALTTVMAP=$NA(^TMP("GPLALERT",$J,"ALERTS"))
+          S ALTTARYTMP=$NA(^TMP("GPLALERT",$J,"ALERTSARYTMP"))
+          K @ALTTVMAP,@ALTTARYTMP
+          N ALTTMP,ALTCNT S ALTTMP=$NA(GMRAL),ALTCNT=1
+	  F  S ALTTMP=$Q(@ALTTMP) Q:ALTTMP=""  D
+          . I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
+	  . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
+          . K @ALTVMAP
+          . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
+          . N ALERTDESCRIPTIONTEXT S ALERTDESCRIPTIONTEXT="Patient has an " ; X $ZINT H 5
+          . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_$S($P(@ALTTMP,U,4)=1:"ADVERSE",$P(@ALTTMP,U,5)=1:"ALLERGIC",1:"UNKNOWN")
+          . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_" reaction to "_$P(@ALTTMP,U,2)_"."
+          . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ALERTDESCRIPTIONTEXT
+          . S @ALTVMAP@("ALERTCODEVALUE")="ALERT CODE VALUE"
+          . S @ALTVMAP@("ALERTCODESYSTEM")="ALERT CODE SYSTEM"
+          . S @ALTVMAP@("ALERTSTATUSTEXT")="ALERT STATUS TEXT"
+          . S @ALTVMAP@("ALERTSOURCEID")="ALERT SOURCE ID"
+          . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="ALERT AGENT PRODUCT OBJECT ID"
+          . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="A"
+          . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")="B"
+          . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="C"
+          . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="D"
+          . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
+          . K @ALTARYTMP
+          . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
+          . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)
+          . I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP)
+          . S ALTCNT=ALTCNT+1
+
+          Q
+
Index: ccr/tags/CCR_1_0_4/p/GPLCCD.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLCCD.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLCCD.m	(revision 169)
@@ -0,0 +1,271 @@
+GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+ ; EXPORT A CCR
+ ;
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+       ; Select a patient.
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+       I Y<1 Q  ; EXIT
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+       Q
+       ;
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+       ; N CCDGLO
+       D CCDRPC(.CCDGLO,DFN,"CCD","","","")
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1))
+       S ONAM=FN
+       I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+       . S @ODIRGLB="/home/glilly/CCROUT"
+       . ;S @ODIRGLB="/home/cedwards/"
+       . ;S @ODIRGLB="/opt/wv/p/"
+       S ODIR=DIR
+       I DIR="" S ODIR=@ODIRGLB
+       N ZY
+       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+       W $P(ZY,U,2)
+       Q
+       ;
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+    ; DFN IS PATIENT IEN
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+    ; - NULL MEANS NOW
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+    ;    "TO" VARIABLES
+    ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
+    I '$D(DEBUG) S DEBUG=0
+    N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
+    I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+    I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
+    E  S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+    I CCD D LOAD^GPLCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+    E  D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+    D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+    N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
+    S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
+    S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
+    S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
+    S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
+    S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
+    S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
+    ;
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
+    D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
+    I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
+    I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
+    ;
+    I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+    ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
+    S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
+    D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
+    D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+    I DEBUG D PARY^GPLXPATH("ACTT2")
+    D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
+    I DEBUG D PARY^GPLXPATH(CCDGLO)
+    K ACTT1 K ACCT2
+    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
+    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
+    D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
+    D CP^GPLXPATH("ACTT2",CCDGLO)
+    ;
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+    . S IXML="INXML"
+    . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+    . ; W OXML,!
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+    . W "RUNNING ",CALL,!
+    . X CALL
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+    . . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
+    . . I CCD D UNSHAVE("ITMP",OXML)
+    . . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+    . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
+    . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+    ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
+    ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
+    ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+    ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+    ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+    N I,J,DONE S DONE=0
+    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+    . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
+    . W "TRIMMED",J,!
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
+    . N I
+    . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
+    . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
+    . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
+    . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
+    . . . S @CCDGLO@(I)="</structuredBody></component>"
+    S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
+    S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
+    Q
+    ;
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+    ; TAB IS PASSED BY NAME
+    W "TAB= ",TAB,!
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+    ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+    Q
+    ;
+SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+    ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+    W SHXML,!
+    W @SHXML@(1),!
+    D QUEUE^GPLXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
+    D QUEUE^GPLXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
+    D QUEUE^GPLXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+    Q
+    ;
+UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+    ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
+    N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
+    W SHXML,!
+    W @SHXML@(1),!
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
+    D QUEUE^GPLXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
+    D QUEUE^GPLXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
+    D PARY^GPLXPATH("SHBLD") ; PRINT BUILD LIST
+    D BUILD^GPLXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
+    D CP^GPLXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
+    Q
+    ;
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+    ; K @VMAP
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+    N CTMP
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+    D CP^GPLXPATH("CTMP",CXML)
+    Q
+    ;
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+    ; P1= OBJECTID - ACTORPATIENT_2
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+    ;OR INSTITUTION
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+    N I,J,K,L
+    K @ACTRTN ; CLEAR RETURN ARRAY
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+    . . W "<ActorID>=>",J,!
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+    . . ;  TO GET RID OF DUPLICATES
+    S I="" ; GOING TO $O THROUGH THE HASH
+    F J=0:0 D  Q:$O(K(I))=""  ;
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+    Q
+    ;
+TEST ; RUN ALL THE TEST CASES
+  D TESTALL^GPLUNIT("GPLCCR")
+  Q
+  ;
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+  N ZTMP
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+  Q
+  ;
+TLIST  ; LIST THE TESTS
+  N ZTMP
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+  D TLIST^GPLUNIT(.ZTMP)
+  Q
+  ;
+ ;;><TEST>
+ ;;><PROBLEMS>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+ ;;><VITALS>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+ ;;><CCR>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+ ;;><ACTLST>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+ ;;><ACTORS>
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+ ;;>>?G3(G3(0))["</Actors>"
+ ;;><TRIM>
+ ;;>>>D ZTEST^GPLCCR("CCR")
+ ;;>>>W $$TRIM^GPLXPATH(CCDGLO)
+ ;;><CCD>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","")
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+ ;;></TEST>
Index: ccr/tags/CCR_1_0_4/p/GPLCCD1.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLCCD1.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLCCD1.m	(revision 169)
@@ -0,0 +1,267 @@
+GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+          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  ; IF ZARY DOES NOT EXIST '
+          ; . 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,"GPLCCD1")
+          ; ZWR @ARY
+          Q
+          ;
+TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+          Q
+MARKUP ;<MARKUP>
+ ;;<Body>
+ ;;<Problems>
+ ;;</Problems>
+ ;;<FamilyHistory>
+ ;;</FamilyHistory>
+ ;;<SocialHistory>
+ ;;</SocialHistory>
+ ;;<Alerts>
+ ;;</Alerts>
+ ;;<Medications>
+ ;;</Medications>
+ ;;<VitalSigns>
+ ;;</VitalSigns>
+ ;;<Results>
+ ;;</Results>
+ ;;</Body>
+ ;;</ContinuityOfCareRecord>
+ ;</MARKUP>
+ ;;<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">
+ ;;</ClinicalDocument>
+ 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>Continuity of Care Document</title>
+ ;;<effectiveTime value="20000407130000+0500"/>
+ ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
+ ;;<languageCode code="en-US"/>
+ ;;<recordTarget>
+ ;;<patientRole>
+ ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
+ ;;<patient>
+ ;;<name>
+ ;;<given>@@ACTORGIVENNAME@@</given>
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+ ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
+ ;;</name>
+ ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
+ ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
+ ;;</patient>
+ ;;<providerOrganization>
+ ;;<id root="2.16.840.1.113883.19.5"/>
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+ ;;</providerOrganization>
+ ;;</patientRole>
+ ;;</recordTarget>
+ ;;<author>
+ ;;<time value="20000407130000+0500"/>
+ ;;<assignedAuthor>
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+ ;;<assignedPerson>
+ ;;<name>
+ ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
+ ;;<given>@@ACTORGIVENNAME@@</given>
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+ ;;</name>
+ ;;</assignedPerson>
+ ;;<representedOrganization>
+ ;;<id root="2.16.840.1.113883.19.5"/>
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+ ;;</representedOrganization>
+ ;;</assignedAuthor>
+ ;;</author>
+ ;;<informant>
+ ;;<assignedEntity>
+ ;;<id nullFlavor="NI"/>
+ ;;<representedOrganization>
+ ;;<id root="2.16.840.1.113883.19.5"/>
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+ ;;</representedOrganization>
+ ;;</assignedEntity>
+ ;;</informant>
+ ;;<custodian>
+ ;;<assignedCustodian>
+ ;;<representedCustodianOrganization>
+ ;;<id root="2.16.840.1.113883.19.5"/>
+ ;;<name>@@ORGANIZATIONNAME@@</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>@@ORGANIZATIONNAME@@</name>
+ ;;</representedOrganization>
+ ;;</assignedEntity>
+ ;;</legalAuthenticator>
+ ;;<Actors>
+ ;;<ACTOR-NOK>
+ ;;<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="Biiological mother"/>
+ ;;<telecom value="tel:(999)555-1212"/>
+ ;;<associatedPerson>
+ ;;<name>
+ ;;<given>Henrietta</given>
+ ;;<family>Levin</family>
+ ;;</name>
+ ;;</associatedPerson>
+ ;;</associatedEntity>
+ ;;</participant>
+ ;;</ACTOR-NOK>
+ ;;</Actors>
+ ;;<documentationOf>
+ ;;<serviceEvent classCode="PCPR">
+ ;;<effectiveTime>
+ ;;<high value="@@DATETIME@@"/>
+ ;;</effectiveTime>
+ ;;<performer typeCode="PRF">
+ ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
+ ;;<time>
+ ;;<low value="1990"/>
+ ;;<high value='20000407'/>
+ ;;</time>
+ ;;<assignedEntity>
+ ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
+ ;;<assignedPerson>
+ ;;<name>
+ ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
+ ;;<given>@@ACTORGIVENNAME@@</given>
+ ;;<family>@@ACTORFAMILYNAME@@</family>
+ ;;</name>
+ ;;</assignedPerson>
+ ;;<representedOrganization>
+ ;;<id root="2.16.840.1.113883.19.5"/>
+ ;;<name>@@ORGANIZATIONNAME@@</name>
+ ;;</representedOrganization>
+ ;;</assignedEntity>
+ ;;</performer>
+ ;;</serviceEvent>
+ ;;</documentationOf>
+ ;;<Body>
+ ;;<PROBLEMS-HTML>
+ ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
+ ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
+ ;;<td>@@PROBLEMDATEOFONSET@@</td>
+ ;;<td>Active</td></tr>
+ ;;</tbody></table></text>
+ ;;</PROBLEMS-HTML>
+ ;;<Problems>
+ ;;<component>
+ ;;<section>
+ ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
+ ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
+ ;;<title>Problems</title>
+ ;;<entry typeCode="DRIV">
+ ;;<act classCode="ACT" moodCode="EVN">
+ ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
+ ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
+ ;;<code nullFlavor="NA"/>
+ ;;<entryRelationship typeCode="SUBJ">
+ ;;<observation classCode="OBS" moodCode="EVN">
+ ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
+ ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
+ ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
+ ;;<statusCode code="completed"/>
+ ;;<effectiveTime>
+ ;;<low value="@@PROBLEMDATEOFONSET@@"/>
+ ;;</effectiveTime>
+ ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
+ ;;<entryRelationship typeCode="REFR">
+ ;;<observation classCode="OBS" moodCode="EVN">
+ ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
+ ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
+ ;;<statusCode code="completed"/>
+ ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
+ ;;</observation>
+ ;;</entryRelationship>
+ ;;</observation>
+ ;;</entryRelationship>
+ ;;</act>
+ ;;</entry>
+ ;;</section>
+ ;;</component>
+ ;;</Problems>
+ ;;<FamilyHistory>
+ ;;</FamilyHistory>
+ ;;<SocialHistory>
+ ;;</SocialHistory>
+ ;;<Alerts>
+ ;;</Alerts>
+ ;;<Medications>
+ ;;</Medications>
+ ;;<VitalSigns>
+ ;;</VitalSigns>
+ ;;<Results>
+ ;;</Results>
+ ;;</Body>
+ ;;</ClinicalDocument>
+ ;</TEMPLATE>
Index: ccr/tags/CCR_1_0_4/p/GPLCCR.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLCCR.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLCCR.m	(revision 169)
@@ -0,0 +1,228 @@
+GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+ ; EXPORT A CCR
+ ;
+EXPORT   ; EXPORT ENTRY POINT FOR CCR
+       ; Select a patient.
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+       I Y<1 Q  ; EXIT
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+       D XPAT(DFN,"","") ; EXPORT TO A FILE
+       Q
+       ;
+XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+       ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
+       ; FN IS FILE NAME, DEFAULTS IF NULL
+       N CCRGLO
+       I '$D(DIR) S DIR=""
+       I '$D(FN) S FN=""
+       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
+       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
+       S ONAM=FN
+       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
+       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
+       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
+       . ;S @ODIRGLB="/home/glilly/CCROUT"
+       . ;S @ODIRGLB="/home/cedwards/"
+       . S @ODIRGLB="/opt/wv/p/"
+       S ODIR=DIR
+       I DIR="" S ODIR=@ODIRGLB
+       N ZY
+       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+       W !,$P(ZY,U,2),!
+       Q
+       ;
+DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
+    ;
+    N G1
+    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
+    I $D(@G1@(0)) D  ; CCR EXISTS
+    . D PARY^GPLXPATH(G1)
+    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
+    Q
+    ;
+CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+    ; DFN IS PATIENT IEN
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+    ; - NULL MEANS NOW
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+    ;    "TO" VARIABLES
+    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
+    I '$D(DEBUG) S DEBUG=0
+    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
+    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
+    I '$D(TESTALERT) S TESTALERT=0 ; FLAG FOR TESTING ALERTS SECTION
+    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
+    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+    ;
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+    ;
+    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+    ;
+    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+    . S IXML="INXML"
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
+    . ; W OXML,!
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+    . I DEBUG W "RUNNING ",CALL,!
+    . X CALL
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
+    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
+    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
+    N TRIMI,J,DONE S DONE=0
+    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
+    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
+    . I DEBUG W "TRIMMED",J,!
+    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
+    Q
+    ;
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+    ; TAB IS PASSED BY NAME
+    I DEBUG W "TAB= ",TAB,!
+    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
+    I TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+    I 'TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
+    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
+    Q
+    ;
+HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
+    ; K @VMAP
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
+    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
+    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+    N CTMP
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+    D CP^GPLXPATH("CTMP",CXML)
+    Q
+    ;
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+    ; P1= OBJECTID - ACTORPATIENT_2
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+    ;OR INSTITUTION
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+    N I,J,K,L
+    K @ACTRTN ; CLEAR RETURN ARRAY
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+    . . I DEBUG W "<ActorID>=>",J,!
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+    . . ;  TO GET RID OF DUPLICATES
+    S I="" ; GOING TO $O THROUGH THE HASH
+    F J=0:0 D  Q:$O(K(I))=""
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+    Q
+    ;
+TEST ; RUN ALL THE TEST CASES
+  D TESTALL^GPLUNIT("GPLCCR")
+  Q
+  ;
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+  N ZTMP
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+  Q
+  ;
+TLIST  ; LIST THE TESTS
+  N ZTMP
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+  D TLIST^GPLUNIT(.ZTMP)
+  Q
+  ;
+ ;;><TEST>
+ ;;><PROBLEMS>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
+ ;;>>?@GPL@(@GPL@(0))["</Problems>"
+ ;;><VITALS>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
+ ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
+ ;;><CCR>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+ ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
+ ;;><ACTLST>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
+ ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+ ;;><ACTORS>
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
+ ;;>>?G3(G3(0))["</Actors>"
+ ;;><TRIM>
+ ;;>>>D ZTEST^GPLCCR("CCR")
+ ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
+ ;;><ALERTS>
+ ;;>>>S TESTALERT=1
+ ;;>>>K GPL S GPL=""
+ ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
+ ;;>>?@GPL@(@GPL@(0))["</Alerts>"
+
Index: ccr/tags/CCR_1_0_4/p/GPLCCR0.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLCCR0.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLCCR0.m	(revision 169)
@@ -0,0 +1,821 @@
+GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+          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
+          ;
+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,"GPLCCR0")
+          ; ZWR @ARY
+          Q
+          ;
+ ;<TEMPLATE>
+ ;;<?xml version="1.0" encoding="UTF-8"?>
+ ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
+ ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
+ ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
+ ;;<Language>
+ ;;<Text>English</Text>
+ ;;</Language>
+ ;;<Version>V1.0</Version>
+ ;;<DateTime>
+ ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
+ ;;</DateTime>
+ ;;<Patient>
+ ;;<ActorID>@@ACTORPATIENT@@</ActorID>
+ ;;</Patient>
+ ;;<From>
+ ;;<ActorLink>
+ ;;<ActorID>@@ACTORFROM@@</ActorID>
+ ;;</ActorLink>
+ ;;<ActorLink>
+ ;;<ActorID>@@ACTORFROM2@@</ActorID>
+ ;;</ActorLink>
+ ;;</From>
+ ;;<To>
+ ;;<ActorLink>
+ ;;<ActorID>@@ACTORTO@@</ActorID>
+ ;;<ActorRole>
+ ;;<Text>@@ACTORTOTEXT@@</Text>
+ ;;</ActorRole>
+ ;;</ActorLink>
+ ;;</To>
+ ;;<Purpose>
+ ;;<Description>
+ ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
+ ;;</Description>
+ ;;</Purpose>
+ ;;<Body>
+ ;;<Problems>
+ ;;<Problem>
+ ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
+ ;;<Type>
+ ;;<Text>Problem</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
+ ;;<Code>
+ ;;<Value>@@PROBLEMCODEVALUE@@</Value>
+ ;;<CodingSystem>ICD9CM</CodingSystem>
+ ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
+ ;;</Code>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Problem>
+ ;;</Problems>
+ ;;<FamilyHistory>
+ ;;<FamilyProblemHistory>
+ ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<FamilyMember>
+ ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
+ ;;<ActorRole>
+ ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
+ ;;</ActorRole>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</FamilyMember>
+ ;;<Problem>
+ ;;<Type>
+ ;;<Text>Problem</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
+ ;;<Code>
+ ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
+ ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
+ ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
+ ;;</Code>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Problem>
+ ;;</FamilyProblemHistory>
+ ;;</FamilyHistory>
+ ;;<SocialHistory>
+ ;;<SocialHistoryElement>
+ ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
+ ;;<Type>
+ ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</SocialHistoryElement>
+ ;;<SocialHistoryElement>
+ ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
+ ;;<Type>
+ ;;<Text>Ethnic Origin</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>Not Hispanic or Latino</Text>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>AA0001</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</SocialHistoryElement>
+ ;;<SocialHistoryElement>
+ ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
+ ;;<Type>
+ ;;<Text>Race</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>White</Text>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>AA0001</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</SocialHistoryElement>
+ ;;<SocialHistoryElement>
+ ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
+ ;;<Type>
+ ;;<Text>Occupation</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>Physician</Text>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>AA0001</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</SocialHistoryElement>
+ ;;</SocialHistory>
+ ;;<Alerts>
+ ;;<Alert>
+ ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
+ ;;<Description>
+ ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@ALERTCODEVALUE@@</Value>
+ ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
+ ;;</Code>
+ ;;</Description>
+ ;;<Status>
+ ;;<Text>@@ALERTSTATUSTEXT@@</Text>
+ ;;</Status>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<Agent>
+ ;;<Products>
+ ;;<Product>
+ ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ALERTAGENTPRODUCTSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<ProductName>
+ ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
+ ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
+ ;;</Code>
+ ;;</ProductName>
+ ;;</Product>
+ ;;</Products>
+ ;;</Agent>
+ ;;<Reaction>
+ ;;<Description>
+ ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
+ ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
+ ;;</Code>
+ ;;</Description>
+ ;;</Reaction>
+ ;;</Alert>
+ ;;</Alerts>
+ ;;<Medications>
+ ;;<Medication>
+ ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
+ ;;<DateTime>
+ ;;<Type>
+ ;;<Text>@@MEDISSUEDATETXT@@</Text>
+ ;;</Type>
+ ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
+ ;;<Type>
+ ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
+ ;;</Type>
+ ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
+ ;;</DateTime>
+ ;;<IDs>
+ ;;<Type>
+ ;;<Text>@@MEDRXNOTXT@@</Text>
+ ;;</Type>
+ ;;<ID>@@MEDRXNO@@</ID>
+ ;;</IDs>
+ ;;<Type>
+ ;;<Text>@@MEDTYPETEXT@@</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>@@MEDDETAILUNADORNED@@</Text>
+ ;;</Description>
+ ;;<Status>
+ ;;<Text>@@MEDSTATUSTEXT@@</Text>
+ ;;</Status>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<Product>
+ ;;<ProductName>
+ ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
+ ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
+ ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
+ ;;</Code>
+ ;;</ProductName>
+ ;;<BrandName>
+ ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
+ ;;</BrandName>
+ ;;<Strength>
+ ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
+ ;;</Units>
+ ;;</Strength>
+ ;;<Form>
+ ;;<Text>@@MEDFORMTEXT@@</Text>
+ ;;</Form>
+ ;;<Concentration>
+ ;;<Value>@@MEDCONCVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@MEDCONCUNIT@@</Unit>
+ ;;</Units>
+ ;;</Concentration>
+ ;;<Size>
+ ;;<Text>@@MEDSIZETEXT@@</Text>
+ ;;</Size>
+ ;;</Product>
+ ;;<Quantity>
+ ;;<Value>@@MEDQUANTITYVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
+ ;;</Units>
+ ;;</Quantity>
+ ;;<Directions>
+ ;;<Direction>
+ ;;<Description>
+ ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
+ ;;</Description>
+ ;;<DoseIndicator>
+ ;;<Text>@@MEDDOSEINDICATOR@@</Text>
+ ;;</DoseIndicator>
+ ;;<DeliveryMethod>
+ ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
+ ;;</DeliveryMethod>
+ ;;<Dose>
+ ;;<Value>@@MEDDOSEVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@MEDDOSEUNIT@@</Unit>
+ ;;</Units>
+ ;;<Rate>
+ ;;<Value>@@MEDRATEVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@MEDRATEUNIT@@</Unit>
+ ;;</Units>
+ ;;</Rate>
+ ;;</Dose>
+ ;;<Vehicle>
+ ;;<Text>@@MEDVEHICLETEXT@@</Text>
+ ;;</Vehicle>
+ ;;<Route>
+ ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
+ ;;</Route>
+ ;;<Frequency>
+ ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
+ ;;</Frequency>
+ ;;<Interval>
+ ;;<Value>@@MEDINTERVALVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
+ ;;</Units>
+ ;;</Interval>
+ ;;<Duration>
+ ;;<Value>@@MEDDURATIONVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
+ ;;</Units>
+ ;;</Duration>
+ ;;<Indication>
+ ;;<PRNFlag>
+ ;;<Text>@@MEDPRNFLAG@@</Text>
+ ;;</PRNFlag>
+ ;;<Problem>
+ ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
+ ;;<Type>
+ ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
+ ;;<Code>
+ ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
+ ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
+ ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
+ ;;</Code>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Problem>
+ ;;</Indication>
+ ;;<StopIndicator>
+ ;;<Text>@@MEDSTOPINDICATOR@@</Text>
+ ;;</StopIndicator>
+ ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
+ ;;<MultipleDirectionModifier>
+ ;;<Text>@@MEDMULDIRMOD@@</Text>
+ ;;</MultipleDirectionModifier>
+ ;;</Direction>
+ ;;</Directions>
+ ;;<PatientInstructions>
+ ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
+ ;;</PatientInstructions>
+ ;;<FullfillmentInstructions>
+ ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
+ ;;</FullfillmentInstructions>
+ ;;<Refills>
+ ;;<Refill>
+ ;;<Number>@@MEDRFNO@@</Number>
+ ;;</Refill>
+ ;;</Refills>
+ ;;</Medication>
+ ;;</Medications>
+ ;;<VitalSigns>
+ ;;<Result>
+ ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
+ ;;<DateTime>
+ ;;<Type>
+ ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
+ ;;</Type>
+ ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
+ ;;</DateTime>
+ ;;<Description>
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<Test>
+ ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
+ ;;<Type>
+ ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
+ ;;</Type>
+ ;;<Description>
+ ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
+ ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
+ ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
+ ;;</Code>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<TestResult>
+ ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
+ ;;</Units>
+ ;;</TestResult>
+ ;;</Test>
+ ;;</Result>
+ ;;</VitalSigns>
+ ;;<Results>
+ ;;<Result>
+ ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
+ ;;<DateTime>
+ ;;<Type>
+ ;;<Text>Assessment Time</Text>
+ ;;</Type>
+ ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
+ ;;</DateTime>
+ ;;<Description>
+ ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@RESULTCODE@@</Value>
+ ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
+ ;;</Code>
+ ;;</Description>
+ ;;<Status>
+ ;;<Text>@@RESULTSTATUS@@</Text>
+ ;;</Status>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<TEST_NORMALDESCRIPTION>
+ ;;<Test>
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+ ;;<DateTime>
+ ;;<Type>
+ ;;<Text>Assessment Time</Text>
+ ;;</Type>
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+ ;;</DateTime>
+ ;;<Description>
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@RESULTTESTCODE@@</Value>
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+ ;;</Code>
+ ;;</Description>
+ ;;<Status>
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+ ;;</Status>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<TestResult>
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+ ;;</Units>
+ ;;</TestResult>
+ ;;<NormalResult>
+ ;;<Normal>
+ ;;<Description>
+ ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
+ ;;</Description>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Normal>
+ ;;</NormalResult>
+ ;;<Flag>
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+ ;;</Flag>
+ ;;</Test>
+ ;;</TEST_NORMALDESCRIPTION>
+ ;;<TEST_NORMALSEQUENCE>
+ ;;<Test>
+ ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
+ ;;<DateTime>
+ ;;<Type>
+ ;;<Text>Assessment Time</Text>
+ ;;</Type>
+ ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
+ ;;</DateTime>
+ ;;<Description>
+ ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
+ ;;<Code>
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+ ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
+ ;;</Code>
+ ;;</Description>
+ ;;<Status>
+ ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
+ ;;</Status>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;<TestResult>
+ ;;<Value>@@RESULTTESTVALUE@@</Value>
+ ;;<Units>
+ ;;<Unit>@@RESULTTESTUNITS@@</Unit>
+ ;;</Units>
+ ;;</TestResult>
+ ;;<NormalResult>
+ ;;<Normal>
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
+ ;;<Units>
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
+ ;;</Units>
+ ;;<ValueSequencePosition>1</ValueSequencePosition>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Normal>
+ ;;<Normal>
+ ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
+ ;;<Units>
+ ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
+ ;;</Units>
+ ;;<ValueSequencePosition>2</ValueSequencePosition>
+ ;;<VariableNomalModifier>
+ ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
+ ;;</VariableNomalModifier>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Normal>
+ ;;</NormalResult>
+ ;;<Flag>
+ ;;<Text>@@RESULTTESTFLAG@@</Text>
+ ;;</Flag>
+ ;;</Test>
+ ;;</TEST_NORMALSEQUENCE>
+ ;;</Result>
+ ;;</Results>
+ ;;<HealthCareProviders>
+ ;;<Provider>
+ ;;<ActorID>AA0005</ActorID>
+ ;;<ActorRole>
+ ;;<Text>Primary Provider</Text>
+ ;;</ActorRole>
+ ;;</Provider>
+ ;;</HealthCareProviders>
+ ;;</Body>
+ ;;<Actors>
+ ;;<ACTOR-PATIENT>
+ ;;<Actor>
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+ ;;<Person>
+ ;;<Name>
+ ;;<CurrentName>
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+ ;;</CurrentName>
+ ;;</Name>
+ ;;<DateOfBirth>
+ ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
+ ;;</DateOfBirth>
+ ;;<Gender>
+ ;;<Text>@@ACTORGENDER@@</Text>
+ ;;<Code>
+ ;;<Value>@@ACTORGENDER@@</Value>
+ ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
+ ;;</Code>
+ ;;</Gender>
+ ;;</Person>
+ ;;<IDs>
+ ;;<Type>
+ ;;<Text>@@ACTORSSNTEXT@@</Text>
+ ;;</Type>
+ ;;<ID>@@ACTORSSN@@</ID>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</IDs>
+ ;;<Address>
+ ;;<Type>
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+ ;;</Type>
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+ ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+ ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
+ ;;</Address>
+ ;;<Telephone>
+ ;;<Value>@@ACTORRESTEL@@</Value>
+ ;;<Type>
+ ;;<Text>@@ACTORRESTELTEXT@@</Text>
+ ;;</Type>
+ ;;</Telephone>
+ ;;<Telephone>
+ ;;<Value>@@ACTORWORKTEL@@</Value>
+ ;;<Type>
+ ;;<Text>@@ACTORWORKTELTEXT@@</Text>
+ ;;</Type>
+ ;;</Telephone>
+ ;;<Telephone>
+ ;;<Value>@@ACTORCELLTEL@@</Value>
+ ;;<Type>
+ ;;<Text>@@ACTORCELLTELTEXT@@</Text>
+ ;;</Type>
+ ;;</Telephone>
+ ;;<EMail>
+ ;;<Value>@@ACTOREMAIL@@</Value>
+ ;;</EMail>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Actor>
+ ;;</ACTOR-PATIENT>
+ ;;<ACTOR-SYSTEM>
+ ;;<Actor>
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+ ;;<InformationSystem>
+ ;;<Name>@@ACTORINFOSYSNAME@@</Name>
+ ;;<Version>@@ACTORINFOSYSVER@@</Version>
+ ;;</InformationSystem>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Actor>
+ ;;</ACTOR-SYSTEM>
+ ;;<ACTOR-NOK>
+ ;;<Actor>
+ ;;<ActorObjectID>AA0003</ActorObjectID>
+ ;;<Person>
+ ;;<Name>
+ ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
+ ;;</Name>
+ ;;</Person>
+ ;;<Relation>
+ ;;<Text>@@ACTORRELATION@@</Text>
+ ;;</Relation>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Actor>
+ ;;</ACTOR-NOK>
+ ;;<ACTOR-PROVIDER>
+ ;;<Actor>
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+ ;;<Person>
+ ;;<Name>
+ ;;<CurrentName>
+ ;;<Given>@@ACTORGIVENNAME@@</Given>
+ ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
+ ;;<Family>@@ACTORFAMILYNAME@@</Family>
+ ;;<Title>@@ACTORTITLE@@</Title>
+ ;;</CurrentName>
+ ;;</Name>
+ ;;</Person>
+ ;;<IDs>
+ ;;<Type>
+ ;;<Text>@@IDTYPE@@</Text>
+ ;;</Type>
+ ;;<ID>@@ID@@</ID>
+ ;;<IssuedBy>
+ ;;<Description>
+ ;;<Text>@@IDDESC@@</Text>
+ ;;</Description>
+ ;;</IssuedBy>
+ ;;</IDs>
+ ;;<Specialty>
+ ;;<Text>@@ACTORSPECIALITY@@</Text>
+ ;;</Specialty>
+ ;;<Address>
+ ;;<Type>
+ ;;<Text>@@ACTORADDRESSTYPE@@</Text>
+ ;;</Type>
+ ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
+ ;;<City>@@ACTORADDRESSCITY@@</City>
+ ;;<State>@@ACTORADDRESSSTATE@@</State>
+ ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
+ ;;</Address>
+ ;;<Telephone>
+ ;;<Value>@@ACTORTELEPHONE@@</Value>
+ ;;<Type>
+ ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
+ ;;</Type>
+ ;;</Telephone>
+ ;;<Email>
+ ;;<Value>@@ACTOREMAIL@@</Value>
+ ;;</Email>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Actor>
+ ;;</ACTOR-PROVIDER>
+ ;;<ACTOR-ORG>
+ ;;<Actor>
+ ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
+ ;;<Organization>
+ ;;<Name>@@ORGANIZATIONNAME@@</Name>
+ ;;</Organization>
+ ;;<Source>
+ ;;<Actor>
+ ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
+ ;;</Actor>
+ ;;</Source>
+ ;;</Actor>
+ ;;</ACTOR-ORG>
+ ;;</Actors>
+ ;;<Signatures>
+ ;;<CCRSignature>
+ ;;<SignatureObjectID>S0001</SignatureObjectID>
+ ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
+ ;;<Source>
+ ;;<ActorID>AA0001</ActorID>
+ ;;</Source>
+ ;;<Signature>
+ ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
+ ;;<SignedInfo>
+ ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
+ ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
+ ;;<Reference URI="">
+ ;;<Transforms>
+ ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
+ ;;</Transforms>
+ ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
+ ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
+ ;;</Reference>
+ ;;</SignedInfo>
+ ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
+ ;;<KeyInfo>
+ ;;<KeyValue>
+ ;;<RSAKeyValue>
+ ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
+ ;;<Exponent>AQAB</Exponent>
+ ;;</RSAKeyValue>
+ ;;</KeyValue>
+ ;;</KeyInfo>
+ ;;</Signature>
+ ;;</Signature>
+ ;;</CCRSignature>
+ ;;</Signatures>
+ ;;</ContinuityOfCareRecord>
+ ;</TEMPLATE>
Index: ccr/tags/CCR_1_0_4/p/GPLMEDS.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLMEDS.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLMEDS.m	(revision 169)
@@ -0,0 +1,168 @@
+GPLMEDS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
+   ;;0.1;CCDCCR;;JUL 16,2008;
+   ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+   ;General Public License See attached copy of the License.
+   ;
+   ;This program is free software; you can redistribute it and/or modify
+   ;it under the terms of the GNU General Public License as published by
+   ;the Free Software Foundation; either version 2 of the License, or
+   ;(at your option) any later version.
+   ;
+   ;This program is distributed in the hope that it will be useful,
+   ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+   ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   ;GNU General Public License for more details.
+   ;
+   ;You should have received a copy of the GNU General Public License along
+   ;with this program; if not, write to the Free Software Foundation, Inc.,
+   ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+   ;
+   W "NO ENTRY FROM TOP",!
+   Q
+   ;
+EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
+   ;
+   ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+   ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+   ;
+   N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
+   N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
+   ; OUTPATIENT MEDS ARE PROCESSED IN EXTRACT^CCRMEDS, ALL OTHERS HERE
+   D EXTRACT^CCRMEDS(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
+   I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
+   . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
+   . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
+   . W "HAS ACTIVE OP MEDS",!
+   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
+   D ACTIVE^ORWPS(.MEDRSLT,DFN)
+   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
+   . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
+   . S @MEDOUTXML@(0)=0
+   . Q
+   ; I DEBUG ZWR MEDRSLT
+   M GPLMEDS=MEDRSLT
+   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
+   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
+   I 'HASOP K @MEDTVMAP,@MEDTARYTMP
+   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
+   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
+   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
+   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
+   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
+   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
+   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
+   . . S ZI=ZI+1 ; INCREMENT MED COUNT
+   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
+   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
+   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
+   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
+   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
+   ;ZWR ZA
+   S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
+   F ZI=1:1:ZA(0) D  ; FOR EACH MED
+   . I DEBUG W "ZI IS ",ZI,!
+   . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
+   . K @MEDVMAP
+   . I DEBUG W "VMAP= ",MEDVMAP,!
+   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
+   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
+   . I $P(MEDPTMP,U,1)?1"~OP"&$P(MEDPTMP,"^",10)="ACTIVE" Q  ; SKIP OP ACTIVE
+   . S @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
+   . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
+   . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
+   . S @MEDVMAP@("MEDISSUEDATE")=""
+   . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
+   . S @MEDVMAP@("MEDLASTFILLDATE")=""
+   . S @MEDVMAP@("MEDRXNOTXT")=""
+   . S @MEDVMAP@("MEDRXNO")=""
+   . S @MEDVMAP@("MEDDETAILUNADORNED")=""
+   . S @MEDVMAP@("MEDCONCVALUE")=""
+   . S @MEDVMAP@("MEDCONCUNIT")=""
+   . S @MEDVMAP@("MEDSIZETEXT")=""
+   . S @MEDVMAP@("MEDDOSEINDICATOR")=""
+   . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
+   . S @MEDVMAP@("MEDRATEVALUE")=""
+   . S @MEDVMAP@("MEDRATEUNIT")=""
+   . S @MEDVMAP@("MEDVEHICLETEXT")=""
+   . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
+   . S @MEDVMAP@("MEDINTERVALVALUE")=""
+   . S @MEDVMAP@("MEDINTERVALUNIT")=""
+   . S @MEDVMAP@("MEDPRNFLAG")=""
+   . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
+   . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
+   . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
+   . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
+   . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
+   . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
+   . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
+   . S @MEDVMAP@("MEDSTOPINDICATOR")=""
+   . S @MEDVMAP@("MEDDIRSEQ")=""
+   . S @MEDVMAP@("MEDMULDIRMOD")=""
+   . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
+   . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
+   . S @MEDVMAP@("MEDDATETIMEAGE")=""
+   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
+   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
+   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
+   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
+   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
+   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
+   . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
+   . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
+   . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
+   . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
+   . . . I DEBUG W "RXIEN=",RXIEN,! ;
+   . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
+   . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
+   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
+   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
+   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
+   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
+   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
+   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
+   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
+   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
+   . S @MEDVMAP@("MEDFORMTEXT")=""
+   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
+   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
+   . S @MEDVMAP@("MEDRFNO")=""
+   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
+   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
+   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
+   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
+   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
+   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
+   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
+   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
+   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
+   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
+   . S @MEDVMAP@("MEDDOSEVALUE")=""
+   . S @MEDVMAP@("MEDDOSEUNIT")=""
+   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
+   . S @MEDVMAP@("MEDDURATIONVALUE")=""
+   . S @MEDVMAP@("MEDDURATIONUNIT")=""
+   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
+   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
+   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
+   . K @MEDARYTMP
+   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
+   . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
+   . . ; W "FIRST ONE",!
+   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
+   . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
+   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
+   N MEDTMP,MEDI
+   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+   . W "MEDICATION MISSING ",!
+   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+   Q
+   ;
+DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
+   ; EXAMPLE: $$DIGITS("13R") RETURNS 13
+   N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
+   S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
+   Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
+   ;
Index: ccr/tags/CCR_1_0_4/p/GPLPROBS.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLPROBS.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLPROBS.m	(revision 169)
@@ -0,0 +1,112 @@
+GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+           ;
+           ;  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,TBU
+          S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
+          S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
+          K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
+          D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
+          I '$D(RPCRSLT(1)) D  Q  ; RPC RETURNS NULL
+          . W "NULL RESULT FROM LIST^ORQQPL3 ",!
+          . S @OUTXML@(0)=0
+          . ; Q
+          ; I DEBUG ZWR RPCRSLT
+          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
+          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@("PROBLEMCODINGVERSION")=""
+          . 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("GPLCCR",$J,"PROBVALS",*)
+          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
+          ; ZWR @OUTXML
+          ; $$HTML^DILF(
+          ; GENERATE THE NARITIVE HTML FOR THE CCD
+          I CCD D  ; IF THIS IS FOR A CCD
+          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
+          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
+          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
+          . . I DEBUG W "VMAP =",VMAP,!
+          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
+          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
+          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
+          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
+          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
+          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
+          . . . D CP^GPLXPATH("HOUT","HTMLO")
+          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
+          . . . I DEBUG W "DOING INNER",!
+          . . . N HTMLBLD,HTMLTMP
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
+          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
+          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
+          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
+          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
+          . I DEBUG D PARY^GPLXPATH("HTMLO")
+          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
+          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
+          ;
Index: ccr/tags/CCR_1_0_4/p/GPLRIMA.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLRIMA.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLRIMA.m	(revision 169)
@@ -0,0 +1,417 @@
+GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+ ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
+ ; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
+ ; THESE PATIENTS. IT BEGINS TO MEASURE "HL7 RIM COHERENCE" WHICH IS HOW USEFUL
+ ; THE VARIABLES WILL BE TO A RIM-MODELED APPLICATION AFTER THEY ARE
+ ; CONVEYED VIA THE CCR OR CCD.
+ ; FACTORS THAT AFFECT RIM COHERENCE INCLUDE:
+ ;    1. THE PRESENSE OF CLINICAL DATA IN A SECTION
+ ;    2. ARE THE DATA ELEMENTS TIME-BOUND
+ ;    3. ARE THE DATA ELEMENTS CODED WITH SNOMED OR LOINC ETC
+ ;    4. ARE SOURCE ACTORS ASSOCIATED WITH THE DATA ELEMENTS
+ ;    5. ARE ACTORS IDENTIFIED REGARDING THEIR ROLE
+ ;    .. AND OTHER FACTORS YET TO BE DETERMINED
+ ;
+ ;    SINCE THESE MEASUREMENTS ARE DONE AT THE VARIABLE LEVEL, THEY
+ ;    REFLECT ON RIM COHERENCE WHETHER THE CCR OR THE CCD IS USED FOR
+ ;    CONVEYANCE TO THE RIM APPLICATION.
+ ;
+ ;
+ANALYZE(BEGDFN,DFNCNT) ; RIM COHERANCE ANALYSIS ROUTINE
+    ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
+    ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
+    ; USE RESET^GPLRIMA TO RESET TO TOP OF PATIENT LIST
+    ;
+    N RIMARY,RIMTMP,RIMI,RIMDFN,RATTR
+    N CCRGLO
+    D ASETUP ; SET UP VARIABLES AND GLOBALS
+    D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
+    I '$D(@RIMBASE@("RESUME")) S @RIMBASE@("RESUME")=$O(^DPT(0)) ; FIRST TIME
+    S RESUME=@RIMBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
+    S RIMDFN=BEGDFN ; BEGIN WITH THE BEGDFN PATIENT
+    I RIMDFN="" S RIMDFN=RESUME
+    I +RIMDFN=0 D  Q  ; AT THE END OF THE PATIENTS
+    . W "END OF PATIENT LIST, CALL RESET^GPLRIMA",!
+    F RIMI=1:1:DFNCNT  D  Q:+RIMDFN=0  ; FOR DFNCNT NUMBER OF PATIENTS OR END
+    . D CCRRPC^GPLCCR(.CCRGLO,RIMDFN,"CCR","","","") ;PROCESS THE CCR
+    . W RIMDFN,!
+    . K @RIMBASE@("VARS",RIMDFN) ; CLEAR OUT OLD VARS
+    . ;
+    . ; COPY ALL THE VARIABLES TO THE RIM MAP AREA INDEXED BY PATIENT
+    . ;
+    . I $D(^TMP("GPLCCR",$J,"PROBVALS",1)) D  ; PROBLEM VARS EXISTS
+    . . M @RIMBASE@("VARS",RIMDFN,"PROBLEMS")=^TMP("GPLCCR",$J,"PROBVALS")
+    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
+    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
+    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
+    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
+    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
+    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
+    . ;
+    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
+    . ;
+    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
+    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
+    . ;
+    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
+    . ;
+    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
+    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
+    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
+    . ;
+    . N CATNAME,CATTBL
+    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
+    . S CATNAME=""
+    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
+    . W "CATEGORY NAME: ",CATNAME,!
+    . ;
+    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
+    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
+    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
+    . ; AND WE SKIP IT
+    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
+    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
+    Q
+    ;
+SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+    N SBASE,SATTR
+    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
+    D APOST("SATTR","RIMTBL","HEADER")
+    I $D(@SBASE@("PROBLEMS",1)) D  ;
+    . D APOST("SATTR","RIMTBL","PROBLEMS")
+    . ; W "POSTING PROBLEMS",!
+    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
+    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
+    . D APOST("SATTR","RIMTBL","MEDS")
+    . N ZR,ZI
+    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
+    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
+    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
+    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
+    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
+    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
+    W "ATTRIBUTES: ",SATTR,!
+    Q SATTR
+    ;
+RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+    K ^TMP("GPLRIM","RESUME")
+    K ^TMP("GPLRIM")
+    Q
+    ;
+CLIST ; LIST THE CATEGORIES
+    ;
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N CLBASE,CLNUM,ZI,CLIDX
+    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
+    S CLNUM=@CLBASE@(0)
+    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
+    . S CLIDX=@CLBASE@(ZI)
+    . W "(",$P(@CLBASE@(CLIDX),"^",1)
+    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
+    . W CLIDX,!
+    ; D PARY^GPLXPATH(CLBASE)
+    Q
+    ;
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
+    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
+    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
+    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
+    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
+    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
+    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
+    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
+    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
+    ; NUMBER IE CTBL_X(CDFN)=""
+    ;
+    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
+    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
+    W "CBASE: ",CCTBL,!
+    ;
+    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
+    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
+    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
+    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
+    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
+    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
+    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
+    ;
+    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
+    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
+    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
+    ;
+    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
+    ;
+    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
+    W "PATS BASE: ",CPATLIST,!
+    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
+    ;
+    Q
+    ;
+CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+    ;
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
+    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
+    . S ZCNT=0
+    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
+    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
+    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
+    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
+    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
+    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
+    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
+    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
+    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
+    . S ZTOT=ZTOT+ZCNT
+    W "TOTAL: ",ZTOT,!
+    Q
+    ;
+CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+    ; INLST IS PASSED BY NAME
+    N ZI,ZDX,ZCOUNT
+    W INLST,!
+    S ZCOUNT=0
+    S ZDX=""
+    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
+    . S ZCOUNT=ZCOUNT+1
+    . S ZDX=$O(@INLST@(ZDX))
+    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
+    Q ZCOUNT
+    ;
+XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+    ;
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N ZI,ZJ,ZC,ZPATBASE
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+    S ZI=""
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+    . S ZI=$O(@ZPATBASE@(ZI))
+    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
+    Q
+    ;
+CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+    ;
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    N ZI,ZJ,ZC,ZPATBASE
+    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
+    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
+    S ZI=""
+    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
+    . S ZI=$O(@ZPATBASE@(ZI))
+    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
+    . W ZI," "
+    . I ZC=10 D  ; NEW LINE
+    . . S ZC=0
+    . . W !
+    Q
+    ;
+PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
+    ;
+    N ATTR S ATTR=""
+    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
+    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
+    S ATTR=^TMP("GPLRIM","ATTR",DFN)
+    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
+    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
+    . N CAT
+    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
+    . W CAT,": ",ATTR,!
+    Q
+    ;
+APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
+    ; AND AMAP(N)=AVAL IS THE NTH AVAL
+    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
+    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
+    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
+    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
+    ;
+    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
+    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
+    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
+    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
+    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
+    Q
+    ;
+ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
+      I '$D(@RIMBASE) S @RIMBASE=""
+      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
+      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
+      Q
+      ;
+AINIT ; INITIALIZE ATTRIBUTE TABLE
+      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+      K @RIMTBL
+      D APUSH(RIMTBL,"EXTRACTED")
+      D APUSH(RIMTBL,"NOTEXTRACTED")
+      D APUSH(RIMTBL,"HEADER")
+      D APUSH(RIMTBL,"NOPCP")
+      D APUSH(RIMTBL,"PCP")
+      D APUSH(RIMTBL,"PROBLEMS")
+      D APUSH(RIMTBL,"PROBCODE")
+      D APUSH(RIMTBL,"PROBNOCODE")
+      D APUSH(RIMTBL,"PROBDATE")
+      D APUSH(RIMTBL,"PROBNODATE")
+      D APUSH(RIMTBL,"VITALS")
+      D APUSH(RIMTBL,"VITALSCODE")
+      D APUSH(RIMTBL,"VITALSNOCODE")
+      D APUSH(RIMTBL,"VITALSDATE")
+      D APUSH(RIMTBL,"VITALSNODATE")
+      D APUSH(RIMTBL,"MEDS")
+      D APUSH(RIMTBL,"MEDSCODE")
+      D APUSH(RIMTBL,"MEDSNOCODE")
+      D APUSH(RIMTBL,"MEDSDATE")
+      D APUSH(RIMTBL,"MEDSNODATE")
+      Q
+      ;
+APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
+    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
+    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
+    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
+    N USETBL
+    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
+    . W "ERROR NO SUCH TABLE",!
+    S USETBL=@RIMBASE@("TABLES",PTBL)
+    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
+    Q
+GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
+    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
+    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
+    ; IN SECTION "MEDS"
+    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
+    ; PENDING FOR MED 2 FOR PATIENT 2
+    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
+    ; RETURNED. RTN IS PASSED BY REFERENCE
+    ;
+    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
+    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
+    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
+    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
+    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
+    N ZZI,ZZS
+    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
+    ; ZWR @ZZS@(1)
+    S RTN(0)=@ZZS@(0)
+    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
+    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
+    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
+    Q
+    ;
+PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
+    ;
+    N ZR
+    D GETPA(.ZR,DFN,ISEC,IVAR)
+    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
+    E  W "NOTHING RETURNED",!
+    Q
+    ;
+CAGET(RTN,IATTR) ;
+    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
+    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
+    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
+    Q
+    ;
+PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
+    ;
+    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
+    N ZLST
+    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
+    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
+    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
+    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
+    S ZNC=@ZCBASE@(0)
+    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
+    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
+    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
+    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
+    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
+    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
+    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
+    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
+    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
+    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
+    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
+    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
+    . S ZCNT=ZCNT+1
+    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
+    Q
+    ;
+DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
+    ;
+    N ZR
+    D PCLST(.ZR,CATTR)
+    I ZR(0)=0 D  Q  ;
+    . W "NO PATIENTS RETURNED",!
+    E  D  ;
+    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
+    . W "COUNT=",ZR(0),!
+    Q
+    ;
+RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
+    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
+    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
+    ; DFN IS THE PATIENT NUMBER.
+    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
+    ; OR OTHER SECTIONS AS THEY ARE ADDED
+    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
+    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
+    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
+    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
+    N ZZGI
+    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
+    . F ZZGI="PROBLEMS","VITALS","MEDS" D  ; FOR EACH SECTION
+    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
+    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
+    Q
+    ;
+ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
+    ;
+    N ZZGN ; NAME FOR SECTION VARIABLES
+    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
+    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
+    E  D  ; VARS EXIST
+    . N ZGVI
+    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
+    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
+    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
+    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
+    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
+    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
+    . . ; D PARY^GPLXPATH("ZZGA")
+    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
+    Q
+    ;
+DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
+    ; ALONG WITH SAMPLE VALUES.
+    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
+    N GTMP
+    D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
+    I '$D(IWHICH) S IWHICH="ALL"
+    D RPCGV(.GTMP,DFN,IWHICH)
+    D PARY^GPLXPATH("GTMP")
+    Q
+    ;
Index: ccr/tags/CCR_1_0_4/p/GPLUNIT.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLUNIT.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLUNIT.m	(revision 169)
@@ -0,0 +1,156 @@
+GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
+ ;;0.1;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+          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
+          ;
+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
+          ;
+ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+          N ZI,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  Q ; TEST SECTION DOESN'T EXIST
+          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+          N FIRST,LAST
+          S FIRST=$P(ZARY(WHICH),"^",1)
+          S LAST=$P(ZARY(WHICH),"^",2)
+          F ZI=FIRST:1:LAST  D
+          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+          . . ;  W ZP,!
+          . . S ZX=ZP
+          . . W "RUNNING: "_ZP
+          . . X ZX
+          . . W "..SUCCESS: ",WHICH,!
+          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
+          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
+          . . 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!",!
+          ; I DEBUG 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
+          ;
+TESTALL(RNM) ; RUN ALL THE TESTS
+          N ZI,J,TZTMP,TSTS,TOTP,TOTF
+          S TOTP=0 S TOTF=0
+          D ZLOAD^GPLUNIT("TZTMP",RNM)
+          D GTSTS(.TZTMP,"TSTS")
+          F ZI=1:1:TSTS(0) D  ;
+          . S TPASSED=0 S TFAILED=0
+          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
+          . S TOTP=TOTP+TPASSED
+          . S TOTF=TOTF+TFAILED
+          . S $P(TSTS(ZI),"^",2)=TPASSED
+          . S $P(TSTS(ZI),"^",3)=TFAILED
+          F I=1:1:TSTS(0) D  ;
+          . W "TEST=> ",$P(TSTS(ZI),"^",1)
+          . W " PASSED=>",$P(TSTS(ZI),"^",2)
+          . W " FAILED=>",$P(TSTS(ZI),"^",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
+          ;
Index: ccr/tags/CCR_1_0_4/p/GPLVITAL.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLVITAL.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLVITAL.m	(revision 169)
@@ -0,0 +1,197 @@
+GPLVITAL ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+          ;;0.1;CCDCCR;;JUL 16,2008;
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+          ;General Public License See attached copy of the License.
+          ;
+          ;This program is free software; you can redistribute it and/or modify
+          ;it under the terms of the GNU General Public License as published by
+          ;the Free Software Foundation; either version 2 of the License, or
+          ;(at your option) any later version.
+          ;
+          ;This program is distributed in the hope that it will be useful,
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+          ;GNU General Public License for more details.
+          ;
+          ;You should have received a copy of the GNU General Public License along
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+          ;
+          W "NO ENTRY FROM TOP",!
+          Q
+          ;
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+          ;
+          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+          ; IVITXML CONTAINS ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+          ;
+          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF,VORDR
+          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+          I '$D(VITRSLT(1)) S @VITOUTXML@(0)=0 Q  ; RETURN NOT FOUND AND QUIT
+          I $P(VITRSLT(1),U,2)="No vitals found." D  Q  ; NULL RESULT FROM RPC
+          . I DEBUG W "NO VITALS FOUND FROM VITALS RPC",!
+          . S @VITOUTXML@(0)=0
+          I $P(VITRSLT(1),U,2)="No vitals found." Q  ; QUIT
+          ; ZWR RPCRSLT
+          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
+          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
+          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+          N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
+          D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
+          ; I DEBUG ZWR VDATES ;DEBUG
+          S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
+          ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
+          S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
+          F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
+          . I $D(VITRSLT(VSORT(J))) D
+          . . S VITVMAP=$NA(@VITTVMAP@(J))
+          . . K @VITVMAP
+          . . I DEBUG W "VMAP= ",VITVMAP,!
+          . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
+          . . I DEBUG W "VITAL ",VSORT(J),!
+          . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
+          . . I DEBUG W $P(VITPTMP,U,4),!
+          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
+          . . I $P(VITPTMP,U,2)="HT" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+          . . 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")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+          . . E  I $P(VITPTMP,U,2)="BP" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . E  I $P(VITPTMP,U,2)="T" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+          . . E  I $P(VITPTMP,U,2)="R" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . E  I $P(VITPTMP,U,2)="P" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . E  I $P(VITPTMP,U,2)="PN" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . 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")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+          . . 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)
+          . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
+          . . 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
+          I DEBUG D PARY^GPLXPATH(VITOUTXML)
+          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
+          ;
+VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+         ; OF DATES IN THE VITALS RESULTS
+         N VDTI,VDTJ,VTDCNT
+         S VTDCNT=0 ; COUNT TO BUILD ARRAY
+         S VDTJ="" ; USED TO VISIT THE RESULTS
+         F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
+         . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
+         . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
+         . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
+         Q
+         ;
Index: ccr/tags/CCR_1_0_4/p/GPLXPAT0.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLXPAT0.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLXPAT0.m	(revision 169)
@@ -0,0 +1,212 @@
+GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
+ ;;0.2;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+        W "NO ENTRY",!
+        Q
+        ;
+ ;;><TEST>
+ ;;><INIT>
+ ;;>>>K GPL S GPL=""
+ ;;>>>D PUSH^GPLXPATH("GPL","FIRST")
+ ;;>>>D PUSH^GPLXPATH("GPL","SECOND")
+ ;;>>>D PUSH^GPLXPATH("GPL","THIRD")
+ ;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
+ ;;>>?GPL(0)=4
+ ;;><INITXML>
+ ;;>>>K GXML S GXML=""
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
+ ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+ ;;><INITXML2>
+ ;;>>>K GXML S GXML=""
+ ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
+ ;;>>>D PUSH^GPLXPATH("GXML","DATA2")
+ ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
+ ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
+ ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
+ ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
+ ;;><PUSHPOP>
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+ ;;>>?GPL(GPL(0))="FOURTH"
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+ ;;>>?GX="FOURTH"
+ ;;>>?GPL(GPL(0))="THIRD"
+ ;;>>>D POP^GPLXPATH("GPL",.GX)
+ ;;>>?GX="THIRD"
+ ;;>>?GPL(GPL(0))="SECOND"
+ ;;><MKMDX>
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
+ ;;>>>S GX=""
+ ;;>>>D MKMDX^GPLXPATH("GPL",.GX)
+ ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
+ ;;><XNAME>
+ ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
+ ;;>>?$$XNAME^GPLXPATH("<SIXTH  ID=""SELF"" />")="SIXTH"
+ ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
+ ;;><INDEX>
+ ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+ ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
+ ;;>>>D INDEX^GPLXPATH("GXML")
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
+ ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+ ;;>>?GXML("//FIRST")="1^13"
+ ;;><INDEX2>
+ ;;>>>D ZTEST^GPLXPATH("INITXML2")
+ ;;>>>D INDEX^GPLXPATH("GXML")
+ ;;>>?GXML("//FIRST/SECOND")="2^12"
+ ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
+ ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
+ ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
+ ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
+ ;;>>?GXML("//FIRST")="1^13"
+ ;;><MISSING>
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
+ ;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
+ ;;>>?@OUTARY@(1)="DATA1"
+ ;;>>?@OUTARY@(2)="DATA2"
+ ;;><MAP>
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+ ;;>>?@OUTARY@(6)="VALUE2"
+ ;;><MAP2>
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
+ ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
+ ;;>>>S @MAPARY@("DATA1")="VALUE1"
+ ;;>>>S @MAPARY@("DATA2")="VALUE2"
+ ;;>>>S @MAPARY@("DATA3")="VALUE3"
+ ;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
+ ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
+ ;;>>>D PARY^GPLXPATH(OUTARY)
+ ;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
+ ;;><QUEUE>
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
+ ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
+ ;;>>?$P(BTLIST(2),";",2)=4
+ ;;><BUILD>
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
+ ;;>>>D ZTEST^GPLXPATH("QUEUE")
+ ;;>>>D BUILD^GPLXPATH("BTLIST","G3")
+ ;;><CP>
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D CP^GPLXPATH("GXML","G2")
+ ;;>>?G2(0)=13
+ ;;><QOPEN>
+ ;;>>>K G2,GBL
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
+ ;;>>?$P(GBL(1),";",3)=12
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+ ;;>>?G2(G2(0))="</SECOND>"
+ ;;><QOPEN2>
+ ;;>>>K G2,GBL
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
+ ;;>>?$P(GBL(1),";",3)=11
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+ ;;>>?G2(G2(0))="</SECOND>"
+ ;;><QCLOSE>
+ ;;>>>K G2,GBL
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
+ ;;>>?$P(GBL(1),";",3)=13
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+ ;;>>?G2(G2(0))="</FIRST>"
+ ;;><QCLOSE2>
+ ;;>>>K G2,GBL
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
+ ;;>>?$P(GBL(1),";",3)=13
+ ;;>>>D BUILD^GPLXPATH("GBL","G2")
+ ;;>>?G2(G2(0))="</FIRST>"
+ ;;>>?G2(1)="</THIRD>"
+ ;;><INSERT>
+ ;;>>>K G2,GBL,G3,G4
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+ ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+ ;;>>>D INSERT^GPLXPATH("G3","G2","//")
+ ;;>>?G2(1)=GXML(9)
+ ;;><REPLACE>
+ ;;>>>K G2,GBL,G3
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
+ ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
+ ;;>>?GXML(2)="<FIFTH>"
+ ;;><INSINNER>
+ ;;>>>K GXML,G2,GBL,G3
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+ ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+ ;;>>?GXML(10)="<FIFTH>"
+ ;;><INSINNER2>
+ ;;>>>K GXML,G2,GBL,G3
+ ;;>>>D ZTEST^GPLXPATH("INITXML")
+ ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
+ ;;>>>D INSINNER^GPLXPATH("G2","G2")
+ ;;>>?G2(8)="<FIFTH>"
+ ;;><PUSHA>
+ ;;>>>K GTMP,GTMP2
+ ;;>>>N GTMP,GTMP2
+ ;;>>>D PUSH^GPLXPATH("GTMP","A")
+ ;;>>>D PUSH^GPLXPATH("GTMP2","B")
+ ;;>>>D PUSH^GPLXPATH("GTMP2","C")
+ ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
+ ;;>>?GTMP(3)="C"
+ ;;>>?GTMP(0)=3
+ ;;><H2ARY>
+ ;;>>>K GTMP,GTMP2
+ ;;>>>S GTMP("TEST1")=1
+ ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
+ ;;>>?GTMP2(0)=1
+ ;;>>?GTMP2(1)="TEST1^1"
+ ;;><XVARS>
+ ;;>>>K GTMP,GTMP2
+ ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
+ ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
+ ;;>>?GTMP2(1)="VAR1^"
+ ;;></TEST>
Index: ccr/tags/CCR_1_0_4/p/GPLXPATH.m
===================================================================
--- ccr/tags/CCR_1_0_4/p/GPLXPATH.m	(revision 169)
+++ ccr/tags/CCR_1_0_4/p/GPLXPATH.m	(revision 169)
@@ -0,0 +1,482 @@
+GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
+ ;;0.2;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ ;
+ W "This is an XML XPATH utility library",!
+ W !
+ Q
+ ;
+OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+ ;
+ N Y
+ S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
+ I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
+ I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
+ Q
+ ;
+PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+ ;  VAL IS A STRING AND STK IS PASSED BY NAME
+ ;
+ I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
+ S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
+ S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
+ Q
+ ;
+POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+ ; VAL AND STK ARE PASSED BY REFERENCE
+ ;
+ I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
+ . S VAL=""
+ . S @STK@(0)=0
+ I @STK@(0)>0  D  ;
+ . S VAL=@STK@(@STK@(0))
+ . K @STK@(@STK@(0))
+ . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
+ Q
+ ;
+PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
+ ;
+ N ZGI
+ F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
+ . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
+ Q
+ ;
+MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+ ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
+ S RTN=""
+ N I
+ ; W "STK= ",STK,!
+ I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
+ . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
+ . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
+ . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
+ Q
+ ;
+XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+ ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
+ ; ISTR IS PASSED BY VALUE
+ N CUR,TMP
+ I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
+ . S TMP=$P(ISTR,"<",2)
+ I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
+ . S TMP=$P(TMP,"/",2)
+ S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
+ ; W "CUR= ",CUR,!
+ I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
+ . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
+ ; W "CUR2= ",CUR,!
+ Q CUR
+ ;
+INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
+ ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
+ ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
+ ; XML SECTION
+ ; ZXML IS PASSED BY NAME
+ N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
+ N GPLSTK ; LEAVE OUT FOR DEBUGGING
+ I '$D(@ZXML@(0))  D  ; NO XML PASSED
+ . W "ERROR IN XML FILE",!
+ S GPLSTK(0)=0 ; INITIALIZE STACK
+ F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
+ . S LINE=@ZXML@(I)
+ . ;W LINE,!
+ . S FOUND=0  ; INTIALIZED FOUND FLAG
+ . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
+ . I FOUND'=1  D
+ . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
+ . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
+ . . . ; ON THE SAME LINE
+ . . . ; W "FOUND ",LINE,!
+ . . . S FOUND=1  ; SET FOUND FLAG
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+ . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+ . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+ . . . ; W "MDX=",MDX,!
+ . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+ . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+ . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+ . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
+ . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+ . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
+ . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
+ . . . ; W "FOUND ",LINE,!
+ . . . S FOUND=1  ; SET FOUND FLAG
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+ . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+ . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+ . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
+ . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
+ . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
+ . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
+ . . . . Q
+ . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
+ . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
+ . . . ; W "FOUND ",LINE,!
+ . . . S FOUND=1  ; SET FOUND FLAG
+ . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
+ . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
+ . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
+ . . . ; W "MDX=",MDX,!
+ . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
+ . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
+ . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
+ . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
+ S @ZXML@("INDEXED")=""
+ S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
+ Q
+ ;
+QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+ ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
+ ; IARY AND OARY ARE PASSED BY NAME
+ I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
+ . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
+ N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
+ N TMP,I,J,QXPATH
+ S FIRST=1
+ S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
+ I XPATH'="//" D  ; NOT A ROOT QUERY
+ . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
+ . S FIRST=$P(TMP,"^",1)
+ . S LAST=$P(TMP,"^",2)
+ K @OARY
+ S @OARY@(0)=+LAST-FIRST+1
+ S J=1
+ FOR I=FIRST:1:LAST  D
+ . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
+ . S J=J+1
+ ; ZWR OARY
+ Q
+ ;
+XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+ ; INDEX WITH TWO PIECES START^FINISH
+ ; IDX IS PASSED BY NAME
+ Q $P(@IDX@(XPATH),"^",1)
+ ;
+XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+ ; INDEX WITH TWO PIECES START^FINISH
+ ; IDX IS PASSED BY NAME
+ Q $P(@IDX@(XPATH),"^",2)
+ ;
+START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+ ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+ ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
+ Q $P(ISTR,";",2)
+ ;
+FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+ ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+ Q $P(ISTR,";",3)
+ ;
+ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+ ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
+ Q $P(ISTR,";",1)
+ ;
+BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+ ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
+ ; DEST IS CLEARED TO START
+ ; USES PUSH TO DO THE COPY
+ N I
+ K @BDEST
+ F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
+ . N J,ATMP
+ . S ATMP=$$ARRAY(@BLIST@(I))
+ . I DEBUG W "ATMP=",ATMP,!
+ . I DEBUG W @BLIST@(I),!
+ . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
+ . . ; FOR EACH LINE IN THIS INSTR
+ . . I DEBUG W "BDEST= ",BDEST,!
+ . . I DEBUG W "ATMP= ",@ATMP@(J),!
+ . . D PUSH(BDEST,@ATMP@(J))
+ Q
+ ;
+QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+ ;
+ I DEBUG W "QUEUEING ",BLST,!
+ D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
+ Q
+ ;
+CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+ ; KILLS CPDEST FIRST
+ N CPINSTR
+ I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
+ I @CPSRC@(0)<1 D  ; BAD LENGTH
+ . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
+ . Q
+ ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
+ D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
+ D BUILD("CPINSTR",CPDEST)
+ Q
+ ;
+QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+ ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
+ ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
+ ; USED TO INSERT CHILDREN NODES
+ I @QOXML@(0)<1 D  ; MALFORMED XML
+ . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
+ . Q
+ I DEBUG W "DOING QOPEN",!
+ N S1,E1,QOT,QOTMP
+ S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
+ I $D(QOXPATH) D  ; XPATH PROVIDED
+ . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
+ . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
+ I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+ . S E1=@QOXML@(0)-1
+ D QUEUE(QOBLIST,QOXML,S1,E1)
+ ; S QOTMP=QOXML_"^"_S1_"^"_E1
+ ; D PUSH(QOBLIST,QOTMP)
+ Q
+ ;
+QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+ ; ADDS THE LIST LINE OF QCXML TO QCBLIST
+ ; USED TO FINISH INSERTING CHILDERN NODES
+ ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
+ ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
+ I @QCXML@(0)<1 D  ; MALFORMED XML
+ . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
+ I DEBUG W "GOING TO CLOSE",!
+ N S1,E1,QCT,QCTMP
+ S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
+ I $D(QCXPATH) D  ; XPATH PROVIDED
+ . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
+ . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
+ I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+ . S S1=@QCXML@(0)
+ D QUEUE(QCBLIST,QCXML,S1,E1)
+ ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
+ Q
+ ;
+INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+ ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
+ ; OMITTED, INSERTION WILL BE AT THE ROOT
+ ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
+ ; XML AT THE END OF THE XPATH POINT
+ ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
+ N INSBLD,INSTMP
+ I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
+ I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
+ I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
+ . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
+ I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
+ . I $D(INSXPATH) D  ; XPATH PROVIDED
+ . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
+ . . I DEBUG D PARY^GPLXPATH("INSBLD")
+ . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
+ . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
+ . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
+ . I $D(INSXPATH) D  ; XPATH PROVIDED
+ . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
+ . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
+ . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
+ . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+ . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
+ Q
+ ;
+INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+ ; INTO INNXML AT THE INNXPATH XPATH POINT
+ ;
+ N INNBLD,UXPATH
+ N INNTBUF
+ S INNTBUF=$NA(^TMP($J,"INNTBUF"))
+ I '$D(INNXPATH) D  ; XPATH NOT PASSED
+ . S UXPATH="//" ; USE ROOT XPATH
+ I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
+ I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
+ . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
+ . D BUILD("INNBLD",INNXML)
+ I @INNXML@(0)>0  D  ; NOT EMPTY
+ . D QOPEN("INNBLD",INNXML,UXPATH) ;
+ . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
+ . D QCLOSE("INNBLD",INNXML,UXPATH)
+ . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
+ . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
+ Q
+ ;
+INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+ ; BUT XDEST AN XNEW ARE PASSED BY NAME
+ N XBLD,XTMP
+ D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
+ D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
+ D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
+ D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+ D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
+ I DEBUG D PARY("XDEST")
+ Q
+ ;
+REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+ ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
+ ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
+ ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
+ N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
+ S OLD=$NA(^TMP($J,"REPLACE_OLD"))
+ D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
+ S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
+ S XFIRST=$P(XNODE,"^",1)
+ S XLAST=$P(XNODE,"^",2)
+ I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
+ . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
+ . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
+ I RENEW'="" D  ; NEW XML IS NOT NULL
+ . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
+ . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
+ . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
+ I DEBUG W "REPLACE PREBUILD",!
+ I DEBUG D PARY("REBLD")
+ D BUILD("REBLD","RTMP")
+ K @REXML ; KILL WHAT WAS THERE
+ D CP("RTMP",REXML) ; COPY IN THE RESULT
+ Q
+ ;
+MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+ ; W "Reporting on the missing",!
+ ; W OARY
+ I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
+ N I
+ S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
+ F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+ . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
+ . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
+ . . Q
+ Q
+ ;
+MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+ ; AND PUT THE RESULTS IN OXML
+ I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
+ I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
+ N I,J,TNAM,TVAL,TSTR
+ S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
+ F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
+ . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
+ . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
+ . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
+ . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
+ . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
+ . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
+ . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
+ . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
+ . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
+ . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
+ . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
+ . . I DEBUG W TSTR
+ I DEBUG W "MAPPED",!
+ Q
+ ;
+TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+ ; THEXML IS PASSED BY NAME
+ N I,J,TMPXML,DEL,FOUND,INTXT
+ S FOUND=0
+ S INTXT=0
+ I DEBUG W "DELETING EMPTY ELEMENTS",!
+ F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
+ . S J=@THEXML@(I)
+ . I J["<text>" D
+ . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
+ . . I DEBUG W "IN HTML SECTION",!
+ . N JM,JP,JPX ; JMINUS AND JPLUS
+ . S JM=@THEXML@(I-1) ; LINE BEFORE
+ . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
+ . S JP=@THEXML@(I+1) ; LINE AFTER
+ . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
+ . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
+ . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
+ . . . I DEBUG W I,J,JP,!
+ . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+ . . . S DEL(I)="" ; SET LINE TO DELETE
+ . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
+ . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
+ . . . I DEBUG W I,J,!
+ . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
+ . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
+ . . . I JM=JPX D  ;
+ . . . . I DEBUG W I,JM_J_JPX,!
+ . . . . S DEL(I-1)=""
+ . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
+ ; . I J'["><" D PUSH("TMPXML",J)
+ I FOUND D  ; NEED TO DELETE THINGS
+ . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
+ . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
+ . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
+ . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
+ Q FOUND
+ ;
+UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+ ; XSEC IS A SECTION PASSED BY NAME
+ N XBLD,XTMP
+ D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
+ D BUILD("XBLD","XTMP") ; BUILD THE RESULT
+ D CP("XTMP",XSEC) ; REPLACE PASSED XML
+ Q
+ ;
+PARY(GLO)       ;PRINT AN ARRAY
+ N I
+ F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
+ Q
+ ;
+H2ARY(IARYRTN,IHASH) ; CONVERT IHASH TO RETURN ARRAY
+ ;
+ N H2I S H2I=""
+ ; W $O(@IHASH@(H2I)),!
+ F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
+ . ; W H2I_"^"_@IHASH@(H2I),!
+ . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
+ . ; W @IARYRTN@(0),!
+ Q
+ ;
+XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
+ ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
+ ; XVRTN AND XVIXML ARE PASSED BY NAME
+ ;
+ N XVI,XVTMP,XVT
+ F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
+ . S XVT=@XVIXML@(XVI)
+ . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
+ D H2ARY(XVRTN,"XVTMP")
+ Q
+ ;
+DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
+ ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
+ ;
+ N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
+ I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
+ . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
+ . S DXUSE="DTMP" ; DXUSE IS NAME
+ E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
+ . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
+ . S DXUSE="DTMP" ; DXUSE IS NAME
+ E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
+ N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
+ D XVARS("DVARS",DXUSE) ; PULL OUT VARS
+ D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
+ Q
+ ;
+TEST     ; Run all the test cases
+ D TESTALL^GPLUNIT("GPLXPAT0")
+ Q
+ ;
+ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+ N ZTMP
+ S DEBUG=1
+ D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+ D ZTEST^GPLUNIT(.ZTMP,WHICH)
+ Q
+ ;
+TLIST   ; LIST THE TESTS
+ N ZTMP
+ D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
+ D TLIST^GPLUNIT(.ZTMP)
+ Q
+ ;
