Index: ccr/tags/CCR_1_0_7/p/CCR_1_0_1_T2_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_1_T2_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,8916 +1,0 @@
-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_7/p/CCR_1_0_1_T2_GTM.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_1_T2_GTM.KID	(revision 289)
+++ 	(revision )
@@ -1,8916 +1,0 @@
-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_7/p/CCR_1_0_2_T1_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_2_T1_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,8916 +1,0 @@
-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_7/p/CCR_1_0_2_T2_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_2_T2_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,8916 +1,0 @@
-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_7/p/CCR_1_0_3_T1_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_3_T1_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,9130 +1,0 @@
-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_7/p/CCR_1_0_4_T1_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_4_T1_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,9714 +1,0 @@
-KIDS Distribution saved on Sep 23, 2008@11:41:51
-First tagged release of CCR package
-**KIDS**:CCR*1.0*4^
-
-**INSTALL NAME**
-CCR*1.0*4
-"BLD",6955,0)
-CCR*1.0*4^^0^3080923^n
-"BLD",6955,1,0)
-^^23^23^3080923^
-"BLD",6955,1,1,0)
- 
-"BLD",6955,1,2,0)
-CCR AND CCD EXPORT TOOLS 
-"BLD",6955,1,3,0)
- 
-"BLD",6955,1,4,0)
-SINGLE XML EXPORT TO A HOST DIRECTORY AT 
-"BLD",6955,1,5,0)
- 
-"BLD",6955,1,6,0)
-BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
-"BLD",6955,1,7,0)
-DIRECTORY
-"BLD",6955,1,8,0)
- 
-"BLD",6955,1,9,0)
-EXPORT^GPLCRR FOR THE CCR
-"BLD",6955,1,10,0)
-EXPORT^GPLCCD FOR THE CCD
-"BLD",6955,1,11,0)
-XPAT^GPLCCR(DFN,"","") 
-"BLD",6955,1,12,0)
- 
-"BLD",6955,1,13,0)
-BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
-"BLD",6955,1,14,0)
- 
-"BLD",6955,1,15,0)
-ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
-"BLD",6955,1,16,0)
-RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
-"BLD",6955,1,17,0)
-ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
-"BLD",6955,1,18,0)
- 
-"BLD",6955,1,19,0)
-CLIST^GPLRIMA TO LIST CATEGORY TOTALS
-"BLD",6955,1,20,0)
-CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
-"BLD",6955,1,21,0)
-XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
-"BLD",6955,1,22,0)
- 
-"BLD",6955,1,23,0)
-TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
-"BLD",6955,4,0)
-^9.64PA^^
-"BLD",6955,6.3)
-7
-"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^B71426320
-"BLD",6955,"KRN",9.8,"NM",4,0)
-CCRSYS^^0^B5866233
-"BLD",6955,"KRN",9.8,"NM",5,0)
-CCRUNIT^^0^B8574
-"BLD",6955,"KRN",9.8,"NM",6,0)
-CCRUTIL^^0^B19506955
-"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^B234894534
-"BLD",6955,"KRN",9.8,"NM",10,0)
-GPLUNIT^^0^B31438520
-"BLD",6955,"KRN",9.8,"NM",11,0)
-GPLPROBS^^0^B25875394
-"BLD",6955,"KRN",9.8,"NM",12,0)
-GPLVITAL^^0^B99833868
-"BLD",6955,"KRN",9.8,"NM",13,0)
-GPLRIMA^^0^B212485446
-"BLD",6955,"KRN",9.8,"NM",14,0)
-GPLCCR^^0^B82153553
-"BLD",6955,"KRN",9.8,"NM",15,0)
-GPLCCR0^^0^B654252455
-"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^B55630630
-"BLD",6955,"KRN",9.8,"NM",19,0)
-GPLXPAT0^^0^B50983429
-"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 7
-"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 7
-"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^B71426320
-"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 7
-"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(MINXML,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)
-          ; D PARY^GPLXPATH(MINXML)
-"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)
-          N MEDCOUNT S MEDCOUNT=0
-"RTN","CCRMEDS",48,0)
-          F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS",49,0)
-          . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS",50,0)
-          . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS",51,0)
-          . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS",52,0)
-          . K @MAP
-"RTN","CCRMEDS",53,0)
-          . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS",54,0)
-          . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","CCRMEDS",55,0)
-          . S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
-"RTN","CCRMEDS",56,0)
-          . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","CCRMEDS",57,0)
-          . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
-"RTN","CCRMEDS",58,0)
-          . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-"RTN","CCRMEDS",59,0)
-          . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
-"RTN","CCRMEDS",60,0)
-          . S @MAP@("MEDRXNOTXT")="Prescription Number"
-"RTN","CCRMEDS",61,0)
-          . S @MAP@("MEDRXNO")=MED(.01)
-"RTN","CCRMEDS",62,0)
-          . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS",63,0)
-          . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS",64,0)
-          . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
-"RTN","CCRMEDS",65,0)
-          . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
-"RTN","CCRMEDS",66,0)
-          . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
-"RTN","CCRMEDS",67,0)
-          . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
-"RTN","CCRMEDS",68,0)
-          . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS",69,0)
-          . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
-"RTN","CCRMEDS",70,0)
-          . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
-"RTN","CCRMEDS",71,0)
-          . N MEDIEN S MEDIEN=$P(MED(6),U)
-"RTN","CCRMEDS",72,0)
-          . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS",73,0)
-          . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS",74,0)
-          . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","CCRMEDS",75,0)
-          . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","CCRMEDS",76,0)
-          . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS",77,0)
-          . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS",78,0)
-          . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS",79,0)
-          . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS",80,0)
-          . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS",81,0)
-          . ; Documented in the same manual.
-"RTN","CCRMEDS",82,0)
-          . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS",83,0)
-          . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS",84,0)
-          . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS",85,0)
-          . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS",86,0)
-          . N CONCDATA
-"RTN","CCRMEDS",87,0)
-          . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS",88,0)
-          . ; and this will crash the call. So...
-"RTN","CCRMEDS",89,0)
-          . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS",90,0)
-          . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS",91,0)
-          . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","CCRMEDS",92,0)
-          . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","CCRMEDS",93,0)
-          . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","CCRMEDS",94,0)
-          . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
-"RTN","CCRMEDS",95,0)
-          . S @MAP@("MEDQUANTITYVALUE")=MED(7)
-"RTN","CCRMEDS",96,0)
-          . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS",97,0)
-          . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS",98,0)
-          . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS",99,0)
-          . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS",100,0)
-          . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS",101,0)
-          . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS",102,0)
-          . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS",103,0)
-          . ;
-"RTN","CCRMEDS",104,0)
-          . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS",105,0)
-          . ;
-"RTN","CCRMEDS",106,0)
-          . S @MAP@("MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","CCRMEDS",107,0)
-          . S @MAP@("MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","CCRMEDS",108,0)
-          . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-"RTN","CCRMEDS",109,0)
-          . ; we want the compoenents.
-"RTN","CCRMEDS",110,0)
-          . ; It's in node 6 of ^PSRX(IEN)
-"RTN","CCRMEDS",111,0)
-          . ; So, here we go again
-"RTN","CCRMEDS",112,0)
-          . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
-"RTN","CCRMEDS",113,0)
-          . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
-"RTN","CCRMEDS",114,0)
-          . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
-"RTN","CCRMEDS",115,0)
-          . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
-"RTN","CCRMEDS",116,0)
-          . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,1,0)
-"RTN","CCRMEDS",117,0)
-          . S @MAP@("MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
-"RTN","CCRMEDS",118,0)
-          . S @MAP@("MEDDOSEVALUE")=$P(SIGDATA,U,1)
-"RTN","CCRMEDS",119,0)
-          . S @MAP@("MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","CCRMEDS",120,0)
-          . S @MAP@("MEDRATEVALUE")=""  ; For inpatient
-"RTN","CCRMEDS",121,0)
-          . S @MAP@("MEDRATEUNIT")=""  ; For inpatient
-"RTN","CCRMEDS",122,0)
-          . S @MAP@("MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","CCRMEDS",123,0)
-          . S @MAP@("MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
-"RTN","CCRMEDS",124,0)
-          . S @MAP@("MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
-"RTN","CCRMEDS",125,0)
-          . ; Invervals... again another call.
-"RTN","CCRMEDS",126,0)
-          . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","CCRMEDS",127,0)
-          . ; However, it gets translated by a call to the administration schedule file
-"RTN","CCRMEDS",128,0)
-          . ; to see if that schedule exists.
-"RTN","CCRMEDS",129,0)
-          . ; That's the same thing I am going to do.
-"RTN","CCRMEDS",130,0)
-          . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","CCRMEDS",131,0)
-          . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","CCRMEDS",132,0)
-          . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
-"RTN","CCRMEDS",133,0)
-          . ; So...
-"RTN","CCRMEDS",134,0)
-          . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
-"RTN","CCRMEDS",135,0)
-          . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","CCRMEDS",136,0)
-          . N INTERVAL
-"RTN","CCRMEDS",137,0)
-          . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","CCRMEDS",138,0)
-          . E  D
-"RTN","CCRMEDS",139,0)
-          . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","CCRMEDS",140,0)
-          . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","CCRMEDS",141,0)
-          . S @MAP@("MEDINTERVALVALUE")=INTERVAL
-"RTN","CCRMEDS",142,0)
-          . S @MAP@("MEDINTERVALUNIT")="Minute"
-"RTN","CCRMEDS",143,0)
-          . S @MAP@("MEDDURATIONVALUE")=$P(SIGDATA,U,5)
-"RTN","CCRMEDS",144,0)
-          . S @MAP@("MEDDURATIONUNIT")=""
-"RTN","CCRMEDS",145,0)
-          . S @MAP@("MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
-"RTN","CCRMEDS",146,0)
-          . S @MAP@("MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS",147,0)
-          . S @MAP@("MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS",148,0)
-          . S @MAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS",149,0)
-          . S @MAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS",150,0)
-          . S @MAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS",151,0)
-          . S @MAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS",152,0)
-          . S @MAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS",153,0)
-          . S @MAP@("MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS",154,0)
-          . S @MAP@("MEDDIRSEQ")=""
-"RTN","CCRMEDS",155,0)
-          . S @MAP@("MEDMULDIRMOD")=""
-"RTN","CCRMEDS",156,0)
-          . ;
-"RTN","CCRMEDS",157,0)
-          . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS",158,0)
-          . ;
-"RTN","CCRMEDS",159,0)
-          . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
-"RTN","CCRMEDS",160,0)
-          . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
-"RTN","CCRMEDS",161,0)
-          . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
-"RTN","CCRMEDS",162,0)
-          . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
-"RTN","CCRMEDS",163,0)
-          . S @MAP@("MEDRFNO")=MED(9)
-"RTN","CCRMEDS",164,0)
-          . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"RESULT"))
-"RTN","CCRMEDS",165,0)
-          . K @RESULT
-"RTN","CCRMEDS",166,0)
-          . ; D MAP^GPLXPATH($NA(INXML),MAP,RESULT)
-"RTN","CCRMEDS",167,0)
-          . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS",168,0)
-          . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS",169,0)
-          . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS",170,0)
-          . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","CCRMEDS",171,0)
-          N MEDTMP,MEDI
-"RTN","CCRMEDS",172,0)
-          D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS",173,0)
-          I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS",174,0)
-          . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS",175,0)
-          . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS",176,0)
-          Q
-"RTN","CCRMEDS",177,0)
-          ;
-"RTN","CCRSYS")
-0^4^B5866233
-"RTN","CCRSYS",1,0)
-CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
-"RTN","CCRSYS",2,0)
-        ;;0.1;CCDCCR;;;Build 7
-"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 DFN="" Q 0  ; BAD DFN PASSED
-"RTN","CCRSYS",41,0)
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","CCRSYS",42,0)
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","CCRSYS",43,0)
-         ;
-"RTN","CCRSYS",44,0)
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","CCRSYS",45,0)
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","CCRSYS",46,0)
-         N DIERR,DATA
-"RTN","CCRSYS",47,0)
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","CCRSYS",48,0)
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","CCRSYS",49,0)
-         ; 1 = Test Patient
-"RTN","CCRSYS",50,0)
-         ; 0 = Non-test Patient
-"RTN","CCRSYS",51,0)
-         I DATA Q DATA
-"RTN","CCRSYS",52,0)
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","CCRSYS",53,0)
-         D CLEAN^DILF
-"RTN","CCRSYS",54,0)
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-"RTN","CCRSYS",55,0)
-         I $E(DATA,1,3)="000" Q 1
-"RTN","CCRSYS",56,0)
-         I $E(DATA,1,3)="666" Q 1
-"RTN","CCRSYS",57,0)
-         Q 0
-"RTN","CCRSYS",58,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 7
-"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=3
-"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)
-        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","CCRUNIT",12,0)
-        W "XPATH is: "_XPATH,!
-"RTN","CCRUNIT",13,0)
-        W "Getting Med Template into INXML using",!
-"RTN","CCRUNIT",14,0)
-        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
-"RTN","CCRUNIT",15,0)
-        D QUERY^GPLXPATH(T,XPATH,"INXML")
-"RTN","CCRUNIT",16,0)
-        B
-"RTN","CCRUNIT",17,0)
-  W "Executing EXTRACT^CCRMEDS(INXML,DFN,OUTXML)",!
-"RTN","CCRUNIT",18,0)
-        W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","CCRUNIT",19,0)
-        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","CCRUNIT",20,0)
-        D EXTRACT^CCRMEDS(.INXML,DFN,OUTXML)
-"RTN","CCRUNIT",21,0)
-        Q
-"RTN","CCRUTIL")
-0^6^B19506955
-"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 7
-"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","CCRUTIL",93,0)
-SORTDT2(V1,V2,ORDR) ; REWRITE TO USE 3 INSTEAD OF 2 LVLS OF INDEX
-"RTN","CCRUTIL",94,0)
- ; AND $Q INSTEAD OF $O
-"RTN","CCRUTIL",95,0)
- ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
-"RTN","CCRUTIL",96,0)
- ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
-"RTN","CCRUTIL",97,0)
- ; DATE AND TIME ORDER. DEFAULT IS FORWARD
-"RTN","CCRUTIL",98,0)
- ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
-"RTN","CCRUTIL",99,0)
- ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
-"RTN","CCRUTIL",100,0)
- ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
-"RTN","CCRUTIL",101,0)
- ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
-"RTN","CCRUTIL",102,0)
- ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
-"RTN","CCRUTIL",103,0)
- N VSRT ; TEMP FOR HASHING DATES
-"RTN","CCRUTIL",104,0)
- N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
-"RTN","CCRUTIL",105,0)
- S ZCNT=0 ; COUNTING NUMBER OF DATES
-"RTN","CCRUTIL",106,0)
- S ZTMP="" ;
-"RTN","CCRUTIL",107,0)
- F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH DATE IN THE ARRAY
-"RTN","CCRUTIL",108,0)
- . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","CCRUTIL",109,0)
- . S ZTMP=$O(V2(ZTMP)) ; NEXT DATE
-"RTN","CCRUTIL",110,0)
- . I $D(V2(ZTMP)) D  ; IF THE DATE EXISTS
-"RTN","CCRUTIL",111,0)
- . . S ZP1=$P(V2(ZTMP),".",1) ; THE DATE PIECE
-"RTN","CCRUTIL",112,0)
- . . S ZP2=$P(V2(ZTMP),".",2) ; THE TIME PIECE
-"RTN","CCRUTIL",113,0)
- . . S VSRT(ZP1,ZP2,ZCNT)=ZCNT ; HASH ON DATE AND TIME
-"RTN","CCRUTIL",114,0)
- . I DEBUG W "ZTMP=",ZTMP," "
-"RTN","CCRUTIL",115,0)
- S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
-"RTN","CCRUTIL",116,0)
- ; I DEBUG ZWR V2
-"RTN","CCRUTIL",117,0)
- ; I DEBUG ZWR VSRT
-"RTN","CCRUTIL",118,0)
- N ZD,ZT ; DATA AND TIME ITERATORS
-"RTN","CCRUTIL",119,0)
- N ZDONE ; DONE FLAG
-"RTN","CCRUTIL",120,0)
- S (ZD,ZT)=""
-"RTN","CCRUTIL",121,0)
- S ZDONE=0
-"RTN","CCRUTIL",122,0)
- N UORDR ; ORDER TO USE 1=FORWARD -1=REVERSE
-"RTN","CCRUTIL",123,0)
- S UORDR=ORDR ; DIRECTION TO SORT
-"RTN","CCRUTIL",124,0)
- I ORDR="" S UORDR=1
-"RTN","CCRUTIL",125,0)
- N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
-"RTN","CCRUTIL",126,0)
- F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
-"RTN","CCRUTIL",127,0)
- . S ZD=$O(VSRT(ZD),UORDR) ; NEXT DATE fix this
-"RTN","CCRUTIL",128,0)
- . I ZD="" S ZDONE=1
-"RTN","CCRUTIL",129,0)
- . I 'ZDONE D  ; MORE DATES
-"RTN","CCRUTIL",130,0)
- . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
-"RTN","CCRUTIL",131,0)
- . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),UORDR)=""  ; LOOP THROUGH ALL TIMES
-"RTN","CCRUTIL",132,0)
- . . . S ZT=$O(VSRT(ZD,ZT),UORDR) ; NEXT TIME
-"RTN","CCRUTIL",133,0)
- . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
-"RTN","CCRUTIL",134,0)
- . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
-"RTN","CCRUTIL",135,0)
- Q ZCNT
-"RTN","CCRUTIL",136,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 7
-"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 7
-"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 7
-"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 7
-"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^B82153553
-"RTN","GPLCCR",1,0)
-GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-"RTN","GPLCCR",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7
-"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)
-       I '$D(DIR) S DIR=""
-"RTN","GPLCCR",35,0)
-       I '$D(FN) S FN=""
-"RTN","GPLCCR",36,0)
-       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-"RTN","GPLCCR",37,0)
-       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
-"RTN","GPLCCR",38,0)
-       S ONAM=FN
-"RTN","GPLCCR",39,0)
-       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
-"RTN","GPLCCR",40,0)
-       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
-"RTN","GPLCCR",41,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","GPLCCR",42,0)
-       . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","GPLCCR",43,0)
-       . ;S @ODIRGLB="/home/cedwards/"
-"RTN","GPLCCR",44,0)
-       . S @ODIRGLB="/opt/wv/p/"
-"RTN","GPLCCR",45,0)
-       S ODIR=DIR
-"RTN","GPLCCR",46,0)
-       I DIR="" S ODIR=@ODIRGLB
-"RTN","GPLCCR",47,0)
-       N ZY
-"RTN","GPLCCR",48,0)
-       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-"RTN","GPLCCR",49,0)
-       W !,$P(ZY,U,2),!
-"RTN","GPLCCR",50,0)
-       Q
-"RTN","GPLCCR",51,0)
-       ;
-"RTN","GPLCCR",52,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","GPLCCR",53,0)
-    ;
-"RTN","GPLCCR",54,0)
-    N G1
-"RTN","GPLCCR",55,0)
-    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
-"RTN","GPLCCR",56,0)
-    I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","GPLCCR",57,0)
-    . D PARY^GPLXPATH(G1)
-"RTN","GPLCCR",58,0)
-    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
-"RTN","GPLCCR",59,0)
-    Q
-"RTN","GPLCCR",60,0)
-    ;
-"RTN","GPLCCR",61,0)
-CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","GPLCCR",62,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-"RTN","GPLCCR",63,0)
-    ; DFN IS PATIENT IEN
-"RTN","GPLCCR",64,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","GPLCCR",65,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","GPLCCR",66,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-"RTN","GPLCCR",67,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-"RTN","GPLCCR",68,0)
-    ; - NULL MEANS NOW
-"RTN","GPLCCR",69,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-"RTN","GPLCCR",70,0)
-    ;    "TO" VARIABLES
-"RTN","GPLCCR",71,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-"RTN","GPLCCR",72,0)
-    I '$D(DEBUG) S DEBUG=0
-"RTN","GPLCCR",73,0)
-    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","GPLCCR",74,0)
-    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","GPLCCR",75,0)
-    I '$D(TESTALERT) S TESTALERT=0 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","GPLCCR",76,0)
-    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
-"RTN","GPLCCR",77,0)
-    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","GPLCCR",78,0)
-    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","GPLCCR",79,0)
-    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","GPLCCR",80,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","GPLCCR",81,0)
-    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-"RTN","GPLCCR",82,0)
-    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","GPLCCR",83,0)
-    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","GPLCCR",84,0)
-    ;
-"RTN","GPLCCR",85,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","GPLCCR",86,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","GPLCCR",87,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",88,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",89,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","GPLCCR",90,0)
-    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","GPLCCR",91,0)
-    ;
-"RTN","GPLCCR",92,0)
-    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-"RTN","GPLCCR",93,0)
-    ;
-"RTN","GPLCCR",94,0)
-    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","GPLCCR",95,0)
-    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","GPLCCR",96,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","GPLCCR",97,0)
-    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","GPLCCR",98,0)
-    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","GPLCCR",99,0)
-    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","GPLCCR",100,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","GPLCCR",101,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","GPLCCR",102,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","GPLCCR",103,0)
-    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","GPLCCR",104,0)
-    . S IXML="INXML"
-"RTN","GPLCCR",105,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","GPLCCR",106,0)
-    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","GPLCCR",107,0)
-    . ; W OXML,!
-"RTN","GPLCCR",108,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","GPLCCR",109,0)
-    . I DEBUG W "RUNNING ",CALL,!
-"RTN","GPLCCR",110,0)
-    . X CALL
-"RTN","GPLCCR",111,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","GPLCCR",112,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-"RTN","GPLCCR",113,0)
-    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",114,0)
-    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-"RTN","GPLCCR",115,0)
-    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","GPLCCR",116,0)
-    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","GPLCCR",117,0)
-    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","GPLCCR",118,0)
-    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",119,0)
-    N TRIMI,J,DONE S DONE=0
-"RTN","GPLCCR",120,0)
-    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","GPLCCR",121,0)
-    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","GPLCCR",122,0)
-    . I DEBUG W "TRIMMED",J,!
-"RTN","GPLCCR",123,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","GPLCCR",124,0)
-    Q
-"RTN","GPLCCR",125,0)
-    ;
-"RTN","GPLCCR",126,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","GPLCCR",127,0)
-    ; TAB IS PASSED BY NAME
-"RTN","GPLCCR",128,0)
-    I DEBUG W "TAB= ",TAB,!
-"RTN","GPLCCR",129,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","GPLCCR",130,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","GPLCCR",131,0)
-    I TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",132,0)
-    I 'TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",133,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
-"RTN","GPLCCR",134,0)
-    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
-"RTN","GPLCCR",135,0)
-    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
-"RTN","GPLCCR",136,0)
-    Q
-"RTN","GPLCCR",137,0)
-    ;
-"RTN","GPLCCR",138,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","GPLCCR",139,0)
-    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
-"RTN","GPLCCR",140,0)
-    ; K @VMAP
-"RTN","GPLCCR",141,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
-"RTN","GPLCCR",142,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","GPLCCR",143,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","GPLCCR",144,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","GPLCCR",145,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","GPLCCR",146,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-"RTN","GPLCCR",147,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",148,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",149,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","GPLCCR",150,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","GPLCCR",151,0)
-    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","GPLCCR",152,0)
-    N CTMP
-"RTN","GPLCCR",153,0)
-    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-"RTN","GPLCCR",154,0)
-    D CP^GPLXPATH("CTMP",CXML)
-"RTN","GPLCCR",155,0)
-    Q
-"RTN","GPLCCR",156,0)
-    ;
-"RTN","GPLCCR",157,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","GPLCCR",158,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","GPLCCR",159,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","GPLCCR",160,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","GPLCCR",161,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","GPLCCR",162,0)
-    ;OR INSTITUTION
-"RTN","GPLCCR",163,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","GPLCCR",164,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","GPLCCR",165,0)
-    N I,J,K,L
-"RTN","GPLCCR",166,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","GPLCCR",167,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","GPLCCR",168,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","GPLCCR",169,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","GPLCCR",170,0)
-    . . I DEBUG W "<ActorID>=>",J,!
-"RTN","GPLCCR",171,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","GPLCCR",172,0)
-    . . ;  TO GET RID OF DUPLICATES
-"RTN","GPLCCR",173,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","GPLCCR",174,0)
-    F J=0:0 D  Q:$O(K(I))=""
-"RTN","GPLCCR",175,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","GPLCCR",176,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","GPLCCR",177,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","GPLCCR",178,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","GPLCCR",179,0)
-    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","GPLCCR",180,0)
-    Q
-"RTN","GPLCCR",181,0)
-    ;
-"RTN","GPLCCR",182,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","GPLCCR",183,0)
-  D TESTALL^GPLUNIT("GPLCCR")
-"RTN","GPLCCR",184,0)
-  Q
-"RTN","GPLCCR",185,0)
-  ;
-"RTN","GPLCCR",186,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","GPLCCR",187,0)
-  N ZTMP
-"RTN","GPLCCR",188,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",189,0)
-  D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLCCR",190,0)
-  Q
-"RTN","GPLCCR",191,0)
-  ;
-"RTN","GPLCCR",192,0)
-TLIST  ; LIST THE TESTS
-"RTN","GPLCCR",193,0)
-  N ZTMP
-"RTN","GPLCCR",194,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",195,0)
-  D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLCCR",196,0)
-  Q
-"RTN","GPLCCR",197,0)
-  ;
-"RTN","GPLCCR",198,0)
- ;;><TEST>
-"RTN","GPLCCR",199,0)
- ;;><PROBLEMS>
-"RTN","GPLCCR",200,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",201,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
-"RTN","GPLCCR",202,0)
- ;;>>?@GPL@(@GPL@(0))["</Problems>"
-"RTN","GPLCCR",203,0)
- ;;><VITALS>
-"RTN","GPLCCR",204,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",205,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
-"RTN","GPLCCR",206,0)
- ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
-"RTN","GPLCCR",207,0)
- ;;><CCR>
-"RTN","GPLCCR",208,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",209,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",210,0)
- ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
-"RTN","GPLCCR",211,0)
- ;;><ACTLST>
-"RTN","GPLCCR",212,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",213,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",214,0)
- ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
-"RTN","GPLCCR",215,0)
- ;;><ACTORS>
-"RTN","GPLCCR",216,0)
- ;;>>>D ZTEST^GPLCCR("ACTLST")
-"RTN","GPLCCR",217,0)
- ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","GPLCCR",218,0)
- ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
-"RTN","GPLCCR",219,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","GPLCCR",220,0)
- ;;><TRIM>
-"RTN","GPLCCR",221,0)
- ;;>>>D ZTEST^GPLCCR("CCR")
-"RTN","GPLCCR",222,0)
- ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
-"RTN","GPLCCR",223,0)
- ;;><ALERTS>
-"RTN","GPLCCR",224,0)
- ;;>>>S TESTALERT=1
-"RTN","GPLCCR",225,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",226,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
-"RTN","GPLCCR",227,0)
- ;;>>?@GPL@(@GPL@(0))["</Alerts>"
-"RTN","GPLCCR",228,0)
- 
-"RTN","GPLCCR0")
-0^15^B654252455
-"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 7
-"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)
- ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
-"RTN","GPLCCR0",368,0)
- ;;</Frequency>
-"RTN","GPLCCR0",369,0)
- ;;<Interval>
-"RTN","GPLCCR0",370,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","GPLCCR0",371,0)
- ;;<Units>
-"RTN","GPLCCR0",372,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","GPLCCR0",373,0)
- ;;</Units>
-"RTN","GPLCCR0",374,0)
- ;;</Interval>
-"RTN","GPLCCR0",375,0)
- ;;<Duration>
-"RTN","GPLCCR0",376,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","GPLCCR0",377,0)
- ;;<Units>
-"RTN","GPLCCR0",378,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","GPLCCR0",379,0)
- ;;</Units>
-"RTN","GPLCCR0",380,0)
- ;;</Duration>
-"RTN","GPLCCR0",381,0)
- ;;<Indication>
-"RTN","GPLCCR0",382,0)
- ;;<PRNFlag>
-"RTN","GPLCCR0",383,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","GPLCCR0",384,0)
- ;;</PRNFlag>
-"RTN","GPLCCR0",385,0)
- ;;<Problem>
-"RTN","GPLCCR0",386,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",387,0)
- ;;<Type>
-"RTN","GPLCCR0",388,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","GPLCCR0",389,0)
- ;;</Type>
-"RTN","GPLCCR0",390,0)
- ;;<Description>
-"RTN","GPLCCR0",391,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","GPLCCR0",392,0)
- ;;<Code>
-"RTN","GPLCCR0",393,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","GPLCCR0",394,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",395,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","GPLCCR0",396,0)
- ;;</Code>
-"RTN","GPLCCR0",397,0)
- ;;</Description>
-"RTN","GPLCCR0",398,0)
- ;;<Source>
-"RTN","GPLCCR0",399,0)
- ;;<Actor>
-"RTN","GPLCCR0",400,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",401,0)
- ;;</Actor>
-"RTN","GPLCCR0",402,0)
- ;;</Source>
-"RTN","GPLCCR0",403,0)
- ;;</Problem>
-"RTN","GPLCCR0",404,0)
- ;;</Indication>
-"RTN","GPLCCR0",405,0)
- ;;<StopIndicator>
-"RTN","GPLCCR0",406,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","GPLCCR0",407,0)
- ;;</StopIndicator>
-"RTN","GPLCCR0",408,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","GPLCCR0",409,0)
- ;;<MultipleDirectionModifier>
-"RTN","GPLCCR0",410,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","GPLCCR0",411,0)
- ;;</MultipleDirectionModifier>
-"RTN","GPLCCR0",412,0)
- ;;</Direction>
-"RTN","GPLCCR0",413,0)
- ;;</Directions>
-"RTN","GPLCCR0",414,0)
- ;;<PatientInstructions>
-"RTN","GPLCCR0",415,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",416,0)
- ;;</PatientInstructions>
-"RTN","GPLCCR0",417,0)
- ;;<FullfillmentInstructions>
-"RTN","GPLCCR0",418,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",419,0)
- ;;</FullfillmentInstructions>
-"RTN","GPLCCR0",420,0)
- ;;<Refills>
-"RTN","GPLCCR0",421,0)
- ;;<Refill>
-"RTN","GPLCCR0",422,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","GPLCCR0",423,0)
- ;;</Refill>
-"RTN","GPLCCR0",424,0)
- ;;</Refills>
-"RTN","GPLCCR0",425,0)
- ;;</Medication>
-"RTN","GPLCCR0",426,0)
- ;;</Medications>
-"RTN","GPLCCR0",427,0)
- ;;<VitalSigns>
-"RTN","GPLCCR0",428,0)
- ;;<Result>
-"RTN","GPLCCR0",429,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",430,0)
- ;;<DateTime>
-"RTN","GPLCCR0",431,0)
- ;;<Type>
-"RTN","GPLCCR0",432,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","GPLCCR0",433,0)
- ;;</Type>
-"RTN","GPLCCR0",434,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",435,0)
- ;;</DateTime>
-"RTN","GPLCCR0",436,0)
- ;;<Description>
-"RTN","GPLCCR0",437,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",438,0)
- ;;</Description>
-"RTN","GPLCCR0",439,0)
- ;;<Source>
-"RTN","GPLCCR0",440,0)
- ;;<Actor>
-"RTN","GPLCCR0",441,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",442,0)
- ;;</Actor>
-"RTN","GPLCCR0",443,0)
- ;;</Source>
-"RTN","GPLCCR0",444,0)
- ;;<Test>
-"RTN","GPLCCR0",445,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",446,0)
- ;;<Type>
-"RTN","GPLCCR0",447,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","GPLCCR0",448,0)
- ;;</Type>
-"RTN","GPLCCR0",449,0)
- ;;<Description>
-"RTN","GPLCCR0",450,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",451,0)
- ;;<Code>
-"RTN","GPLCCR0",452,0)
- ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
-"RTN","GPLCCR0",453,0)
- ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",454,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","GPLCCR0",455,0)
- ;;</Code>
-"RTN","GPLCCR0",456,0)
- ;;</Description>
-"RTN","GPLCCR0",457,0)
- ;;<Source>
-"RTN","GPLCCR0",458,0)
- ;;<Actor>
-"RTN","GPLCCR0",459,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",460,0)
- ;;</Actor>
-"RTN","GPLCCR0",461,0)
- ;;</Source>
-"RTN","GPLCCR0",462,0)
- ;;<TestResult>
-"RTN","GPLCCR0",463,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","GPLCCR0",464,0)
- ;;<Units>
-"RTN","GPLCCR0",465,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","GPLCCR0",466,0)
- ;;</Units>
-"RTN","GPLCCR0",467,0)
- ;;</TestResult>
-"RTN","GPLCCR0",468,0)
- ;;</Test>
-"RTN","GPLCCR0",469,0)
- ;;</Result>
-"RTN","GPLCCR0",470,0)
- ;;</VitalSigns>
-"RTN","GPLCCR0",471,0)
- ;;<Results>
-"RTN","GPLCCR0",472,0)
- ;;<Result>
-"RTN","GPLCCR0",473,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",474,0)
- ;;<DateTime>
-"RTN","GPLCCR0",475,0)
- ;;<Type>
-"RTN","GPLCCR0",476,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",477,0)
- ;;</Type>
-"RTN","GPLCCR0",478,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",479,0)
- ;;</DateTime>
-"RTN","GPLCCR0",480,0)
- ;;<Description>
-"RTN","GPLCCR0",481,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",482,0)
- ;;<Code>
-"RTN","GPLCCR0",483,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","GPLCCR0",484,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",485,0)
- ;;</Code>
-"RTN","GPLCCR0",486,0)
- ;;</Description>
-"RTN","GPLCCR0",487,0)
- ;;<Status>
-"RTN","GPLCCR0",488,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","GPLCCR0",489,0)
- ;;</Status>
-"RTN","GPLCCR0",490,0)
- ;;<Source>
-"RTN","GPLCCR0",491,0)
- ;;<Actor>
-"RTN","GPLCCR0",492,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",493,0)
- ;;</Actor>
-"RTN","GPLCCR0",494,0)
- ;;</Source>
-"RTN","GPLCCR0",495,0)
- ;;<TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",496,0)
- ;;<Test>
-"RTN","GPLCCR0",497,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",498,0)
- ;;<DateTime>
-"RTN","GPLCCR0",499,0)
- ;;<Type>
-"RTN","GPLCCR0",500,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",501,0)
- ;;</Type>
-"RTN","GPLCCR0",502,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",503,0)
- ;;</DateTime>
-"RTN","GPLCCR0",504,0)
- ;;<Description>
-"RTN","GPLCCR0",505,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",506,0)
- ;;<Code>
-"RTN","GPLCCR0",507,0)
- ;;<Value>@@RESULTTESTCODE@@</Value>
-"RTN","GPLCCR0",508,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",509,0)
- ;;</Code>
-"RTN","GPLCCR0",510,0)
- ;;</Description>
-"RTN","GPLCCR0",511,0)
- ;;<Status>
-"RTN","GPLCCR0",512,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",513,0)
- ;;</Status>
-"RTN","GPLCCR0",514,0)
- ;;<Source>
-"RTN","GPLCCR0",515,0)
- ;;<Actor>
-"RTN","GPLCCR0",516,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",517,0)
- ;;</Actor>
-"RTN","GPLCCR0",518,0)
- ;;</Source>
-"RTN","GPLCCR0",519,0)
- ;;<TestResult>
-"RTN","GPLCCR0",520,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",521,0)
- ;;<Units>
-"RTN","GPLCCR0",522,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",523,0)
- ;;</Units>
-"RTN","GPLCCR0",524,0)
- ;;</TestResult>
-"RTN","GPLCCR0",525,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",526,0)
- ;;<Normal>
-"RTN","GPLCCR0",527,0)
- ;;<Description>
-"RTN","GPLCCR0",528,0)
- ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",529,0)
- ;;</Description>
-"RTN","GPLCCR0",530,0)
- ;;<Source>
-"RTN","GPLCCR0",531,0)
- ;;<Actor>
-"RTN","GPLCCR0",532,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",533,0)
- ;;</Actor>
-"RTN","GPLCCR0",534,0)
- ;;</Source>
-"RTN","GPLCCR0",535,0)
- ;;</Normal>
-"RTN","GPLCCR0",536,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",537,0)
- ;;<Flag>
-"RTN","GPLCCR0",538,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",539,0)
- ;;</Flag>
-"RTN","GPLCCR0",540,0)
- ;;</Test>
-"RTN","GPLCCR0",541,0)
- ;;</TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",542,0)
- ;;<TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",543,0)
- ;;<Test>
-"RTN","GPLCCR0",544,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",545,0)
- ;;<DateTime>
-"RTN","GPLCCR0",546,0)
- ;;<Type>
-"RTN","GPLCCR0",547,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",548,0)
- ;;</Type>
-"RTN","GPLCCR0",549,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",550,0)
- ;;</DateTime>
-"RTN","GPLCCR0",551,0)
- ;;<Description>
-"RTN","GPLCCR0",552,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",553,0)
- ;;<Code>
-"RTN","GPLCCR0",554,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",555,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",556,0)
- ;;</Code>
-"RTN","GPLCCR0",557,0)
- ;;</Description>
-"RTN","GPLCCR0",558,0)
- ;;<Status>
-"RTN","GPLCCR0",559,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",560,0)
- ;;</Status>
-"RTN","GPLCCR0",561,0)
- ;;<Source>
-"RTN","GPLCCR0",562,0)
- ;;<Actor>
-"RTN","GPLCCR0",563,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",564,0)
- ;;</Actor>
-"RTN","GPLCCR0",565,0)
- ;;</Source>
-"RTN","GPLCCR0",566,0)
- ;;<TestResult>
-"RTN","GPLCCR0",567,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",568,0)
- ;;<Units>
-"RTN","GPLCCR0",569,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",570,0)
- ;;</Units>
-"RTN","GPLCCR0",571,0)
- ;;</TestResult>
-"RTN","GPLCCR0",572,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",573,0)
- ;;<Normal>
-"RTN","GPLCCR0",574,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
-"RTN","GPLCCR0",575,0)
- ;;<Units>
-"RTN","GPLCCR0",576,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
-"RTN","GPLCCR0",577,0)
- ;;</Units>
-"RTN","GPLCCR0",578,0)
- ;;<ValueSequencePosition>1</ValueSequencePosition>
-"RTN","GPLCCR0",579,0)
- ;;<Source>
-"RTN","GPLCCR0",580,0)
- ;;<Actor>
-"RTN","GPLCCR0",581,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",582,0)
- ;;</Actor>
-"RTN","GPLCCR0",583,0)
- ;;</Source>
-"RTN","GPLCCR0",584,0)
- ;;</Normal>
-"RTN","GPLCCR0",585,0)
- ;;<Normal>
-"RTN","GPLCCR0",586,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
-"RTN","GPLCCR0",587,0)
- ;;<Units>
-"RTN","GPLCCR0",588,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
-"RTN","GPLCCR0",589,0)
- ;;</Units>
-"RTN","GPLCCR0",590,0)
- ;;<ValueSequencePosition>2</ValueSequencePosition>
-"RTN","GPLCCR0",591,0)
- ;;<VariableNomalModifier>
-"RTN","GPLCCR0",592,0)
- ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
-"RTN","GPLCCR0",593,0)
- ;;</VariableNomalModifier>
-"RTN","GPLCCR0",594,0)
- ;;<Source>
-"RTN","GPLCCR0",595,0)
- ;;<Actor>
-"RTN","GPLCCR0",596,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",597,0)
- ;;</Actor>
-"RTN","GPLCCR0",598,0)
- ;;</Source>
-"RTN","GPLCCR0",599,0)
- ;;</Normal>
-"RTN","GPLCCR0",600,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",601,0)
- ;;<Flag>
-"RTN","GPLCCR0",602,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",603,0)
- ;;</Flag>
-"RTN","GPLCCR0",604,0)
- ;;</Test>
-"RTN","GPLCCR0",605,0)
- ;;</TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",606,0)
- ;;</Result>
-"RTN","GPLCCR0",607,0)
- ;;</Results>
-"RTN","GPLCCR0",608,0)
- ;;<HealthCareProviders>
-"RTN","GPLCCR0",609,0)
- ;;<Provider>
-"RTN","GPLCCR0",610,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","GPLCCR0",611,0)
- ;;<ActorRole>
-"RTN","GPLCCR0",612,0)
- ;;<Text>Primary Provider</Text>
-"RTN","GPLCCR0",613,0)
- ;;</ActorRole>
-"RTN","GPLCCR0",614,0)
- ;;</Provider>
-"RTN","GPLCCR0",615,0)
- ;;</HealthCareProviders>
-"RTN","GPLCCR0",616,0)
- ;;</Body>
-"RTN","GPLCCR0",617,0)
- ;;<Actors>
-"RTN","GPLCCR0",618,0)
- ;;<ACTOR-PATIENT>
-"RTN","GPLCCR0",619,0)
- ;;<Actor>
-"RTN","GPLCCR0",620,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",621,0)
- ;;<Person>
-"RTN","GPLCCR0",622,0)
- ;;<Name>
-"RTN","GPLCCR0",623,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",624,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",625,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",626,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",627,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",628,0)
- ;;</Name>
-"RTN","GPLCCR0",629,0)
- ;;<DateOfBirth>
-"RTN","GPLCCR0",630,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","GPLCCR0",631,0)
- ;;</DateOfBirth>
-"RTN","GPLCCR0",632,0)
- ;;<Gender>
-"RTN","GPLCCR0",633,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","GPLCCR0",634,0)
- ;;<Code>
-"RTN","GPLCCR0",635,0)
- ;;<Value>@@ACTORGENDER@@</Value>
-"RTN","GPLCCR0",636,0)
- ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
-"RTN","GPLCCR0",637,0)
- ;;</Code>
-"RTN","GPLCCR0",638,0)
- ;;</Gender>
-"RTN","GPLCCR0",639,0)
- ;;</Person>
-"RTN","GPLCCR0",640,0)
- ;;<IDs>
-"RTN","GPLCCR0",641,0)
- ;;<Type>
-"RTN","GPLCCR0",642,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","GPLCCR0",643,0)
- ;;</Type>
-"RTN","GPLCCR0",644,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","GPLCCR0",645,0)
- ;;<Source>
-"RTN","GPLCCR0",646,0)
- ;;<Actor>
-"RTN","GPLCCR0",647,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","GPLCCR0",648,0)
- ;;</Actor>
-"RTN","GPLCCR0",649,0)
- ;;</Source>
-"RTN","GPLCCR0",650,0)
- ;;</IDs>
-"RTN","GPLCCR0",651,0)
- ;;<Address>
-"RTN","GPLCCR0",652,0)
- ;;<Type>
-"RTN","GPLCCR0",653,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",654,0)
- ;;</Type>
-"RTN","GPLCCR0",655,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",656,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","GPLCCR0",657,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",658,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",659,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","GPLCCR0",660,0)
- ;;</Address>
-"RTN","GPLCCR0",661,0)
- ;;<Telephone>
-"RTN","GPLCCR0",662,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","GPLCCR0",663,0)
- ;;<Type>
-"RTN","GPLCCR0",664,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","GPLCCR0",665,0)
- ;;</Type>
-"RTN","GPLCCR0",666,0)
- ;;</Telephone>
-"RTN","GPLCCR0",667,0)
- ;;<Telephone>
-"RTN","GPLCCR0",668,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","GPLCCR0",669,0)
- ;;<Type>
-"RTN","GPLCCR0",670,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","GPLCCR0",671,0)
- ;;</Type>
-"RTN","GPLCCR0",672,0)
- ;;</Telephone>
-"RTN","GPLCCR0",673,0)
- ;;<Telephone>
-"RTN","GPLCCR0",674,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","GPLCCR0",675,0)
- ;;<Type>
-"RTN","GPLCCR0",676,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","GPLCCR0",677,0)
- ;;</Type>
-"RTN","GPLCCR0",678,0)
- ;;</Telephone>
-"RTN","GPLCCR0",679,0)
- ;;<EMail>
-"RTN","GPLCCR0",680,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",681,0)
- ;;</EMail>
-"RTN","GPLCCR0",682,0)
- ;;<Source>
-"RTN","GPLCCR0",683,0)
- ;;<Actor>
-"RTN","GPLCCR0",684,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",685,0)
- ;;</Actor>
-"RTN","GPLCCR0",686,0)
- ;;</Source>
-"RTN","GPLCCR0",687,0)
- ;;</Actor>
-"RTN","GPLCCR0",688,0)
- ;;</ACTOR-PATIENT>
-"RTN","GPLCCR0",689,0)
- ;;<ACTOR-SYSTEM>
-"RTN","GPLCCR0",690,0)
- ;;<Actor>
-"RTN","GPLCCR0",691,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",692,0)
- ;;<InformationSystem>
-"RTN","GPLCCR0",693,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","GPLCCR0",694,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","GPLCCR0",695,0)
- ;;</InformationSystem>
-"RTN","GPLCCR0",696,0)
- ;;<Source>
-"RTN","GPLCCR0",697,0)
- ;;<Actor>
-"RTN","GPLCCR0",698,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",699,0)
- ;;</Actor>
-"RTN","GPLCCR0",700,0)
- ;;</Source>
-"RTN","GPLCCR0",701,0)
- ;;</Actor>
-"RTN","GPLCCR0",702,0)
- ;;</ACTOR-SYSTEM>
-"RTN","GPLCCR0",703,0)
- ;;<ACTOR-NOK>
-"RTN","GPLCCR0",704,0)
- ;;<Actor>
-"RTN","GPLCCR0",705,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","GPLCCR0",706,0)
- ;;<Person>
-"RTN","GPLCCR0",707,0)
- ;;<Name>
-"RTN","GPLCCR0",708,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","GPLCCR0",709,0)
- ;;</Name>
-"RTN","GPLCCR0",710,0)
- ;;</Person>
-"RTN","GPLCCR0",711,0)
- ;;<Relation>
-"RTN","GPLCCR0",712,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","GPLCCR0",713,0)
- ;;</Relation>
-"RTN","GPLCCR0",714,0)
- ;;<Source>
-"RTN","GPLCCR0",715,0)
- ;;<Actor>
-"RTN","GPLCCR0",716,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","GPLCCR0",717,0)
- ;;</Actor>
-"RTN","GPLCCR0",718,0)
- ;;</Source>
-"RTN","GPLCCR0",719,0)
- ;;</Actor>
-"RTN","GPLCCR0",720,0)
- ;;</ACTOR-NOK>
-"RTN","GPLCCR0",721,0)
- ;;<ACTOR-PROVIDER>
-"RTN","GPLCCR0",722,0)
- ;;<Actor>
-"RTN","GPLCCR0",723,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",724,0)
- ;;<Person>
-"RTN","GPLCCR0",725,0)
- ;;<Name>
-"RTN","GPLCCR0",726,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",727,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",728,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",729,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",730,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","GPLCCR0",731,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",732,0)
- ;;</Name>
-"RTN","GPLCCR0",733,0)
- ;;</Person>
-"RTN","GPLCCR0",734,0)
- ;;<IDs>
-"RTN","GPLCCR0",735,0)
- ;;<Type>
-"RTN","GPLCCR0",736,0)
- ;;<Text>@@IDTYPE@@</Text>
-"RTN","GPLCCR0",737,0)
- ;;</Type>
-"RTN","GPLCCR0",738,0)
- ;;<ID>@@ID@@</ID>
-"RTN","GPLCCR0",739,0)
- ;;<IssuedBy>
-"RTN","GPLCCR0",740,0)
- ;;<Description>
-"RTN","GPLCCR0",741,0)
- ;;<Text>@@IDDESC@@</Text>
-"RTN","GPLCCR0",742,0)
- ;;</Description>
-"RTN","GPLCCR0",743,0)
- ;;</IssuedBy>
-"RTN","GPLCCR0",744,0)
- ;;</IDs>
-"RTN","GPLCCR0",745,0)
- ;;<Specialty>
-"RTN","GPLCCR0",746,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","GPLCCR0",747,0)
- ;;</Specialty>
-"RTN","GPLCCR0",748,0)
- ;;<Address>
-"RTN","GPLCCR0",749,0)
- ;;<Type>
-"RTN","GPLCCR0",750,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",751,0)
- ;;</Type>
-"RTN","GPLCCR0",752,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",753,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",754,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",755,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","GPLCCR0",756,0)
- ;;</Address>
-"RTN","GPLCCR0",757,0)
- ;;<Telephone>
-"RTN","GPLCCR0",758,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","GPLCCR0",759,0)
- ;;<Type>
-"RTN","GPLCCR0",760,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","GPLCCR0",761,0)
- ;;</Type>
-"RTN","GPLCCR0",762,0)
- ;;</Telephone>
-"RTN","GPLCCR0",763,0)
- ;;<Email>
-"RTN","GPLCCR0",764,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",765,0)
- ;;</Email>
-"RTN","GPLCCR0",766,0)
- ;;<Source>
-"RTN","GPLCCR0",767,0)
- ;;<Actor>
-"RTN","GPLCCR0",768,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",769,0)
- ;;</Actor>
-"RTN","GPLCCR0",770,0)
- ;;</Source>
-"RTN","GPLCCR0",771,0)
- ;;</Actor>
-"RTN","GPLCCR0",772,0)
- ;;</ACTOR-PROVIDER>
-"RTN","GPLCCR0",773,0)
- ;;<ACTOR-ORG>
-"RTN","GPLCCR0",774,0)
- ;;<Actor>
-"RTN","GPLCCR0",775,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",776,0)
- ;;<Organization>
-"RTN","GPLCCR0",777,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","GPLCCR0",778,0)
- ;;</Organization>
-"RTN","GPLCCR0",779,0)
- ;;<Source>
-"RTN","GPLCCR0",780,0)
- ;;<Actor>
-"RTN","GPLCCR0",781,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",782,0)
- ;;</Actor>
-"RTN","GPLCCR0",783,0)
- ;;</Source>
-"RTN","GPLCCR0",784,0)
- ;;</Actor>
-"RTN","GPLCCR0",785,0)
- ;;</ACTOR-ORG>
-"RTN","GPLCCR0",786,0)
- ;;</Actors>
-"RTN","GPLCCR0",787,0)
- ;;<Signatures>
-"RTN","GPLCCR0",788,0)
- ;;<CCRSignature>
-"RTN","GPLCCR0",789,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","GPLCCR0",790,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","GPLCCR0",791,0)
- ;;<Source>
-"RTN","GPLCCR0",792,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","GPLCCR0",793,0)
- ;;</Source>
-"RTN","GPLCCR0",794,0)
- ;;<Signature>
-"RTN","GPLCCR0",795,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","GPLCCR0",796,0)
- ;;<SignedInfo>
-"RTN","GPLCCR0",797,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","GPLCCR0",798,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","GPLCCR0",799,0)
- ;;<Reference URI="">
-"RTN","GPLCCR0",800,0)
- ;;<Transforms>
-"RTN","GPLCCR0",801,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","GPLCCR0",802,0)
- ;;</Transforms>
-"RTN","GPLCCR0",803,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","GPLCCR0",804,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","GPLCCR0",805,0)
- ;;</Reference>
-"RTN","GPLCCR0",806,0)
- ;;</SignedInfo>
-"RTN","GPLCCR0",807,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","GPLCCR0",808,0)
- ;;<KeyInfo>
-"RTN","GPLCCR0",809,0)
- ;;<KeyValue>
-"RTN","GPLCCR0",810,0)
- ;;<RSAKeyValue>
-"RTN","GPLCCR0",811,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","GPLCCR0",812,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","GPLCCR0",813,0)
- ;;</RSAKeyValue>
-"RTN","GPLCCR0",814,0)
- ;;</KeyValue>
-"RTN","GPLCCR0",815,0)
- ;;</KeyInfo>
-"RTN","GPLCCR0",816,0)
- ;;</Signature>
-"RTN","GPLCCR0",817,0)
- ;;</Signature>
-"RTN","GPLCCR0",818,0)
- ;;</CCRSignature>
-"RTN","GPLCCR0",819,0)
- ;;</Signatures>
-"RTN","GPLCCR0",820,0)
- ;;</ContinuityOfCareRecord>
-"RTN","GPLCCR0",821,0)
- ;</TEMPLATE>
-"RTN","GPLMEDS")
-0^18^B55630630
-"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 7
-"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 HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","GPLMEDS",29,0)
-   N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","GPLMEDS",30,0)
-   ; OUTPATIENT MEDS ARE PROCESSED IN EXTRACT^CCRMEDS, ALL OTHERS HERE
-"RTN","GPLMEDS",31,0)
-   D EXTRACT^CCRMEDS(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","GPLMEDS",32,0)
-   I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","GPLMEDS",33,0)
-   . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","GPLMEDS",34,0)
-   . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","GPLMEDS",35,0)
-   . W "HAS ACTIVE OP MEDS",!
-"RTN","GPLMEDS",36,0)
-   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","GPLMEDS",37,0)
-   D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","GPLMEDS",38,0)
-   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","GPLMEDS",39,0)
-   . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","GPLMEDS",40,0)
-   . S @MEDOUTXML@(0)=0
-"RTN","GPLMEDS",41,0)
-   . Q
-"RTN","GPLMEDS",42,0)
-   ; I DEBUG ZWR MEDRSLT
-"RTN","GPLMEDS",43,0)
-   M GPLMEDS=MEDRSLT
-"RTN","GPLMEDS",44,0)
-   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","GPLMEDS",45,0)
-   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","GPLMEDS",46,0)
-   I 'HASOP K @MEDTVMAP,@MEDTARYTMP
-"RTN","GPLMEDS",47,0)
-   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","GPLMEDS",48,0)
-   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","GPLMEDS",49,0)
-   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","GPLMEDS",50,0)
-   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","GPLMEDS",51,0)
-   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","GPLMEDS",52,0)
-   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","GPLMEDS",53,0)
-   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","GPLMEDS",54,0)
-   . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","GPLMEDS",55,0)
-   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","GPLMEDS",56,0)
-   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","GPLMEDS",57,0)
-   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","GPLMEDS",58,0)
-   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","GPLMEDS",59,0)
-   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","GPLMEDS",60,0)
-   ;ZWR ZA
-"RTN","GPLMEDS",61,0)
-   S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","GPLMEDS",62,0)
-   F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","GPLMEDS",63,0)
-   . I DEBUG W "ZI IS ",ZI,!
-"RTN","GPLMEDS",64,0)
-   . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","GPLMEDS",65,0)
-   . K @MEDVMAP
-"RTN","GPLMEDS",66,0)
-   . I DEBUG W "VMAP= ",MEDVMAP,!
-"RTN","GPLMEDS",67,0)
-   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","GPLMEDS",68,0)
-   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","GPLMEDS",69,0)
-   . I $P(MEDPTMP,U,1)?1"~OP"&$P(MEDPTMP,"^",10)="ACTIVE" Q  ; SKIP OP ACTIVE
-"RTN","GPLMEDS",70,0)
-   . S @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","GPLMEDS",71,0)
-   . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","GPLMEDS",72,0)
-   . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","GPLMEDS",73,0)
-   . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","GPLMEDS",74,0)
-   . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","GPLMEDS",75,0)
-   . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","GPLMEDS",76,0)
-   . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","GPLMEDS",77,0)
-   . S @MEDVMAP@("MEDRXNO")=""
-"RTN","GPLMEDS",78,0)
-   . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","GPLMEDS",79,0)
-   . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","GPLMEDS",80,0)
-   . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","GPLMEDS",81,0)
-   . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","GPLMEDS",82,0)
-   . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","GPLMEDS",83,0)
-   . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","GPLMEDS",84,0)
-   . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","GPLMEDS",85,0)
-   . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","GPLMEDS",86,0)
-   . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","GPLMEDS",87,0)
-   . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","GPLMEDS",88,0)
-   . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","GPLMEDS",89,0)
-   . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","GPLMEDS",90,0)
-   . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","GPLMEDS",91,0)
-   . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","GPLMEDS",92,0)
-   . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","GPLMEDS",93,0)
-   . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","GPLMEDS",94,0)
-   . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","GPLMEDS",95,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","GPLMEDS",96,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","GPLMEDS",97,0)
-   . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","GPLMEDS",98,0)
-   . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","GPLMEDS",99,0)
-   . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","GPLMEDS",100,0)
-   . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","GPLMEDS",101,0)
-   . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","GPLMEDS",102,0)
-   . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","GPLMEDS",103,0)
-   . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","GPLMEDS",104,0)
-   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","GPLMEDS",105,0)
-   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","GPLMEDS",106,0)
-   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","GPLMEDS",107,0)
-   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLMEDS",108,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","GPLMEDS",109,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","GPLMEDS",110,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","GPLMEDS",111,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","GPLMEDS",112,0)
-   . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","GPLMEDS",113,0)
-   . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","GPLMEDS",114,0)
-   . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","GPLMEDS",115,0)
-   . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","GPLMEDS",116,0)
-   . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","GPLMEDS",117,0)
-   . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","GPLMEDS",118,0)
-   . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","GPLMEDS",119,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","GPLMEDS",120,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","GPLMEDS",121,0)
-   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","GPLMEDS",122,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","GPLMEDS",123,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","GPLMEDS",124,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","GPLMEDS",125,0)
-   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","GPLMEDS",126,0)
-   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","GPLMEDS",127,0)
-   . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","GPLMEDS",128,0)
-   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","GPLMEDS",129,0)
-   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","GPLMEDS",130,0)
-   . S @MEDVMAP@("MEDRFNO")=""
-"RTN","GPLMEDS",131,0)
-   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","GPLMEDS",132,0)
-   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","GPLMEDS",133,0)
-   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","GPLMEDS",134,0)
-   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","GPLMEDS",135,0)
-   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","GPLMEDS",136,0)
-   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","GPLMEDS",137,0)
-   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","GPLMEDS",138,0)
-   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","GPLMEDS",139,0)
-   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","GPLMEDS",140,0)
-   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","GPLMEDS",141,0)
-   . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","GPLMEDS",142,0)
-   . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","GPLMEDS",143,0)
-   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","GPLMEDS",144,0)
-   . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","GPLMEDS",145,0)
-   . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","GPLMEDS",146,0)
-   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","GPLMEDS",147,0)
-   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","GPLMEDS",148,0)
-   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","GPLMEDS",149,0)
-   . K @MEDARYTMP
-"RTN","GPLMEDS",150,0)
-   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","GPLMEDS",151,0)
-   . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","GPLMEDS",152,0)
-   . . ; W "FIRST ONE",!
-"RTN","GPLMEDS",153,0)
-   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","GPLMEDS",154,0)
-   . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","GPLMEDS",155,0)
-   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","GPLMEDS",156,0)
-   N MEDTMP,MEDI
-"RTN","GPLMEDS",157,0)
-   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLMEDS",158,0)
-   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLMEDS",159,0)
-   . W "MEDICATION MISSING ",!
-"RTN","GPLMEDS",160,0)
-   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","GPLMEDS",161,0)
-   Q
-"RTN","GPLMEDS",162,0)
-   ;
-"RTN","GPLMEDS",163,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","GPLMEDS",164,0)
-   ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","GPLMEDS",165,0)
-   N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","GPLMEDS",166,0)
-   S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","GPLMEDS",167,0)
-   Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","GPLMEDS",168,0)
-   ;
-"RTN","GPLPROBS")
-0^11^B25875394
-"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 7
-"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)
-          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","GPLPROBS",42,0)
-          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","GPLPROBS",43,0)
-          . S VMAP=$NA(@TVMAP@(J))
-"RTN","GPLPROBS",44,0)
-          . K @VMAP
-"RTN","GPLPROBS",45,0)
-          . I DEBUG W "VMAP= ",VMAP,!
-"RTN","GPLPROBS",46,0)
-          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","GPLPROBS",47,0)
-          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","GPLPROBS",48,0)
-          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","GPLPROBS",49,0)
-          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
-"RTN","GPLPROBS",50,0)
-          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","GPLPROBS",51,0)
-          . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","GPLPROBS",52,0)
-          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","GPLPROBS",53,0)
-          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
-"RTN","GPLPROBS",54,0)
-          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
-"RTN","GPLPROBS",55,0)
-          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","GPLPROBS",56,0)
-          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","GPLPROBS",57,0)
-          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","GPLPROBS",58,0)
-          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","GPLPROBS",59,0)
-          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","GPLPROBS",60,0)
-          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","GPLPROBS",61,0)
-          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","GPLPROBS",62,0)
-          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","GPLPROBS",63,0)
-          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","GPLPROBS",64,0)
-          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","GPLPROBS",65,0)
-          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
-"RTN","GPLPROBS",66,0)
-          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
-"RTN","GPLPROBS",67,0)
-          . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","GPLPROBS",68,0)
-          . ; W "ARYTMP= ",ARYTMP,!
-"RTN","GPLPROBS",69,0)
-          . K @ARYTMP
-"RTN","GPLPROBS",70,0)
-          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","GPLPROBS",71,0)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",72,0)
-          . . ; W "FIRST ONE",!
-"RTN","GPLPROBS",73,0)
-          . . D CP^GPLXPATH(ARYTMP,OUTXML)
-"RTN","GPLPROBS",74,0)
-          . . ; W "OUTXML ",OUTXML,!
-"RTN","GPLPROBS",75,0)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLPROBS",76,0)
-          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
-"RTN","GPLPROBS",77,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
-"RTN","GPLPROBS",78,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLPROBS",79,0)
-          ; ZWR @OUTXML
-"RTN","GPLPROBS",80,0)
-          ; $$HTML^DILF(
-"RTN","GPLPROBS",81,0)
-          ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","GPLPROBS",82,0)
-          I CCD D  ; IF THIS IS FOR A CCD
-"RTN","GPLPROBS",83,0)
-          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
-"RTN","GPLPROBS",84,0)
-          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","GPLPROBS",85,0)
-          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
-"RTN","GPLPROBS",86,0)
-          . . I DEBUG W "VMAP =",VMAP,!
-"RTN","GPLPROBS",87,0)
-          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","GPLPROBS",88,0)
-          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","GPLPROBS",89,0)
-          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
-"RTN","GPLPROBS",90,0)
-          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","GPLPROBS",91,0)
-          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","GPLPROBS",92,0)
-          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",93,0)
-          . . . D CP^GPLXPATH("HOUT","HTMLO")
-"RTN","GPLPROBS",94,0)
-          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","GPLPROBS",95,0)
-          . . . I DEBUG W "DOING INNER",!
-"RTN","GPLPROBS",96,0)
-          . . . N HTMLBLD,HTMLTMP
-"RTN","GPLPROBS",97,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","GPLPROBS",98,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","GPLPROBS",99,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","GPLPROBS",100,0)
-          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
-"RTN","GPLPROBS",101,0)
-          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
-"RTN","GPLPROBS",102,0)
-          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
-"RTN","GPLPROBS",103,0)
-          . I DEBUG D PARY^GPLXPATH("HTMLO")
-"RTN","GPLPROBS",104,0)
-          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","GPLPROBS",105,0)
-          N PROBSTMP,I
-"RTN","GPLPROBS",106,0)
-          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLPROBS",107,0)
-          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLPROBS",108,0)
-          . ; STRINGS MARKED AS @@X@@
-"RTN","GPLPROBS",109,0)
-          . W !,"PROBLEMS Missing list: ",!
-"RTN","GPLPROBS",110,0)
-          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","GPLPROBS",111,0)
-          Q
-"RTN","GPLPROBS",112,0)
-          ;
-"RTN","GPLRIMA")
-0^13^B212485446
-"RTN","GPLRIMA",1,0)
-GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-"RTN","GPLRIMA",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7
-"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)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
-"RTN","GPLRIMA",63,0)
-    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","GPLRIMA",64,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
-"RTN","GPLRIMA",65,0)
-    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","GPLRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
-"RTN","GPLRIMA",67,0)
-    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","GPLRIMA",68,0)
-    . ;
-"RTN","GPLRIMA",69,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-"RTN","GPLRIMA",70,0)
-    . ;
-"RTN","GPLRIMA",71,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-"RTN","GPLRIMA",72,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","GPLRIMA",73,0)
-    . ;
-"RTN","GPLRIMA",74,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","GPLRIMA",75,0)
-    . ;
-"RTN","GPLRIMA",76,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","GPLRIMA",77,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","GPLRIMA",78,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","GPLRIMA",79,0)
-    . ;
-"RTN","GPLRIMA",80,0)
-    . N CATNAME,CATTBL
-"RTN","GPLRIMA",81,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","GPLRIMA",82,0)
-    . S CATNAME=""
-"RTN","GPLRIMA",83,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","GPLRIMA",84,0)
-    . W "CATEGORY NAME: ",CATNAME,!
-"RTN","GPLRIMA",85,0)
-    . ;
-"RTN","GPLRIMA",86,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
-"RTN","GPLRIMA",87,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","GPLRIMA",88,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","GPLRIMA",89,0)
-    . ; AND WE SKIP IT
-"RTN","GPLRIMA",90,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","GPLRIMA",91,0)
-    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","GPLRIMA",92,0)
-    Q
-"RTN","GPLRIMA",93,0)
-    ;
-"RTN","GPLRIMA",94,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","GPLRIMA",95,0)
-    N SBASE,SATTR
-"RTN","GPLRIMA",96,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","GPLRIMA",97,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","GPLRIMA",98,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","GPLRIMA",99,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","GPLRIMA",100,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","GPLRIMA",101,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","GPLRIMA",102,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","GPLRIMA",103,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","GPLRIMA",104,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",105,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","GPLRIMA",106,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",107,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",108,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","GPLRIMA",109,0)
-    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","GPLRIMA",110,0)
-    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","GPLRIMA",111,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","GPLRIMA",112,0)
-    Q SATTR
-"RTN","GPLRIMA",113,0)
-    ;
-"RTN","GPLRIMA",114,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","GPLRIMA",115,0)
-    K ^TMP("GPLRIM","RESUME")
-"RTN","GPLRIMA",116,0)
-    K ^TMP("GPLRIM")
-"RTN","GPLRIMA",117,0)
-    Q
-"RTN","GPLRIMA",118,0)
-    ;
-"RTN","GPLRIMA",119,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","GPLRIMA",120,0)
-    ;
-"RTN","GPLRIMA",121,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",122,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","GPLRIMA",123,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","GPLRIMA",124,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","GPLRIMA",125,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","GPLRIMA",126,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","GPLRIMA",127,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","GPLRIMA",128,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","GPLRIMA",129,0)
-    . W CLIDX,!
-"RTN","GPLRIMA",130,0)
-    ; D PARY^GPLXPATH(CLBASE)
-"RTN","GPLRIMA",131,0)
-    Q
-"RTN","GPLRIMA",132,0)
-    ;
-"RTN","GPLRIMA",133,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","GPLRIMA",134,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","GPLRIMA",135,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","GPLRIMA",136,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","GPLRIMA",137,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","GPLRIMA",138,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","GPLRIMA",139,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","GPLRIMA",140,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","GPLRIMA",141,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","GPLRIMA",142,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","GPLRIMA",143,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","GPLRIMA",144,0)
-    ;
-"RTN","GPLRIMA",145,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","GPLRIMA",146,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","GPLRIMA",147,0)
-    W "CBASE: ",CCTBL,!
-"RTN","GPLRIMA",148,0)
-    ;
-"RTN","GPLRIMA",149,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","GPLRIMA",150,0)
-    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","GPLRIMA",151,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","GPLRIMA",152,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","GPLRIMA",153,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","GPLRIMA",154,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","GPLRIMA",155,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","GPLRIMA",156,0)
-    ;
-"RTN","GPLRIMA",157,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","GPLRIMA",158,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",159,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","GPLRIMA",160,0)
-    ;
-"RTN","GPLRIMA",161,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","GPLRIMA",162,0)
-    ;
-"RTN","GPLRIMA",163,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","GPLRIMA",164,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","GPLRIMA",165,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","GPLRIMA",166,0)
-    ;
-"RTN","GPLRIMA",167,0)
-    Q
-"RTN","GPLRIMA",168,0)
-    ;
-"RTN","GPLRIMA",169,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","GPLRIMA",170,0)
-    ;
-"RTN","GPLRIMA",171,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",172,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","GPLRIMA",173,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",174,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",175,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","GPLRIMA",176,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","GPLRIMA",177,0)
-    . S ZCNT=0
-"RTN","GPLRIMA",178,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","GPLRIMA",179,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","GPLRIMA",180,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","GPLRIMA",181,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","GPLRIMA",182,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",183,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","GPLRIMA",184,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","GPLRIMA",185,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","GPLRIMA",186,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","GPLRIMA",187,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","GPLRIMA",188,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","GPLRIMA",189,0)
-    Q
-"RTN","GPLRIMA",190,0)
-    ;
-"RTN","GPLRIMA",191,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","GPLRIMA",192,0)
-    ; INLST IS PASSED BY NAME
-"RTN","GPLRIMA",193,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","GPLRIMA",194,0)
-    W INLST,!
-"RTN","GPLRIMA",195,0)
-    S ZCOUNT=0
-"RTN","GPLRIMA",196,0)
-    S ZDX=""
-"RTN","GPLRIMA",197,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","GPLRIMA",198,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","GPLRIMA",199,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","GPLRIMA",200,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","GPLRIMA",201,0)
-    Q ZCOUNT
-"RTN","GPLRIMA",202,0)
-    ;
-"RTN","GPLRIMA",203,0)
-XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN 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 ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",208,0)
-    S ZI=""
-"RTN","GPLRIMA",209,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",210,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",211,0)
-    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
-"RTN","GPLRIMA",212,0)
-    Q
-"RTN","GPLRIMA",213,0)
-    ;
-"RTN","GPLRIMA",214,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","GPLRIMA",215,0)
-    ;
-"RTN","GPLRIMA",216,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",217,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",218,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","GPLRIMA",219,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",220,0)
-    S ZI=""
-"RTN","GPLRIMA",221,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",222,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",223,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","GPLRIMA",224,0)
-    . W ZI," "
-"RTN","GPLRIMA",225,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","GPLRIMA",226,0)
-    . . S ZC=0
-"RTN","GPLRIMA",227,0)
-    . . W !
-"RTN","GPLRIMA",228,0)
-    Q
-"RTN","GPLRIMA",229,0)
-    ;
-"RTN","GPLRIMA",230,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","GPLRIMA",231,0)
-    ;
-"RTN","GPLRIMA",232,0)
-    N ATTR S ATTR=""
-"RTN","GPLRIMA",233,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",234,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","GPLRIMA",235,0)
-    S ATTR=^TMP("GPLRIM","ATTR",DFN)
-"RTN","GPLRIMA",236,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","GPLRIMA",237,0)
-    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","GPLRIMA",238,0)
-    . N CAT
-"RTN","GPLRIMA",239,0)
-    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","GPLRIMA",240,0)
-    . W CAT,": ",ATTR,!
-"RTN","GPLRIMA",241,0)
-    Q
-"RTN","GPLRIMA",242,0)
-    ;
-"RTN","GPLRIMA",243,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","GPLRIMA",244,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","GPLRIMA",245,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","GPLRIMA",246,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","GPLRIMA",247,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","GPLRIMA",248,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","GPLRIMA",249,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","GPLRIMA",250,0)
-    ;
-"RTN","GPLRIMA",251,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","GPLRIMA",252,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","GPLRIMA",253,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","GPLRIMA",254,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","GPLRIMA",255,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","GPLRIMA",256,0)
-    Q
-"RTN","GPLRIMA",257,0)
-    ;
-"RTN","GPLRIMA",258,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","GPLRIMA",259,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
-"RTN","GPLRIMA",260,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","GPLRIMA",261,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","GPLRIMA",262,0)
-      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","GPLRIMA",263,0)
-      Q
-"RTN","GPLRIMA",264,0)
-      ;
-"RTN","GPLRIMA",265,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","GPLRIMA",266,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",267,0)
-      K @RIMTBL
-"RTN","GPLRIMA",268,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","GPLRIMA",269,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","GPLRIMA",270,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","GPLRIMA",271,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","GPLRIMA",272,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","GPLRIMA",273,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","GPLRIMA",274,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","GPLRIMA",275,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","GPLRIMA",276,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","GPLRIMA",277,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","GPLRIMA",278,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","GPLRIMA",279,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","GPLRIMA",280,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","GPLRIMA",281,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","GPLRIMA",282,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","GPLRIMA",283,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","GPLRIMA",284,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","GPLRIMA",285,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","GPLRIMA",286,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","GPLRIMA",287,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","GPLRIMA",288,0)
-      Q
-"RTN","GPLRIMA",289,0)
-      ;
-"RTN","GPLRIMA",290,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","GPLRIMA",291,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","GPLRIMA",292,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","GPLRIMA",293,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","GPLRIMA",294,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","GPLRIMA",295,0)
-    N USETBL
-"RTN","GPLRIMA",296,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","GPLRIMA",297,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","GPLRIMA",298,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","GPLRIMA",299,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","GPLRIMA",300,0)
-    Q
-"RTN","GPLRIMA",301,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","GPLRIMA",302,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","GPLRIMA",303,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","GPLRIMA",304,0)
-    ; IN SECTION "MEDS"
-"RTN","GPLRIMA",305,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","GPLRIMA",306,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","GPLRIMA",307,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","GPLRIMA",308,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","GPLRIMA",309,0)
-    ;
-"RTN","GPLRIMA",310,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","GPLRIMA",311,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",312,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",313,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","GPLRIMA",314,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","GPLRIMA",315,0)
-    N ZZI,ZZS
-"RTN","GPLRIMA",316,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","GPLRIMA",317,0)
-    ; ZWR @ZZS@(1)
-"RTN","GPLRIMA",318,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","GPLRIMA",319,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","GPLRIMA",320,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","GPLRIMA",321,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","GPLRIMA",322,0)
-    Q
-"RTN","GPLRIMA",323,0)
-    ;
-"RTN","GPLRIMA",324,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","GPLRIMA",325,0)
-    ;
-"RTN","GPLRIMA",326,0)
-    N ZR
-"RTN","GPLRIMA",327,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","GPLRIMA",328,0)
-    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
-"RTN","GPLRIMA",329,0)
-    E  W "NOTHING RETURNED",!
-"RTN","GPLRIMA",330,0)
-    Q
-"RTN","GPLRIMA",331,0)
-    ;
-"RTN","GPLRIMA",332,0)
-CAGET(RTN,IATTR) ;
-"RTN","GPLRIMA",333,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",334,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","GPLRIMA",335,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","GPLRIMA",336,0)
-    Q
-"RTN","GPLRIMA",337,0)
-    ;
-"RTN","GPLRIMA",338,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",339,0)
-    ;
-"RTN","GPLRIMA",340,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",341,0)
-    N ZLST
-"RTN","GPLRIMA",342,0)
-    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
-"RTN","GPLRIMA",343,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",344,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",345,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","GPLRIMA",346,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","GPLRIMA",347,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","GPLRIMA",348,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","GPLRIMA",349,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","GPLRIMA",350,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","GPLRIMA",351,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","GPLRIMA",352,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","GPLRIMA",353,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","GPLRIMA",354,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","GPLRIMA",355,0)
-    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","GPLRIMA",356,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","GPLRIMA",357,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","GPLRIMA",358,0)
-    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","GPLRIMA",359,0)
-    . S ZCNT=ZCNT+1
-"RTN","GPLRIMA",360,0)
-    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","GPLRIMA",361,0)
-    Q
-"RTN","GPLRIMA",362,0)
-    ;
-"RTN","GPLRIMA",363,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","GPLRIMA",364,0)
-    ;
-"RTN","GPLRIMA",365,0)
-    N ZR
-"RTN","GPLRIMA",366,0)
-    D PCLST(.ZR,CATTR)
-"RTN","GPLRIMA",367,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","GPLRIMA",368,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","GPLRIMA",369,0)
-    E  D  ;
-"RTN","GPLRIMA",370,0)
-    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
-"RTN","GPLRIMA",371,0)
-    . W "COUNT=",ZR(0),!
-"RTN","GPLRIMA",372,0)
-    Q
-"RTN","GPLRIMA",373,0)
-    ;
-"RTN","GPLRIMA",374,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","GPLRIMA",375,0)
-    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","GPLRIMA",376,0)
-    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","GPLRIMA",377,0)
-    ; DFN IS THE PATIENT NUMBER.
-"RTN","GPLRIMA",378,0)
-    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",379,0)
-    ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","GPLRIMA",380,0)
-    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","GPLRIMA",381,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",382,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",383,0)
-    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","GPLRIMA",384,0)
-    N ZZGI
-"RTN","GPLRIMA",385,0)
-    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","GPLRIMA",386,0)
-    . F ZZGI="PROBLEMS","VITALS","MEDS" D  ; FOR EACH SECTION
-"RTN","GPLRIMA",387,0)
-    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","GPLRIMA",388,0)
-    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","GPLRIMA",389,0)
-    Q
-"RTN","GPLRIMA",390,0)
-    ;
-"RTN","GPLRIMA",391,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","GPLRIMA",392,0)
-    ;
-"RTN","GPLRIMA",393,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","GPLRIMA",394,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","GPLRIMA",395,0)
-    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","GPLRIMA",396,0)
-    E  D  ; VARS EXIST
-"RTN","GPLRIMA",397,0)
-    . N ZGVI
-"RTN","GPLRIMA",398,0)
-    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","GPLRIMA",399,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","GPLRIMA",400,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","GPLRIMA",401,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","GPLRIMA",402,0)
-    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","GPLRIMA",403,0)
-    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
-"RTN","GPLRIMA",404,0)
-    . . ; D PARY^GPLXPATH("ZZGA")
-"RTN","GPLRIMA",405,0)
-    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","GPLRIMA",406,0)
-    Q
-"RTN","GPLRIMA",407,0)
-    ;
-"RTN","GPLRIMA",408,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
-"RTN","GPLRIMA",409,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","GPLRIMA",410,0)
-    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",411,0)
-    N GTMP
-"RTN","GPLRIMA",412,0)
-    D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","GPLRIMA",413,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","GPLRIMA",414,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","GPLRIMA",415,0)
-    D PARY^GPLXPATH("GTMP")
-"RTN","GPLRIMA",416,0)
-    Q
-"RTN","GPLRIMA",417,0)
-    ;
-"RTN","GPLUNIT")
-0^10^B31438520
-"RTN","GPLUNIT",1,0)
-GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-"RTN","GPLUNIT",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7
-"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  Q ; TEST SECTION DOESN'T EXIST
-"RTN","GPLUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","GPLUNIT",83,0)
-          N FIRST,LAST
-"RTN","GPLUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","GPLUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","GPLUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
-"RTN","GPLUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","GPLUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",89,0)
-          . . ;  W ZP,!
-"RTN","GPLUNIT",90,0)
-          . . S ZX=ZP
-"RTN","GPLUNIT",91,0)
-          . . W "RUNNING: "_ZP
-"RTN","GPLUNIT",92,0)
-          . . X ZX
-"RTN","GPLUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
-"RTN","GPLUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-"RTN","GPLUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",96,0)
-          . . S ZX="S ZR="_ZP
-"RTN","GPLUNIT",97,0)
-          . . W "TRYING: "_ZP
-"RTN","GPLUNIT",98,0)
-          . . X ZX
-"RTN","GPLUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","GPLUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-"RTN","GPLUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
-"RTN","GPLUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
-"RTN","GPLUNIT",104,0)
-          Q
-"RTN","GPLUNIT",105,0)
-          ;
-"RTN","GPLUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
-"RTN","GPLUNIT",107,0)
-          N ZTMP
-"RTN","GPLUNIT",108,0)
-          D ZLOAD(.ZTMP)
-"RTN","GPLUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
-"RTN","GPLUNIT",110,0)
-          W "PASSED: ",TPASSED,!
-"RTN","GPLUNIT",111,0)
-          W "FAILED: ",TFAILED,!
-"RTN","GPLUNIT",112,0)
-          W !
-"RTN","GPLUNIT",113,0)
-          W "THE TESTS!",!
-"RTN","GPLUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
-"RTN","GPLUNIT",115,0)
-          Q
-"RTN","GPLUNIT",116,0)
-          ;
-"RTN","GPLUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","GPLUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",119,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",120,0)
-          . D PUSH^GPLXPATH(RTN,I)
-"RTN","GPLUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",122,0)
-          Q
-"RTN","GPLUNIT",123,0)
-          ;
-"RTN","GPLUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","GPLUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","GPLUNIT",126,0)
-          S TOTP=0 S TOTF=0
-"RTN","GPLUNIT",127,0)
-          D ZLOAD^GPLUNIT("TZTMP",RNM)
-"RTN","GPLUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
-"RTN","GPLUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",131,0)
-          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
-"RTN","GPLUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
-"RTN","GPLUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
-"RTN","GPLUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","GPLUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","GPLUNIT",136,0)
-          F I=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","GPLUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","GPLUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","GPLUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","GPLUNIT",141,0)
-          Q
-"RTN","GPLUNIT",142,0)
-          ;
-"RTN","GPLUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","GPLUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-"RTN","GPLUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
-"RTN","GPLUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",147,0)
-          S K=1
-"RTN","GPLUNIT",148,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",149,0)
-          . ; W "I IS NOW=",I,!
-"RTN","GPLUNIT",150,0)
-          . W I," "
-"RTN","GPLUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",152,0)
-          . S K=K+1 I K=6  D
-"RTN","GPLUNIT",153,0)
-          . . W !
-"RTN","GPLUNIT",154,0)
-          . . S K=1
-"RTN","GPLUNIT",155,0)
-          Q
-"RTN","GPLUNIT",156,0)
-          ;
-"RTN","GPLVITAL")
-0^12^B99833868
-"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 7
-"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)
-          S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","GPLVITAL",45,0)
-          F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","GPLVITAL",46,0)
-          . I $D(VITRSLT(VSORT(J))) D
-"RTN","GPLVITAL",47,0)
-          . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","GPLVITAL",48,0)
-          . . K @VITVMAP
-"RTN","GPLVITAL",49,0)
-          . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","GPLVITAL",50,0)
-          . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","GPLVITAL",51,0)
-          . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","GPLVITAL",52,0)
-          . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","GPLVITAL",53,0)
-          . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","GPLVITAL",54,0)
-          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","GPLVITAL",55,0)
-          . . I $P(VITPTMP,U,2)="HT" D
-"RTN","GPLVITAL",56,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",57,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",58,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",59,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",60,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",61,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",62,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",63,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-"RTN","GPLVITAL",64,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",65,0)
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",66,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",67,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",68,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","GPLVITAL",69,0)
-          . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","GPLVITAL",70,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",71,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",72,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",73,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",74,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",75,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",76,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",77,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-"RTN","GPLVITAL",78,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",79,0)
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",80,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",81,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",82,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","GPLVITAL",83,0)
-          . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","GPLVITAL",84,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",85,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",86,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",87,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",88,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",89,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",90,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",91,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-"RTN","GPLVITAL",92,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",93,0)
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",94,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",95,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",96,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",97,0)
-          . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","GPLVITAL",98,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",99,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",100,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",101,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",102,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",103,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",104,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",105,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-"RTN","GPLVITAL",106,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",107,0)
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",108,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",109,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",110,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","GPLVITAL",111,0)
-          . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","GPLVITAL",112,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",113,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",114,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",115,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",116,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",117,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",118,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",119,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-"RTN","GPLVITAL",120,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",121,0)
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",122,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",123,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",124,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",125,0)
-          . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","GPLVITAL",126,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",127,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",128,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",129,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",130,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",131,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",132,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",133,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-"RTN","GPLVITAL",134,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",135,0)
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",136,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",137,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",138,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",139,0)
-          . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","GPLVITAL",140,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",141,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",142,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",143,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",144,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",145,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",146,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",147,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-"RTN","GPLVITAL",148,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",149,0)
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",150,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",151,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",152,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",153,0)
-          . . E  D
-"RTN","GPLVITAL",154,0)
-          . . . ;W "IN VITAL:  OTHER",!
-"RTN","GPLVITAL",155,0)
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",156,0)
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",157,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","GPLVITAL",158,0)
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",159,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",160,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","GPLVITAL",161,0)
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","GPLVITAL",162,0)
-          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-"RTN","GPLVITAL",163,0)
-          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-"RTN","GPLVITAL",164,0)
-          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",165,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",166,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",167,0)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","GPLVITAL",168,0)
-          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","GPLVITAL",169,0)
-          . . K @VITARYTMP
-"RTN","GPLVITAL",170,0)
-          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","GPLVITAL",171,0)
-          . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLVITAL",172,0)
-          . . . ; W "FIRST ONE",!
-"RTN","GPLVITAL",173,0)
-          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-"RTN","GPLVITAL",174,0)
-          . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","GPLVITAL",175,0)
-          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLVITAL",176,0)
-          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-"RTN","GPLVITAL",177,0)
-          ; ZWR ^TMP($J,"VITALS",*)
-"RTN","GPLVITAL",178,0)
-          ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLVITAL",179,0)
-          I DEBUG D PARY^GPLXPATH(VITOUTXML)
-"RTN","GPLVITAL",180,0)
-          N VITTMP,I
-"RTN","GPLVITAL",181,0)
-          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLVITAL",182,0)
-          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLVITAL",183,0)
-          . W "VITALS MISSING ",!
-"RTN","GPLVITAL",184,0)
-          . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","GPLVITAL",185,0)
-          Q
-"RTN","GPLVITAL",186,0)
-          ;
-"RTN","GPLVITAL",187,0)
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","GPLVITAL",188,0)
-         ; OF DATES IN THE VITALS RESULTS
-"RTN","GPLVITAL",189,0)
-         N VDTI,VDTJ,VTDCNT
-"RTN","GPLVITAL",190,0)
-         S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","GPLVITAL",191,0)
-         S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","GPLVITAL",192,0)
-         F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","GPLVITAL",193,0)
-         . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","GPLVITAL",194,0)
-         . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","GPLVITAL",195,0)
-         . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","GPLVITAL",196,0)
-         Q
-"RTN","GPLVITAL",197,0)
-         ;
-"RTN","GPLXPAT0")
-0^19^B50983429
-"RTN","GPLXPAT0",1,0)
-GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-"RTN","GPLXPAT0",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 7
-"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)
- ;;><PUSHA>
-"RTN","GPLXPAT0",193,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","GPLXPAT0",195,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","A")
-"RTN","GPLXPAT0",196,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","B")
-"RTN","GPLXPAT0",197,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","C")
-"RTN","GPLXPAT0",198,0)
- ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
-"RTN","GPLXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","GPLXPAT0",200,0)
- ;;>>?GTMP(0)=3
-"RTN","GPLXPAT0",201,0)
- ;;><H2ARY>
-"RTN","GPLXPAT0",202,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","GPLXPAT0",204,0)
- ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","GPLXPAT0",206,0)
- ;;>>?GTMP2(1)="TEST1^1"
-"RTN","GPLXPAT0",207,0)
- ;;><XVARS>
-"RTN","GPLXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",209,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
-"RTN","GPLXPAT0",210,0)
- ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",211,0)
- ;;>>?GTMP2(1)="VAR1^"
-"RTN","GPLXPAT0",212,0)
- ;;></TEST>
-"RTN","GPLXPATH")
-0^9^B234894534
-"RTN","GPLXPATH",1,0)
-GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-"RTN","GPLXPATH",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 7
-"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)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","GPLXPATH",53,0)
- ;
-"RTN","GPLXPATH",54,0)
- N ZGI
-"RTN","GPLXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
-"RTN","GPLXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
-"RTN","GPLXPATH",57,0)
- Q
-"RTN","GPLXPATH",58,0)
- ;
-"RTN","GPLXPATH",59,0)
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","GPLXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","GPLXPATH",61,0)
- S RTN=""
-"RTN","GPLXPATH",62,0)
- N I
-"RTN","GPLXPATH",63,0)
- ; W "STK= ",STK,!
-"RTN","GPLXPATH",64,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",65,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","GPLXPATH",66,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","GPLXPATH",67,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","GPLXPATH",68,0)
- Q
-"RTN","GPLXPATH",69,0)
- ;
-"RTN","GPLXPATH",70,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","GPLXPATH",71,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","GPLXPATH",72,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","GPLXPATH",73,0)
- N CUR,TMP
-"RTN","GPLXPATH",74,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","GPLXPATH",75,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","GPLXPATH",76,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","GPLXPATH",77,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","GPLXPATH",78,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","GPLXPATH",79,0)
- ; W "CUR= ",CUR,!
-"RTN","GPLXPATH",80,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","GPLXPATH",81,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","GPLXPATH",82,0)
- ; W "CUR2= ",CUR,!
-"RTN","GPLXPATH",83,0)
- Q CUR
-"RTN","GPLXPATH",84,0)
- ;
-"RTN","GPLXPATH",85,0)
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
-"RTN","GPLXPATH",86,0)
- ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
-"RTN","GPLXPATH",87,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","GPLXPATH",88,0)
- ; XML SECTION
-"RTN","GPLXPATH",89,0)
- ; ZXML IS PASSED BY NAME
-"RTN","GPLXPATH",90,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
-"RTN","GPLXPATH",91,0)
- N GPLSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","GPLXPATH",92,0)
- I '$D(@ZXML@(0))  D  ; NO XML PASSED
-"RTN","GPLXPATH",93,0)
- . W "ERROR IN XML FILE",!
-"RTN","GPLXPATH",94,0)
- S GPLSTK(0)=0 ; INITIALIZE STACK
-"RTN","GPLXPATH",95,0)
- F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","GPLXPATH",96,0)
- . S LINE=@ZXML@(I)
-"RTN","GPLXPATH",97,0)
- . ;W LINE,!
-"RTN","GPLXPATH",98,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","GPLXPATH",99,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","GPLXPATH",100,0)
- . I FOUND'=1  D
-"RTN","GPLXPATH",101,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","GPLXPATH",102,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","GPLXPATH",103,0)
- . . . ; ON THE SAME LINE
-"RTN","GPLXPATH",104,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",105,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",106,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",107,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",108,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",109,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",110,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",111,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",112,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",113,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","GPLXPATH",114,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",115,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","GPLXPATH",116,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","GPLXPATH",117,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",118,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",119,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",120,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",121,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",122,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",123,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","GPLXPATH",124,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","GPLXPATH",125,0)
- . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","GPLXPATH",126,0)
- . . . . Q
-"RTN","GPLXPATH",127,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","GPLXPATH",128,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","GPLXPATH",129,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",130,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",131,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",132,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",133,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",134,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",135,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",136,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",137,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",138,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","GPLXPATH",139,0)
- S @ZXML@("INDEXED")=""
-"RTN","GPLXPATH",140,0)
- S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
-"RTN","GPLXPATH",141,0)
- Q
-"RTN","GPLXPATH",142,0)
- ;
-"RTN","GPLXPATH",143,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","GPLXPATH",144,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","GPLXPATH",145,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","GPLXPATH",146,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","GPLXPATH",147,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","GPLXPATH",148,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","GPLXPATH",149,0)
- N TMP,I,J,QXPATH
-"RTN","GPLXPATH",150,0)
- S FIRST=1
-"RTN","GPLXPATH",151,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","GPLXPATH",152,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","GPLXPATH",153,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","GPLXPATH",154,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","GPLXPATH",155,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","GPLXPATH",156,0)
- K @OARY
-"RTN","GPLXPATH",157,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","GPLXPATH",158,0)
- S J=1
-"RTN","GPLXPATH",159,0)
- FOR I=FIRST:1:LAST  D
-"RTN","GPLXPATH",160,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","GPLXPATH",161,0)
- . S J=J+1
-"RTN","GPLXPATH",162,0)
- ; ZWR OARY
-"RTN","GPLXPATH",163,0)
- Q
-"RTN","GPLXPATH",164,0)
- ;
-"RTN","GPLXPATH",165,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","GPLXPATH",166,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",167,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",168,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","GPLXPATH",169,0)
- ;
-"RTN","GPLXPATH",170,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","GPLXPATH",171,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",172,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",173,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","GPLXPATH",174,0)
- ;
-"RTN","GPLXPATH",175,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","GPLXPATH",176,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",177,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",178,0)
- Q $P(ISTR,";",2)
-"RTN","GPLXPATH",179,0)
- ;
-"RTN","GPLXPATH",180,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","GPLXPATH",181,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",182,0)
- Q $P(ISTR,";",3)
-"RTN","GPLXPATH",183,0)
- ;
-"RTN","GPLXPATH",184,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","GPLXPATH",185,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",186,0)
- Q $P(ISTR,";",1)
-"RTN","GPLXPATH",187,0)
- ;
-"RTN","GPLXPATH",188,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","GPLXPATH",189,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","GPLXPATH",190,0)
- ; DEST IS CLEARED TO START
-"RTN","GPLXPATH",191,0)
- ; USES PUSH TO DO THE COPY
-"RTN","GPLXPATH",192,0)
- N I
-"RTN","GPLXPATH",193,0)
- K @BDEST
-"RTN","GPLXPATH",194,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","GPLXPATH",195,0)
- . N J,ATMP
-"RTN","GPLXPATH",196,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","GPLXPATH",197,0)
- . I DEBUG W "ATMP=",ATMP,!
-"RTN","GPLXPATH",198,0)
- . I DEBUG W @BLIST@(I),!
-"RTN","GPLXPATH",199,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","GPLXPATH",200,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","GPLXPATH",201,0)
- . . I DEBUG W "BDEST= ",BDEST,!
-"RTN","GPLXPATH",202,0)
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
-"RTN","GPLXPATH",203,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","GPLXPATH",204,0)
- Q
-"RTN","GPLXPATH",205,0)
- ;
-"RTN","GPLXPATH",206,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","GPLXPATH",207,0)
- ;
-"RTN","GPLXPATH",208,0)
- I DEBUG W "QUEUEING ",BLST,!
-"RTN","GPLXPATH",209,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","GPLXPATH",210,0)
- Q
-"RTN","GPLXPATH",211,0)
- ;
-"RTN","GPLXPATH",212,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","GPLXPATH",213,0)
- ; KILLS CPDEST FIRST
-"RTN","GPLXPATH",214,0)
- N CPINSTR
-"RTN","GPLXPATH",215,0)
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","GPLXPATH",216,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","GPLXPATH",217,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","GPLXPATH",218,0)
- . Q
-"RTN","GPLXPATH",219,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","GPLXPATH",220,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","GPLXPATH",221,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","GPLXPATH",222,0)
- Q
-"RTN","GPLXPATH",223,0)
- ;
-"RTN","GPLXPATH",224,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","GPLXPATH",225,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","GPLXPATH",226,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","GPLXPATH",227,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","GPLXPATH",228,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",229,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","GPLXPATH",230,0)
- . Q
-"RTN","GPLXPATH",231,0)
- I DEBUG W "DOING QOPEN",!
-"RTN","GPLXPATH",232,0)
- N S1,E1,QOT,QOTMP
-"RTN","GPLXPATH",233,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","GPLXPATH",234,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",235,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","GPLXPATH",236,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","GPLXPATH",237,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",238,0)
- . S E1=@QOXML@(0)-1
-"RTN","GPLXPATH",239,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","GPLXPATH",240,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","GPLXPATH",241,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","GPLXPATH",242,0)
- Q
-"RTN","GPLXPATH",243,0)
- ;
-"RTN","GPLXPATH",244,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","GPLXPATH",245,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","GPLXPATH",246,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","GPLXPATH",247,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","GPLXPATH",248,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","GPLXPATH",249,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",250,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","GPLXPATH",251,0)
- I DEBUG W "GOING TO CLOSE",!
-"RTN","GPLXPATH",252,0)
- N S1,E1,QCT,QCTMP
-"RTN","GPLXPATH",253,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","GPLXPATH",254,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",255,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","GPLXPATH",256,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","GPLXPATH",257,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",258,0)
- . S S1=@QCXML@(0)
-"RTN","GPLXPATH",259,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","GPLXPATH",260,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","GPLXPATH",261,0)
- Q
-"RTN","GPLXPATH",262,0)
- ;
-"RTN","GPLXPATH",263,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","GPLXPATH",264,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","GPLXPATH",265,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","GPLXPATH",266,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","GPLXPATH",267,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","GPLXPATH",268,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","GPLXPATH",269,0)
- N INSBLD,INSTMP
-"RTN","GPLXPATH",270,0)
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","GPLXPATH",271,0)
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","GPLXPATH",272,0)
- I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","GPLXPATH",273,0)
- . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","GPLXPATH",274,0)
- I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",275,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",276,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","GPLXPATH",277,0)
- . . I DEBUG D PARY^GPLXPATH("INSBLD")
-"RTN","GPLXPATH",278,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",279,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","GPLXPATH",280,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","GPLXPATH",281,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",282,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","GPLXPATH",283,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",284,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","GPLXPATH",285,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","GPLXPATH",286,0)
- . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","GPLXPATH",287,0)
- Q
-"RTN","GPLXPATH",288,0)
- ;
-"RTN","GPLXPATH",289,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","GPLXPATH",290,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","GPLXPATH",291,0)
- ;
-"RTN","GPLXPATH",292,0)
- N INNBLD,UXPATH
-"RTN","GPLXPATH",293,0)
- N INNTBUF
-"RTN","GPLXPATH",294,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","GPLXPATH",295,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","GPLXPATH",296,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","GPLXPATH",297,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","GPLXPATH",298,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","GPLXPATH",299,0)
- . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","GPLXPATH",300,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","GPLXPATH",301,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","GPLXPATH",302,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","GPLXPATH",303,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","GPLXPATH",304,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","GPLXPATH",305,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","GPLXPATH",306,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","GPLXPATH",307,0)
- Q
-"RTN","GPLXPATH",308,0)
- ;
-"RTN","GPLXPATH",309,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","GPLXPATH",310,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","GPLXPATH",311,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",312,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","GPLXPATH",313,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","GPLXPATH",314,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","GPLXPATH",315,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",316,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","GPLXPATH",317,0)
- I DEBUG D PARY("XDEST")
-"RTN","GPLXPATH",318,0)
- Q
-"RTN","GPLXPATH",319,0)
- ;
-"RTN","GPLXPATH",320,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","GPLXPATH",321,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","GPLXPATH",322,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","GPLXPATH",323,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","GPLXPATH",324,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","GPLXPATH",325,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","GPLXPATH",326,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","GPLXPATH",327,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","GPLXPATH",328,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","GPLXPATH",329,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","GPLXPATH",330,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","GPLXPATH",331,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","GPLXPATH",332,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",333,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","GPLXPATH",334,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","GPLXPATH",335,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","GPLXPATH",336,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",337,0)
- I DEBUG W "REPLACE PREBUILD",!
-"RTN","GPLXPATH",338,0)
- I DEBUG D PARY("REBLD")
-"RTN","GPLXPATH",339,0)
- D BUILD("REBLD","RTMP")
-"RTN","GPLXPATH",340,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","GPLXPATH",341,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","GPLXPATH",342,0)
- Q
-"RTN","GPLXPATH",343,0)
- ;
-"RTN","GPLXPATH",344,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","GPLXPATH",345,0)
- ; W "Reporting on the missing",!
-"RTN","GPLXPATH",346,0)
- ; W OARY
-"RTN","GPLXPATH",347,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","GPLXPATH",348,0)
- N I
-"RTN","GPLXPATH",349,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","GPLXPATH",350,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",351,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","GPLXPATH",352,0)
- . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","GPLXPATH",353,0)
- . . Q
-"RTN","GPLXPATH",354,0)
- Q
-"RTN","GPLXPATH",355,0)
- ;
-"RTN","GPLXPATH",356,0)
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","GPLXPATH",357,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","GPLXPATH",358,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","GPLXPATH",359,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","GPLXPATH",360,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","GPLXPATH",361,0)
- S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
-"RTN","GPLXPATH",362,0)
- F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",363,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","GPLXPATH",364,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","GPLXPATH",365,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","GPLXPATH",366,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","GPLXPATH",367,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","GPLXPATH",368,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","GPLXPATH",369,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","GPLXPATH",370,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","GPLXPATH",371,0)
- . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","GPLXPATH",372,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","GPLXPATH",373,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","GPLXPATH",374,0)
- . . I DEBUG W TSTR
-"RTN","GPLXPATH",375,0)
- I DEBUG W "MAPPED",!
-"RTN","GPLXPATH",376,0)
- Q
-"RTN","GPLXPATH",377,0)
- ;
-"RTN","GPLXPATH",378,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","GPLXPATH",379,0)
- ; THEXML IS PASSED BY NAME
-"RTN","GPLXPATH",380,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","GPLXPATH",381,0)
- S FOUND=0
-"RTN","GPLXPATH",382,0)
- S INTXT=0
-"RTN","GPLXPATH",383,0)
- I DEBUG W "DELETING EMPTY ELEMENTS",!
-"RTN","GPLXPATH",384,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","GPLXPATH",385,0)
- . S J=@THEXML@(I)
-"RTN","GPLXPATH",386,0)
- . I J["<text>" D
-"RTN","GPLXPATH",387,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","GPLXPATH",388,0)
- . . I DEBUG W "IN HTML SECTION",!
-"RTN","GPLXPATH",389,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","GPLXPATH",390,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","GPLXPATH",391,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","GPLXPATH",392,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","GPLXPATH",393,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","GPLXPATH",394,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","GPLXPATH",395,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","GPLXPATH",396,0)
- . . . I DEBUG W I,J,JP,!
-"RTN","GPLXPATH",397,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",398,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","GPLXPATH",399,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","GPLXPATH",400,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","GPLXPATH",401,0)
- . . . I DEBUG W I,J,!
-"RTN","GPLXPATH",402,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",403,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","GPLXPATH",404,0)
- . . . I JM=JPX D  ;
-"RTN","GPLXPATH",405,0)
- . . . . I DEBUG W I,JM_J_JPX,!
-"RTN","GPLXPATH",406,0)
- . . . . S DEL(I-1)=""
-"RTN","GPLXPATH",407,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","GPLXPATH",408,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","GPLXPATH",409,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","GPLXPATH",410,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","GPLXPATH",411,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","GPLXPATH",412,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","GPLXPATH",413,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","GPLXPATH",414,0)
- Q FOUND
-"RTN","GPLXPATH",415,0)
- ;
-"RTN","GPLXPATH",416,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","GPLXPATH",417,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","GPLXPATH",418,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",419,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","GPLXPATH",420,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",421,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","GPLXPATH",422,0)
- Q
-"RTN","GPLXPATH",423,0)
- ;
-"RTN","GPLXPATH",424,0)
-PARY(GLO)       ;PRINT AN ARRAY
-"RTN","GPLXPATH",425,0)
- N I
-"RTN","GPLXPATH",426,0)
- F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
-"RTN","GPLXPATH",427,0)
- Q
-"RTN","GPLXPATH",428,0)
- ;
-"RTN","GPLXPATH",429,0)
-H2ARY(IARYRTN,IHASH) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","GPLXPATH",430,0)
- ;
-"RTN","GPLXPATH",431,0)
- N H2I S H2I=""
-"RTN","GPLXPATH",432,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","GPLXPATH",433,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","GPLXPATH",434,0)
- . ; W H2I_"^"_@IHASH@(H2I),!
-"RTN","GPLXPATH",435,0)
- . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
-"RTN","GPLXPATH",436,0)
- . ; W @IARYRTN@(0),!
-"RTN","GPLXPATH",437,0)
- Q
-"RTN","GPLXPATH",438,0)
- ;
-"RTN","GPLXPATH",439,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","GPLXPATH",440,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","GPLXPATH",441,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","GPLXPATH",442,0)
- ;
-"RTN","GPLXPATH",443,0)
- N XVI,XVTMP,XVT
-"RTN","GPLXPATH",444,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","GPLXPATH",445,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","GPLXPATH",446,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
-"RTN","GPLXPATH",447,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","GPLXPATH",448,0)
- Q
-"RTN","GPLXPATH",449,0)
- ;
-"RTN","GPLXPATH",450,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","GPLXPATH",451,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","GPLXPATH",452,0)
- ;
-"RTN","GPLXPATH",453,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","GPLXPATH",454,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","GPLXPATH",455,0)
- . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",456,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",457,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","GPLXPATH",458,0)
- . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",459,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",460,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","GPLXPATH",461,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","GPLXPATH",462,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","GPLXPATH",463,0)
- D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","GPLXPATH",464,0)
- Q
-"RTN","GPLXPATH",465,0)
- ;
-"RTN","GPLXPATH",466,0)
-TEST     ; Run all the test cases
-"RTN","GPLXPATH",467,0)
- D TESTALL^GPLUNIT("GPLXPAT0")
-"RTN","GPLXPATH",468,0)
- Q
-"RTN","GPLXPATH",469,0)
- ;
-"RTN","GPLXPATH",470,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","GPLXPATH",471,0)
- N ZTMP
-"RTN","GPLXPATH",472,0)
- S DEBUG=1
-"RTN","GPLXPATH",473,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",474,0)
- D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLXPATH",475,0)
- Q
-"RTN","GPLXPATH",476,0)
- ;
-"RTN","GPLXPATH",477,0)
-TLIST   ; LIST THE TESTS
-"RTN","GPLXPATH",478,0)
- N ZTMP
-"RTN","GPLXPATH",479,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",480,0)
- D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLXPATH",481,0)
- Q
-"RTN","GPLXPATH",482,0)
- ;
-"VER")
-8.0^22.0
-**END**
-**END**
Index: ccr/tags/CCR_1_0_7/p/CCR_1_0_5_T1_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_5_T1_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,9070 +1,0 @@
-KIDS Distribution saved on Oct 07, 2008@13:29:01
-improved meds, repaired Vitals, new cmds DPATV
-**KIDS**:CCR*1.0*5^
-
-**INSTALL NAME**
-CCR*1.0*5
-"BLD",6955,0)
-CCR*1.0*5^^0^3081007^n
-"BLD",6955,1,0)
-^^23^23^3080923^
-"BLD",6955,1,1,0)
- 
-"BLD",6955,1,2,0)
-CCR AND CCD EXPORT TOOLS 
-"BLD",6955,1,3,0)
- 
-"BLD",6955,1,4,0)
-SINGLE XML EXPORT TO A HOST DIRECTORY AT 
-"BLD",6955,1,5,0)
- 
-"BLD",6955,1,6,0)
-BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
-"BLD",6955,1,7,0)
-DIRECTORY
-"BLD",6955,1,8,0)
- 
-"BLD",6955,1,9,0)
-EXPORT^GPLCRR FOR THE CCR
-"BLD",6955,1,10,0)
-EXPORT^GPLCCD FOR THE CCD
-"BLD",6955,1,11,0)
-XPAT^GPLCCR(DFN,"","") 
-"BLD",6955,1,12,0)
- 
-"BLD",6955,1,13,0)
-BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
-"BLD",6955,1,14,0)
- 
-"BLD",6955,1,15,0)
-ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
-"BLD",6955,1,16,0)
-RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
-"BLD",6955,1,17,0)
-ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
-"BLD",6955,1,18,0)
- 
-"BLD",6955,1,19,0)
-CLIST^GPLRIMA TO LIST CATEGORY TOTALS
-"BLD",6955,1,20,0)
-CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
-"BLD",6955,1,21,0)
-XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
-"BLD",6955,1,22,0)
- 
-"BLD",6955,1,23,0)
-TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
-"BLD",6955,4,0)
-^9.64PA^^
-"BLD",6955,6.3)
-8
-"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^B45805995
-"BLD",6955,"KRN",9.8,"NM",2,0)
-CCRDPTT^^0^B4791589
-"BLD",6955,"KRN",9.8,"NM",3,0)
-CCRMEDS^^0^B59807333
-"BLD",6955,"KRN",9.8,"NM",4,0)
-CCRSYS^^0^B5866233
-"BLD",6955,"KRN",9.8,"NM",5,0)
-CCRUNIT^^0^B8574
-"BLD",6955,"KRN",9.8,"NM",6,0)
-CCRUTIL^^0^B5927217
-"BLD",6955,"KRN",9.8,"NM",7,0)
-CCRVA200^^0^B35847405
-"BLD",6955,"KRN",9.8,"NM",8,0)
-GPLACTOR^^0^B52628160
-"BLD",6955,"KRN",9.8,"NM",9,0)
-GPLXPATH^^0^B241520746
-"BLD",6955,"KRN",9.8,"NM",10,0)
-GPLUNIT^^0^B31438520
-"BLD",6955,"KRN",9.8,"NM",11,0)
-GPLPROBS^^0^B25875394
-"BLD",6955,"KRN",9.8,"NM",12,0)
-GPLVITAL^^0^B82628966
-"BLD",6955,"KRN",9.8,"NM",13,0)
-GPLRIMA^^0^B214212612
-"BLD",6955,"KRN",9.8,"NM",14,0)
-GPLCCR^^0^B82167126
-"BLD",6955,"KRN",9.8,"NM",15,0)
-GPLCCR0^^0^B654252455
-"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^B55630630
-"BLD",6955,"KRN",9.8,"NM",19,0)
-GPLXPAT0^^0^B50983429
-"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^B45805995
-"RTN","CCRDPT",1,0)
-CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
-"RTN","CCRDPT",2,0)
- ;;0.2;CCRCCD;;Jun 15, 2008;Build 8
-"RTN","CCRDPT",3,0)
- ;
-"RTN","CCRDPT",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRDPT",5,0)
- ; General Public License. 
-"RTN","CCRDPT",6,0)
- ; 
-"RTN","CCRDPT",7,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRDPT",8,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRDPT",9,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRDPT",10,0)
- ; GNU General Public License for more details.
-"RTN","CCRDPT",11,0)
- ; 
-"RTN","CCRDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRDPT",14,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRDPT",15,0)
- ;
-"RTN","CCRDPT",16,0)
- ; CCRDPT       CCRCCD/SMH - Routines to Extract Patient Data for
-"RTN","CCRDPT",17,0)
- ; FAMILY       Family Name
-"RTN","CCRDPT",18,0)
- ; GIVEN        Given Name
-"RTN","CCRDPT",19,0)
- ; MIDDLE       Middle Name
-"RTN","CCRDPT",20,0)
- ; SUFFIX       Suffix Name
-"RTN","CCRDPT",21,0)
- ; DISPNAME     Display Name
-"RTN","CCRDPT",22,0)
- ; DOB          Date of Birth
-"RTN","CCRDPT",23,0)
- ; GENDER       Get Gender
-"RTN","CCRDPT",24,0)
- ; SSN          Get SSN for ID
-"RTN","CCRDPT",25,0)
- ; ADDRTYPE     Get Home Address
-"RTN","CCRDPT",26,0)
- ; ADDR1        Get Home Address line 1
-"RTN","CCRDPT",27,0)
- ; ADDR2        Get Home Address line 2
-"RTN","CCRDPT",28,0)
- ; CITY         Get City for Home Address
-"RTN","CCRDPT",29,0)
- ; STATE        Get State for Home Address
-"RTN","CCRDPT",30,0)
- ; ZIP          Get Zip code for Home Address
-"RTN","CCRDPT",31,0)
- ; COUNTY       Get County for our Address
-"RTN","CCRDPT",32,0)
- ; COUNTRY      Get Country for our Address
-"RTN","CCRDPT",33,0)
- ; RESTEL       Residential Telephone
-"RTN","CCRDPT",34,0)
- ; WORKTEL      Work Telephone
-"RTN","CCRDPT",35,0)
- ; EMAIL        Email Adddress
-"RTN","CCRDPT",36,0)
- ; CELLTEL      Cell Phone
-"RTN","CCRDPT",37,0)
- ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",38,0)
- ; NOK1GIV      NOK1 Given Name
-"RTN","CCRDPT",39,0)
- ; NOK1MID      NOK1 Middle Name
-"RTN","CCRDPT",40,0)
- ; NOK1SUF      NOK1 Suffi Name
-"RTN","CCRDPT",41,0)
- ; NOK1DISP     NOK1 Display Name
-"RTN","CCRDPT",42,0)
- ; NOK1REL      NOK1 Relationship to the patient
-"RTN","CCRDPT",43,0)
- ; NOK1ADD1     NOK1 Address 1
-"RTN","CCRDPT",44,0)
- ; NOK1ADD2     NOK1 Address 2
-"RTN","CCRDPT",45,0)
- ; NOK1CITY     NOK1 City
-"RTN","CCRDPT",46,0)
- ; NOK1STAT     NOK1 State
-"RTN","CCRDPT",47,0)
- ; NOK1ZIP      NOK1 Zip Code
-"RTN","CCRDPT",48,0)
- ; NOK1HTEL     NOK1 Home Telephone
-"RTN","CCRDPT",49,0)
- ; NOK1WTEL     NOK1 Work Telephone
-"RTN","CCRDPT",50,0)
- ; NOK1SAME     Is NOK1's Address the same the patient?
-"RTN","CCRDPT",51,0)
- ; NOK2FAM      NOK2 Family Name
-"RTN","CCRDPT",52,0)
- ; NOK2GIV      NOK2 Given Name
-"RTN","CCRDPT",53,0)
- ; NOK2MID      NOK2 Middle Name
-"RTN","CCRDPT",54,0)
- ; NOK2SUF      NOK2 Suffi Name
-"RTN","CCRDPT",55,0)
- ; NOK2DISP     NOK2 Display Name
-"RTN","CCRDPT",56,0)
- ; NOK2REL      NOK2 Relationship to the patient
-"RTN","CCRDPT",57,0)
- ; NOK2ADD1     NOK2 Address 1
-"RTN","CCRDPT",58,0)
- ; NOK2ADD2     NOK2 Address 2
-"RTN","CCRDPT",59,0)
- ; NOK2CITY     NOK2 City
-"RTN","CCRDPT",60,0)
- ; NOK2STAT     NOK2 State
-"RTN","CCRDPT",61,0)
- ; NOK2ZIP      NOK2 Zip Code
-"RTN","CCRDPT",62,0)
- ; NOK2HTEL     NOK2 Home Telephone
-"RTN","CCRDPT",63,0)
- ; NOK2WTEL     NOK2 Work Telephone
-"RTN","CCRDPT",64,0)
- ; NOK2SAME     Is NOK2's Address the same the patient?
-"RTN","CCRDPT",65,0)
- ; EMERFAM      Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",66,0)
- ; EMERGIV      EMER Given Name
-"RTN","CCRDPT",67,0)
- ; EMERMID      EMER Middle Name
-"RTN","CCRDPT",68,0)
- ; EMERSUF      EMER Suffi Name
-"RTN","CCRDPT",69,0)
- ; EMERDISP     EMER Display Name
-"RTN","CCRDPT",70,0)
- ; EMERREL      EMER Relationship to the patient
-"RTN","CCRDPT",71,0)
- ; EMERADD1     EMER Address 1
-"RTN","CCRDPT",72,0)
- ; EMERADD2     EMER Address 2
-"RTN","CCRDPT",73,0)
- ; EMERCITY     EMER City
-"RTN","CCRDPT",74,0)
- ; EMERSTAT     EMER State
-"RTN","CCRDPT",75,0)
- ; EMERZIP      EMER Zip Code
-"RTN","CCRDPT",76,0)
- ; EMERHTEL     EMER Home Telephone
-"RTN","CCRDPT",77,0)
- ; EMERWTEL     EMER Work Telephone
-"RTN","CCRDPT",78,0)
- ; EMERSAME     Is EMER's Address the same the NOK?
-"RTN","CCRDPT",79,0)
- ;
-"RTN","CCRDPT",80,0)
- W "No Entry at top!" Q
-"RTN","CCRDPT",81,0)
- ;
-"RTN","CCRDPT",82,0)
- ;**Revision History**
-"RTN","CCRDPT",83,0)
- ; - June 15, 08: v0.1 using merged global
-"RTN","CCRDPT",84,0)
- ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
-"RTN","CCRDPT",85,0)
- ;
-"RTN","CCRDPT",86,0)
- ; All methods are Public and Extrinsic
-"RTN","CCRDPT",87,0)
- ; All calls use Fileman file 2 (Patient).
-"RTN","CCRDPT",88,0)
- ; You can obtain field numbers using the data dictionary
-"RTN","CCRDPT",89,0)
- ;
-"RTN","CCRDPT",90,0)
-FAMILY(DFN) ; Family Name
-"RTN","CCRDPT",91,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",92,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",93,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",94,0)
-GIVEN(DFN) ; Given Name
-"RTN","CCRDPT",95,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",96,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",97,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",98,0)
-MIDDLE(DFN) ; Middle Name
-"RTN","CCRDPT",99,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",100,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",101,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",102,0)
-SUFFIX(DFN) ; Suffi Name
-"RTN","CCRDPT",103,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",104,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",105,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",106,0)
-DISPNAME(DFN) ; Display Name
-"RTN","CCRDPT",107,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",108,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",109,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",110,0)
-DOB(DFN) ; Date of Birth
-"RTN","CCRDPT",111,0)
- N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","CCRDPT",112,0)
- ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","CCRDPT",113,0)
- Q $$FMDTOUTC^CCRUTIL(DOB,"D")
-"RTN","CCRDPT",114,0)
-GENDER(DFN) ; Gender/Sex
-"RTN","CCRDPT",115,0)
- Q $$GET1^DIQ(2,DFN,.02) ;
-"RTN","CCRDPT",116,0)
-SSN(DFN) ; SSN
-"RTN","CCRDPT",117,0)
- Q $$GET1^DIQ(2,DFN,.09)
-"RTN","CCRDPT",118,0)
-ADDRTYPE(DFN) ; Address Type
-"RTN","CCRDPT",119,0)
- ; Vista only stores a home address for the patient.
-"RTN","CCRDPT",120,0)
- Q "Home"
-"RTN","CCRDPT",121,0)
-ADDR1(DFN) ; Get Home Address line 1
-"RTN","CCRDPT",122,0)
- Q $$GET1^DIQ(2,DFN,.111)
-"RTN","CCRDPT",123,0)
-ADDR2(DFN) ; Get Home Address line 2
-"RTN","CCRDPT",124,0)
- ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","CCRDPT",125,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",126,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","CCRDPT",127,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",128,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",129,0)
-CITY(DFN) ; Get City for Home Address
-"RTN","CCRDPT",130,0)
- Q $$GET1^DIQ(2,DFN,.114)
-"RTN","CCRDPT",131,0)
-STATE(DFN) ; Get State for Home Address
-"RTN","CCRDPT",132,0)
- Q $$GET1^DIQ(2,DFN,.115)
-"RTN","CCRDPT",133,0)
-ZIP(DFN) ; Get Zip code for Home Address
-"RTN","CCRDPT",134,0)
- Q $$GET1^DIQ(2,DFN,.116)
-"RTN","CCRDPT",135,0)
-COUNTY(DFN) ; Get County for our Address
-"RTN","CCRDPT",136,0)
- Q $$GET1^DIQ(2,DFN,.117)
-"RTN","CCRDPT",137,0)
-COUNTRY(DFN) ; Get Country for our Address
-"RTN","CCRDPT",138,0)
- ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","CCRDPT",139,0)
- Q "USA"
-"RTN","CCRDPT",140,0)
-RESTEL(DFN) ; Residential Telephone
-"RTN","CCRDPT",141,0)
- Q $$GET1^DIQ(2,DFN,.131)
-"RTN","CCRDPT",142,0)
-WORKTEL(DFN) ; Work Telephone
-"RTN","CCRDPT",143,0)
- Q $$GET1^DIQ(2,DFN,.132)
-"RTN","CCRDPT",144,0)
-EMAIL(DFN) ; Email Adddress
-"RTN","CCRDPT",145,0)
- Q $$GET1^DIQ(2,DFN,.133)
-"RTN","CCRDPT",146,0)
-CELLTEL(DFN) ; Cell Phone
-"RTN","CCRDPT",147,0)
- Q $$GET1^DIQ(2,DFN,.134)
-"RTN","CCRDPT",148,0)
-NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",149,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",150,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",151,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",152,0)
-NOK1GIV(DFN) ; NOK1 Given Name
-"RTN","CCRDPT",153,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",154,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",155,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",156,0)
-NOK1MID(DFN) ; NOK1 Middle Name
-"RTN","CCRDPT",157,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",158,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",159,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",160,0)
-NOK1SUF(DFN) ; NOK1 Suffi Name
-"RTN","CCRDPT",161,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",162,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",163,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",164,0)
-NOK1DISP(DFN) ; NOK1 Display Name
-"RTN","CCRDPT",165,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",166,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",167,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",168,0)
-NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","CCRDPT",169,0)
- Q $$GET1^DIQ(2,DFN,.212)
-"RTN","CCRDPT",170,0)
-NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","CCRDPT",171,0)
- Q $$GET1^DIQ(2,DFN,.213)
-"RTN","CCRDPT",172,0)
-NOK1ADD2(DFN) ; NOK1 Address 2 
-"RTN","CCRDPT",173,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",174,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","CCRDPT",175,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",176,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",177,0)
-NOK1CITY(DFN) ; NOK1 City
-"RTN","CCRDPT",178,0)
- Q $$GET1^DIQ(2,DFN,.216)
-"RTN","CCRDPT",179,0)
-NOK1STAT(DFN) ; NOK1 State
-"RTN","CCRDPT",180,0)
- Q $$GET1^DIQ(2,DFN,.217)
-"RTN","CCRDPT",181,0)
-NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","CCRDPT",182,0)
- Q $$GET1^DIQ(2,DFN,.218)
-"RTN","CCRDPT",183,0)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","CCRDPT",184,0)
- Q $$GET1^DIQ(2,DFN,.219)
-"RTN","CCRDPT",185,0)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","CCRDPT",186,0)
- Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","CCRDPT",187,0)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","CCRDPT",188,0)
- Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","CCRDPT",189,0)
-NOK2FAM(DFN) ; NOK2 Family Name
-"RTN","CCRDPT",190,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",191,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",192,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",193,0)
-NOK2GIV(DFN) ; NOK2 Given Name
-"RTN","CCRDPT",194,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",195,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",196,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",197,0)
-NOK2MID(DFN) ; NOK2 Middle Name
-"RTN","CCRDPT",198,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",199,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",200,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",201,0)
-NOK2SUF(DFN) ; NOK2 Suffi Name
-"RTN","CCRDPT",202,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",203,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",204,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",205,0)
-NOK2DISP(DFN) ; NOK2 Display Name
-"RTN","CCRDPT",206,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",207,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",208,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",209,0)
-NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","CCRDPT",210,0)
- Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","CCRDPT",211,0)
-NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","CCRDPT",212,0)
- Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","CCRDPT",213,0)
-NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","CCRDPT",214,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",215,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","CCRDPT",216,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",217,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",218,0)
-NOK2CITY(DFN) ; NOK2 City
-"RTN","CCRDPT",219,0)
- Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","CCRDPT",220,0)
-NOK2STAT(DFN) ; NOK2 State
-"RTN","CCRDPT",221,0)
- Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","CCRDPT",222,0)
-NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","CCRDPT",223,0)
- Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","CCRDPT",224,0)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","CCRDPT",225,0)
- Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","CCRDPT",226,0)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","CCRDPT",227,0)
- Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","CCRDPT",228,0)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","CCRDPT",229,0)
- Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","CCRDPT",230,0)
-EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",231,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",232,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",233,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",234,0)
-EMERGIV(DFN) ; EMER Given Name
-"RTN","CCRDPT",235,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",236,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",237,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",238,0)
-EMERMID(DFN) ; EMER Middle Name
-"RTN","CCRDPT",239,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",240,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",241,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",242,0)
-EMERSUF(DFN) ; EMER Suffi Name
-"RTN","CCRDPT",243,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",244,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",245,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",246,0)
-EMERDISP(DFN) ; EMER Display Name
-"RTN","CCRDPT",247,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",248,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",249,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",250,0)
-EMERREL(DFN) ; EMER Relationship to the patient
-"RTN","CCRDPT",251,0)
- Q $$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",252,0)
-EMERADD1(DFN) ; EMER Address 1
-"RTN","CCRDPT",253,0)
- Q $$GET1^DIQ(2,DFN,.333)
-"RTN","CCRDPT",254,0)
-EMERADD2(DFN) ; EMER Address 2
-"RTN","CCRDPT",255,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",256,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
-"RTN","CCRDPT",257,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",258,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",259,0)
-EMERCITY(DFN) ; EMER City
-"RTN","CCRDPT",260,0)
- Q $$GET1^DIQ(2,DFN,.336)
-"RTN","CCRDPT",261,0)
-EMERSTAT(DFN) ; EMER State
-"RTN","CCRDPT",262,0)
- Q $$GET1^DIQ(2,DFN,.337)
-"RTN","CCRDPT",263,0)
-EMERZIP(DFN) ; EMER Zip Code
-"RTN","CCRDPT",264,0)
- Q $$GET1^DIQ(2,DFN,.338)
-"RTN","CCRDPT",265,0)
-EMERHTEL(DFN) ; EMER Home Telephone
-"RTN","CCRDPT",266,0)
- Q $$GET1^DIQ(2,DFN,.339)
-"RTN","CCRDPT",267,0)
-EMERWTEL(DFN) ; EMER Work Telephone
-"RTN","CCRDPT",268,0)
- Q $$GET1^DIQ(2,DFN,.33011)
-"RTN","CCRDPT",269,0)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
-"RTN","CCRDPT",270,0)
- Q $$GET1^DIQ(2,DFN,.3305)
-"RTN","CCRDPTT")
-0^2^B4791589
-"RTN","CCRDPTT",1,0)
-CCRDPTT ; Unit Tester...
-"RTN","CCRDPTT",2,0)
-  ;;0.1;CCRCCD;;Jun 15, 2008;Build 8
-"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)
-          N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
-"RTN","CCRDPTT",39,0)
-          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
-"RTN","CCRDPTT",40,0)
-          . W "valued at "
-"RTN","CCRDPTT",41,0)
-    . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
-"RTN","CCRDPTT",42,0)
-          . W !
-"RTN","CCRDPTT",43,0)
-          Q
-"RTN","CCRMEDS")
-0^3^B59807333
-"RTN","CCRMEDS",1,0)
-CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
-"RTN","CCRMEDS",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 8
-"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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS",24,0)
- ;
-"RTN","CCRMEDS",25,0)
- ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS",26,0)
- ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS",27,0)
- ;
-"RTN","CCRMEDS",28,0)
- N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","CCRMEDS",29,0)
- N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","CCRMEDS",30,0)
- ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
-"RTN","CCRMEDS",31,0)
- ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
-"RTN","CCRMEDS",32,0)
- ; NON-VA MEDS IN EXTRACT^CCRMEDS3
-"RTN","CCRMEDS",33,0)
- ; INPATIENT MEDS IN EXTRACT^CCRMEDS4
-"RTN","CCRMEDS",34,0)
- ; ALL OTHERS HERE
-"RTN","CCRMEDS",35,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",36,0)
- K @MEDTVMAP ; CLEAR VARIABLE ARRAY
-"RTN","CCRMEDS",37,0)
- S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
-"RTN","CCRMEDS",38,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",39,0)
- K @MEDTARYTMP ; KILL XML ARRAY
-"RTN","CCRMEDS",40,0)
- D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",41,0)
- I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","CCRMEDS",42,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",43,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",44,0)
- . W MEDCNT,!
-"RTN","CCRMEDS",45,0)
- . W "HAS ACTIVE OP MEDS",!
-"RTN","CCRMEDS",46,0)
- N PENDINGXML,MEDPENDING
-"RTN","CCRMEDS",47,0)
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
-"RTN","CCRMEDS",48,0)
- D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",49,0)
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
-"RTN","CCRMEDS",50,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",51,0)
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
-"RTN","CCRMEDS",52,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
-"RTN","CCRMEDS",53,0)
- . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
-"RTN","CCRMEDS",54,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",55,0)
- . ; W MEDCNT,!
-"RTN","CCRMEDS",56,0)
- . W "HAS OP PENDING MEDS",!
-"RTN","CCRMEDS",57,0)
- N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","CCRMEDS",58,0)
- D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","CCRMEDS",59,0)
- I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","CCRMEDS",60,0)
- . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","CCRMEDS",61,0)
- . S @MEDOUTXML@(0)=0
-"RTN","CCRMEDS",62,0)
- . Q
-"RTN","CCRMEDS",63,0)
- ; I DEBUG ZWR MEDRSLT
-"RTN","CCRMEDS",64,0)
- M GPLMEDS=MEDRSLT
-"RTN","CCRMEDS",65,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",66,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",67,0)
- ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
-"RTN","CCRMEDS",68,0)
- ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","CCRMEDS",69,0)
- ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","CCRMEDS",70,0)
- N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","CCRMEDS",71,0)
- ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","CCRMEDS",72,0)
- S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","CCRMEDS",73,0)
- F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","CCRMEDS",74,0)
- . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","CCRMEDS",75,0)
- . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","CCRMEDS",76,0)
- . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","CCRMEDS",77,0)
- . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","CCRMEDS",78,0)
- . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","CCRMEDS",79,0)
- . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","CCRMEDS",80,0)
- . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","CCRMEDS",81,0)
- ;ZWR ZA
-"RTN","CCRMEDS",82,0)
- ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","CCRMEDS",83,0)
- F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","CCRMEDS",84,0)
- . I DEBUG W "ZI IS ",ZI,!
-"RTN","CCRMEDS",85,0)
- . ; W ZI," ",MEDCNT,!
-"RTN","CCRMEDS",86,0)
- . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","CCRMEDS",87,0)
- . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","CCRMEDS",88,0)
- . I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
-"RTN","CCRMEDS",89,0)
- . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
-"RTN","CCRMEDS",90,0)
- . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","CCRMEDS",91,0)
- . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
-"RTN","CCRMEDS",92,0)
- . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","CCRMEDS",93,0)
- . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","CCRMEDS",94,0)
- . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","CCRMEDS",95,0)
- . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","CCRMEDS",96,0)
- . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS",97,0)
- . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS",98,0)
- . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS",99,0)
- . S @MEDVMAP@("MEDRXNO")=""
-"RTN","CCRMEDS",100,0)
- . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","CCRMEDS",101,0)
- . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","CCRMEDS",102,0)
- . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","CCRMEDS",103,0)
- . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","CCRMEDS",104,0)
- . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","CCRMEDS",105,0)
- . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","CCRMEDS",106,0)
- . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","CCRMEDS",107,0)
- . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","CCRMEDS",108,0)
- . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","CCRMEDS",109,0)
- . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","CCRMEDS",110,0)
- . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","CCRMEDS",111,0)
- . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","CCRMEDS",112,0)
- . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","CCRMEDS",113,0)
- . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS",114,0)
- . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS",115,0)
- . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS",116,0)
- . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS",117,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS",118,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS",119,0)
- . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS",120,0)
- . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS",121,0)
- . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","CCRMEDS",122,0)
- . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","CCRMEDS",123,0)
- . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","CCRMEDS",124,0)
- . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","CCRMEDS",125,0)
- . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","CCRMEDS",126,0)
- . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","CCRMEDS",127,0)
- . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS",128,0)
- . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","CCRMEDS",129,0)
- . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","CCRMEDS",130,0)
- . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","CCRMEDS",131,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","CCRMEDS",132,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","CCRMEDS",133,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","CCRMEDS",134,0)
- . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","CCRMEDS",135,0)
- . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","CCRMEDS",136,0)
- . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","CCRMEDS",137,0)
- . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","CCRMEDS",138,0)
- . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","CCRMEDS",139,0)
- . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","CCRMEDS",140,0)
- . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","CCRMEDS",141,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","CCRMEDS",142,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS",143,0)
- . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS",144,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","CCRMEDS",145,0)
- . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","CCRMEDS",146,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","CCRMEDS",147,0)
- . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","CCRMEDS",148,0)
- . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","CCRMEDS",149,0)
- . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","CCRMEDS",150,0)
- . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","CCRMEDS",151,0)
- . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","CCRMEDS",152,0)
- . S @MEDVMAP@("MEDRFNO")=""
-"RTN","CCRMEDS",153,0)
- . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","CCRMEDS",154,0)
- . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","CCRMEDS",155,0)
- . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","CCRMEDS",156,0)
- . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","CCRMEDS",157,0)
- . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","CCRMEDS",158,0)
- . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","CCRMEDS",159,0)
- . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","CCRMEDS",160,0)
- . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","CCRMEDS",161,0)
- . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","CCRMEDS",162,0)
- . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","CCRMEDS",163,0)
- . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","CCRMEDS",164,0)
- . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","CCRMEDS",165,0)
- . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","CCRMEDS",166,0)
- . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","CCRMEDS",167,0)
- . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","CCRMEDS",168,0)
- . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","CCRMEDS",169,0)
- . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","CCRMEDS",170,0)
- . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","CCRMEDS",171,0)
- . K @MEDARYTMP
-"RTN","CCRMEDS",172,0)
- . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","CCRMEDS",173,0)
- . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","CCRMEDS",174,0)
- . . ; W "FIRST ONE",!
-"RTN","CCRMEDS",175,0)
- . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","CCRMEDS",176,0)
- . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","CCRMEDS",177,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","CCRMEDS",178,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS",179,0)
- D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS",180,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS",181,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS",182,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS",183,0)
- Q
-"RTN","CCRMEDS",184,0)
- ;
-"RTN","CCRMEDS",185,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","CCRMEDS",186,0)
- ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","CCRMEDS",187,0)
- N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","CCRMEDS",188,0)
- S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","CCRMEDS",189,0)
- Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","CCRMEDS",190,0)
- ;
-"RTN","CCRSYS")
-0^4^B5866233
-"RTN","CCRSYS",1,0)
-CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
-"RTN","CCRSYS",2,0)
-        ;;0.1;CCDCCR;;;Build 8
-"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 DFN="" Q 0  ; BAD DFN PASSED
-"RTN","CCRSYS",41,0)
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","CCRSYS",42,0)
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","CCRSYS",43,0)
-         ;
-"RTN","CCRSYS",44,0)
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","CCRSYS",45,0)
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","CCRSYS",46,0)
-         N DIERR,DATA
-"RTN","CCRSYS",47,0)
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","CCRSYS",48,0)
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","CCRSYS",49,0)
-         ; 1 = Test Patient
-"RTN","CCRSYS",50,0)
-         ; 0 = Non-test Patient
-"RTN","CCRSYS",51,0)
-         I DATA Q DATA
-"RTN","CCRSYS",52,0)
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","CCRSYS",53,0)
-         D CLEAN^DILF
-"RTN","CCRSYS",54,0)
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-"RTN","CCRSYS",55,0)
-         I $E(DATA,1,3)="000" Q 1
-"RTN","CCRSYS",56,0)
-         I $E(DATA,1,3)="666" Q 1
-"RTN","CCRSYS",57,0)
-         Q 0
-"RTN","CCRSYS",58,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 8
-"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)
-        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","CCRUNIT",12,0)
-        W "XPATH is: "_XPATH,!
-"RTN","CCRUNIT",13,0)
-        W "Getting Med Template into MINXML using",!
-"RTN","CCRUNIT",14,0)
-        W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
-"RTN","CCRUNIT",15,0)
-        D QUERY^GPLXPATH(T,XPATH,"MINXML")
-"RTN","CCRUNIT",16,0)
-  W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
-"RTN","CCRUNIT",17,0)
-        W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","CCRUNIT",18,0)
-        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","CCRUNIT",19,0)
-        D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
-"RTN","CCRUNIT",20,0)
-        Q
-"RTN","CCRUTIL")
-0^6^B5927217
-"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 8
-"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=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","CCRUTIL",61,0)
- F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-"RTN","CCRUTIL",62,0)
- . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-"RTN","CCRUTIL",63,0)
- . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","CCRUTIL",64,0)
- . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","CCRUTIL",65,0)
- . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","CCRUTIL",66,0)
- . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","CCRUTIL",67,0)
- N ZG
-"RTN","CCRUTIL",68,0)
- S ZG=$Q(VSRT(""))
-"RTN","CCRUTIL",69,0)
- F  D  Q:ZG=""  ;
-"RTN","CCRUTIL",70,0)
- . ; W ZG,!
-"RTN","CCRUTIL",71,0)
- . D PUSH^GPLXPATH("V1",@ZG)
-"RTN","CCRUTIL",72,0)
- . S ZG=$Q(@ZG)
-"RTN","CCRUTIL",73,0)
- I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-"RTN","CCRUTIL",74,0)
- . N ZG2
-"RTN","CCRUTIL",75,0)
- . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-"RTN","CCRUTIL",76,0)
- . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","CCRUTIL",77,0)
- . S ZG2(0)=V1(0)
-"RTN","CCRUTIL",78,0)
- . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","CCRUTIL",79,0)
- Q ZCNT
-"RTN","CCRUTIL",80,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 8
-"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^B52628160
-"RTN","GPLACTOR",1,0)
-GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
-"RTN","GPLACTOR",2,0)
- ;;0.4;CCDCCR;nopatch;noreleasedate;Build 8
-"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)
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
-"RTN","GPLACTOR",27,0)
- ;
-"RTN","GPLACTOR",28,0)
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-"RTN","GPLACTOR",29,0)
- ; IPXML is the Input Actor Template into which we  substitute values
-"RTN","GPLACTOR",30,0)
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
-"RTN","GPLACTOR",31,0)
- ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
-"RTN","GPLACTOR",32,0)
- ; ^TMP(7542,1,"ACTORS",0)=Count
-"RTN","GPLACTOR",33,0)
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-"RTN","GPLACTOR",34,0)
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-"RTN","GPLACTOR",35,0)
- ; AXML is the output arrary, to contain XML.
-"RTN","GPLACTOR",36,0)
- ;
-"RTN","GPLACTOR",37,0)
- N I,J,AMAP,AOID,ATYP,AIEN
-"RTN","GPLACTOR",38,0)
- D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-"RTN","GPLACTOR",39,0)
- D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-"RTN","GPLACTOR",40,0)
- I DEBUG W "PROCESSING ACTORS ",!
-"RTN","GPLACTOR",41,0)
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
-"RTN","GPLACTOR",42,0)
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",43,0)
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-"RTN","GPLACTOR",44,0)
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-"RTN","GPLACTOR",45,0)
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-"RTN","GPLACTOR",46,0)
- . I ATYP="" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",47,0)
- . ;
-"RTN","GPLACTOR",48,0)
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","GPLACTOR",49,0)
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
-"RTN","GPLACTOR",50,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-"RTN","GPLACTOR",51,0)
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",52,0)
- . ;
-"RTN","GPLACTOR",53,0)
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
-"RTN","GPLACTOR",54,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-"RTN","GPLACTOR",55,0)
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",56,0)
- . ;
-"RTN","GPLACTOR",57,0)
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
-"RTN","GPLACTOR",58,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-"RTN","GPLACTOR",59,0)
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",60,0)
- . ;
-"RTN","GPLACTOR",61,0)
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",62,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-"RTN","GPLACTOR",63,0)
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",64,0)
- . ;
-"RTN","GPLACTOR",65,0)
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",66,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-"RTN","GPLACTOR",67,0)
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",68,0)
- . ;
-"RTN","GPLACTOR",69,0)
- . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-"RTN","GPLACTOR",70,0)
- ;
-"RTN","GPLACTOR",71,0)
- N ACTTMP
-"RTN","GPLACTOR",72,0)
- D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLACTOR",73,0)
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLACTOR",74,0)
- . ; STRINGS MARKED AS @@X@@
-"RTN","GPLACTOR",75,0)
- . W "ACTORS Missing list: ",!
-"RTN","GPLACTOR",76,0)
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
-"RTN","GPLACTOR",77,0)
- Q
-"RTN","GPLACTOR",78,0)
- ;
-"RTN","GPLACTOR",79,0)
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"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)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",85,0)
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
-"RTN","GPLACTOR",86,0)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
-"RTN","GPLACTOR",87,0)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
-"RTN","GPLACTOR",88,0)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
-"RTN","GPLACTOR",89,0)
- S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
-"RTN","GPLACTOR",90,0)
- S @AMAP@("ACTORSSN")=""
-"RTN","GPLACTOR",91,0)
- S @AMAP@("ACTORSSNTEXT")=""
-"RTN","GPLACTOR",92,0)
- S @AMAP@("ACTORSSNSOURCEID")=""
-"RTN","GPLACTOR",93,0)
- S ZX=$$SSN^CCRDPT(AIEN)
-"RTN","GPLACTOR",94,0)
- I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
-"RTN","GPLACTOR",95,0)
- . S @AMAP@("ACTORSSN")=ZX
-"RTN","GPLACTOR",96,0)
- . S @AMAP@("ACTORSSNTEXT")="SSN"
-"RTN","GPLACTOR",97,0)
- . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","GPLACTOR",98,0)
- S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
-"RTN","GPLACTOR",99,0)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
-"RTN","GPLACTOR",100,0)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
-"RTN","GPLACTOR",101,0)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
-"RTN","GPLACTOR",102,0)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
-"RTN","GPLACTOR",103,0)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
-"RTN","GPLACTOR",104,0)
- S @AMAP@("ACTORRESTEL")=""
-"RTN","GPLACTOR",105,0)
- S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","GPLACTOR",106,0)
- S ZX=$$RESTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",107,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",108,0)
- . S @AMAP@("ACTORRESTEL")=ZX
-"RTN","GPLACTOR",109,0)
- . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","GPLACTOR",110,0)
- S @AMAP@("ACTORWORKTEL")=""
-"RTN","GPLACTOR",111,0)
- S @AMAP@("ACTORWORKTELTEXT")=""
-"RTN","GPLACTOR",112,0)
- S ZX=$$WORKTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",113,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",114,0)
- . S @AMAP@("ACTORWORKTEL")=ZX
-"RTN","GPLACTOR",115,0)
- . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","GPLACTOR",116,0)
- S @AMAP@("ACTORCELLTEL")=""
-"RTN","GPLACTOR",117,0)
- S @AMAP@("ACTORCELLTELTEXT")=""
-"RTN","GPLACTOR",118,0)
- S ZX=$$CELLTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",119,0)
- I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
-"RTN","GPLACTOR",120,0)
- . S @AMAP@("ACTORCELLTEL")=ZX
-"RTN","GPLACTOR",121,0)
- . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-"RTN","GPLACTOR",122,0)
- S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
-"RTN","GPLACTOR",123,0)
- S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-"RTN","GPLACTOR",124,0)
- S @AMAP@("ACTORIEN")=AIEN
-"RTN","GPLACTOR",125,0)
- S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
-"RTN","GPLACTOR",126,0)
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",127,0)
- D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",128,0)
- Q
-"RTN","GPLACTOR",129,0)
- ;
-"RTN","GPLACTOR",130,0)
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-"RTN","GPLACTOR",131,0)
-     ;
-"RTN","GPLACTOR",132,0)
-     ; N AMAP
-"RTN","GPLACTOR",133,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",134,0)
-     K @AMAP
-"RTN","GPLACTOR",135,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",136,0)
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
-"RTN","GPLACTOR",137,0)
-         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
-"RTN","GPLACTOR",138,0)
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-"RTN","GPLACTOR",139,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",140,0)
-     Q
-"RTN","GPLACTOR",141,0)
-     ;
-"RTN","GPLACTOR",142,0)
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-"RTN","GPLACTOR",143,0)
-     ;
-"RTN","GPLACTOR",144,0)
-     ; N AMAP
-"RTN","GPLACTOR",145,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",146,0)
-     K @AMAP
-"RTN","GPLACTOR",147,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",148,0)
-     S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","GPLACTOR",149,0)
-     S @AMAP@("ACTORRELATION")=""
-"RTN","GPLACTOR",150,0)
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-"RTN","GPLACTOR",151,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",152,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",153,0)
-     Q
-"RTN","GPLACTOR",154,0)
-     ;
-"RTN","GPLACTOR",155,0)
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-"RTN","GPLACTOR",156,0)
-     ;
-"RTN","GPLACTOR",157,0)
-     ; N AMAP
-"RTN","GPLACTOR",158,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",159,0)
-     K @AMAP
-"RTN","GPLACTOR",160,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",161,0)
-     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
-"RTN","GPLACTOR",162,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",163,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",164,0)
-     Q
-"RTN","GPLACTOR",165,0)
-     ;
-"RTN","GPLACTOR",166,0)
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-"RTN","GPLACTOR",167,0)
-     ;
-"RTN","GPLACTOR",168,0)
-     ; N AMAP
-"RTN","GPLACTOR",169,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",170,0)
-     K @AMAP
-"RTN","GPLACTOR",171,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",172,0)
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
-"RTN","GPLACTOR",173,0)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",174,0)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
-"RTN","GPLACTOR",175,0)
-         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",176,0)
-         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
-"RTN","GPLACTOR",177,0)
-         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
-"RTN","GPLACTOR",178,0)
-         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
-"RTN","GPLACTOR",179,0)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
-"RTN","GPLACTOR",180,0)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",181,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
-"RTN","GPLACTOR",182,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
-"RTN","GPLACTOR",183,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
-"RTN","GPLACTOR",184,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
-"RTN","GPLACTOR",185,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","GPLACTOR",186,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","GPLACTOR",187,0)
-     S ZX=$$TEL^CCRVA200(AIEN)
-"RTN","GPLACTOR",188,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","GPLACTOR",189,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","GPLACTOR",190,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",191,0)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
-"RTN","GPLACTOR",192,0)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",193,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",194,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",195,0)
-     Q
-"RTN","GPLACTOR",196,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 8
-"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 8
-"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^B82167126
-"RTN","GPLCCR",1,0)
-GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-"RTN","GPLCCR",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 8
-"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)
-       I '$D(DIR) S DIR=""
-"RTN","GPLCCR",35,0)
-       I '$D(FN) S FN=""
-"RTN","GPLCCR",36,0)
-       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-"RTN","GPLCCR",37,0)
-       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
-"RTN","GPLCCR",38,0)
-       S ONAM=FN
-"RTN","GPLCCR",39,0)
-       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
-"RTN","GPLCCR",40,0)
-       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
-"RTN","GPLCCR",41,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","GPLCCR",42,0)
-       . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","GPLCCR",43,0)
-       . ;S @ODIRGLB="/home/cedwards/"
-"RTN","GPLCCR",44,0)
-       . S @ODIRGLB="/opt/wv/p/"
-"RTN","GPLCCR",45,0)
-       S ODIR=DIR
-"RTN","GPLCCR",46,0)
-       I DIR="" S ODIR=@ODIRGLB
-"RTN","GPLCCR",47,0)
-       N ZY
-"RTN","GPLCCR",48,0)
-       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-"RTN","GPLCCR",49,0)
-       W !,$P(ZY,U,2),!
-"RTN","GPLCCR",50,0)
-       Q
-"RTN","GPLCCR",51,0)
-       ;
-"RTN","GPLCCR",52,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","GPLCCR",53,0)
-    ;
-"RTN","GPLCCR",54,0)
-    N G1
-"RTN","GPLCCR",55,0)
-    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
-"RTN","GPLCCR",56,0)
-    I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","GPLCCR",57,0)
-    . D PARY^GPLXPATH(G1)
-"RTN","GPLCCR",58,0)
-    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
-"RTN","GPLCCR",59,0)
-    Q
-"RTN","GPLCCR",60,0)
-    ;
-"RTN","GPLCCR",61,0)
-CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","GPLCCR",62,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-"RTN","GPLCCR",63,0)
-    ; DFN IS PATIENT IEN
-"RTN","GPLCCR",64,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","GPLCCR",65,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","GPLCCR",66,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-"RTN","GPLCCR",67,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-"RTN","GPLCCR",68,0)
-    ; - NULL MEANS NOW
-"RTN","GPLCCR",69,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-"RTN","GPLCCR",70,0)
-    ;    "TO" VARIABLES
-"RTN","GPLCCR",71,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-"RTN","GPLCCR",72,0)
-    I '$D(DEBUG) S DEBUG=0
-"RTN","GPLCCR",73,0)
-    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","GPLCCR",74,0)
-    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","GPLCCR",75,0)
-    I '$D(TESTALERT) S TESTALERT=0 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","GPLCCR",76,0)
-    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
-"RTN","GPLCCR",77,0)
-    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","GPLCCR",78,0)
-    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","GPLCCR",79,0)
-    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","GPLCCR",80,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","GPLCCR",81,0)
-    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-"RTN","GPLCCR",82,0)
-    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","GPLCCR",83,0)
-    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","GPLCCR",84,0)
-    ;
-"RTN","GPLCCR",85,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","GPLCCR",86,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","GPLCCR",87,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",88,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",89,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","GPLCCR",90,0)
-    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","GPLCCR",91,0)
-    ;
-"RTN","GPLCCR",92,0)
-    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-"RTN","GPLCCR",93,0)
-    ;
-"RTN","GPLCCR",94,0)
-    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","GPLCCR",95,0)
-    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","GPLCCR",96,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","GPLCCR",97,0)
-    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","GPLCCR",98,0)
-    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","GPLCCR",99,0)
-    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","GPLCCR",100,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","GPLCCR",101,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","GPLCCR",102,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","GPLCCR",103,0)
-    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","GPLCCR",104,0)
-    . S IXML="INXML"
-"RTN","GPLCCR",105,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","GPLCCR",106,0)
-    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","GPLCCR",107,0)
-    . ; W OXML,!
-"RTN","GPLCCR",108,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","GPLCCR",109,0)
-    . I DEBUG W "RUNNING ",CALL,!
-"RTN","GPLCCR",110,0)
-    . X CALL
-"RTN","GPLCCR",111,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","GPLCCR",112,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-"RTN","GPLCCR",113,0)
-    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",114,0)
-    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-"RTN","GPLCCR",115,0)
-    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","GPLCCR",116,0)
-    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","GPLCCR",117,0)
-    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","GPLCCR",118,0)
-    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",119,0)
-    N TRIMI,J,DONE S DONE=0
-"RTN","GPLCCR",120,0)
-    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","GPLCCR",121,0)
-    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","GPLCCR",122,0)
-    . I DEBUG W "TRIMMED",J,!
-"RTN","GPLCCR",123,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","GPLCCR",124,0)
-    Q
-"RTN","GPLCCR",125,0)
-    ;
-"RTN","GPLCCR",126,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","GPLCCR",127,0)
-    ; TAB IS PASSED BY NAME
-"RTN","GPLCCR",128,0)
-    I DEBUG W "TAB= ",TAB,!
-"RTN","GPLCCR",129,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","GPLCCR",130,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","GPLCCR",131,0)
-    I TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS1;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",132,0)
-    I 'TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",133,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
-"RTN","GPLCCR",134,0)
-    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
-"RTN","GPLCCR",135,0)
-    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
-"RTN","GPLCCR",136,0)
-    Q
-"RTN","GPLCCR",137,0)
-    ;
-"RTN","GPLCCR",138,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","GPLCCR",139,0)
-    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
-"RTN","GPLCCR",140,0)
-    ; K @VMAP
-"RTN","GPLCCR",141,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
-"RTN","GPLCCR",142,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","GPLCCR",143,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","GPLCCR",144,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","GPLCCR",145,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","GPLCCR",146,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-"RTN","GPLCCR",147,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",148,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",149,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","GPLCCR",150,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","GPLCCR",151,0)
-    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","GPLCCR",152,0)
-    N CTMP
-"RTN","GPLCCR",153,0)
-    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-"RTN","GPLCCR",154,0)
-    D CP^GPLXPATH("CTMP",CXML)
-"RTN","GPLCCR",155,0)
-    Q
-"RTN","GPLCCR",156,0)
-    ;
-"RTN","GPLCCR",157,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","GPLCCR",158,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","GPLCCR",159,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","GPLCCR",160,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","GPLCCR",161,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","GPLCCR",162,0)
-    ;OR INSTITUTION
-"RTN","GPLCCR",163,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","GPLCCR",164,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","GPLCCR",165,0)
-    N I,J,K,L
-"RTN","GPLCCR",166,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","GPLCCR",167,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","GPLCCR",168,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","GPLCCR",169,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","GPLCCR",170,0)
-    . . I DEBUG W "<ActorID>=>",J,!
-"RTN","GPLCCR",171,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","GPLCCR",172,0)
-    . . ;  TO GET RID OF DUPLICATES
-"RTN","GPLCCR",173,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","GPLCCR",174,0)
-    F J=0:0 D  Q:$O(K(I))=""
-"RTN","GPLCCR",175,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","GPLCCR",176,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","GPLCCR",177,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","GPLCCR",178,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","GPLCCR",179,0)
-    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","GPLCCR",180,0)
-    Q
-"RTN","GPLCCR",181,0)
-    ;
-"RTN","GPLCCR",182,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","GPLCCR",183,0)
-  D TESTALL^GPLUNIT("GPLCCR")
-"RTN","GPLCCR",184,0)
-  Q
-"RTN","GPLCCR",185,0)
-  ;
-"RTN","GPLCCR",186,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","GPLCCR",187,0)
-  N ZTMP
-"RTN","GPLCCR",188,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",189,0)
-  D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLCCR",190,0)
-  Q
-"RTN","GPLCCR",191,0)
-  ;
-"RTN","GPLCCR",192,0)
-TLIST  ; LIST THE TESTS
-"RTN","GPLCCR",193,0)
-  N ZTMP
-"RTN","GPLCCR",194,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",195,0)
-  D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLCCR",196,0)
-  Q
-"RTN","GPLCCR",197,0)
-  ;
-"RTN","GPLCCR",198,0)
- ;;><TEST>
-"RTN","GPLCCR",199,0)
- ;;><PROBLEMS>
-"RTN","GPLCCR",200,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",201,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
-"RTN","GPLCCR",202,0)
- ;;>>?@GPL@(@GPL@(0))["</Problems>"
-"RTN","GPLCCR",203,0)
- ;;><VITALS>
-"RTN","GPLCCR",204,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",205,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
-"RTN","GPLCCR",206,0)
- ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
-"RTN","GPLCCR",207,0)
- ;;><CCR>
-"RTN","GPLCCR",208,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",209,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",210,0)
- ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
-"RTN","GPLCCR",211,0)
- ;;><ACTLST>
-"RTN","GPLCCR",212,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",213,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",214,0)
- ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
-"RTN","GPLCCR",215,0)
- ;;><ACTORS>
-"RTN","GPLCCR",216,0)
- ;;>>>D ZTEST^GPLCCR("ACTLST")
-"RTN","GPLCCR",217,0)
- ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","GPLCCR",218,0)
- ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
-"RTN","GPLCCR",219,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","GPLCCR",220,0)
- ;;><TRIM>
-"RTN","GPLCCR",221,0)
- ;;>>>D ZTEST^GPLCCR("CCR")
-"RTN","GPLCCR",222,0)
- ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
-"RTN","GPLCCR",223,0)
- ;;><ALERTS>
-"RTN","GPLCCR",224,0)
- ;;>>>S TESTALERT=1
-"RTN","GPLCCR",225,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",226,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
-"RTN","GPLCCR",227,0)
- ;;>>?@GPL@(@GPL@(0))["</Alerts>"
-"RTN","GPLCCR",228,0)
- 
-"RTN","GPLCCR0")
-0^15^B654252455
-"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 8
-"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)
- ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
-"RTN","GPLCCR0",368,0)
- ;;</Frequency>
-"RTN","GPLCCR0",369,0)
- ;;<Interval>
-"RTN","GPLCCR0",370,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","GPLCCR0",371,0)
- ;;<Units>
-"RTN","GPLCCR0",372,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","GPLCCR0",373,0)
- ;;</Units>
-"RTN","GPLCCR0",374,0)
- ;;</Interval>
-"RTN","GPLCCR0",375,0)
- ;;<Duration>
-"RTN","GPLCCR0",376,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","GPLCCR0",377,0)
- ;;<Units>
-"RTN","GPLCCR0",378,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","GPLCCR0",379,0)
- ;;</Units>
-"RTN","GPLCCR0",380,0)
- ;;</Duration>
-"RTN","GPLCCR0",381,0)
- ;;<Indication>
-"RTN","GPLCCR0",382,0)
- ;;<PRNFlag>
-"RTN","GPLCCR0",383,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","GPLCCR0",384,0)
- ;;</PRNFlag>
-"RTN","GPLCCR0",385,0)
- ;;<Problem>
-"RTN","GPLCCR0",386,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",387,0)
- ;;<Type>
-"RTN","GPLCCR0",388,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","GPLCCR0",389,0)
- ;;</Type>
-"RTN","GPLCCR0",390,0)
- ;;<Description>
-"RTN","GPLCCR0",391,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","GPLCCR0",392,0)
- ;;<Code>
-"RTN","GPLCCR0",393,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","GPLCCR0",394,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",395,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","GPLCCR0",396,0)
- ;;</Code>
-"RTN","GPLCCR0",397,0)
- ;;</Description>
-"RTN","GPLCCR0",398,0)
- ;;<Source>
-"RTN","GPLCCR0",399,0)
- ;;<Actor>
-"RTN","GPLCCR0",400,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",401,0)
- ;;</Actor>
-"RTN","GPLCCR0",402,0)
- ;;</Source>
-"RTN","GPLCCR0",403,0)
- ;;</Problem>
-"RTN","GPLCCR0",404,0)
- ;;</Indication>
-"RTN","GPLCCR0",405,0)
- ;;<StopIndicator>
-"RTN","GPLCCR0",406,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","GPLCCR0",407,0)
- ;;</StopIndicator>
-"RTN","GPLCCR0",408,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","GPLCCR0",409,0)
- ;;<MultipleDirectionModifier>
-"RTN","GPLCCR0",410,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","GPLCCR0",411,0)
- ;;</MultipleDirectionModifier>
-"RTN","GPLCCR0",412,0)
- ;;</Direction>
-"RTN","GPLCCR0",413,0)
- ;;</Directions>
-"RTN","GPLCCR0",414,0)
- ;;<PatientInstructions>
-"RTN","GPLCCR0",415,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",416,0)
- ;;</PatientInstructions>
-"RTN","GPLCCR0",417,0)
- ;;<FullfillmentInstructions>
-"RTN","GPLCCR0",418,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",419,0)
- ;;</FullfillmentInstructions>
-"RTN","GPLCCR0",420,0)
- ;;<Refills>
-"RTN","GPLCCR0",421,0)
- ;;<Refill>
-"RTN","GPLCCR0",422,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","GPLCCR0",423,0)
- ;;</Refill>
-"RTN","GPLCCR0",424,0)
- ;;</Refills>
-"RTN","GPLCCR0",425,0)
- ;;</Medication>
-"RTN","GPLCCR0",426,0)
- ;;</Medications>
-"RTN","GPLCCR0",427,0)
- ;;<VitalSigns>
-"RTN","GPLCCR0",428,0)
- ;;<Result>
-"RTN","GPLCCR0",429,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",430,0)
- ;;<DateTime>
-"RTN","GPLCCR0",431,0)
- ;;<Type>
-"RTN","GPLCCR0",432,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","GPLCCR0",433,0)
- ;;</Type>
-"RTN","GPLCCR0",434,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",435,0)
- ;;</DateTime>
-"RTN","GPLCCR0",436,0)
- ;;<Description>
-"RTN","GPLCCR0",437,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",438,0)
- ;;</Description>
-"RTN","GPLCCR0",439,0)
- ;;<Source>
-"RTN","GPLCCR0",440,0)
- ;;<Actor>
-"RTN","GPLCCR0",441,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",442,0)
- ;;</Actor>
-"RTN","GPLCCR0",443,0)
- ;;</Source>
-"RTN","GPLCCR0",444,0)
- ;;<Test>
-"RTN","GPLCCR0",445,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",446,0)
- ;;<Type>
-"RTN","GPLCCR0",447,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","GPLCCR0",448,0)
- ;;</Type>
-"RTN","GPLCCR0",449,0)
- ;;<Description>
-"RTN","GPLCCR0",450,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",451,0)
- ;;<Code>
-"RTN","GPLCCR0",452,0)
- ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
-"RTN","GPLCCR0",453,0)
- ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",454,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","GPLCCR0",455,0)
- ;;</Code>
-"RTN","GPLCCR0",456,0)
- ;;</Description>
-"RTN","GPLCCR0",457,0)
- ;;<Source>
-"RTN","GPLCCR0",458,0)
- ;;<Actor>
-"RTN","GPLCCR0",459,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",460,0)
- ;;</Actor>
-"RTN","GPLCCR0",461,0)
- ;;</Source>
-"RTN","GPLCCR0",462,0)
- ;;<TestResult>
-"RTN","GPLCCR0",463,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","GPLCCR0",464,0)
- ;;<Units>
-"RTN","GPLCCR0",465,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","GPLCCR0",466,0)
- ;;</Units>
-"RTN","GPLCCR0",467,0)
- ;;</TestResult>
-"RTN","GPLCCR0",468,0)
- ;;</Test>
-"RTN","GPLCCR0",469,0)
- ;;</Result>
-"RTN","GPLCCR0",470,0)
- ;;</VitalSigns>
-"RTN","GPLCCR0",471,0)
- ;;<Results>
-"RTN","GPLCCR0",472,0)
- ;;<Result>
-"RTN","GPLCCR0",473,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",474,0)
- ;;<DateTime>
-"RTN","GPLCCR0",475,0)
- ;;<Type>
-"RTN","GPLCCR0",476,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",477,0)
- ;;</Type>
-"RTN","GPLCCR0",478,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",479,0)
- ;;</DateTime>
-"RTN","GPLCCR0",480,0)
- ;;<Description>
-"RTN","GPLCCR0",481,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",482,0)
- ;;<Code>
-"RTN","GPLCCR0",483,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","GPLCCR0",484,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",485,0)
- ;;</Code>
-"RTN","GPLCCR0",486,0)
- ;;</Description>
-"RTN","GPLCCR0",487,0)
- ;;<Status>
-"RTN","GPLCCR0",488,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","GPLCCR0",489,0)
- ;;</Status>
-"RTN","GPLCCR0",490,0)
- ;;<Source>
-"RTN","GPLCCR0",491,0)
- ;;<Actor>
-"RTN","GPLCCR0",492,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",493,0)
- ;;</Actor>
-"RTN","GPLCCR0",494,0)
- ;;</Source>
-"RTN","GPLCCR0",495,0)
- ;;<TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",496,0)
- ;;<Test>
-"RTN","GPLCCR0",497,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",498,0)
- ;;<DateTime>
-"RTN","GPLCCR0",499,0)
- ;;<Type>
-"RTN","GPLCCR0",500,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",501,0)
- ;;</Type>
-"RTN","GPLCCR0",502,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",503,0)
- ;;</DateTime>
-"RTN","GPLCCR0",504,0)
- ;;<Description>
-"RTN","GPLCCR0",505,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",506,0)
- ;;<Code>
-"RTN","GPLCCR0",507,0)
- ;;<Value>@@RESULTTESTCODE@@</Value>
-"RTN","GPLCCR0",508,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",509,0)
- ;;</Code>
-"RTN","GPLCCR0",510,0)
- ;;</Description>
-"RTN","GPLCCR0",511,0)
- ;;<Status>
-"RTN","GPLCCR0",512,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",513,0)
- ;;</Status>
-"RTN","GPLCCR0",514,0)
- ;;<Source>
-"RTN","GPLCCR0",515,0)
- ;;<Actor>
-"RTN","GPLCCR0",516,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",517,0)
- ;;</Actor>
-"RTN","GPLCCR0",518,0)
- ;;</Source>
-"RTN","GPLCCR0",519,0)
- ;;<TestResult>
-"RTN","GPLCCR0",520,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",521,0)
- ;;<Units>
-"RTN","GPLCCR0",522,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",523,0)
- ;;</Units>
-"RTN","GPLCCR0",524,0)
- ;;</TestResult>
-"RTN","GPLCCR0",525,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",526,0)
- ;;<Normal>
-"RTN","GPLCCR0",527,0)
- ;;<Description>
-"RTN","GPLCCR0",528,0)
- ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",529,0)
- ;;</Description>
-"RTN","GPLCCR0",530,0)
- ;;<Source>
-"RTN","GPLCCR0",531,0)
- ;;<Actor>
-"RTN","GPLCCR0",532,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",533,0)
- ;;</Actor>
-"RTN","GPLCCR0",534,0)
- ;;</Source>
-"RTN","GPLCCR0",535,0)
- ;;</Normal>
-"RTN","GPLCCR0",536,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",537,0)
- ;;<Flag>
-"RTN","GPLCCR0",538,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",539,0)
- ;;</Flag>
-"RTN","GPLCCR0",540,0)
- ;;</Test>
-"RTN","GPLCCR0",541,0)
- ;;</TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",542,0)
- ;;<TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",543,0)
- ;;<Test>
-"RTN","GPLCCR0",544,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",545,0)
- ;;<DateTime>
-"RTN","GPLCCR0",546,0)
- ;;<Type>
-"RTN","GPLCCR0",547,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",548,0)
- ;;</Type>
-"RTN","GPLCCR0",549,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",550,0)
- ;;</DateTime>
-"RTN","GPLCCR0",551,0)
- ;;<Description>
-"RTN","GPLCCR0",552,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",553,0)
- ;;<Code>
-"RTN","GPLCCR0",554,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",555,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",556,0)
- ;;</Code>
-"RTN","GPLCCR0",557,0)
- ;;</Description>
-"RTN","GPLCCR0",558,0)
- ;;<Status>
-"RTN","GPLCCR0",559,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",560,0)
- ;;</Status>
-"RTN","GPLCCR0",561,0)
- ;;<Source>
-"RTN","GPLCCR0",562,0)
- ;;<Actor>
-"RTN","GPLCCR0",563,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",564,0)
- ;;</Actor>
-"RTN","GPLCCR0",565,0)
- ;;</Source>
-"RTN","GPLCCR0",566,0)
- ;;<TestResult>
-"RTN","GPLCCR0",567,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",568,0)
- ;;<Units>
-"RTN","GPLCCR0",569,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",570,0)
- ;;</Units>
-"RTN","GPLCCR0",571,0)
- ;;</TestResult>
-"RTN","GPLCCR0",572,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",573,0)
- ;;<Normal>
-"RTN","GPLCCR0",574,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
-"RTN","GPLCCR0",575,0)
- ;;<Units>
-"RTN","GPLCCR0",576,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
-"RTN","GPLCCR0",577,0)
- ;;</Units>
-"RTN","GPLCCR0",578,0)
- ;;<ValueSequencePosition>1</ValueSequencePosition>
-"RTN","GPLCCR0",579,0)
- ;;<Source>
-"RTN","GPLCCR0",580,0)
- ;;<Actor>
-"RTN","GPLCCR0",581,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",582,0)
- ;;</Actor>
-"RTN","GPLCCR0",583,0)
- ;;</Source>
-"RTN","GPLCCR0",584,0)
- ;;</Normal>
-"RTN","GPLCCR0",585,0)
- ;;<Normal>
-"RTN","GPLCCR0",586,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
-"RTN","GPLCCR0",587,0)
- ;;<Units>
-"RTN","GPLCCR0",588,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
-"RTN","GPLCCR0",589,0)
- ;;</Units>
-"RTN","GPLCCR0",590,0)
- ;;<ValueSequencePosition>2</ValueSequencePosition>
-"RTN","GPLCCR0",591,0)
- ;;<VariableNomalModifier>
-"RTN","GPLCCR0",592,0)
- ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
-"RTN","GPLCCR0",593,0)
- ;;</VariableNomalModifier>
-"RTN","GPLCCR0",594,0)
- ;;<Source>
-"RTN","GPLCCR0",595,0)
- ;;<Actor>
-"RTN","GPLCCR0",596,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",597,0)
- ;;</Actor>
-"RTN","GPLCCR0",598,0)
- ;;</Source>
-"RTN","GPLCCR0",599,0)
- ;;</Normal>
-"RTN","GPLCCR0",600,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",601,0)
- ;;<Flag>
-"RTN","GPLCCR0",602,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",603,0)
- ;;</Flag>
-"RTN","GPLCCR0",604,0)
- ;;</Test>
-"RTN","GPLCCR0",605,0)
- ;;</TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",606,0)
- ;;</Result>
-"RTN","GPLCCR0",607,0)
- ;;</Results>
-"RTN","GPLCCR0",608,0)
- ;;<HealthCareProviders>
-"RTN","GPLCCR0",609,0)
- ;;<Provider>
-"RTN","GPLCCR0",610,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","GPLCCR0",611,0)
- ;;<ActorRole>
-"RTN","GPLCCR0",612,0)
- ;;<Text>Primary Provider</Text>
-"RTN","GPLCCR0",613,0)
- ;;</ActorRole>
-"RTN","GPLCCR0",614,0)
- ;;</Provider>
-"RTN","GPLCCR0",615,0)
- ;;</HealthCareProviders>
-"RTN","GPLCCR0",616,0)
- ;;</Body>
-"RTN","GPLCCR0",617,0)
- ;;<Actors>
-"RTN","GPLCCR0",618,0)
- ;;<ACTOR-PATIENT>
-"RTN","GPLCCR0",619,0)
- ;;<Actor>
-"RTN","GPLCCR0",620,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",621,0)
- ;;<Person>
-"RTN","GPLCCR0",622,0)
- ;;<Name>
-"RTN","GPLCCR0",623,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",624,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",625,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",626,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",627,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",628,0)
- ;;</Name>
-"RTN","GPLCCR0",629,0)
- ;;<DateOfBirth>
-"RTN","GPLCCR0",630,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","GPLCCR0",631,0)
- ;;</DateOfBirth>
-"RTN","GPLCCR0",632,0)
- ;;<Gender>
-"RTN","GPLCCR0",633,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","GPLCCR0",634,0)
- ;;<Code>
-"RTN","GPLCCR0",635,0)
- ;;<Value>@@ACTORGENDER@@</Value>
-"RTN","GPLCCR0",636,0)
- ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
-"RTN","GPLCCR0",637,0)
- ;;</Code>
-"RTN","GPLCCR0",638,0)
- ;;</Gender>
-"RTN","GPLCCR0",639,0)
- ;;</Person>
-"RTN","GPLCCR0",640,0)
- ;;<IDs>
-"RTN","GPLCCR0",641,0)
- ;;<Type>
-"RTN","GPLCCR0",642,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","GPLCCR0",643,0)
- ;;</Type>
-"RTN","GPLCCR0",644,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","GPLCCR0",645,0)
- ;;<Source>
-"RTN","GPLCCR0",646,0)
- ;;<Actor>
-"RTN","GPLCCR0",647,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","GPLCCR0",648,0)
- ;;</Actor>
-"RTN","GPLCCR0",649,0)
- ;;</Source>
-"RTN","GPLCCR0",650,0)
- ;;</IDs>
-"RTN","GPLCCR0",651,0)
- ;;<Address>
-"RTN","GPLCCR0",652,0)
- ;;<Type>
-"RTN","GPLCCR0",653,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",654,0)
- ;;</Type>
-"RTN","GPLCCR0",655,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",656,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","GPLCCR0",657,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",658,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",659,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","GPLCCR0",660,0)
- ;;</Address>
-"RTN","GPLCCR0",661,0)
- ;;<Telephone>
-"RTN","GPLCCR0",662,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","GPLCCR0",663,0)
- ;;<Type>
-"RTN","GPLCCR0",664,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","GPLCCR0",665,0)
- ;;</Type>
-"RTN","GPLCCR0",666,0)
- ;;</Telephone>
-"RTN","GPLCCR0",667,0)
- ;;<Telephone>
-"RTN","GPLCCR0",668,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","GPLCCR0",669,0)
- ;;<Type>
-"RTN","GPLCCR0",670,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","GPLCCR0",671,0)
- ;;</Type>
-"RTN","GPLCCR0",672,0)
- ;;</Telephone>
-"RTN","GPLCCR0",673,0)
- ;;<Telephone>
-"RTN","GPLCCR0",674,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","GPLCCR0",675,0)
- ;;<Type>
-"RTN","GPLCCR0",676,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","GPLCCR0",677,0)
- ;;</Type>
-"RTN","GPLCCR0",678,0)
- ;;</Telephone>
-"RTN","GPLCCR0",679,0)
- ;;<EMail>
-"RTN","GPLCCR0",680,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",681,0)
- ;;</EMail>
-"RTN","GPLCCR0",682,0)
- ;;<Source>
-"RTN","GPLCCR0",683,0)
- ;;<Actor>
-"RTN","GPLCCR0",684,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",685,0)
- ;;</Actor>
-"RTN","GPLCCR0",686,0)
- ;;</Source>
-"RTN","GPLCCR0",687,0)
- ;;</Actor>
-"RTN","GPLCCR0",688,0)
- ;;</ACTOR-PATIENT>
-"RTN","GPLCCR0",689,0)
- ;;<ACTOR-SYSTEM>
-"RTN","GPLCCR0",690,0)
- ;;<Actor>
-"RTN","GPLCCR0",691,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",692,0)
- ;;<InformationSystem>
-"RTN","GPLCCR0",693,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","GPLCCR0",694,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","GPLCCR0",695,0)
- ;;</InformationSystem>
-"RTN","GPLCCR0",696,0)
- ;;<Source>
-"RTN","GPLCCR0",697,0)
- ;;<Actor>
-"RTN","GPLCCR0",698,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",699,0)
- ;;</Actor>
-"RTN","GPLCCR0",700,0)
- ;;</Source>
-"RTN","GPLCCR0",701,0)
- ;;</Actor>
-"RTN","GPLCCR0",702,0)
- ;;</ACTOR-SYSTEM>
-"RTN","GPLCCR0",703,0)
- ;;<ACTOR-NOK>
-"RTN","GPLCCR0",704,0)
- ;;<Actor>
-"RTN","GPLCCR0",705,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","GPLCCR0",706,0)
- ;;<Person>
-"RTN","GPLCCR0",707,0)
- ;;<Name>
-"RTN","GPLCCR0",708,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","GPLCCR0",709,0)
- ;;</Name>
-"RTN","GPLCCR0",710,0)
- ;;</Person>
-"RTN","GPLCCR0",711,0)
- ;;<Relation>
-"RTN","GPLCCR0",712,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","GPLCCR0",713,0)
- ;;</Relation>
-"RTN","GPLCCR0",714,0)
- ;;<Source>
-"RTN","GPLCCR0",715,0)
- ;;<Actor>
-"RTN","GPLCCR0",716,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","GPLCCR0",717,0)
- ;;</Actor>
-"RTN","GPLCCR0",718,0)
- ;;</Source>
-"RTN","GPLCCR0",719,0)
- ;;</Actor>
-"RTN","GPLCCR0",720,0)
- ;;</ACTOR-NOK>
-"RTN","GPLCCR0",721,0)
- ;;<ACTOR-PROVIDER>
-"RTN","GPLCCR0",722,0)
- ;;<Actor>
-"RTN","GPLCCR0",723,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",724,0)
- ;;<Person>
-"RTN","GPLCCR0",725,0)
- ;;<Name>
-"RTN","GPLCCR0",726,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",727,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",728,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",729,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",730,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","GPLCCR0",731,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",732,0)
- ;;</Name>
-"RTN","GPLCCR0",733,0)
- ;;</Person>
-"RTN","GPLCCR0",734,0)
- ;;<IDs>
-"RTN","GPLCCR0",735,0)
- ;;<Type>
-"RTN","GPLCCR0",736,0)
- ;;<Text>@@IDTYPE@@</Text>
-"RTN","GPLCCR0",737,0)
- ;;</Type>
-"RTN","GPLCCR0",738,0)
- ;;<ID>@@ID@@</ID>
-"RTN","GPLCCR0",739,0)
- ;;<IssuedBy>
-"RTN","GPLCCR0",740,0)
- ;;<Description>
-"RTN","GPLCCR0",741,0)
- ;;<Text>@@IDDESC@@</Text>
-"RTN","GPLCCR0",742,0)
- ;;</Description>
-"RTN","GPLCCR0",743,0)
- ;;</IssuedBy>
-"RTN","GPLCCR0",744,0)
- ;;</IDs>
-"RTN","GPLCCR0",745,0)
- ;;<Specialty>
-"RTN","GPLCCR0",746,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","GPLCCR0",747,0)
- ;;</Specialty>
-"RTN","GPLCCR0",748,0)
- ;;<Address>
-"RTN","GPLCCR0",749,0)
- ;;<Type>
-"RTN","GPLCCR0",750,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",751,0)
- ;;</Type>
-"RTN","GPLCCR0",752,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",753,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",754,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",755,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","GPLCCR0",756,0)
- ;;</Address>
-"RTN","GPLCCR0",757,0)
- ;;<Telephone>
-"RTN","GPLCCR0",758,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","GPLCCR0",759,0)
- ;;<Type>
-"RTN","GPLCCR0",760,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","GPLCCR0",761,0)
- ;;</Type>
-"RTN","GPLCCR0",762,0)
- ;;</Telephone>
-"RTN","GPLCCR0",763,0)
- ;;<Email>
-"RTN","GPLCCR0",764,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",765,0)
- ;;</Email>
-"RTN","GPLCCR0",766,0)
- ;;<Source>
-"RTN","GPLCCR0",767,0)
- ;;<Actor>
-"RTN","GPLCCR0",768,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",769,0)
- ;;</Actor>
-"RTN","GPLCCR0",770,0)
- ;;</Source>
-"RTN","GPLCCR0",771,0)
- ;;</Actor>
-"RTN","GPLCCR0",772,0)
- ;;</ACTOR-PROVIDER>
-"RTN","GPLCCR0",773,0)
- ;;<ACTOR-ORG>
-"RTN","GPLCCR0",774,0)
- ;;<Actor>
-"RTN","GPLCCR0",775,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",776,0)
- ;;<Organization>
-"RTN","GPLCCR0",777,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","GPLCCR0",778,0)
- ;;</Organization>
-"RTN","GPLCCR0",779,0)
- ;;<Source>
-"RTN","GPLCCR0",780,0)
- ;;<Actor>
-"RTN","GPLCCR0",781,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",782,0)
- ;;</Actor>
-"RTN","GPLCCR0",783,0)
- ;;</Source>
-"RTN","GPLCCR0",784,0)
- ;;</Actor>
-"RTN","GPLCCR0",785,0)
- ;;</ACTOR-ORG>
-"RTN","GPLCCR0",786,0)
- ;;</Actors>
-"RTN","GPLCCR0",787,0)
- ;;<Signatures>
-"RTN","GPLCCR0",788,0)
- ;;<CCRSignature>
-"RTN","GPLCCR0",789,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","GPLCCR0",790,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","GPLCCR0",791,0)
- ;;<Source>
-"RTN","GPLCCR0",792,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","GPLCCR0",793,0)
- ;;</Source>
-"RTN","GPLCCR0",794,0)
- ;;<Signature>
-"RTN","GPLCCR0",795,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","GPLCCR0",796,0)
- ;;<SignedInfo>
-"RTN","GPLCCR0",797,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","GPLCCR0",798,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","GPLCCR0",799,0)
- ;;<Reference URI="">
-"RTN","GPLCCR0",800,0)
- ;;<Transforms>
-"RTN","GPLCCR0",801,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","GPLCCR0",802,0)
- ;;</Transforms>
-"RTN","GPLCCR0",803,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","GPLCCR0",804,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","GPLCCR0",805,0)
- ;;</Reference>
-"RTN","GPLCCR0",806,0)
- ;;</SignedInfo>
-"RTN","GPLCCR0",807,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","GPLCCR0",808,0)
- ;;<KeyInfo>
-"RTN","GPLCCR0",809,0)
- ;;<KeyValue>
-"RTN","GPLCCR0",810,0)
- ;;<RSAKeyValue>
-"RTN","GPLCCR0",811,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","GPLCCR0",812,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","GPLCCR0",813,0)
- ;;</RSAKeyValue>
-"RTN","GPLCCR0",814,0)
- ;;</KeyValue>
-"RTN","GPLCCR0",815,0)
- ;;</KeyInfo>
-"RTN","GPLCCR0",816,0)
- ;;</Signature>
-"RTN","GPLCCR0",817,0)
- ;;</Signature>
-"RTN","GPLCCR0",818,0)
- ;;</CCRSignature>
-"RTN","GPLCCR0",819,0)
- ;;</Signatures>
-"RTN","GPLCCR0",820,0)
- ;;</ContinuityOfCareRecord>
-"RTN","GPLCCR0",821,0)
- ;</TEMPLATE>
-"RTN","GPLMEDS")
-0^18^B55630630
-"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 8
-"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 HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","GPLMEDS",29,0)
-   N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","GPLMEDS",30,0)
-   ; OUTPATIENT MEDS ARE PROCESSED IN EXTRACT^CCRMEDS, ALL OTHERS HERE
-"RTN","GPLMEDS",31,0)
-   D EXTRACT^CCRMEDS(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","GPLMEDS",32,0)
-   I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","GPLMEDS",33,0)
-   . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","GPLMEDS",34,0)
-   . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","GPLMEDS",35,0)
-   . W "HAS ACTIVE OP MEDS",!
-"RTN","GPLMEDS",36,0)
-   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","GPLMEDS",37,0)
-   D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","GPLMEDS",38,0)
-   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","GPLMEDS",39,0)
-   . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","GPLMEDS",40,0)
-   . S @MEDOUTXML@(0)=0
-"RTN","GPLMEDS",41,0)
-   . Q
-"RTN","GPLMEDS",42,0)
-   ; I DEBUG ZWR MEDRSLT
-"RTN","GPLMEDS",43,0)
-   M GPLMEDS=MEDRSLT
-"RTN","GPLMEDS",44,0)
-   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","GPLMEDS",45,0)
-   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","GPLMEDS",46,0)
-   I 'HASOP K @MEDTVMAP,@MEDTARYTMP
-"RTN","GPLMEDS",47,0)
-   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","GPLMEDS",48,0)
-   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","GPLMEDS",49,0)
-   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","GPLMEDS",50,0)
-   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","GPLMEDS",51,0)
-   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","GPLMEDS",52,0)
-   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","GPLMEDS",53,0)
-   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","GPLMEDS",54,0)
-   . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","GPLMEDS",55,0)
-   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","GPLMEDS",56,0)
-   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","GPLMEDS",57,0)
-   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","GPLMEDS",58,0)
-   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","GPLMEDS",59,0)
-   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","GPLMEDS",60,0)
-   ;ZWR ZA
-"RTN","GPLMEDS",61,0)
-   S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","GPLMEDS",62,0)
-   F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","GPLMEDS",63,0)
-   . I DEBUG W "ZI IS ",ZI,!
-"RTN","GPLMEDS",64,0)
-   . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","GPLMEDS",65,0)
-   . K @MEDVMAP
-"RTN","GPLMEDS",66,0)
-   . I DEBUG W "VMAP= ",MEDVMAP,!
-"RTN","GPLMEDS",67,0)
-   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","GPLMEDS",68,0)
-   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","GPLMEDS",69,0)
-   . I $P(MEDPTMP,U,1)?1"~OP"&$P(MEDPTMP,"^",10)="ACTIVE" Q  ; SKIP OP ACTIVE
-"RTN","GPLMEDS",70,0)
-   . S @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","GPLMEDS",71,0)
-   . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","GPLMEDS",72,0)
-   . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","GPLMEDS",73,0)
-   . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","GPLMEDS",74,0)
-   . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","GPLMEDS",75,0)
-   . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","GPLMEDS",76,0)
-   . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","GPLMEDS",77,0)
-   . S @MEDVMAP@("MEDRXNO")=""
-"RTN","GPLMEDS",78,0)
-   . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","GPLMEDS",79,0)
-   . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","GPLMEDS",80,0)
-   . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","GPLMEDS",81,0)
-   . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","GPLMEDS",82,0)
-   . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","GPLMEDS",83,0)
-   . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","GPLMEDS",84,0)
-   . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","GPLMEDS",85,0)
-   . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","GPLMEDS",86,0)
-   . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","GPLMEDS",87,0)
-   . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","GPLMEDS",88,0)
-   . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","GPLMEDS",89,0)
-   . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","GPLMEDS",90,0)
-   . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","GPLMEDS",91,0)
-   . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","GPLMEDS",92,0)
-   . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","GPLMEDS",93,0)
-   . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","GPLMEDS",94,0)
-   . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","GPLMEDS",95,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","GPLMEDS",96,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","GPLMEDS",97,0)
-   . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","GPLMEDS",98,0)
-   . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","GPLMEDS",99,0)
-   . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","GPLMEDS",100,0)
-   . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","GPLMEDS",101,0)
-   . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","GPLMEDS",102,0)
-   . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","GPLMEDS",103,0)
-   . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","GPLMEDS",104,0)
-   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","GPLMEDS",105,0)
-   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","GPLMEDS",106,0)
-   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","GPLMEDS",107,0)
-   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLMEDS",108,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","GPLMEDS",109,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","GPLMEDS",110,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","GPLMEDS",111,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","GPLMEDS",112,0)
-   . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","GPLMEDS",113,0)
-   . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","GPLMEDS",114,0)
-   . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","GPLMEDS",115,0)
-   . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","GPLMEDS",116,0)
-   . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","GPLMEDS",117,0)
-   . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","GPLMEDS",118,0)
-   . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","GPLMEDS",119,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","GPLMEDS",120,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","GPLMEDS",121,0)
-   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","GPLMEDS",122,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","GPLMEDS",123,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","GPLMEDS",124,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","GPLMEDS",125,0)
-   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","GPLMEDS",126,0)
-   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","GPLMEDS",127,0)
-   . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","GPLMEDS",128,0)
-   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","GPLMEDS",129,0)
-   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","GPLMEDS",130,0)
-   . S @MEDVMAP@("MEDRFNO")=""
-"RTN","GPLMEDS",131,0)
-   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","GPLMEDS",132,0)
-   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","GPLMEDS",133,0)
-   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","GPLMEDS",134,0)
-   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","GPLMEDS",135,0)
-   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","GPLMEDS",136,0)
-   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","GPLMEDS",137,0)
-   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","GPLMEDS",138,0)
-   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","GPLMEDS",139,0)
-   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","GPLMEDS",140,0)
-   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","GPLMEDS",141,0)
-   . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","GPLMEDS",142,0)
-   . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","GPLMEDS",143,0)
-   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","GPLMEDS",144,0)
-   . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","GPLMEDS",145,0)
-   . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","GPLMEDS",146,0)
-   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","GPLMEDS",147,0)
-   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","GPLMEDS",148,0)
-   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","GPLMEDS",149,0)
-   . K @MEDARYTMP
-"RTN","GPLMEDS",150,0)
-   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","GPLMEDS",151,0)
-   . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","GPLMEDS",152,0)
-   . . ; W "FIRST ONE",!
-"RTN","GPLMEDS",153,0)
-   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","GPLMEDS",154,0)
-   . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","GPLMEDS",155,0)
-   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","GPLMEDS",156,0)
-   N MEDTMP,MEDI
-"RTN","GPLMEDS",157,0)
-   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLMEDS",158,0)
-   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLMEDS",159,0)
-   . W "MEDICATION MISSING ",!
-"RTN","GPLMEDS",160,0)
-   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","GPLMEDS",161,0)
-   Q
-"RTN","GPLMEDS",162,0)
-   ;
-"RTN","GPLMEDS",163,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","GPLMEDS",164,0)
-   ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","GPLMEDS",165,0)
-   N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","GPLMEDS",166,0)
-   S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","GPLMEDS",167,0)
-   Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","GPLMEDS",168,0)
-   ;
-"RTN","GPLPROBS")
-0^11^B25875394
-"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 8
-"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)
-          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","GPLPROBS",42,0)
-          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","GPLPROBS",43,0)
-          . S VMAP=$NA(@TVMAP@(J))
-"RTN","GPLPROBS",44,0)
-          . K @VMAP
-"RTN","GPLPROBS",45,0)
-          . I DEBUG W "VMAP= ",VMAP,!
-"RTN","GPLPROBS",46,0)
-          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","GPLPROBS",47,0)
-          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","GPLPROBS",48,0)
-          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","GPLPROBS",49,0)
-          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
-"RTN","GPLPROBS",50,0)
-          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","GPLPROBS",51,0)
-          . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","GPLPROBS",52,0)
-          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","GPLPROBS",53,0)
-          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
-"RTN","GPLPROBS",54,0)
-          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
-"RTN","GPLPROBS",55,0)
-          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","GPLPROBS",56,0)
-          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","GPLPROBS",57,0)
-          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","GPLPROBS",58,0)
-          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","GPLPROBS",59,0)
-          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","GPLPROBS",60,0)
-          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","GPLPROBS",61,0)
-          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","GPLPROBS",62,0)
-          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","GPLPROBS",63,0)
-          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","GPLPROBS",64,0)
-          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","GPLPROBS",65,0)
-          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
-"RTN","GPLPROBS",66,0)
-          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
-"RTN","GPLPROBS",67,0)
-          . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","GPLPROBS",68,0)
-          . ; W "ARYTMP= ",ARYTMP,!
-"RTN","GPLPROBS",69,0)
-          . K @ARYTMP
-"RTN","GPLPROBS",70,0)
-          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","GPLPROBS",71,0)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",72,0)
-          . . ; W "FIRST ONE",!
-"RTN","GPLPROBS",73,0)
-          . . D CP^GPLXPATH(ARYTMP,OUTXML)
-"RTN","GPLPROBS",74,0)
-          . . ; W "OUTXML ",OUTXML,!
-"RTN","GPLPROBS",75,0)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLPROBS",76,0)
-          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
-"RTN","GPLPROBS",77,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
-"RTN","GPLPROBS",78,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLPROBS",79,0)
-          ; ZWR @OUTXML
-"RTN","GPLPROBS",80,0)
-          ; $$HTML^DILF(
-"RTN","GPLPROBS",81,0)
-          ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","GPLPROBS",82,0)
-          I CCD D  ; IF THIS IS FOR A CCD
-"RTN","GPLPROBS",83,0)
-          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
-"RTN","GPLPROBS",84,0)
-          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","GPLPROBS",85,0)
-          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
-"RTN","GPLPROBS",86,0)
-          . . I DEBUG W "VMAP =",VMAP,!
-"RTN","GPLPROBS",87,0)
-          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","GPLPROBS",88,0)
-          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","GPLPROBS",89,0)
-          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
-"RTN","GPLPROBS",90,0)
-          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","GPLPROBS",91,0)
-          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","GPLPROBS",92,0)
-          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",93,0)
-          . . . D CP^GPLXPATH("HOUT","HTMLO")
-"RTN","GPLPROBS",94,0)
-          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","GPLPROBS",95,0)
-          . . . I DEBUG W "DOING INNER",!
-"RTN","GPLPROBS",96,0)
-          . . . N HTMLBLD,HTMLTMP
-"RTN","GPLPROBS",97,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","GPLPROBS",98,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","GPLPROBS",99,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","GPLPROBS",100,0)
-          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
-"RTN","GPLPROBS",101,0)
-          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
-"RTN","GPLPROBS",102,0)
-          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
-"RTN","GPLPROBS",103,0)
-          . I DEBUG D PARY^GPLXPATH("HTMLO")
-"RTN","GPLPROBS",104,0)
-          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","GPLPROBS",105,0)
-          N PROBSTMP,I
-"RTN","GPLPROBS",106,0)
-          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLPROBS",107,0)
-          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLPROBS",108,0)
-          . ; STRINGS MARKED AS @@X@@
-"RTN","GPLPROBS",109,0)
-          . W !,"PROBLEMS Missing list: ",!
-"RTN","GPLPROBS",110,0)
-          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","GPLPROBS",111,0)
-          Q
-"RTN","GPLPROBS",112,0)
-          ;
-"RTN","GPLRIMA")
-0^13^B214212612
-"RTN","GPLRIMA",1,0)
-GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-"RTN","GPLRIMA",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 8
-"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)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
-"RTN","GPLRIMA",63,0)
-    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","GPLRIMA",64,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
-"RTN","GPLRIMA",65,0)
-    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","GPLRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
-"RTN","GPLRIMA",67,0)
-    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","GPLRIMA",68,0)
-    . ;
-"RTN","GPLRIMA",69,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-"RTN","GPLRIMA",70,0)
-    . ;
-"RTN","GPLRIMA",71,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-"RTN","GPLRIMA",72,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","GPLRIMA",73,0)
-    . ;
-"RTN","GPLRIMA",74,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","GPLRIMA",75,0)
-    . ;
-"RTN","GPLRIMA",76,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","GPLRIMA",77,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","GPLRIMA",78,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","GPLRIMA",79,0)
-    . ;
-"RTN","GPLRIMA",80,0)
-    . N CATNAME,CATTBL
-"RTN","GPLRIMA",81,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","GPLRIMA",82,0)
-    . S CATNAME=""
-"RTN","GPLRIMA",83,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","GPLRIMA",84,0)
-    . W "CATEGORY NAME: ",CATNAME,!
-"RTN","GPLRIMA",85,0)
-    . ;
-"RTN","GPLRIMA",86,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
-"RTN","GPLRIMA",87,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","GPLRIMA",88,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","GPLRIMA",89,0)
-    . ; AND WE SKIP IT
-"RTN","GPLRIMA",90,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","GPLRIMA",91,0)
-    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","GPLRIMA",92,0)
-    Q
-"RTN","GPLRIMA",93,0)
-    ;
-"RTN","GPLRIMA",94,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","GPLRIMA",95,0)
-    N SBASE,SATTR
-"RTN","GPLRIMA",96,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","GPLRIMA",97,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","GPLRIMA",98,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","GPLRIMA",99,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","GPLRIMA",100,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","GPLRIMA",101,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","GPLRIMA",102,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","GPLRIMA",103,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","GPLRIMA",104,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",105,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","GPLRIMA",106,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",107,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",108,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","GPLRIMA",109,0)
-    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","GPLRIMA",110,0)
-    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","GPLRIMA",111,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","GPLRIMA",112,0)
-    Q SATTR
-"RTN","GPLRIMA",113,0)
-    ;
-"RTN","GPLRIMA",114,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","GPLRIMA",115,0)
-    K ^TMP("GPLRIM","RESUME")
-"RTN","GPLRIMA",116,0)
-    K ^TMP("GPLRIM")
-"RTN","GPLRIMA",117,0)
-    Q
-"RTN","GPLRIMA",118,0)
-    ;
-"RTN","GPLRIMA",119,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","GPLRIMA",120,0)
-    ;
-"RTN","GPLRIMA",121,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",122,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","GPLRIMA",123,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","GPLRIMA",124,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","GPLRIMA",125,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","GPLRIMA",126,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","GPLRIMA",127,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","GPLRIMA",128,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","GPLRIMA",129,0)
-    . W CLIDX,!
-"RTN","GPLRIMA",130,0)
-    ; D PARY^GPLXPATH(CLBASE)
-"RTN","GPLRIMA",131,0)
-    Q
-"RTN","GPLRIMA",132,0)
-    ;
-"RTN","GPLRIMA",133,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","GPLRIMA",134,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","GPLRIMA",135,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","GPLRIMA",136,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","GPLRIMA",137,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","GPLRIMA",138,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","GPLRIMA",139,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","GPLRIMA",140,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","GPLRIMA",141,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","GPLRIMA",142,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","GPLRIMA",143,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","GPLRIMA",144,0)
-    ;
-"RTN","GPLRIMA",145,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","GPLRIMA",146,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","GPLRIMA",147,0)
-    W "CBASE: ",CCTBL,!
-"RTN","GPLRIMA",148,0)
-    ;
-"RTN","GPLRIMA",149,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","GPLRIMA",150,0)
-    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","GPLRIMA",151,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","GPLRIMA",152,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","GPLRIMA",153,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","GPLRIMA",154,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","GPLRIMA",155,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","GPLRIMA",156,0)
-    ;
-"RTN","GPLRIMA",157,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","GPLRIMA",158,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",159,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","GPLRIMA",160,0)
-    ;
-"RTN","GPLRIMA",161,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","GPLRIMA",162,0)
-    ;
-"RTN","GPLRIMA",163,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","GPLRIMA",164,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","GPLRIMA",165,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","GPLRIMA",166,0)
-    ;
-"RTN","GPLRIMA",167,0)
-    Q
-"RTN","GPLRIMA",168,0)
-    ;
-"RTN","GPLRIMA",169,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","GPLRIMA",170,0)
-    ;
-"RTN","GPLRIMA",171,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",172,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","GPLRIMA",173,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",174,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",175,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","GPLRIMA",176,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","GPLRIMA",177,0)
-    . S ZCNT=0
-"RTN","GPLRIMA",178,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","GPLRIMA",179,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","GPLRIMA",180,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","GPLRIMA",181,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","GPLRIMA",182,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",183,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","GPLRIMA",184,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","GPLRIMA",185,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","GPLRIMA",186,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","GPLRIMA",187,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","GPLRIMA",188,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","GPLRIMA",189,0)
-    Q
-"RTN","GPLRIMA",190,0)
-    ;
-"RTN","GPLRIMA",191,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","GPLRIMA",192,0)
-    ; INLST IS PASSED BY NAME
-"RTN","GPLRIMA",193,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","GPLRIMA",194,0)
-    W INLST,!
-"RTN","GPLRIMA",195,0)
-    S ZCOUNT=0
-"RTN","GPLRIMA",196,0)
-    S ZDX=""
-"RTN","GPLRIMA",197,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","GPLRIMA",198,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","GPLRIMA",199,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","GPLRIMA",200,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","GPLRIMA",201,0)
-    Q ZCOUNT
-"RTN","GPLRIMA",202,0)
-    ;
-"RTN","GPLRIMA",203,0)
-XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN 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 ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",208,0)
-    S ZI=""
-"RTN","GPLRIMA",209,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",210,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",211,0)
-    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
-"RTN","GPLRIMA",212,0)
-    Q
-"RTN","GPLRIMA",213,0)
-    ;
-"RTN","GPLRIMA",214,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","GPLRIMA",215,0)
-    ;
-"RTN","GPLRIMA",216,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",217,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",218,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","GPLRIMA",219,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",220,0)
-    S ZI=""
-"RTN","GPLRIMA",221,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",222,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",223,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","GPLRIMA",224,0)
-    . W ZI," "
-"RTN","GPLRIMA",225,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","GPLRIMA",226,0)
-    . . S ZC=0
-"RTN","GPLRIMA",227,0)
-    . . W !
-"RTN","GPLRIMA",228,0)
-    Q
-"RTN","GPLRIMA",229,0)
-    ;
-"RTN","GPLRIMA",230,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","GPLRIMA",231,0)
-    ;
-"RTN","GPLRIMA",232,0)
-    N ATTR S ATTR=""
-"RTN","GPLRIMA",233,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",234,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","GPLRIMA",235,0)
-    S ATTR=^TMP("GPLRIM","ATTR",DFN)
-"RTN","GPLRIMA",236,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","GPLRIMA",237,0)
-    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","GPLRIMA",238,0)
-    . N CAT
-"RTN","GPLRIMA",239,0)
-    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","GPLRIMA",240,0)
-    . W CAT,": ",ATTR,!
-"RTN","GPLRIMA",241,0)
-    Q
-"RTN","GPLRIMA",242,0)
-    ;
-"RTN","GPLRIMA",243,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","GPLRIMA",244,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","GPLRIMA",245,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","GPLRIMA",246,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","GPLRIMA",247,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","GPLRIMA",248,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","GPLRIMA",249,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","GPLRIMA",250,0)
-    ;
-"RTN","GPLRIMA",251,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","GPLRIMA",252,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","GPLRIMA",253,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","GPLRIMA",254,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","GPLRIMA",255,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","GPLRIMA",256,0)
-    Q
-"RTN","GPLRIMA",257,0)
-    ;
-"RTN","GPLRIMA",258,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","GPLRIMA",259,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
-"RTN","GPLRIMA",260,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","GPLRIMA",261,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","GPLRIMA",262,0)
-      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","GPLRIMA",263,0)
-      Q
-"RTN","GPLRIMA",264,0)
-      ;
-"RTN","GPLRIMA",265,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","GPLRIMA",266,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",267,0)
-      K @RIMTBL
-"RTN","GPLRIMA",268,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","GPLRIMA",269,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","GPLRIMA",270,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","GPLRIMA",271,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","GPLRIMA",272,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","GPLRIMA",273,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","GPLRIMA",274,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","GPLRIMA",275,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","GPLRIMA",276,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","GPLRIMA",277,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","GPLRIMA",278,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","GPLRIMA",279,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","GPLRIMA",280,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","GPLRIMA",281,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","GPLRIMA",282,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","GPLRIMA",283,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","GPLRIMA",284,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","GPLRIMA",285,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","GPLRIMA",286,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","GPLRIMA",287,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","GPLRIMA",288,0)
-      Q
-"RTN","GPLRIMA",289,0)
-      ;
-"RTN","GPLRIMA",290,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","GPLRIMA",291,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","GPLRIMA",292,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","GPLRIMA",293,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","GPLRIMA",294,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","GPLRIMA",295,0)
-    N USETBL
-"RTN","GPLRIMA",296,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","GPLRIMA",297,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","GPLRIMA",298,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","GPLRIMA",299,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","GPLRIMA",300,0)
-    Q
-"RTN","GPLRIMA",301,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","GPLRIMA",302,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","GPLRIMA",303,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","GPLRIMA",304,0)
-    ; IN SECTION "MEDS"
-"RTN","GPLRIMA",305,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","GPLRIMA",306,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","GPLRIMA",307,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","GPLRIMA",308,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","GPLRIMA",309,0)
-    ;
-"RTN","GPLRIMA",310,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","GPLRIMA",311,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",312,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",313,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","GPLRIMA",314,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","GPLRIMA",315,0)
-    N ZZI,ZZS
-"RTN","GPLRIMA",316,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","GPLRIMA",317,0)
-    ; ZWR @ZZS@(1)
-"RTN","GPLRIMA",318,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","GPLRIMA",319,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","GPLRIMA",320,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","GPLRIMA",321,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","GPLRIMA",322,0)
-    Q
-"RTN","GPLRIMA",323,0)
-    ;
-"RTN","GPLRIMA",324,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","GPLRIMA",325,0)
-    ;
-"RTN","GPLRIMA",326,0)
-    N ZR
-"RTN","GPLRIMA",327,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","GPLRIMA",328,0)
-    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
-"RTN","GPLRIMA",329,0)
-    E  W "NOTHING RETURNED",!
-"RTN","GPLRIMA",330,0)
-    Q
-"RTN","GPLRIMA",331,0)
-    ;
-"RTN","GPLRIMA",332,0)
-CAGET(RTN,IATTR) ;
-"RTN","GPLRIMA",333,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",334,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","GPLRIMA",335,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","GPLRIMA",336,0)
-    Q
-"RTN","GPLRIMA",337,0)
-    ;
-"RTN","GPLRIMA",338,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",339,0)
-    ;
-"RTN","GPLRIMA",340,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",341,0)
-    N ZLST
-"RTN","GPLRIMA",342,0)
-    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
-"RTN","GPLRIMA",343,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",344,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",345,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","GPLRIMA",346,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","GPLRIMA",347,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","GPLRIMA",348,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","GPLRIMA",349,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","GPLRIMA",350,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","GPLRIMA",351,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","GPLRIMA",352,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","GPLRIMA",353,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","GPLRIMA",354,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","GPLRIMA",355,0)
-    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","GPLRIMA",356,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","GPLRIMA",357,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","GPLRIMA",358,0)
-    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","GPLRIMA",359,0)
-    . S ZCNT=ZCNT+1
-"RTN","GPLRIMA",360,0)
-    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","GPLRIMA",361,0)
-    Q
-"RTN","GPLRIMA",362,0)
-    ;
-"RTN","GPLRIMA",363,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","GPLRIMA",364,0)
-    ;
-"RTN","GPLRIMA",365,0)
-    N ZR
-"RTN","GPLRIMA",366,0)
-    D PCLST(.ZR,CATTR)
-"RTN","GPLRIMA",367,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","GPLRIMA",368,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","GPLRIMA",369,0)
-    E  D  ;
-"RTN","GPLRIMA",370,0)
-    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
-"RTN","GPLRIMA",371,0)
-    . W "COUNT=",ZR(0),!
-"RTN","GPLRIMA",372,0)
-    Q
-"RTN","GPLRIMA",373,0)
-    ;
-"RTN","GPLRIMA",374,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","GPLRIMA",375,0)
-    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","GPLRIMA",376,0)
-    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","GPLRIMA",377,0)
-    ; DFN IS THE PATIENT NUMBER.
-"RTN","GPLRIMA",378,0)
-    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",379,0)
-    ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","GPLRIMA",380,0)
-    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","GPLRIMA",381,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",382,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",383,0)
-    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","GPLRIMA",384,0)
-    N ZZGI
-"RTN","GPLRIMA",385,0)
-    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","GPLRIMA",386,0)
-    . F ZZGI="PROBLEMS","VITALS","MEDS" D  ; FOR EACH SECTION
-"RTN","GPLRIMA",387,0)
-    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","GPLRIMA",388,0)
-    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","GPLRIMA",389,0)
-    Q
-"RTN","GPLRIMA",390,0)
-    ;
-"RTN","GPLRIMA",391,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","GPLRIMA",392,0)
-    ;
-"RTN","GPLRIMA",393,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","GPLRIMA",394,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","GPLRIMA",395,0)
-    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","GPLRIMA",396,0)
-    E  D  ; VARS EXIST
-"RTN","GPLRIMA",397,0)
-    . N ZGVI
-"RTN","GPLRIMA",398,0)
-    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","GPLRIMA",399,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","GPLRIMA",400,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","GPLRIMA",401,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","GPLRIMA",402,0)
-    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","GPLRIMA",403,0)
-    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
-"RTN","GPLRIMA",404,0)
-    . . ; D PARY^GPLXPATH("ZZGA")
-"RTN","GPLRIMA",405,0)
-    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","GPLRIMA",406,0)
-    Q
-"RTN","GPLRIMA",407,0)
-    ;
-"RTN","GPLRIMA",408,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
-"RTN","GPLRIMA",409,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","GPLRIMA",410,0)
-    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",411,0)
-    N GTMP
-"RTN","GPLRIMA",412,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",413,0)
-    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","GPLRIMA",414,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","GPLRIMA",415,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","GPLRIMA",416,0)
-    D PARY^GPLXPATH("GTMP")
-"RTN","GPLRIMA",417,0)
-    Q
-"RTN","GPLRIMA",418,0)
-    ;
-"RTN","GPLUNIT")
-0^10^B31438520
-"RTN","GPLUNIT",1,0)
-GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-"RTN","GPLUNIT",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 8
-"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  Q ; TEST SECTION DOESN'T EXIST
-"RTN","GPLUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","GPLUNIT",83,0)
-          N FIRST,LAST
-"RTN","GPLUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","GPLUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","GPLUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
-"RTN","GPLUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","GPLUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",89,0)
-          . . ;  W ZP,!
-"RTN","GPLUNIT",90,0)
-          . . S ZX=ZP
-"RTN","GPLUNIT",91,0)
-          . . W "RUNNING: "_ZP
-"RTN","GPLUNIT",92,0)
-          . . X ZX
-"RTN","GPLUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
-"RTN","GPLUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-"RTN","GPLUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",96,0)
-          . . S ZX="S ZR="_ZP
-"RTN","GPLUNIT",97,0)
-          . . W "TRYING: "_ZP
-"RTN","GPLUNIT",98,0)
-          . . X ZX
-"RTN","GPLUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","GPLUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-"RTN","GPLUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
-"RTN","GPLUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
-"RTN","GPLUNIT",104,0)
-          Q
-"RTN","GPLUNIT",105,0)
-          ;
-"RTN","GPLUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
-"RTN","GPLUNIT",107,0)
-          N ZTMP
-"RTN","GPLUNIT",108,0)
-          D ZLOAD(.ZTMP)
-"RTN","GPLUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
-"RTN","GPLUNIT",110,0)
-          W "PASSED: ",TPASSED,!
-"RTN","GPLUNIT",111,0)
-          W "FAILED: ",TFAILED,!
-"RTN","GPLUNIT",112,0)
-          W !
-"RTN","GPLUNIT",113,0)
-          W "THE TESTS!",!
-"RTN","GPLUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
-"RTN","GPLUNIT",115,0)
-          Q
-"RTN","GPLUNIT",116,0)
-          ;
-"RTN","GPLUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","GPLUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",119,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",120,0)
-          . D PUSH^GPLXPATH(RTN,I)
-"RTN","GPLUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",122,0)
-          Q
-"RTN","GPLUNIT",123,0)
-          ;
-"RTN","GPLUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","GPLUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","GPLUNIT",126,0)
-          S TOTP=0 S TOTF=0
-"RTN","GPLUNIT",127,0)
-          D ZLOAD^GPLUNIT("TZTMP",RNM)
-"RTN","GPLUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
-"RTN","GPLUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",131,0)
-          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
-"RTN","GPLUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
-"RTN","GPLUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
-"RTN","GPLUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","GPLUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","GPLUNIT",136,0)
-          F I=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","GPLUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","GPLUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","GPLUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","GPLUNIT",141,0)
-          Q
-"RTN","GPLUNIT",142,0)
-          ;
-"RTN","GPLUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","GPLUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-"RTN","GPLUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
-"RTN","GPLUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",147,0)
-          S K=1
-"RTN","GPLUNIT",148,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",149,0)
-          . ; W "I IS NOW=",I,!
-"RTN","GPLUNIT",150,0)
-          . W I," "
-"RTN","GPLUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",152,0)
-          . S K=K+1 I K=6  D
-"RTN","GPLUNIT",153,0)
-          . . W !
-"RTN","GPLUNIT",154,0)
-          . . S K=1
-"RTN","GPLUNIT",155,0)
-          Q
-"RTN","GPLUNIT",156,0)
-          ;
-"RTN","GPLVITAL")
-0^12^B82628966
-"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 8
-"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)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","GPLVITAL",45,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","GPLVITAL",46,0)
- . I $D(VITRSLT(VSORT(J))) D
-"RTN","GPLVITAL",47,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","GPLVITAL",48,0)
- . . K @VITVMAP
-"RTN","GPLVITAL",49,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","GPLVITAL",50,0)
- . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","GPLVITAL",51,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","GPLVITAL",52,0)
- . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","GPLVITAL",53,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","GPLVITAL",54,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","GPLVITAL",55,0)
- . . I $P(VITPTMP,U,2)="HT" D
-"RTN","GPLVITAL",56,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",57,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",58,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",59,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",60,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",61,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",62,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",63,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-"RTN","GPLVITAL",64,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",65,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",66,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",67,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",68,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","GPLVITAL",69,0)
- . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","GPLVITAL",70,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",71,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",72,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",73,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",74,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",75,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",76,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",77,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-"RTN","GPLVITAL",78,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",79,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",80,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",81,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",82,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","GPLVITAL",83,0)
- . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","GPLVITAL",84,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",85,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",86,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",87,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",88,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",89,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",90,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",91,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-"RTN","GPLVITAL",92,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",93,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",94,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",95,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",96,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",97,0)
- . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","GPLVITAL",98,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",99,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",100,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",101,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",102,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",103,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",104,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",105,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-"RTN","GPLVITAL",106,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",107,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",108,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",109,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",110,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","GPLVITAL",111,0)
- . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","GPLVITAL",112,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",113,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",114,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",115,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",116,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",117,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",118,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",119,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-"RTN","GPLVITAL",120,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",121,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",122,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",123,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",124,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",125,0)
- . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","GPLVITAL",126,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",127,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",128,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",129,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",130,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",131,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",132,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",133,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-"RTN","GPLVITAL",134,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",135,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",136,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",137,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",138,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",139,0)
- . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","GPLVITAL",140,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",141,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",142,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",143,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",144,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",145,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",146,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",147,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-"RTN","GPLVITAL",148,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",149,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",150,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",151,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",152,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",153,0)
- . . E  D
-"RTN","GPLVITAL",154,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","GPLVITAL",155,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",156,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",157,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","GPLVITAL",158,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",159,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",160,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","GPLVITAL",161,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","GPLVITAL",162,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-"RTN","GPLVITAL",163,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-"RTN","GPLVITAL",164,0)
- . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",165,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",166,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",167,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","GPLVITAL",168,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","GPLVITAL",169,0)
- . . K @VITARYTMP
-"RTN","GPLVITAL",170,0)
- . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","GPLVITAL",171,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLVITAL",172,0)
- . . . ; W "FIRST ONE",!
-"RTN","GPLVITAL",173,0)
- . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-"RTN","GPLVITAL",174,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","GPLVITAL",175,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLVITAL",176,0)
- . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-"RTN","GPLVITAL",177,0)
- ; ZWR ^TMP($J,"VITALS",*)
-"RTN","GPLVITAL",178,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLVITAL",179,0)
- I DEBUG D PARY^GPLXPATH(VITOUTXML)
-"RTN","GPLVITAL",180,0)
- N VITTMP,I
-"RTN","GPLVITAL",181,0)
- D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLVITAL",182,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLVITAL",183,0)
- . W "VITALS MISSING ",!
-"RTN","GPLVITAL",184,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","GPLVITAL",185,0)
- Q
-"RTN","GPLVITAL",186,0)
- ;
-"RTN","GPLVITAL",187,0)
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","GPLVITAL",188,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","GPLVITAL",189,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","GPLVITAL",190,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","GPLVITAL",191,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","GPLVITAL",192,0)
- F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","GPLVITAL",193,0)
- . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","GPLVITAL",194,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","GPLVITAL",195,0)
- . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","GPLVITAL",196,0)
- S VDT(0)=VTDCNT
-"RTN","GPLVITAL",197,0)
- Q
-"RTN","GPLVITAL",198,0)
- ;
-"RTN","GPLXPAT0")
-0^19^B50983429
-"RTN","GPLXPAT0",1,0)
-GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-"RTN","GPLXPAT0",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 8
-"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)
- ;;><PUSHA>
-"RTN","GPLXPAT0",193,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","GPLXPAT0",195,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","A")
-"RTN","GPLXPAT0",196,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","B")
-"RTN","GPLXPAT0",197,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","C")
-"RTN","GPLXPAT0",198,0)
- ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
-"RTN","GPLXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","GPLXPAT0",200,0)
- ;;>>?GTMP(0)=3
-"RTN","GPLXPAT0",201,0)
- ;;><H2ARY>
-"RTN","GPLXPAT0",202,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","GPLXPAT0",204,0)
- ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","GPLXPAT0",206,0)
- ;;>>?GTMP2(1)="TEST1^1"
-"RTN","GPLXPAT0",207,0)
- ;;><XVARS>
-"RTN","GPLXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",209,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
-"RTN","GPLXPAT0",210,0)
- ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",211,0)
- ;;>>?GTMP2(1)="VAR1^"
-"RTN","GPLXPAT0",212,0)
- ;;></TEST>
-"RTN","GPLXPATH")
-0^9^B241520746
-"RTN","GPLXPATH",1,0)
-GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-"RTN","GPLXPATH",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 8
-"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)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","GPLXPATH",53,0)
- ;
-"RTN","GPLXPATH",54,0)
- N ZGI
-"RTN","GPLXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
-"RTN","GPLXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
-"RTN","GPLXPATH",57,0)
- Q
-"RTN","GPLXPATH",58,0)
- ;
-"RTN","GPLXPATH",59,0)
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","GPLXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","GPLXPATH",61,0)
- S RTN=""
-"RTN","GPLXPATH",62,0)
- N I
-"RTN","GPLXPATH",63,0)
- ; W "STK= ",STK,!
-"RTN","GPLXPATH",64,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",65,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","GPLXPATH",66,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","GPLXPATH",67,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","GPLXPATH",68,0)
- Q
-"RTN","GPLXPATH",69,0)
- ;
-"RTN","GPLXPATH",70,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","GPLXPATH",71,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","GPLXPATH",72,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","GPLXPATH",73,0)
- N CUR,TMP
-"RTN","GPLXPATH",74,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","GPLXPATH",75,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","GPLXPATH",76,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","GPLXPATH",77,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","GPLXPATH",78,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","GPLXPATH",79,0)
- ; W "CUR= ",CUR,!
-"RTN","GPLXPATH",80,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","GPLXPATH",81,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","GPLXPATH",82,0)
- ; W "CUR2= ",CUR,!
-"RTN","GPLXPATH",83,0)
- Q CUR
-"RTN","GPLXPATH",84,0)
- ;
-"RTN","GPLXPATH",85,0)
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
-"RTN","GPLXPATH",86,0)
- ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
-"RTN","GPLXPATH",87,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","GPLXPATH",88,0)
- ; XML SECTION
-"RTN","GPLXPATH",89,0)
- ; ZXML IS PASSED BY NAME
-"RTN","GPLXPATH",90,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
-"RTN","GPLXPATH",91,0)
- N GPLSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","GPLXPATH",92,0)
- I '$D(@ZXML@(0))  D  ; NO XML PASSED
-"RTN","GPLXPATH",93,0)
- . W "ERROR IN XML FILE",!
-"RTN","GPLXPATH",94,0)
- S GPLSTK(0)=0 ; INITIALIZE STACK
-"RTN","GPLXPATH",95,0)
- F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","GPLXPATH",96,0)
- . S LINE=@ZXML@(I)
-"RTN","GPLXPATH",97,0)
- . ;W LINE,!
-"RTN","GPLXPATH",98,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","GPLXPATH",99,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","GPLXPATH",100,0)
- . I FOUND'=1  D
-"RTN","GPLXPATH",101,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","GPLXPATH",102,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","GPLXPATH",103,0)
- . . . ; ON THE SAME LINE
-"RTN","GPLXPATH",104,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",105,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",106,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",107,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",108,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",109,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",110,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",111,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",112,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",113,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","GPLXPATH",114,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",115,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","GPLXPATH",116,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","GPLXPATH",117,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",118,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",119,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",120,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",121,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",122,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",123,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","GPLXPATH",124,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","GPLXPATH",125,0)
- . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","GPLXPATH",126,0)
- . . . . Q
-"RTN","GPLXPATH",127,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","GPLXPATH",128,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","GPLXPATH",129,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",130,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",131,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",132,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",133,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",134,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",135,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",136,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",137,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",138,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","GPLXPATH",139,0)
- S @ZXML@("INDEXED")=""
-"RTN","GPLXPATH",140,0)
- S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
-"RTN","GPLXPATH",141,0)
- Q
-"RTN","GPLXPATH",142,0)
- ;
-"RTN","GPLXPATH",143,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","GPLXPATH",144,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","GPLXPATH",145,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","GPLXPATH",146,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","GPLXPATH",147,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","GPLXPATH",148,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","GPLXPATH",149,0)
- N TMP,I,J,QXPATH
-"RTN","GPLXPATH",150,0)
- S FIRST=1
-"RTN","GPLXPATH",151,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","GPLXPATH",152,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","GPLXPATH",153,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","GPLXPATH",154,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","GPLXPATH",155,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","GPLXPATH",156,0)
- K @OARY
-"RTN","GPLXPATH",157,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","GPLXPATH",158,0)
- S J=1
-"RTN","GPLXPATH",159,0)
- FOR I=FIRST:1:LAST  D
-"RTN","GPLXPATH",160,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","GPLXPATH",161,0)
- . S J=J+1
-"RTN","GPLXPATH",162,0)
- ; ZWR OARY
-"RTN","GPLXPATH",163,0)
- Q
-"RTN","GPLXPATH",164,0)
- ;
-"RTN","GPLXPATH",165,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","GPLXPATH",166,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",167,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",168,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","GPLXPATH",169,0)
- ;
-"RTN","GPLXPATH",170,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","GPLXPATH",171,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",172,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",173,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","GPLXPATH",174,0)
- ;
-"RTN","GPLXPATH",175,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","GPLXPATH",176,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",177,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",178,0)
- Q $P(ISTR,";",2)
-"RTN","GPLXPATH",179,0)
- ;
-"RTN","GPLXPATH",180,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","GPLXPATH",181,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",182,0)
- Q $P(ISTR,";",3)
-"RTN","GPLXPATH",183,0)
- ;
-"RTN","GPLXPATH",184,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","GPLXPATH",185,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",186,0)
- Q $P(ISTR,";",1)
-"RTN","GPLXPATH",187,0)
- ;
-"RTN","GPLXPATH",188,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","GPLXPATH",189,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","GPLXPATH",190,0)
- ; DEST IS CLEARED TO START
-"RTN","GPLXPATH",191,0)
- ; USES PUSH TO DO THE COPY
-"RTN","GPLXPATH",192,0)
- N I
-"RTN","GPLXPATH",193,0)
- K @BDEST
-"RTN","GPLXPATH",194,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","GPLXPATH",195,0)
- . N J,ATMP
-"RTN","GPLXPATH",196,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","GPLXPATH",197,0)
- . I DEBUG W "ATMP=",ATMP,!
-"RTN","GPLXPATH",198,0)
- . I DEBUG W @BLIST@(I),!
-"RTN","GPLXPATH",199,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","GPLXPATH",200,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","GPLXPATH",201,0)
- . . I DEBUG W "BDEST= ",BDEST,!
-"RTN","GPLXPATH",202,0)
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
-"RTN","GPLXPATH",203,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","GPLXPATH",204,0)
- Q
-"RTN","GPLXPATH",205,0)
- ;
-"RTN","GPLXPATH",206,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","GPLXPATH",207,0)
- ;
-"RTN","GPLXPATH",208,0)
- I DEBUG W "QUEUEING ",BLST,!
-"RTN","GPLXPATH",209,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","GPLXPATH",210,0)
- Q
-"RTN","GPLXPATH",211,0)
- ;
-"RTN","GPLXPATH",212,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","GPLXPATH",213,0)
- ; KILLS CPDEST FIRST
-"RTN","GPLXPATH",214,0)
- N CPINSTR
-"RTN","GPLXPATH",215,0)
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","GPLXPATH",216,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","GPLXPATH",217,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","GPLXPATH",218,0)
- . Q
-"RTN","GPLXPATH",219,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","GPLXPATH",220,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","GPLXPATH",221,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","GPLXPATH",222,0)
- Q
-"RTN","GPLXPATH",223,0)
- ;
-"RTN","GPLXPATH",224,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","GPLXPATH",225,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","GPLXPATH",226,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","GPLXPATH",227,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","GPLXPATH",228,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",229,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","GPLXPATH",230,0)
- . Q
-"RTN","GPLXPATH",231,0)
- I DEBUG W "DOING QOPEN",!
-"RTN","GPLXPATH",232,0)
- N S1,E1,QOT,QOTMP
-"RTN","GPLXPATH",233,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","GPLXPATH",234,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",235,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","GPLXPATH",236,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","GPLXPATH",237,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",238,0)
- . S E1=@QOXML@(0)-1
-"RTN","GPLXPATH",239,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","GPLXPATH",240,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","GPLXPATH",241,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","GPLXPATH",242,0)
- Q
-"RTN","GPLXPATH",243,0)
- ;
-"RTN","GPLXPATH",244,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","GPLXPATH",245,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","GPLXPATH",246,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","GPLXPATH",247,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","GPLXPATH",248,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","GPLXPATH",249,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",250,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","GPLXPATH",251,0)
- I DEBUG W "GOING TO CLOSE",!
-"RTN","GPLXPATH",252,0)
- N S1,E1,QCT,QCTMP
-"RTN","GPLXPATH",253,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","GPLXPATH",254,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",255,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","GPLXPATH",256,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","GPLXPATH",257,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",258,0)
- . S S1=@QCXML@(0)
-"RTN","GPLXPATH",259,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","GPLXPATH",260,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","GPLXPATH",261,0)
- Q
-"RTN","GPLXPATH",262,0)
- ;
-"RTN","GPLXPATH",263,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","GPLXPATH",264,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","GPLXPATH",265,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","GPLXPATH",266,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","GPLXPATH",267,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","GPLXPATH",268,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","GPLXPATH",269,0)
- N INSBLD,INSTMP
-"RTN","GPLXPATH",270,0)
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","GPLXPATH",271,0)
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","GPLXPATH",272,0)
- I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","GPLXPATH",273,0)
- . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","GPLXPATH",274,0)
- I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",275,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",276,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","GPLXPATH",277,0)
- . . I DEBUG D PARY^GPLXPATH("INSBLD")
-"RTN","GPLXPATH",278,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",279,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","GPLXPATH",280,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","GPLXPATH",281,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",282,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","GPLXPATH",283,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",284,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","GPLXPATH",285,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","GPLXPATH",286,0)
- . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","GPLXPATH",287,0)
- Q
-"RTN","GPLXPATH",288,0)
- ;
-"RTN","GPLXPATH",289,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","GPLXPATH",290,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","GPLXPATH",291,0)
- ;
-"RTN","GPLXPATH",292,0)
- N INNBLD,UXPATH
-"RTN","GPLXPATH",293,0)
- N INNTBUF
-"RTN","GPLXPATH",294,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","GPLXPATH",295,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","GPLXPATH",296,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","GPLXPATH",297,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","GPLXPATH",298,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","GPLXPATH",299,0)
- . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","GPLXPATH",300,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","GPLXPATH",301,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","GPLXPATH",302,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","GPLXPATH",303,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","GPLXPATH",304,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","GPLXPATH",305,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","GPLXPATH",306,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","GPLXPATH",307,0)
- Q
-"RTN","GPLXPATH",308,0)
- ;
-"RTN","GPLXPATH",309,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","GPLXPATH",310,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","GPLXPATH",311,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",312,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","GPLXPATH",313,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","GPLXPATH",314,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","GPLXPATH",315,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",316,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","GPLXPATH",317,0)
- I DEBUG D PARY("XDEST")
-"RTN","GPLXPATH",318,0)
- Q
-"RTN","GPLXPATH",319,0)
- ;
-"RTN","GPLXPATH",320,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","GPLXPATH",321,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","GPLXPATH",322,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","GPLXPATH",323,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","GPLXPATH",324,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","GPLXPATH",325,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","GPLXPATH",326,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","GPLXPATH",327,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","GPLXPATH",328,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","GPLXPATH",329,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","GPLXPATH",330,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","GPLXPATH",331,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","GPLXPATH",332,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",333,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","GPLXPATH",334,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","GPLXPATH",335,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","GPLXPATH",336,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",337,0)
- I DEBUG W "REPLACE PREBUILD",!
-"RTN","GPLXPATH",338,0)
- I DEBUG D PARY("REBLD")
-"RTN","GPLXPATH",339,0)
- D BUILD("REBLD","RTMP")
-"RTN","GPLXPATH",340,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","GPLXPATH",341,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","GPLXPATH",342,0)
- Q
-"RTN","GPLXPATH",343,0)
- ;
-"RTN","GPLXPATH",344,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","GPLXPATH",345,0)
- ; W "Reporting on the missing",!
-"RTN","GPLXPATH",346,0)
- ; W OARY
-"RTN","GPLXPATH",347,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","GPLXPATH",348,0)
- N I
-"RTN","GPLXPATH",349,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","GPLXPATH",350,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",351,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","GPLXPATH",352,0)
- . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","GPLXPATH",353,0)
- . . Q
-"RTN","GPLXPATH",354,0)
- Q
-"RTN","GPLXPATH",355,0)
- ;
-"RTN","GPLXPATH",356,0)
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","GPLXPATH",357,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","GPLXPATH",358,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","GPLXPATH",359,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","GPLXPATH",360,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","GPLXPATH",361,0)
- S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
-"RTN","GPLXPATH",362,0)
- F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",363,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","GPLXPATH",364,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","GPLXPATH",365,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","GPLXPATH",366,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","GPLXPATH",367,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","GPLXPATH",368,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","GPLXPATH",369,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","GPLXPATH",370,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","GPLXPATH",371,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","GPLXPATH",372,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","GPLXPATH",373,0)
- . . . . E  D DOFLD ; PROCESS A FIELD
-"RTN","GPLXPATH",374,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","GPLXPATH",375,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","GPLXPATH",376,0)
- . . I DEBUG W TSTR
-"RTN","GPLXPATH",377,0)
- I DEBUG W "MAPPED",!
-"RTN","GPLXPATH",378,0)
- Q
-"RTN","GPLXPATH",379,0)
- ;
-"RTN","GPLXPATH",380,0)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
-"RTN","GPLXPATH",381,0)
- ;
-"RTN","GPLXPATH",382,0)
- Q
-"RTN","GPLXPATH",383,0)
- ;
-"RTN","GPLXPATH",384,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","GPLXPATH",385,0)
- ; THEXML IS PASSED BY NAME
-"RTN","GPLXPATH",386,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","GPLXPATH",387,0)
- S FOUND=0
-"RTN","GPLXPATH",388,0)
- S INTXT=0
-"RTN","GPLXPATH",389,0)
- I DEBUG W "DELETING EMPTY ELEMENTS",!
-"RTN","GPLXPATH",390,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","GPLXPATH",391,0)
- . S J=@THEXML@(I)
-"RTN","GPLXPATH",392,0)
- . I J["<text>" D
-"RTN","GPLXPATH",393,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","GPLXPATH",394,0)
- . . I DEBUG W "IN HTML SECTION",!
-"RTN","GPLXPATH",395,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","GPLXPATH",396,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","GPLXPATH",397,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","GPLXPATH",398,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","GPLXPATH",399,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","GPLXPATH",400,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","GPLXPATH",401,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","GPLXPATH",402,0)
- . . . I DEBUG W I,J,JP,!
-"RTN","GPLXPATH",403,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",404,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","GPLXPATH",405,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","GPLXPATH",406,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","GPLXPATH",407,0)
- . . . I DEBUG W I,J,!
-"RTN","GPLXPATH",408,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",409,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","GPLXPATH",410,0)
- . . . I JM=JPX D  ;
-"RTN","GPLXPATH",411,0)
- . . . . I DEBUG W I,JM_J_JPX,!
-"RTN","GPLXPATH",412,0)
- . . . . S DEL(I-1)=""
-"RTN","GPLXPATH",413,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","GPLXPATH",414,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","GPLXPATH",415,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","GPLXPATH",416,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","GPLXPATH",417,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","GPLXPATH",418,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","GPLXPATH",419,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","GPLXPATH",420,0)
- Q FOUND
-"RTN","GPLXPATH",421,0)
- ;
-"RTN","GPLXPATH",422,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","GPLXPATH",423,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","GPLXPATH",424,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",425,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","GPLXPATH",426,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",427,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","GPLXPATH",428,0)
- Q
-"RTN","GPLXPATH",429,0)
- ;
-"RTN","GPLXPATH",430,0)
-PARY(GLO)       ;PRINT AN ARRAY
-"RTN","GPLXPATH",431,0)
- N I
-"RTN","GPLXPATH",432,0)
- F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
-"RTN","GPLXPATH",433,0)
- Q
-"RTN","GPLXPATH",434,0)
- ;
-"RTN","GPLXPATH",435,0)
-H2ARY(IARYRTN,IHASH) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","GPLXPATH",436,0)
- ;
-"RTN","GPLXPATH",437,0)
- N H2I S H2I=""
-"RTN","GPLXPATH",438,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","GPLXPATH",439,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","GPLXPATH",440,0)
- . ; W H2I_"^"_@IHASH@(H2I),!
-"RTN","GPLXPATH",441,0)
- . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
-"RTN","GPLXPATH",442,0)
- . . W "GPLZZ",!
-"RTN","GPLXPATH",443,0)
- . . W $NA(@IHASH@(H2I)),!
-"RTN","GPLXPATH",444,0)
- . . Q  ;
-"RTN","GPLXPATH",445,0)
- . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
-"RTN","GPLXPATH",446,0)
- . ; W @IARYRTN@(0),!
-"RTN","GPLXPATH",447,0)
- Q
-"RTN","GPLXPATH",448,0)
- ;
-"RTN","GPLXPATH",449,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","GPLXPATH",450,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","GPLXPATH",451,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","GPLXPATH",452,0)
- ;
-"RTN","GPLXPATH",453,0)
- N XVI,XVTMP,XVT
-"RTN","GPLXPATH",454,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","GPLXPATH",455,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","GPLXPATH",456,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
-"RTN","GPLXPATH",457,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","GPLXPATH",458,0)
- Q
-"RTN","GPLXPATH",459,0)
- ;
-"RTN","GPLXPATH",460,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","GPLXPATH",461,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","GPLXPATH",462,0)
- ;
-"RTN","GPLXPATH",463,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","GPLXPATH",464,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","GPLXPATH",465,0)
- . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",466,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",467,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","GPLXPATH",468,0)
- . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",469,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",470,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","GPLXPATH",471,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","GPLXPATH",472,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","GPLXPATH",473,0)
- D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","GPLXPATH",474,0)
- Q
-"RTN","GPLXPATH",475,0)
- ;
-"RTN","GPLXPATH",476,0)
-TEST     ; Run all the test cases
-"RTN","GPLXPATH",477,0)
- D TESTALL^GPLUNIT("GPLXPAT0")
-"RTN","GPLXPATH",478,0)
- Q
-"RTN","GPLXPATH",479,0)
- ;
-"RTN","GPLXPATH",480,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","GPLXPATH",481,0)
- N ZTMP
-"RTN","GPLXPATH",482,0)
- S DEBUG=1
-"RTN","GPLXPATH",483,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",484,0)
- D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLXPATH",485,0)
- Q
-"RTN","GPLXPATH",486,0)
- ;
-"RTN","GPLXPATH",487,0)
-TLIST   ; LIST THE TESTS
-"RTN","GPLXPATH",488,0)
- N ZTMP
-"RTN","GPLXPATH",489,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",490,0)
- D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLXPATH",491,0)
- Q
-"RTN","GPLXPATH",492,0)
- ;
-"VER")
-8.0^22.0
-**END**
-**END**
Index: ccr/tags/CCR_1_0_7/p/CCR_1_0_5_T2_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_5_T2_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,9070 +1,0 @@
-KIDS Distribution saved on Oct 07, 2008@15:52:44
-output file names have version number
-**KIDS**:CCR*1.0*5^
-
-**INSTALL NAME**
-CCR*1.0*5
-"BLD",6955,0)
-CCR*1.0*5^^0^3081007^n
-"BLD",6955,1,0)
-^^23^23^3080923^
-"BLD",6955,1,1,0)
- 
-"BLD",6955,1,2,0)
-CCR AND CCD EXPORT TOOLS 
-"BLD",6955,1,3,0)
- 
-"BLD",6955,1,4,0)
-SINGLE XML EXPORT TO A HOST DIRECTORY AT 
-"BLD",6955,1,5,0)
- 
-"BLD",6955,1,6,0)
-BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
-"BLD",6955,1,7,0)
-DIRECTORY
-"BLD",6955,1,8,0)
- 
-"BLD",6955,1,9,0)
-EXPORT^GPLCRR FOR THE CCR
-"BLD",6955,1,10,0)
-EXPORT^GPLCCD FOR THE CCD
-"BLD",6955,1,11,0)
-XPAT^GPLCCR(DFN,"","") 
-"BLD",6955,1,12,0)
- 
-"BLD",6955,1,13,0)
-BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
-"BLD",6955,1,14,0)
- 
-"BLD",6955,1,15,0)
-ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
-"BLD",6955,1,16,0)
-RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
-"BLD",6955,1,17,0)
-ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
-"BLD",6955,1,18,0)
- 
-"BLD",6955,1,19,0)
-CLIST^GPLRIMA TO LIST CATEGORY TOTALS
-"BLD",6955,1,20,0)
-CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
-"BLD",6955,1,21,0)
-XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
-"BLD",6955,1,22,0)
- 
-"BLD",6955,1,23,0)
-TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
-"BLD",6955,4,0)
-^9.64PA^^
-"BLD",6955,6.3)
-9
-"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^B45805995
-"BLD",6955,"KRN",9.8,"NM",2,0)
-CCRDPTT^^0^B4791589
-"BLD",6955,"KRN",9.8,"NM",3,0)
-CCRMEDS^^0^B59807333
-"BLD",6955,"KRN",9.8,"NM",4,0)
-CCRSYS^^0^B5866233
-"BLD",6955,"KRN",9.8,"NM",5,0)
-CCRUNIT^^0^B8574
-"BLD",6955,"KRN",9.8,"NM",6,0)
-CCRUTIL^^0^B5927217
-"BLD",6955,"KRN",9.8,"NM",7,0)
-CCRVA200^^0^B35847405
-"BLD",6955,"KRN",9.8,"NM",8,0)
-GPLACTOR^^0^B52628160
-"BLD",6955,"KRN",9.8,"NM",9,0)
-GPLXPATH^^0^B241520746
-"BLD",6955,"KRN",9.8,"NM",10,0)
-GPLUNIT^^0^B31438520
-"BLD",6955,"KRN",9.8,"NM",11,0)
-GPLPROBS^^0^B25875394
-"BLD",6955,"KRN",9.8,"NM",12,0)
-GPLVITAL^^0^B82628966
-"BLD",6955,"KRN",9.8,"NM",13,0)
-GPLRIMA^^0^B214212612
-"BLD",6955,"KRN",9.8,"NM",14,0)
-GPLCCR^^0^B82192762
-"BLD",6955,"KRN",9.8,"NM",15,0)
-GPLCCR0^^0^B654252455
-"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^B55630630
-"BLD",6955,"KRN",9.8,"NM",19,0)
-GPLXPAT0^^0^B50983429
-"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^B45805995
-"RTN","CCRDPT",1,0)
-CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
-"RTN","CCRDPT",2,0)
- ;;0.2;CCRCCD;;Jun 15, 2008;Build 9
-"RTN","CCRDPT",3,0)
- ;
-"RTN","CCRDPT",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRDPT",5,0)
- ; General Public License. 
-"RTN","CCRDPT",6,0)
- ; 
-"RTN","CCRDPT",7,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRDPT",8,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRDPT",9,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRDPT",10,0)
- ; GNU General Public License for more details.
-"RTN","CCRDPT",11,0)
- ; 
-"RTN","CCRDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRDPT",14,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRDPT",15,0)
- ;
-"RTN","CCRDPT",16,0)
- ; CCRDPT       CCRCCD/SMH - Routines to Extract Patient Data for
-"RTN","CCRDPT",17,0)
- ; FAMILY       Family Name
-"RTN","CCRDPT",18,0)
- ; GIVEN        Given Name
-"RTN","CCRDPT",19,0)
- ; MIDDLE       Middle Name
-"RTN","CCRDPT",20,0)
- ; SUFFIX       Suffix Name
-"RTN","CCRDPT",21,0)
- ; DISPNAME     Display Name
-"RTN","CCRDPT",22,0)
- ; DOB          Date of Birth
-"RTN","CCRDPT",23,0)
- ; GENDER       Get Gender
-"RTN","CCRDPT",24,0)
- ; SSN          Get SSN for ID
-"RTN","CCRDPT",25,0)
- ; ADDRTYPE     Get Home Address
-"RTN","CCRDPT",26,0)
- ; ADDR1        Get Home Address line 1
-"RTN","CCRDPT",27,0)
- ; ADDR2        Get Home Address line 2
-"RTN","CCRDPT",28,0)
- ; CITY         Get City for Home Address
-"RTN","CCRDPT",29,0)
- ; STATE        Get State for Home Address
-"RTN","CCRDPT",30,0)
- ; ZIP          Get Zip code for Home Address
-"RTN","CCRDPT",31,0)
- ; COUNTY       Get County for our Address
-"RTN","CCRDPT",32,0)
- ; COUNTRY      Get Country for our Address
-"RTN","CCRDPT",33,0)
- ; RESTEL       Residential Telephone
-"RTN","CCRDPT",34,0)
- ; WORKTEL      Work Telephone
-"RTN","CCRDPT",35,0)
- ; EMAIL        Email Adddress
-"RTN","CCRDPT",36,0)
- ; CELLTEL      Cell Phone
-"RTN","CCRDPT",37,0)
- ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",38,0)
- ; NOK1GIV      NOK1 Given Name
-"RTN","CCRDPT",39,0)
- ; NOK1MID      NOK1 Middle Name
-"RTN","CCRDPT",40,0)
- ; NOK1SUF      NOK1 Suffi Name
-"RTN","CCRDPT",41,0)
- ; NOK1DISP     NOK1 Display Name
-"RTN","CCRDPT",42,0)
- ; NOK1REL      NOK1 Relationship to the patient
-"RTN","CCRDPT",43,0)
- ; NOK1ADD1     NOK1 Address 1
-"RTN","CCRDPT",44,0)
- ; NOK1ADD2     NOK1 Address 2
-"RTN","CCRDPT",45,0)
- ; NOK1CITY     NOK1 City
-"RTN","CCRDPT",46,0)
- ; NOK1STAT     NOK1 State
-"RTN","CCRDPT",47,0)
- ; NOK1ZIP      NOK1 Zip Code
-"RTN","CCRDPT",48,0)
- ; NOK1HTEL     NOK1 Home Telephone
-"RTN","CCRDPT",49,0)
- ; NOK1WTEL     NOK1 Work Telephone
-"RTN","CCRDPT",50,0)
- ; NOK1SAME     Is NOK1's Address the same the patient?
-"RTN","CCRDPT",51,0)
- ; NOK2FAM      NOK2 Family Name
-"RTN","CCRDPT",52,0)
- ; NOK2GIV      NOK2 Given Name
-"RTN","CCRDPT",53,0)
- ; NOK2MID      NOK2 Middle Name
-"RTN","CCRDPT",54,0)
- ; NOK2SUF      NOK2 Suffi Name
-"RTN","CCRDPT",55,0)
- ; NOK2DISP     NOK2 Display Name
-"RTN","CCRDPT",56,0)
- ; NOK2REL      NOK2 Relationship to the patient
-"RTN","CCRDPT",57,0)
- ; NOK2ADD1     NOK2 Address 1
-"RTN","CCRDPT",58,0)
- ; NOK2ADD2     NOK2 Address 2
-"RTN","CCRDPT",59,0)
- ; NOK2CITY     NOK2 City
-"RTN","CCRDPT",60,0)
- ; NOK2STAT     NOK2 State
-"RTN","CCRDPT",61,0)
- ; NOK2ZIP      NOK2 Zip Code
-"RTN","CCRDPT",62,0)
- ; NOK2HTEL     NOK2 Home Telephone
-"RTN","CCRDPT",63,0)
- ; NOK2WTEL     NOK2 Work Telephone
-"RTN","CCRDPT",64,0)
- ; NOK2SAME     Is NOK2's Address the same the patient?
-"RTN","CCRDPT",65,0)
- ; EMERFAM      Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",66,0)
- ; EMERGIV      EMER Given Name
-"RTN","CCRDPT",67,0)
- ; EMERMID      EMER Middle Name
-"RTN","CCRDPT",68,0)
- ; EMERSUF      EMER Suffi Name
-"RTN","CCRDPT",69,0)
- ; EMERDISP     EMER Display Name
-"RTN","CCRDPT",70,0)
- ; EMERREL      EMER Relationship to the patient
-"RTN","CCRDPT",71,0)
- ; EMERADD1     EMER Address 1
-"RTN","CCRDPT",72,0)
- ; EMERADD2     EMER Address 2
-"RTN","CCRDPT",73,0)
- ; EMERCITY     EMER City
-"RTN","CCRDPT",74,0)
- ; EMERSTAT     EMER State
-"RTN","CCRDPT",75,0)
- ; EMERZIP      EMER Zip Code
-"RTN","CCRDPT",76,0)
- ; EMERHTEL     EMER Home Telephone
-"RTN","CCRDPT",77,0)
- ; EMERWTEL     EMER Work Telephone
-"RTN","CCRDPT",78,0)
- ; EMERSAME     Is EMER's Address the same the NOK?
-"RTN","CCRDPT",79,0)
- ;
-"RTN","CCRDPT",80,0)
- W "No Entry at top!" Q
-"RTN","CCRDPT",81,0)
- ;
-"RTN","CCRDPT",82,0)
- ;**Revision History**
-"RTN","CCRDPT",83,0)
- ; - June 15, 08: v0.1 using merged global
-"RTN","CCRDPT",84,0)
- ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
-"RTN","CCRDPT",85,0)
- ;
-"RTN","CCRDPT",86,0)
- ; All methods are Public and Extrinsic
-"RTN","CCRDPT",87,0)
- ; All calls use Fileman file 2 (Patient).
-"RTN","CCRDPT",88,0)
- ; You can obtain field numbers using the data dictionary
-"RTN","CCRDPT",89,0)
- ;
-"RTN","CCRDPT",90,0)
-FAMILY(DFN) ; Family Name
-"RTN","CCRDPT",91,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",92,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",93,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",94,0)
-GIVEN(DFN) ; Given Name
-"RTN","CCRDPT",95,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",96,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",97,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",98,0)
-MIDDLE(DFN) ; Middle Name
-"RTN","CCRDPT",99,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",100,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",101,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",102,0)
-SUFFIX(DFN) ; Suffi Name
-"RTN","CCRDPT",103,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",104,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",105,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",106,0)
-DISPNAME(DFN) ; Display Name
-"RTN","CCRDPT",107,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",108,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",109,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",110,0)
-DOB(DFN) ; Date of Birth
-"RTN","CCRDPT",111,0)
- N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","CCRDPT",112,0)
- ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","CCRDPT",113,0)
- Q $$FMDTOUTC^CCRUTIL(DOB,"D")
-"RTN","CCRDPT",114,0)
-GENDER(DFN) ; Gender/Sex
-"RTN","CCRDPT",115,0)
- Q $$GET1^DIQ(2,DFN,.02) ;
-"RTN","CCRDPT",116,0)
-SSN(DFN) ; SSN
-"RTN","CCRDPT",117,0)
- Q $$GET1^DIQ(2,DFN,.09)
-"RTN","CCRDPT",118,0)
-ADDRTYPE(DFN) ; Address Type
-"RTN","CCRDPT",119,0)
- ; Vista only stores a home address for the patient.
-"RTN","CCRDPT",120,0)
- Q "Home"
-"RTN","CCRDPT",121,0)
-ADDR1(DFN) ; Get Home Address line 1
-"RTN","CCRDPT",122,0)
- Q $$GET1^DIQ(2,DFN,.111)
-"RTN","CCRDPT",123,0)
-ADDR2(DFN) ; Get Home Address line 2
-"RTN","CCRDPT",124,0)
- ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","CCRDPT",125,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",126,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","CCRDPT",127,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",128,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",129,0)
-CITY(DFN) ; Get City for Home Address
-"RTN","CCRDPT",130,0)
- Q $$GET1^DIQ(2,DFN,.114)
-"RTN","CCRDPT",131,0)
-STATE(DFN) ; Get State for Home Address
-"RTN","CCRDPT",132,0)
- Q $$GET1^DIQ(2,DFN,.115)
-"RTN","CCRDPT",133,0)
-ZIP(DFN) ; Get Zip code for Home Address
-"RTN","CCRDPT",134,0)
- Q $$GET1^DIQ(2,DFN,.116)
-"RTN","CCRDPT",135,0)
-COUNTY(DFN) ; Get County for our Address
-"RTN","CCRDPT",136,0)
- Q $$GET1^DIQ(2,DFN,.117)
-"RTN","CCRDPT",137,0)
-COUNTRY(DFN) ; Get Country for our Address
-"RTN","CCRDPT",138,0)
- ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","CCRDPT",139,0)
- Q "USA"
-"RTN","CCRDPT",140,0)
-RESTEL(DFN) ; Residential Telephone
-"RTN","CCRDPT",141,0)
- Q $$GET1^DIQ(2,DFN,.131)
-"RTN","CCRDPT",142,0)
-WORKTEL(DFN) ; Work Telephone
-"RTN","CCRDPT",143,0)
- Q $$GET1^DIQ(2,DFN,.132)
-"RTN","CCRDPT",144,0)
-EMAIL(DFN) ; Email Adddress
-"RTN","CCRDPT",145,0)
- Q $$GET1^DIQ(2,DFN,.133)
-"RTN","CCRDPT",146,0)
-CELLTEL(DFN) ; Cell Phone
-"RTN","CCRDPT",147,0)
- Q $$GET1^DIQ(2,DFN,.134)
-"RTN","CCRDPT",148,0)
-NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",149,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",150,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",151,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",152,0)
-NOK1GIV(DFN) ; NOK1 Given Name
-"RTN","CCRDPT",153,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",154,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",155,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",156,0)
-NOK1MID(DFN) ; NOK1 Middle Name
-"RTN","CCRDPT",157,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",158,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",159,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",160,0)
-NOK1SUF(DFN) ; NOK1 Suffi Name
-"RTN","CCRDPT",161,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",162,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",163,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",164,0)
-NOK1DISP(DFN) ; NOK1 Display Name
-"RTN","CCRDPT",165,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",166,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",167,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",168,0)
-NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","CCRDPT",169,0)
- Q $$GET1^DIQ(2,DFN,.212)
-"RTN","CCRDPT",170,0)
-NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","CCRDPT",171,0)
- Q $$GET1^DIQ(2,DFN,.213)
-"RTN","CCRDPT",172,0)
-NOK1ADD2(DFN) ; NOK1 Address 2 
-"RTN","CCRDPT",173,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",174,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","CCRDPT",175,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",176,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",177,0)
-NOK1CITY(DFN) ; NOK1 City
-"RTN","CCRDPT",178,0)
- Q $$GET1^DIQ(2,DFN,.216)
-"RTN","CCRDPT",179,0)
-NOK1STAT(DFN) ; NOK1 State
-"RTN","CCRDPT",180,0)
- Q $$GET1^DIQ(2,DFN,.217)
-"RTN","CCRDPT",181,0)
-NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","CCRDPT",182,0)
- Q $$GET1^DIQ(2,DFN,.218)
-"RTN","CCRDPT",183,0)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","CCRDPT",184,0)
- Q $$GET1^DIQ(2,DFN,.219)
-"RTN","CCRDPT",185,0)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","CCRDPT",186,0)
- Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","CCRDPT",187,0)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","CCRDPT",188,0)
- Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","CCRDPT",189,0)
-NOK2FAM(DFN) ; NOK2 Family Name
-"RTN","CCRDPT",190,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",191,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",192,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",193,0)
-NOK2GIV(DFN) ; NOK2 Given Name
-"RTN","CCRDPT",194,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",195,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",196,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",197,0)
-NOK2MID(DFN) ; NOK2 Middle Name
-"RTN","CCRDPT",198,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",199,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",200,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",201,0)
-NOK2SUF(DFN) ; NOK2 Suffi Name
-"RTN","CCRDPT",202,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",203,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",204,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",205,0)
-NOK2DISP(DFN) ; NOK2 Display Name
-"RTN","CCRDPT",206,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",207,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",208,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",209,0)
-NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","CCRDPT",210,0)
- Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","CCRDPT",211,0)
-NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","CCRDPT",212,0)
- Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","CCRDPT",213,0)
-NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","CCRDPT",214,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",215,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","CCRDPT",216,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",217,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",218,0)
-NOK2CITY(DFN) ; NOK2 City
-"RTN","CCRDPT",219,0)
- Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","CCRDPT",220,0)
-NOK2STAT(DFN) ; NOK2 State
-"RTN","CCRDPT",221,0)
- Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","CCRDPT",222,0)
-NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","CCRDPT",223,0)
- Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","CCRDPT",224,0)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","CCRDPT",225,0)
- Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","CCRDPT",226,0)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","CCRDPT",227,0)
- Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","CCRDPT",228,0)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","CCRDPT",229,0)
- Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","CCRDPT",230,0)
-EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",231,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",232,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",233,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",234,0)
-EMERGIV(DFN) ; EMER Given Name
-"RTN","CCRDPT",235,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",236,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",237,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",238,0)
-EMERMID(DFN) ; EMER Middle Name
-"RTN","CCRDPT",239,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",240,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",241,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",242,0)
-EMERSUF(DFN) ; EMER Suffi Name
-"RTN","CCRDPT",243,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",244,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",245,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",246,0)
-EMERDISP(DFN) ; EMER Display Name
-"RTN","CCRDPT",247,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",248,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",249,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",250,0)
-EMERREL(DFN) ; EMER Relationship to the patient
-"RTN","CCRDPT",251,0)
- Q $$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",252,0)
-EMERADD1(DFN) ; EMER Address 1
-"RTN","CCRDPT",253,0)
- Q $$GET1^DIQ(2,DFN,.333)
-"RTN","CCRDPT",254,0)
-EMERADD2(DFN) ; EMER Address 2
-"RTN","CCRDPT",255,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",256,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
-"RTN","CCRDPT",257,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",258,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",259,0)
-EMERCITY(DFN) ; EMER City
-"RTN","CCRDPT",260,0)
- Q $$GET1^DIQ(2,DFN,.336)
-"RTN","CCRDPT",261,0)
-EMERSTAT(DFN) ; EMER State
-"RTN","CCRDPT",262,0)
- Q $$GET1^DIQ(2,DFN,.337)
-"RTN","CCRDPT",263,0)
-EMERZIP(DFN) ; EMER Zip Code
-"RTN","CCRDPT",264,0)
- Q $$GET1^DIQ(2,DFN,.338)
-"RTN","CCRDPT",265,0)
-EMERHTEL(DFN) ; EMER Home Telephone
-"RTN","CCRDPT",266,0)
- Q $$GET1^DIQ(2,DFN,.339)
-"RTN","CCRDPT",267,0)
-EMERWTEL(DFN) ; EMER Work Telephone
-"RTN","CCRDPT",268,0)
- Q $$GET1^DIQ(2,DFN,.33011)
-"RTN","CCRDPT",269,0)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
-"RTN","CCRDPT",270,0)
- Q $$GET1^DIQ(2,DFN,.3305)
-"RTN","CCRDPTT")
-0^2^B4791589
-"RTN","CCRDPTT",1,0)
-CCRDPTT ; Unit Tester...
-"RTN","CCRDPTT",2,0)
-  ;;0.1;CCRCCD;;Jun 15, 2008;Build 9
-"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)
-          N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
-"RTN","CCRDPTT",39,0)
-          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
-"RTN","CCRDPTT",40,0)
-          . W "valued at "
-"RTN","CCRDPTT",41,0)
-    . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
-"RTN","CCRDPTT",42,0)
-          . W !
-"RTN","CCRDPTT",43,0)
-          Q
-"RTN","CCRMEDS")
-0^3^B59807333
-"RTN","CCRMEDS",1,0)
-CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
-"RTN","CCRMEDS",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 9
-"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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS",24,0)
- ;
-"RTN","CCRMEDS",25,0)
- ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS",26,0)
- ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS",27,0)
- ;
-"RTN","CCRMEDS",28,0)
- N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","CCRMEDS",29,0)
- N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","CCRMEDS",30,0)
- ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
-"RTN","CCRMEDS",31,0)
- ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
-"RTN","CCRMEDS",32,0)
- ; NON-VA MEDS IN EXTRACT^CCRMEDS3
-"RTN","CCRMEDS",33,0)
- ; INPATIENT MEDS IN EXTRACT^CCRMEDS4
-"RTN","CCRMEDS",34,0)
- ; ALL OTHERS HERE
-"RTN","CCRMEDS",35,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",36,0)
- K @MEDTVMAP ; CLEAR VARIABLE ARRAY
-"RTN","CCRMEDS",37,0)
- S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
-"RTN","CCRMEDS",38,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",39,0)
- K @MEDTARYTMP ; KILL XML ARRAY
-"RTN","CCRMEDS",40,0)
- D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",41,0)
- I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","CCRMEDS",42,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",43,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",44,0)
- . W MEDCNT,!
-"RTN","CCRMEDS",45,0)
- . W "HAS ACTIVE OP MEDS",!
-"RTN","CCRMEDS",46,0)
- N PENDINGXML,MEDPENDING
-"RTN","CCRMEDS",47,0)
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
-"RTN","CCRMEDS",48,0)
- D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",49,0)
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
-"RTN","CCRMEDS",50,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",51,0)
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
-"RTN","CCRMEDS",52,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
-"RTN","CCRMEDS",53,0)
- . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
-"RTN","CCRMEDS",54,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",55,0)
- . ; W MEDCNT,!
-"RTN","CCRMEDS",56,0)
- . W "HAS OP PENDING MEDS",!
-"RTN","CCRMEDS",57,0)
- N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","CCRMEDS",58,0)
- D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","CCRMEDS",59,0)
- I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","CCRMEDS",60,0)
- . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","CCRMEDS",61,0)
- . S @MEDOUTXML@(0)=0
-"RTN","CCRMEDS",62,0)
- . Q
-"RTN","CCRMEDS",63,0)
- ; I DEBUG ZWR MEDRSLT
-"RTN","CCRMEDS",64,0)
- M GPLMEDS=MEDRSLT
-"RTN","CCRMEDS",65,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",66,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",67,0)
- ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
-"RTN","CCRMEDS",68,0)
- ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","CCRMEDS",69,0)
- ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","CCRMEDS",70,0)
- N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","CCRMEDS",71,0)
- ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","CCRMEDS",72,0)
- S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","CCRMEDS",73,0)
- F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","CCRMEDS",74,0)
- . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","CCRMEDS",75,0)
- . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","CCRMEDS",76,0)
- . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","CCRMEDS",77,0)
- . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","CCRMEDS",78,0)
- . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","CCRMEDS",79,0)
- . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","CCRMEDS",80,0)
- . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","CCRMEDS",81,0)
- ;ZWR ZA
-"RTN","CCRMEDS",82,0)
- ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","CCRMEDS",83,0)
- F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","CCRMEDS",84,0)
- . I DEBUG W "ZI IS ",ZI,!
-"RTN","CCRMEDS",85,0)
- . ; W ZI," ",MEDCNT,!
-"RTN","CCRMEDS",86,0)
- . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","CCRMEDS",87,0)
- . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","CCRMEDS",88,0)
- . I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
-"RTN","CCRMEDS",89,0)
- . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
-"RTN","CCRMEDS",90,0)
- . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","CCRMEDS",91,0)
- . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
-"RTN","CCRMEDS",92,0)
- . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","CCRMEDS",93,0)
- . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","CCRMEDS",94,0)
- . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","CCRMEDS",95,0)
- . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","CCRMEDS",96,0)
- . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS",97,0)
- . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS",98,0)
- . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS",99,0)
- . S @MEDVMAP@("MEDRXNO")=""
-"RTN","CCRMEDS",100,0)
- . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","CCRMEDS",101,0)
- . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","CCRMEDS",102,0)
- . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","CCRMEDS",103,0)
- . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","CCRMEDS",104,0)
- . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","CCRMEDS",105,0)
- . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","CCRMEDS",106,0)
- . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","CCRMEDS",107,0)
- . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","CCRMEDS",108,0)
- . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","CCRMEDS",109,0)
- . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","CCRMEDS",110,0)
- . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","CCRMEDS",111,0)
- . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","CCRMEDS",112,0)
- . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","CCRMEDS",113,0)
- . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS",114,0)
- . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS",115,0)
- . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS",116,0)
- . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS",117,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS",118,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS",119,0)
- . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS",120,0)
- . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS",121,0)
- . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","CCRMEDS",122,0)
- . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","CCRMEDS",123,0)
- . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","CCRMEDS",124,0)
- . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","CCRMEDS",125,0)
- . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","CCRMEDS",126,0)
- . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","CCRMEDS",127,0)
- . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS",128,0)
- . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","CCRMEDS",129,0)
- . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","CCRMEDS",130,0)
- . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","CCRMEDS",131,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","CCRMEDS",132,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","CCRMEDS",133,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","CCRMEDS",134,0)
- . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","CCRMEDS",135,0)
- . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","CCRMEDS",136,0)
- . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","CCRMEDS",137,0)
- . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","CCRMEDS",138,0)
- . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","CCRMEDS",139,0)
- . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","CCRMEDS",140,0)
- . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","CCRMEDS",141,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","CCRMEDS",142,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS",143,0)
- . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS",144,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","CCRMEDS",145,0)
- . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","CCRMEDS",146,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","CCRMEDS",147,0)
- . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","CCRMEDS",148,0)
- . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","CCRMEDS",149,0)
- . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","CCRMEDS",150,0)
- . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","CCRMEDS",151,0)
- . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","CCRMEDS",152,0)
- . S @MEDVMAP@("MEDRFNO")=""
-"RTN","CCRMEDS",153,0)
- . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","CCRMEDS",154,0)
- . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","CCRMEDS",155,0)
- . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","CCRMEDS",156,0)
- . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","CCRMEDS",157,0)
- . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","CCRMEDS",158,0)
- . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","CCRMEDS",159,0)
- . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","CCRMEDS",160,0)
- . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","CCRMEDS",161,0)
- . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","CCRMEDS",162,0)
- . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","CCRMEDS",163,0)
- . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","CCRMEDS",164,0)
- . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","CCRMEDS",165,0)
- . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","CCRMEDS",166,0)
- . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","CCRMEDS",167,0)
- . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","CCRMEDS",168,0)
- . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","CCRMEDS",169,0)
- . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","CCRMEDS",170,0)
- . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","CCRMEDS",171,0)
- . K @MEDARYTMP
-"RTN","CCRMEDS",172,0)
- . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","CCRMEDS",173,0)
- . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","CCRMEDS",174,0)
- . . ; W "FIRST ONE",!
-"RTN","CCRMEDS",175,0)
- . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","CCRMEDS",176,0)
- . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","CCRMEDS",177,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","CCRMEDS",178,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS",179,0)
- D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS",180,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS",181,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS",182,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS",183,0)
- Q
-"RTN","CCRMEDS",184,0)
- ;
-"RTN","CCRMEDS",185,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","CCRMEDS",186,0)
- ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","CCRMEDS",187,0)
- N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","CCRMEDS",188,0)
- S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","CCRMEDS",189,0)
- Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","CCRMEDS",190,0)
- ;
-"RTN","CCRSYS")
-0^4^B5866233
-"RTN","CCRSYS",1,0)
-CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
-"RTN","CCRSYS",2,0)
-        ;;0.1;CCDCCR;;;Build 9
-"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 DFN="" Q 0  ; BAD DFN PASSED
-"RTN","CCRSYS",41,0)
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","CCRSYS",42,0)
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","CCRSYS",43,0)
-         ;
-"RTN","CCRSYS",44,0)
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","CCRSYS",45,0)
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","CCRSYS",46,0)
-         N DIERR,DATA
-"RTN","CCRSYS",47,0)
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","CCRSYS",48,0)
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","CCRSYS",49,0)
-         ; 1 = Test Patient
-"RTN","CCRSYS",50,0)
-         ; 0 = Non-test Patient
-"RTN","CCRSYS",51,0)
-         I DATA Q DATA
-"RTN","CCRSYS",52,0)
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","CCRSYS",53,0)
-         D CLEAN^DILF
-"RTN","CCRSYS",54,0)
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-"RTN","CCRSYS",55,0)
-         I $E(DATA,1,3)="000" Q 1
-"RTN","CCRSYS",56,0)
-         I $E(DATA,1,3)="666" Q 1
-"RTN","CCRSYS",57,0)
-         Q 0
-"RTN","CCRSYS",58,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 9
-"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)
-        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","CCRUNIT",12,0)
-        W "XPATH is: "_XPATH,!
-"RTN","CCRUNIT",13,0)
-        W "Getting Med Template into MINXML using",!
-"RTN","CCRUNIT",14,0)
-        W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
-"RTN","CCRUNIT",15,0)
-        D QUERY^GPLXPATH(T,XPATH,"MINXML")
-"RTN","CCRUNIT",16,0)
-  W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
-"RTN","CCRUNIT",17,0)
-        W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","CCRUNIT",18,0)
-        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","CCRUNIT",19,0)
-        D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
-"RTN","CCRUNIT",20,0)
-        Q
-"RTN","CCRUTIL")
-0^6^B5927217
-"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 9
-"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=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","CCRUTIL",61,0)
- F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-"RTN","CCRUTIL",62,0)
- . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-"RTN","CCRUTIL",63,0)
- . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","CCRUTIL",64,0)
- . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","CCRUTIL",65,0)
- . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","CCRUTIL",66,0)
- . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","CCRUTIL",67,0)
- N ZG
-"RTN","CCRUTIL",68,0)
- S ZG=$Q(VSRT(""))
-"RTN","CCRUTIL",69,0)
- F  D  Q:ZG=""  ;
-"RTN","CCRUTIL",70,0)
- . ; W ZG,!
-"RTN","CCRUTIL",71,0)
- . D PUSH^GPLXPATH("V1",@ZG)
-"RTN","CCRUTIL",72,0)
- . S ZG=$Q(@ZG)
-"RTN","CCRUTIL",73,0)
- I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-"RTN","CCRUTIL",74,0)
- . N ZG2
-"RTN","CCRUTIL",75,0)
- . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-"RTN","CCRUTIL",76,0)
- . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","CCRUTIL",77,0)
- . S ZG2(0)=V1(0)
-"RTN","CCRUTIL",78,0)
- . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","CCRUTIL",79,0)
- Q ZCNT
-"RTN","CCRUTIL",80,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 9
-"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^B52628160
-"RTN","GPLACTOR",1,0)
-GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
-"RTN","GPLACTOR",2,0)
- ;;0.4;CCDCCR;nopatch;noreleasedate;Build 9
-"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)
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
-"RTN","GPLACTOR",27,0)
- ;
-"RTN","GPLACTOR",28,0)
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-"RTN","GPLACTOR",29,0)
- ; IPXML is the Input Actor Template into which we  substitute values
-"RTN","GPLACTOR",30,0)
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
-"RTN","GPLACTOR",31,0)
- ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
-"RTN","GPLACTOR",32,0)
- ; ^TMP(7542,1,"ACTORS",0)=Count
-"RTN","GPLACTOR",33,0)
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-"RTN","GPLACTOR",34,0)
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-"RTN","GPLACTOR",35,0)
- ; AXML is the output arrary, to contain XML.
-"RTN","GPLACTOR",36,0)
- ;
-"RTN","GPLACTOR",37,0)
- N I,J,AMAP,AOID,ATYP,AIEN
-"RTN","GPLACTOR",38,0)
- D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-"RTN","GPLACTOR",39,0)
- D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-"RTN","GPLACTOR",40,0)
- I DEBUG W "PROCESSING ACTORS ",!
-"RTN","GPLACTOR",41,0)
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
-"RTN","GPLACTOR",42,0)
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",43,0)
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-"RTN","GPLACTOR",44,0)
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-"RTN","GPLACTOR",45,0)
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-"RTN","GPLACTOR",46,0)
- . I ATYP="" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",47,0)
- . ;
-"RTN","GPLACTOR",48,0)
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","GPLACTOR",49,0)
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
-"RTN","GPLACTOR",50,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-"RTN","GPLACTOR",51,0)
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",52,0)
- . ;
-"RTN","GPLACTOR",53,0)
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
-"RTN","GPLACTOR",54,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-"RTN","GPLACTOR",55,0)
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",56,0)
- . ;
-"RTN","GPLACTOR",57,0)
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
-"RTN","GPLACTOR",58,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-"RTN","GPLACTOR",59,0)
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",60,0)
- . ;
-"RTN","GPLACTOR",61,0)
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",62,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-"RTN","GPLACTOR",63,0)
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",64,0)
- . ;
-"RTN","GPLACTOR",65,0)
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",66,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-"RTN","GPLACTOR",67,0)
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",68,0)
- . ;
-"RTN","GPLACTOR",69,0)
- . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-"RTN","GPLACTOR",70,0)
- ;
-"RTN","GPLACTOR",71,0)
- N ACTTMP
-"RTN","GPLACTOR",72,0)
- D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLACTOR",73,0)
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLACTOR",74,0)
- . ; STRINGS MARKED AS @@X@@
-"RTN","GPLACTOR",75,0)
- . W "ACTORS Missing list: ",!
-"RTN","GPLACTOR",76,0)
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
-"RTN","GPLACTOR",77,0)
- Q
-"RTN","GPLACTOR",78,0)
- ;
-"RTN","GPLACTOR",79,0)
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"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)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",85,0)
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
-"RTN","GPLACTOR",86,0)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
-"RTN","GPLACTOR",87,0)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
-"RTN","GPLACTOR",88,0)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
-"RTN","GPLACTOR",89,0)
- S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
-"RTN","GPLACTOR",90,0)
- S @AMAP@("ACTORSSN")=""
-"RTN","GPLACTOR",91,0)
- S @AMAP@("ACTORSSNTEXT")=""
-"RTN","GPLACTOR",92,0)
- S @AMAP@("ACTORSSNSOURCEID")=""
-"RTN","GPLACTOR",93,0)
- S ZX=$$SSN^CCRDPT(AIEN)
-"RTN","GPLACTOR",94,0)
- I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
-"RTN","GPLACTOR",95,0)
- . S @AMAP@("ACTORSSN")=ZX
-"RTN","GPLACTOR",96,0)
- . S @AMAP@("ACTORSSNTEXT")="SSN"
-"RTN","GPLACTOR",97,0)
- . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","GPLACTOR",98,0)
- S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
-"RTN","GPLACTOR",99,0)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
-"RTN","GPLACTOR",100,0)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
-"RTN","GPLACTOR",101,0)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
-"RTN","GPLACTOR",102,0)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
-"RTN","GPLACTOR",103,0)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
-"RTN","GPLACTOR",104,0)
- S @AMAP@("ACTORRESTEL")=""
-"RTN","GPLACTOR",105,0)
- S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","GPLACTOR",106,0)
- S ZX=$$RESTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",107,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",108,0)
- . S @AMAP@("ACTORRESTEL")=ZX
-"RTN","GPLACTOR",109,0)
- . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","GPLACTOR",110,0)
- S @AMAP@("ACTORWORKTEL")=""
-"RTN","GPLACTOR",111,0)
- S @AMAP@("ACTORWORKTELTEXT")=""
-"RTN","GPLACTOR",112,0)
- S ZX=$$WORKTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",113,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",114,0)
- . S @AMAP@("ACTORWORKTEL")=ZX
-"RTN","GPLACTOR",115,0)
- . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","GPLACTOR",116,0)
- S @AMAP@("ACTORCELLTEL")=""
-"RTN","GPLACTOR",117,0)
- S @AMAP@("ACTORCELLTELTEXT")=""
-"RTN","GPLACTOR",118,0)
- S ZX=$$CELLTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",119,0)
- I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
-"RTN","GPLACTOR",120,0)
- . S @AMAP@("ACTORCELLTEL")=ZX
-"RTN","GPLACTOR",121,0)
- . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-"RTN","GPLACTOR",122,0)
- S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
-"RTN","GPLACTOR",123,0)
- S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-"RTN","GPLACTOR",124,0)
- S @AMAP@("ACTORIEN")=AIEN
-"RTN","GPLACTOR",125,0)
- S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
-"RTN","GPLACTOR",126,0)
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",127,0)
- D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",128,0)
- Q
-"RTN","GPLACTOR",129,0)
- ;
-"RTN","GPLACTOR",130,0)
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-"RTN","GPLACTOR",131,0)
-     ;
-"RTN","GPLACTOR",132,0)
-     ; N AMAP
-"RTN","GPLACTOR",133,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",134,0)
-     K @AMAP
-"RTN","GPLACTOR",135,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",136,0)
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
-"RTN","GPLACTOR",137,0)
-         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
-"RTN","GPLACTOR",138,0)
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-"RTN","GPLACTOR",139,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",140,0)
-     Q
-"RTN","GPLACTOR",141,0)
-     ;
-"RTN","GPLACTOR",142,0)
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-"RTN","GPLACTOR",143,0)
-     ;
-"RTN","GPLACTOR",144,0)
-     ; N AMAP
-"RTN","GPLACTOR",145,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",146,0)
-     K @AMAP
-"RTN","GPLACTOR",147,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",148,0)
-     S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","GPLACTOR",149,0)
-     S @AMAP@("ACTORRELATION")=""
-"RTN","GPLACTOR",150,0)
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-"RTN","GPLACTOR",151,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",152,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",153,0)
-     Q
-"RTN","GPLACTOR",154,0)
-     ;
-"RTN","GPLACTOR",155,0)
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-"RTN","GPLACTOR",156,0)
-     ;
-"RTN","GPLACTOR",157,0)
-     ; N AMAP
-"RTN","GPLACTOR",158,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",159,0)
-     K @AMAP
-"RTN","GPLACTOR",160,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",161,0)
-     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
-"RTN","GPLACTOR",162,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",163,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",164,0)
-     Q
-"RTN","GPLACTOR",165,0)
-     ;
-"RTN","GPLACTOR",166,0)
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-"RTN","GPLACTOR",167,0)
-     ;
-"RTN","GPLACTOR",168,0)
-     ; N AMAP
-"RTN","GPLACTOR",169,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",170,0)
-     K @AMAP
-"RTN","GPLACTOR",171,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",172,0)
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
-"RTN","GPLACTOR",173,0)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",174,0)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
-"RTN","GPLACTOR",175,0)
-         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",176,0)
-         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
-"RTN","GPLACTOR",177,0)
-         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
-"RTN","GPLACTOR",178,0)
-         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
-"RTN","GPLACTOR",179,0)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
-"RTN","GPLACTOR",180,0)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",181,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
-"RTN","GPLACTOR",182,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
-"RTN","GPLACTOR",183,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
-"RTN","GPLACTOR",184,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
-"RTN","GPLACTOR",185,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","GPLACTOR",186,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","GPLACTOR",187,0)
-     S ZX=$$TEL^CCRVA200(AIEN)
-"RTN","GPLACTOR",188,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","GPLACTOR",189,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","GPLACTOR",190,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",191,0)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
-"RTN","GPLACTOR",192,0)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",193,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",194,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",195,0)
-     Q
-"RTN","GPLACTOR",196,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 9
-"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 9
-"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^B82192762
-"RTN","GPLCCR",1,0)
-GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-"RTN","GPLCCR",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 9
-"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)
-       I '$D(DIR) S DIR=""
-"RTN","GPLCCR",35,0)
-       I '$D(FN) S FN=""
-"RTN","GPLCCR",36,0)
-       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-"RTN","GPLCCR",37,0)
-       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
-"RTN","GPLCCR",38,0)
-       S ONAM=FN
-"RTN","GPLCCR",39,0)
-       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_5.xml"
-"RTN","GPLCCR",40,0)
-       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
-"RTN","GPLCCR",41,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","GPLCCR",42,0)
-       . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","GPLCCR",43,0)
-       . ;S @ODIRGLB="/home/cedwards/"
-"RTN","GPLCCR",44,0)
-       . S @ODIRGLB="/opt/wv/p/"
-"RTN","GPLCCR",45,0)
-       S ODIR=DIR
-"RTN","GPLCCR",46,0)
-       I DIR="" S ODIR=@ODIRGLB
-"RTN","GPLCCR",47,0)
-       N ZY
-"RTN","GPLCCR",48,0)
-       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-"RTN","GPLCCR",49,0)
-       W !,$P(ZY,U,2),!
-"RTN","GPLCCR",50,0)
-       Q
-"RTN","GPLCCR",51,0)
-       ;
-"RTN","GPLCCR",52,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","GPLCCR",53,0)
-    ;
-"RTN","GPLCCR",54,0)
-    N G1
-"RTN","GPLCCR",55,0)
-    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
-"RTN","GPLCCR",56,0)
-    I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","GPLCCR",57,0)
-    . D PARY^GPLXPATH(G1)
-"RTN","GPLCCR",58,0)
-    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
-"RTN","GPLCCR",59,0)
-    Q
-"RTN","GPLCCR",60,0)
-    ;
-"RTN","GPLCCR",61,0)
-CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","GPLCCR",62,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-"RTN","GPLCCR",63,0)
-    ; DFN IS PATIENT IEN
-"RTN","GPLCCR",64,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","GPLCCR",65,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","GPLCCR",66,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-"RTN","GPLCCR",67,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-"RTN","GPLCCR",68,0)
-    ; - NULL MEANS NOW
-"RTN","GPLCCR",69,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-"RTN","GPLCCR",70,0)
-    ;    "TO" VARIABLES
-"RTN","GPLCCR",71,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-"RTN","GPLCCR",72,0)
-    I '$D(DEBUG) S DEBUG=0
-"RTN","GPLCCR",73,0)
-    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","GPLCCR",74,0)
-    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","GPLCCR",75,0)
-    I '$D(TESTALERT) S TESTALERT=0 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","GPLCCR",76,0)
-    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
-"RTN","GPLCCR",77,0)
-    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","GPLCCR",78,0)
-    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","GPLCCR",79,0)
-    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","GPLCCR",80,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","GPLCCR",81,0)
-    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-"RTN","GPLCCR",82,0)
-    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","GPLCCR",83,0)
-    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","GPLCCR",84,0)
-    ;
-"RTN","GPLCCR",85,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","GPLCCR",86,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","GPLCCR",87,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",88,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",89,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","GPLCCR",90,0)
-    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","GPLCCR",91,0)
-    ;
-"RTN","GPLCCR",92,0)
-    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-"RTN","GPLCCR",93,0)
-    ;
-"RTN","GPLCCR",94,0)
-    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","GPLCCR",95,0)
-    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","GPLCCR",96,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","GPLCCR",97,0)
-    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","GPLCCR",98,0)
-    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","GPLCCR",99,0)
-    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","GPLCCR",100,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","GPLCCR",101,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","GPLCCR",102,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","GPLCCR",103,0)
-    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","GPLCCR",104,0)
-    . S IXML="INXML"
-"RTN","GPLCCR",105,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","GPLCCR",106,0)
-    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","GPLCCR",107,0)
-    . ; W OXML,!
-"RTN","GPLCCR",108,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","GPLCCR",109,0)
-    . I DEBUG W "RUNNING ",CALL,!
-"RTN","GPLCCR",110,0)
-    . X CALL
-"RTN","GPLCCR",111,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","GPLCCR",112,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-"RTN","GPLCCR",113,0)
-    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",114,0)
-    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-"RTN","GPLCCR",115,0)
-    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","GPLCCR",116,0)
-    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","GPLCCR",117,0)
-    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","GPLCCR",118,0)
-    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",119,0)
-    N TRIMI,J,DONE S DONE=0
-"RTN","GPLCCR",120,0)
-    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","GPLCCR",121,0)
-    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","GPLCCR",122,0)
-    . I DEBUG W "TRIMMED",J,!
-"RTN","GPLCCR",123,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","GPLCCR",124,0)
-    Q
-"RTN","GPLCCR",125,0)
-    ;
-"RTN","GPLCCR",126,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","GPLCCR",127,0)
-    ; TAB IS PASSED BY NAME
-"RTN","GPLCCR",128,0)
-    I DEBUG W "TAB= ",TAB,!
-"RTN","GPLCCR",129,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","GPLCCR",130,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","GPLCCR",131,0)
-    I TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS1;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",132,0)
-    I 'TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",133,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
-"RTN","GPLCCR",134,0)
-    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
-"RTN","GPLCCR",135,0)
-    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
-"RTN","GPLCCR",136,0)
-    Q
-"RTN","GPLCCR",137,0)
-    ;
-"RTN","GPLCCR",138,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","GPLCCR",139,0)
-    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
-"RTN","GPLCCR",140,0)
-    ; K @VMAP
-"RTN","GPLCCR",141,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
-"RTN","GPLCCR",142,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","GPLCCR",143,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","GPLCCR",144,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","GPLCCR",145,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","GPLCCR",146,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-"RTN","GPLCCR",147,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",148,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",149,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","GPLCCR",150,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","GPLCCR",151,0)
-    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","GPLCCR",152,0)
-    N CTMP
-"RTN","GPLCCR",153,0)
-    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-"RTN","GPLCCR",154,0)
-    D CP^GPLXPATH("CTMP",CXML)
-"RTN","GPLCCR",155,0)
-    Q
-"RTN","GPLCCR",156,0)
-    ;
-"RTN","GPLCCR",157,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","GPLCCR",158,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","GPLCCR",159,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","GPLCCR",160,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","GPLCCR",161,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","GPLCCR",162,0)
-    ;OR INSTITUTION
-"RTN","GPLCCR",163,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","GPLCCR",164,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","GPLCCR",165,0)
-    N I,J,K,L
-"RTN","GPLCCR",166,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","GPLCCR",167,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","GPLCCR",168,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","GPLCCR",169,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","GPLCCR",170,0)
-    . . I DEBUG W "<ActorID>=>",J,!
-"RTN","GPLCCR",171,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","GPLCCR",172,0)
-    . . ;  TO GET RID OF DUPLICATES
-"RTN","GPLCCR",173,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","GPLCCR",174,0)
-    F J=0:0 D  Q:$O(K(I))=""
-"RTN","GPLCCR",175,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","GPLCCR",176,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","GPLCCR",177,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","GPLCCR",178,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","GPLCCR",179,0)
-    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","GPLCCR",180,0)
-    Q
-"RTN","GPLCCR",181,0)
-    ;
-"RTN","GPLCCR",182,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","GPLCCR",183,0)
-  D TESTALL^GPLUNIT("GPLCCR")
-"RTN","GPLCCR",184,0)
-  Q
-"RTN","GPLCCR",185,0)
-  ;
-"RTN","GPLCCR",186,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","GPLCCR",187,0)
-  N ZTMP
-"RTN","GPLCCR",188,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",189,0)
-  D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLCCR",190,0)
-  Q
-"RTN","GPLCCR",191,0)
-  ;
-"RTN","GPLCCR",192,0)
-TLIST  ; LIST THE TESTS
-"RTN","GPLCCR",193,0)
-  N ZTMP
-"RTN","GPLCCR",194,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",195,0)
-  D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLCCR",196,0)
-  Q
-"RTN","GPLCCR",197,0)
-  ;
-"RTN","GPLCCR",198,0)
- ;;><TEST>
-"RTN","GPLCCR",199,0)
- ;;><PROBLEMS>
-"RTN","GPLCCR",200,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",201,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
-"RTN","GPLCCR",202,0)
- ;;>>?@GPL@(@GPL@(0))["</Problems>"
-"RTN","GPLCCR",203,0)
- ;;><VITALS>
-"RTN","GPLCCR",204,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",205,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
-"RTN","GPLCCR",206,0)
- ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
-"RTN","GPLCCR",207,0)
- ;;><CCR>
-"RTN","GPLCCR",208,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",209,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",210,0)
- ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
-"RTN","GPLCCR",211,0)
- ;;><ACTLST>
-"RTN","GPLCCR",212,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",213,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",214,0)
- ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
-"RTN","GPLCCR",215,0)
- ;;><ACTORS>
-"RTN","GPLCCR",216,0)
- ;;>>>D ZTEST^GPLCCR("ACTLST")
-"RTN","GPLCCR",217,0)
- ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","GPLCCR",218,0)
- ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
-"RTN","GPLCCR",219,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","GPLCCR",220,0)
- ;;><TRIM>
-"RTN","GPLCCR",221,0)
- ;;>>>D ZTEST^GPLCCR("CCR")
-"RTN","GPLCCR",222,0)
- ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
-"RTN","GPLCCR",223,0)
- ;;><ALERTS>
-"RTN","GPLCCR",224,0)
- ;;>>>S TESTALERT=1
-"RTN","GPLCCR",225,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",226,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
-"RTN","GPLCCR",227,0)
- ;;>>?@GPL@(@GPL@(0))["</Alerts>"
-"RTN","GPLCCR",228,0)
- 
-"RTN","GPLCCR0")
-0^15^B654252455
-"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 9
-"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)
- ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
-"RTN","GPLCCR0",368,0)
- ;;</Frequency>
-"RTN","GPLCCR0",369,0)
- ;;<Interval>
-"RTN","GPLCCR0",370,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","GPLCCR0",371,0)
- ;;<Units>
-"RTN","GPLCCR0",372,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","GPLCCR0",373,0)
- ;;</Units>
-"RTN","GPLCCR0",374,0)
- ;;</Interval>
-"RTN","GPLCCR0",375,0)
- ;;<Duration>
-"RTN","GPLCCR0",376,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","GPLCCR0",377,0)
- ;;<Units>
-"RTN","GPLCCR0",378,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","GPLCCR0",379,0)
- ;;</Units>
-"RTN","GPLCCR0",380,0)
- ;;</Duration>
-"RTN","GPLCCR0",381,0)
- ;;<Indication>
-"RTN","GPLCCR0",382,0)
- ;;<PRNFlag>
-"RTN","GPLCCR0",383,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","GPLCCR0",384,0)
- ;;</PRNFlag>
-"RTN","GPLCCR0",385,0)
- ;;<Problem>
-"RTN","GPLCCR0",386,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",387,0)
- ;;<Type>
-"RTN","GPLCCR0",388,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","GPLCCR0",389,0)
- ;;</Type>
-"RTN","GPLCCR0",390,0)
- ;;<Description>
-"RTN","GPLCCR0",391,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","GPLCCR0",392,0)
- ;;<Code>
-"RTN","GPLCCR0",393,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","GPLCCR0",394,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",395,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","GPLCCR0",396,0)
- ;;</Code>
-"RTN","GPLCCR0",397,0)
- ;;</Description>
-"RTN","GPLCCR0",398,0)
- ;;<Source>
-"RTN","GPLCCR0",399,0)
- ;;<Actor>
-"RTN","GPLCCR0",400,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",401,0)
- ;;</Actor>
-"RTN","GPLCCR0",402,0)
- ;;</Source>
-"RTN","GPLCCR0",403,0)
- ;;</Problem>
-"RTN","GPLCCR0",404,0)
- ;;</Indication>
-"RTN","GPLCCR0",405,0)
- ;;<StopIndicator>
-"RTN","GPLCCR0",406,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","GPLCCR0",407,0)
- ;;</StopIndicator>
-"RTN","GPLCCR0",408,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","GPLCCR0",409,0)
- ;;<MultipleDirectionModifier>
-"RTN","GPLCCR0",410,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","GPLCCR0",411,0)
- ;;</MultipleDirectionModifier>
-"RTN","GPLCCR0",412,0)
- ;;</Direction>
-"RTN","GPLCCR0",413,0)
- ;;</Directions>
-"RTN","GPLCCR0",414,0)
- ;;<PatientInstructions>
-"RTN","GPLCCR0",415,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",416,0)
- ;;</PatientInstructions>
-"RTN","GPLCCR0",417,0)
- ;;<FullfillmentInstructions>
-"RTN","GPLCCR0",418,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",419,0)
- ;;</FullfillmentInstructions>
-"RTN","GPLCCR0",420,0)
- ;;<Refills>
-"RTN","GPLCCR0",421,0)
- ;;<Refill>
-"RTN","GPLCCR0",422,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","GPLCCR0",423,0)
- ;;</Refill>
-"RTN","GPLCCR0",424,0)
- ;;</Refills>
-"RTN","GPLCCR0",425,0)
- ;;</Medication>
-"RTN","GPLCCR0",426,0)
- ;;</Medications>
-"RTN","GPLCCR0",427,0)
- ;;<VitalSigns>
-"RTN","GPLCCR0",428,0)
- ;;<Result>
-"RTN","GPLCCR0",429,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",430,0)
- ;;<DateTime>
-"RTN","GPLCCR0",431,0)
- ;;<Type>
-"RTN","GPLCCR0",432,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","GPLCCR0",433,0)
- ;;</Type>
-"RTN","GPLCCR0",434,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",435,0)
- ;;</DateTime>
-"RTN","GPLCCR0",436,0)
- ;;<Description>
-"RTN","GPLCCR0",437,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",438,0)
- ;;</Description>
-"RTN","GPLCCR0",439,0)
- ;;<Source>
-"RTN","GPLCCR0",440,0)
- ;;<Actor>
-"RTN","GPLCCR0",441,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",442,0)
- ;;</Actor>
-"RTN","GPLCCR0",443,0)
- ;;</Source>
-"RTN","GPLCCR0",444,0)
- ;;<Test>
-"RTN","GPLCCR0",445,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",446,0)
- ;;<Type>
-"RTN","GPLCCR0",447,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","GPLCCR0",448,0)
- ;;</Type>
-"RTN","GPLCCR0",449,0)
- ;;<Description>
-"RTN","GPLCCR0",450,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",451,0)
- ;;<Code>
-"RTN","GPLCCR0",452,0)
- ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
-"RTN","GPLCCR0",453,0)
- ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",454,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","GPLCCR0",455,0)
- ;;</Code>
-"RTN","GPLCCR0",456,0)
- ;;</Description>
-"RTN","GPLCCR0",457,0)
- ;;<Source>
-"RTN","GPLCCR0",458,0)
- ;;<Actor>
-"RTN","GPLCCR0",459,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",460,0)
- ;;</Actor>
-"RTN","GPLCCR0",461,0)
- ;;</Source>
-"RTN","GPLCCR0",462,0)
- ;;<TestResult>
-"RTN","GPLCCR0",463,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","GPLCCR0",464,0)
- ;;<Units>
-"RTN","GPLCCR0",465,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","GPLCCR0",466,0)
- ;;</Units>
-"RTN","GPLCCR0",467,0)
- ;;</TestResult>
-"RTN","GPLCCR0",468,0)
- ;;</Test>
-"RTN","GPLCCR0",469,0)
- ;;</Result>
-"RTN","GPLCCR0",470,0)
- ;;</VitalSigns>
-"RTN","GPLCCR0",471,0)
- ;;<Results>
-"RTN","GPLCCR0",472,0)
- ;;<Result>
-"RTN","GPLCCR0",473,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",474,0)
- ;;<DateTime>
-"RTN","GPLCCR0",475,0)
- ;;<Type>
-"RTN","GPLCCR0",476,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",477,0)
- ;;</Type>
-"RTN","GPLCCR0",478,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",479,0)
- ;;</DateTime>
-"RTN","GPLCCR0",480,0)
- ;;<Description>
-"RTN","GPLCCR0",481,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",482,0)
- ;;<Code>
-"RTN","GPLCCR0",483,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","GPLCCR0",484,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",485,0)
- ;;</Code>
-"RTN","GPLCCR0",486,0)
- ;;</Description>
-"RTN","GPLCCR0",487,0)
- ;;<Status>
-"RTN","GPLCCR0",488,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","GPLCCR0",489,0)
- ;;</Status>
-"RTN","GPLCCR0",490,0)
- ;;<Source>
-"RTN","GPLCCR0",491,0)
- ;;<Actor>
-"RTN","GPLCCR0",492,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",493,0)
- ;;</Actor>
-"RTN","GPLCCR0",494,0)
- ;;</Source>
-"RTN","GPLCCR0",495,0)
- ;;<TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",496,0)
- ;;<Test>
-"RTN","GPLCCR0",497,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",498,0)
- ;;<DateTime>
-"RTN","GPLCCR0",499,0)
- ;;<Type>
-"RTN","GPLCCR0",500,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",501,0)
- ;;</Type>
-"RTN","GPLCCR0",502,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",503,0)
- ;;</DateTime>
-"RTN","GPLCCR0",504,0)
- ;;<Description>
-"RTN","GPLCCR0",505,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",506,0)
- ;;<Code>
-"RTN","GPLCCR0",507,0)
- ;;<Value>@@RESULTTESTCODE@@</Value>
-"RTN","GPLCCR0",508,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",509,0)
- ;;</Code>
-"RTN","GPLCCR0",510,0)
- ;;</Description>
-"RTN","GPLCCR0",511,0)
- ;;<Status>
-"RTN","GPLCCR0",512,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",513,0)
- ;;</Status>
-"RTN","GPLCCR0",514,0)
- ;;<Source>
-"RTN","GPLCCR0",515,0)
- ;;<Actor>
-"RTN","GPLCCR0",516,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",517,0)
- ;;</Actor>
-"RTN","GPLCCR0",518,0)
- ;;</Source>
-"RTN","GPLCCR0",519,0)
- ;;<TestResult>
-"RTN","GPLCCR0",520,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",521,0)
- ;;<Units>
-"RTN","GPLCCR0",522,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",523,0)
- ;;</Units>
-"RTN","GPLCCR0",524,0)
- ;;</TestResult>
-"RTN","GPLCCR0",525,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",526,0)
- ;;<Normal>
-"RTN","GPLCCR0",527,0)
- ;;<Description>
-"RTN","GPLCCR0",528,0)
- ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",529,0)
- ;;</Description>
-"RTN","GPLCCR0",530,0)
- ;;<Source>
-"RTN","GPLCCR0",531,0)
- ;;<Actor>
-"RTN","GPLCCR0",532,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",533,0)
- ;;</Actor>
-"RTN","GPLCCR0",534,0)
- ;;</Source>
-"RTN","GPLCCR0",535,0)
- ;;</Normal>
-"RTN","GPLCCR0",536,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",537,0)
- ;;<Flag>
-"RTN","GPLCCR0",538,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",539,0)
- ;;</Flag>
-"RTN","GPLCCR0",540,0)
- ;;</Test>
-"RTN","GPLCCR0",541,0)
- ;;</TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",542,0)
- ;;<TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",543,0)
- ;;<Test>
-"RTN","GPLCCR0",544,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",545,0)
- ;;<DateTime>
-"RTN","GPLCCR0",546,0)
- ;;<Type>
-"RTN","GPLCCR0",547,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",548,0)
- ;;</Type>
-"RTN","GPLCCR0",549,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",550,0)
- ;;</DateTime>
-"RTN","GPLCCR0",551,0)
- ;;<Description>
-"RTN","GPLCCR0",552,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",553,0)
- ;;<Code>
-"RTN","GPLCCR0",554,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",555,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",556,0)
- ;;</Code>
-"RTN","GPLCCR0",557,0)
- ;;</Description>
-"RTN","GPLCCR0",558,0)
- ;;<Status>
-"RTN","GPLCCR0",559,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",560,0)
- ;;</Status>
-"RTN","GPLCCR0",561,0)
- ;;<Source>
-"RTN","GPLCCR0",562,0)
- ;;<Actor>
-"RTN","GPLCCR0",563,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",564,0)
- ;;</Actor>
-"RTN","GPLCCR0",565,0)
- ;;</Source>
-"RTN","GPLCCR0",566,0)
- ;;<TestResult>
-"RTN","GPLCCR0",567,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",568,0)
- ;;<Units>
-"RTN","GPLCCR0",569,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",570,0)
- ;;</Units>
-"RTN","GPLCCR0",571,0)
- ;;</TestResult>
-"RTN","GPLCCR0",572,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",573,0)
- ;;<Normal>
-"RTN","GPLCCR0",574,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
-"RTN","GPLCCR0",575,0)
- ;;<Units>
-"RTN","GPLCCR0",576,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
-"RTN","GPLCCR0",577,0)
- ;;</Units>
-"RTN","GPLCCR0",578,0)
- ;;<ValueSequencePosition>1</ValueSequencePosition>
-"RTN","GPLCCR0",579,0)
- ;;<Source>
-"RTN","GPLCCR0",580,0)
- ;;<Actor>
-"RTN","GPLCCR0",581,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",582,0)
- ;;</Actor>
-"RTN","GPLCCR0",583,0)
- ;;</Source>
-"RTN","GPLCCR0",584,0)
- ;;</Normal>
-"RTN","GPLCCR0",585,0)
- ;;<Normal>
-"RTN","GPLCCR0",586,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
-"RTN","GPLCCR0",587,0)
- ;;<Units>
-"RTN","GPLCCR0",588,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
-"RTN","GPLCCR0",589,0)
- ;;</Units>
-"RTN","GPLCCR0",590,0)
- ;;<ValueSequencePosition>2</ValueSequencePosition>
-"RTN","GPLCCR0",591,0)
- ;;<VariableNomalModifier>
-"RTN","GPLCCR0",592,0)
- ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
-"RTN","GPLCCR0",593,0)
- ;;</VariableNomalModifier>
-"RTN","GPLCCR0",594,0)
- ;;<Source>
-"RTN","GPLCCR0",595,0)
- ;;<Actor>
-"RTN","GPLCCR0",596,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",597,0)
- ;;</Actor>
-"RTN","GPLCCR0",598,0)
- ;;</Source>
-"RTN","GPLCCR0",599,0)
- ;;</Normal>
-"RTN","GPLCCR0",600,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",601,0)
- ;;<Flag>
-"RTN","GPLCCR0",602,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",603,0)
- ;;</Flag>
-"RTN","GPLCCR0",604,0)
- ;;</Test>
-"RTN","GPLCCR0",605,0)
- ;;</TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",606,0)
- ;;</Result>
-"RTN","GPLCCR0",607,0)
- ;;</Results>
-"RTN","GPLCCR0",608,0)
- ;;<HealthCareProviders>
-"RTN","GPLCCR0",609,0)
- ;;<Provider>
-"RTN","GPLCCR0",610,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","GPLCCR0",611,0)
- ;;<ActorRole>
-"RTN","GPLCCR0",612,0)
- ;;<Text>Primary Provider</Text>
-"RTN","GPLCCR0",613,0)
- ;;</ActorRole>
-"RTN","GPLCCR0",614,0)
- ;;</Provider>
-"RTN","GPLCCR0",615,0)
- ;;</HealthCareProviders>
-"RTN","GPLCCR0",616,0)
- ;;</Body>
-"RTN","GPLCCR0",617,0)
- ;;<Actors>
-"RTN","GPLCCR0",618,0)
- ;;<ACTOR-PATIENT>
-"RTN","GPLCCR0",619,0)
- ;;<Actor>
-"RTN","GPLCCR0",620,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",621,0)
- ;;<Person>
-"RTN","GPLCCR0",622,0)
- ;;<Name>
-"RTN","GPLCCR0",623,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",624,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",625,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",626,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",627,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",628,0)
- ;;</Name>
-"RTN","GPLCCR0",629,0)
- ;;<DateOfBirth>
-"RTN","GPLCCR0",630,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","GPLCCR0",631,0)
- ;;</DateOfBirth>
-"RTN","GPLCCR0",632,0)
- ;;<Gender>
-"RTN","GPLCCR0",633,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","GPLCCR0",634,0)
- ;;<Code>
-"RTN","GPLCCR0",635,0)
- ;;<Value>@@ACTORGENDER@@</Value>
-"RTN","GPLCCR0",636,0)
- ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
-"RTN","GPLCCR0",637,0)
- ;;</Code>
-"RTN","GPLCCR0",638,0)
- ;;</Gender>
-"RTN","GPLCCR0",639,0)
- ;;</Person>
-"RTN","GPLCCR0",640,0)
- ;;<IDs>
-"RTN","GPLCCR0",641,0)
- ;;<Type>
-"RTN","GPLCCR0",642,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","GPLCCR0",643,0)
- ;;</Type>
-"RTN","GPLCCR0",644,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","GPLCCR0",645,0)
- ;;<Source>
-"RTN","GPLCCR0",646,0)
- ;;<Actor>
-"RTN","GPLCCR0",647,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","GPLCCR0",648,0)
- ;;</Actor>
-"RTN","GPLCCR0",649,0)
- ;;</Source>
-"RTN","GPLCCR0",650,0)
- ;;</IDs>
-"RTN","GPLCCR0",651,0)
- ;;<Address>
-"RTN","GPLCCR0",652,0)
- ;;<Type>
-"RTN","GPLCCR0",653,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",654,0)
- ;;</Type>
-"RTN","GPLCCR0",655,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",656,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","GPLCCR0",657,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",658,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",659,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","GPLCCR0",660,0)
- ;;</Address>
-"RTN","GPLCCR0",661,0)
- ;;<Telephone>
-"RTN","GPLCCR0",662,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","GPLCCR0",663,0)
- ;;<Type>
-"RTN","GPLCCR0",664,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","GPLCCR0",665,0)
- ;;</Type>
-"RTN","GPLCCR0",666,0)
- ;;</Telephone>
-"RTN","GPLCCR0",667,0)
- ;;<Telephone>
-"RTN","GPLCCR0",668,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","GPLCCR0",669,0)
- ;;<Type>
-"RTN","GPLCCR0",670,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","GPLCCR0",671,0)
- ;;</Type>
-"RTN","GPLCCR0",672,0)
- ;;</Telephone>
-"RTN","GPLCCR0",673,0)
- ;;<Telephone>
-"RTN","GPLCCR0",674,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","GPLCCR0",675,0)
- ;;<Type>
-"RTN","GPLCCR0",676,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","GPLCCR0",677,0)
- ;;</Type>
-"RTN","GPLCCR0",678,0)
- ;;</Telephone>
-"RTN","GPLCCR0",679,0)
- ;;<EMail>
-"RTN","GPLCCR0",680,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",681,0)
- ;;</EMail>
-"RTN","GPLCCR0",682,0)
- ;;<Source>
-"RTN","GPLCCR0",683,0)
- ;;<Actor>
-"RTN","GPLCCR0",684,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",685,0)
- ;;</Actor>
-"RTN","GPLCCR0",686,0)
- ;;</Source>
-"RTN","GPLCCR0",687,0)
- ;;</Actor>
-"RTN","GPLCCR0",688,0)
- ;;</ACTOR-PATIENT>
-"RTN","GPLCCR0",689,0)
- ;;<ACTOR-SYSTEM>
-"RTN","GPLCCR0",690,0)
- ;;<Actor>
-"RTN","GPLCCR0",691,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",692,0)
- ;;<InformationSystem>
-"RTN","GPLCCR0",693,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","GPLCCR0",694,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","GPLCCR0",695,0)
- ;;</InformationSystem>
-"RTN","GPLCCR0",696,0)
- ;;<Source>
-"RTN","GPLCCR0",697,0)
- ;;<Actor>
-"RTN","GPLCCR0",698,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",699,0)
- ;;</Actor>
-"RTN","GPLCCR0",700,0)
- ;;</Source>
-"RTN","GPLCCR0",701,0)
- ;;</Actor>
-"RTN","GPLCCR0",702,0)
- ;;</ACTOR-SYSTEM>
-"RTN","GPLCCR0",703,0)
- ;;<ACTOR-NOK>
-"RTN","GPLCCR0",704,0)
- ;;<Actor>
-"RTN","GPLCCR0",705,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","GPLCCR0",706,0)
- ;;<Person>
-"RTN","GPLCCR0",707,0)
- ;;<Name>
-"RTN","GPLCCR0",708,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","GPLCCR0",709,0)
- ;;</Name>
-"RTN","GPLCCR0",710,0)
- ;;</Person>
-"RTN","GPLCCR0",711,0)
- ;;<Relation>
-"RTN","GPLCCR0",712,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","GPLCCR0",713,0)
- ;;</Relation>
-"RTN","GPLCCR0",714,0)
- ;;<Source>
-"RTN","GPLCCR0",715,0)
- ;;<Actor>
-"RTN","GPLCCR0",716,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","GPLCCR0",717,0)
- ;;</Actor>
-"RTN","GPLCCR0",718,0)
- ;;</Source>
-"RTN","GPLCCR0",719,0)
- ;;</Actor>
-"RTN","GPLCCR0",720,0)
- ;;</ACTOR-NOK>
-"RTN","GPLCCR0",721,0)
- ;;<ACTOR-PROVIDER>
-"RTN","GPLCCR0",722,0)
- ;;<Actor>
-"RTN","GPLCCR0",723,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",724,0)
- ;;<Person>
-"RTN","GPLCCR0",725,0)
- ;;<Name>
-"RTN","GPLCCR0",726,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",727,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",728,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",729,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",730,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","GPLCCR0",731,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",732,0)
- ;;</Name>
-"RTN","GPLCCR0",733,0)
- ;;</Person>
-"RTN","GPLCCR0",734,0)
- ;;<IDs>
-"RTN","GPLCCR0",735,0)
- ;;<Type>
-"RTN","GPLCCR0",736,0)
- ;;<Text>@@IDTYPE@@</Text>
-"RTN","GPLCCR0",737,0)
- ;;</Type>
-"RTN","GPLCCR0",738,0)
- ;;<ID>@@ID@@</ID>
-"RTN","GPLCCR0",739,0)
- ;;<IssuedBy>
-"RTN","GPLCCR0",740,0)
- ;;<Description>
-"RTN","GPLCCR0",741,0)
- ;;<Text>@@IDDESC@@</Text>
-"RTN","GPLCCR0",742,0)
- ;;</Description>
-"RTN","GPLCCR0",743,0)
- ;;</IssuedBy>
-"RTN","GPLCCR0",744,0)
- ;;</IDs>
-"RTN","GPLCCR0",745,0)
- ;;<Specialty>
-"RTN","GPLCCR0",746,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","GPLCCR0",747,0)
- ;;</Specialty>
-"RTN","GPLCCR0",748,0)
- ;;<Address>
-"RTN","GPLCCR0",749,0)
- ;;<Type>
-"RTN","GPLCCR0",750,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",751,0)
- ;;</Type>
-"RTN","GPLCCR0",752,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",753,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",754,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",755,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","GPLCCR0",756,0)
- ;;</Address>
-"RTN","GPLCCR0",757,0)
- ;;<Telephone>
-"RTN","GPLCCR0",758,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","GPLCCR0",759,0)
- ;;<Type>
-"RTN","GPLCCR0",760,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","GPLCCR0",761,0)
- ;;</Type>
-"RTN","GPLCCR0",762,0)
- ;;</Telephone>
-"RTN","GPLCCR0",763,0)
- ;;<Email>
-"RTN","GPLCCR0",764,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",765,0)
- ;;</Email>
-"RTN","GPLCCR0",766,0)
- ;;<Source>
-"RTN","GPLCCR0",767,0)
- ;;<Actor>
-"RTN","GPLCCR0",768,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",769,0)
- ;;</Actor>
-"RTN","GPLCCR0",770,0)
- ;;</Source>
-"RTN","GPLCCR0",771,0)
- ;;</Actor>
-"RTN","GPLCCR0",772,0)
- ;;</ACTOR-PROVIDER>
-"RTN","GPLCCR0",773,0)
- ;;<ACTOR-ORG>
-"RTN","GPLCCR0",774,0)
- ;;<Actor>
-"RTN","GPLCCR0",775,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",776,0)
- ;;<Organization>
-"RTN","GPLCCR0",777,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","GPLCCR0",778,0)
- ;;</Organization>
-"RTN","GPLCCR0",779,0)
- ;;<Source>
-"RTN","GPLCCR0",780,0)
- ;;<Actor>
-"RTN","GPLCCR0",781,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",782,0)
- ;;</Actor>
-"RTN","GPLCCR0",783,0)
- ;;</Source>
-"RTN","GPLCCR0",784,0)
- ;;</Actor>
-"RTN","GPLCCR0",785,0)
- ;;</ACTOR-ORG>
-"RTN","GPLCCR0",786,0)
- ;;</Actors>
-"RTN","GPLCCR0",787,0)
- ;;<Signatures>
-"RTN","GPLCCR0",788,0)
- ;;<CCRSignature>
-"RTN","GPLCCR0",789,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","GPLCCR0",790,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","GPLCCR0",791,0)
- ;;<Source>
-"RTN","GPLCCR0",792,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","GPLCCR0",793,0)
- ;;</Source>
-"RTN","GPLCCR0",794,0)
- ;;<Signature>
-"RTN","GPLCCR0",795,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","GPLCCR0",796,0)
- ;;<SignedInfo>
-"RTN","GPLCCR0",797,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","GPLCCR0",798,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","GPLCCR0",799,0)
- ;;<Reference URI="">
-"RTN","GPLCCR0",800,0)
- ;;<Transforms>
-"RTN","GPLCCR0",801,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","GPLCCR0",802,0)
- ;;</Transforms>
-"RTN","GPLCCR0",803,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","GPLCCR0",804,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","GPLCCR0",805,0)
- ;;</Reference>
-"RTN","GPLCCR0",806,0)
- ;;</SignedInfo>
-"RTN","GPLCCR0",807,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","GPLCCR0",808,0)
- ;;<KeyInfo>
-"RTN","GPLCCR0",809,0)
- ;;<KeyValue>
-"RTN","GPLCCR0",810,0)
- ;;<RSAKeyValue>
-"RTN","GPLCCR0",811,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","GPLCCR0",812,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","GPLCCR0",813,0)
- ;;</RSAKeyValue>
-"RTN","GPLCCR0",814,0)
- ;;</KeyValue>
-"RTN","GPLCCR0",815,0)
- ;;</KeyInfo>
-"RTN","GPLCCR0",816,0)
- ;;</Signature>
-"RTN","GPLCCR0",817,0)
- ;;</Signature>
-"RTN","GPLCCR0",818,0)
- ;;</CCRSignature>
-"RTN","GPLCCR0",819,0)
- ;;</Signatures>
-"RTN","GPLCCR0",820,0)
- ;;</ContinuityOfCareRecord>
-"RTN","GPLCCR0",821,0)
- ;</TEMPLATE>
-"RTN","GPLMEDS")
-0^18^B55630630
-"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 9
-"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 HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","GPLMEDS",29,0)
-   N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","GPLMEDS",30,0)
-   ; OUTPATIENT MEDS ARE PROCESSED IN EXTRACT^CCRMEDS, ALL OTHERS HERE
-"RTN","GPLMEDS",31,0)
-   D EXTRACT^CCRMEDS(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","GPLMEDS",32,0)
-   I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","GPLMEDS",33,0)
-   . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","GPLMEDS",34,0)
-   . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","GPLMEDS",35,0)
-   . W "HAS ACTIVE OP MEDS",!
-"RTN","GPLMEDS",36,0)
-   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","GPLMEDS",37,0)
-   D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","GPLMEDS",38,0)
-   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","GPLMEDS",39,0)
-   . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","GPLMEDS",40,0)
-   . S @MEDOUTXML@(0)=0
-"RTN","GPLMEDS",41,0)
-   . Q
-"RTN","GPLMEDS",42,0)
-   ; I DEBUG ZWR MEDRSLT
-"RTN","GPLMEDS",43,0)
-   M GPLMEDS=MEDRSLT
-"RTN","GPLMEDS",44,0)
-   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","GPLMEDS",45,0)
-   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","GPLMEDS",46,0)
-   I 'HASOP K @MEDTVMAP,@MEDTARYTMP
-"RTN","GPLMEDS",47,0)
-   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","GPLMEDS",48,0)
-   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","GPLMEDS",49,0)
-   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","GPLMEDS",50,0)
-   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","GPLMEDS",51,0)
-   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","GPLMEDS",52,0)
-   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","GPLMEDS",53,0)
-   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","GPLMEDS",54,0)
-   . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","GPLMEDS",55,0)
-   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","GPLMEDS",56,0)
-   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","GPLMEDS",57,0)
-   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","GPLMEDS",58,0)
-   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","GPLMEDS",59,0)
-   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","GPLMEDS",60,0)
-   ;ZWR ZA
-"RTN","GPLMEDS",61,0)
-   S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","GPLMEDS",62,0)
-   F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","GPLMEDS",63,0)
-   . I DEBUG W "ZI IS ",ZI,!
-"RTN","GPLMEDS",64,0)
-   . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","GPLMEDS",65,0)
-   . K @MEDVMAP
-"RTN","GPLMEDS",66,0)
-   . I DEBUG W "VMAP= ",MEDVMAP,!
-"RTN","GPLMEDS",67,0)
-   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","GPLMEDS",68,0)
-   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","GPLMEDS",69,0)
-   . I $P(MEDPTMP,U,1)?1"~OP"&$P(MEDPTMP,"^",10)="ACTIVE" Q  ; SKIP OP ACTIVE
-"RTN","GPLMEDS",70,0)
-   . S @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","GPLMEDS",71,0)
-   . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","GPLMEDS",72,0)
-   . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","GPLMEDS",73,0)
-   . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","GPLMEDS",74,0)
-   . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","GPLMEDS",75,0)
-   . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","GPLMEDS",76,0)
-   . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","GPLMEDS",77,0)
-   . S @MEDVMAP@("MEDRXNO")=""
-"RTN","GPLMEDS",78,0)
-   . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","GPLMEDS",79,0)
-   . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","GPLMEDS",80,0)
-   . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","GPLMEDS",81,0)
-   . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","GPLMEDS",82,0)
-   . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","GPLMEDS",83,0)
-   . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","GPLMEDS",84,0)
-   . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","GPLMEDS",85,0)
-   . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","GPLMEDS",86,0)
-   . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","GPLMEDS",87,0)
-   . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","GPLMEDS",88,0)
-   . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","GPLMEDS",89,0)
-   . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","GPLMEDS",90,0)
-   . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","GPLMEDS",91,0)
-   . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","GPLMEDS",92,0)
-   . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","GPLMEDS",93,0)
-   . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","GPLMEDS",94,0)
-   . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","GPLMEDS",95,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","GPLMEDS",96,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","GPLMEDS",97,0)
-   . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","GPLMEDS",98,0)
-   . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","GPLMEDS",99,0)
-   . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","GPLMEDS",100,0)
-   . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","GPLMEDS",101,0)
-   . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","GPLMEDS",102,0)
-   . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","GPLMEDS",103,0)
-   . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","GPLMEDS",104,0)
-   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","GPLMEDS",105,0)
-   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","GPLMEDS",106,0)
-   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","GPLMEDS",107,0)
-   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLMEDS",108,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","GPLMEDS",109,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","GPLMEDS",110,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","GPLMEDS",111,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","GPLMEDS",112,0)
-   . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","GPLMEDS",113,0)
-   . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","GPLMEDS",114,0)
-   . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","GPLMEDS",115,0)
-   . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","GPLMEDS",116,0)
-   . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","GPLMEDS",117,0)
-   . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","GPLMEDS",118,0)
-   . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","GPLMEDS",119,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","GPLMEDS",120,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","GPLMEDS",121,0)
-   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","GPLMEDS",122,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","GPLMEDS",123,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","GPLMEDS",124,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","GPLMEDS",125,0)
-   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","GPLMEDS",126,0)
-   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","GPLMEDS",127,0)
-   . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","GPLMEDS",128,0)
-   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","GPLMEDS",129,0)
-   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","GPLMEDS",130,0)
-   . S @MEDVMAP@("MEDRFNO")=""
-"RTN","GPLMEDS",131,0)
-   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","GPLMEDS",132,0)
-   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","GPLMEDS",133,0)
-   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","GPLMEDS",134,0)
-   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","GPLMEDS",135,0)
-   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","GPLMEDS",136,0)
-   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","GPLMEDS",137,0)
-   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","GPLMEDS",138,0)
-   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","GPLMEDS",139,0)
-   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","GPLMEDS",140,0)
-   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","GPLMEDS",141,0)
-   . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","GPLMEDS",142,0)
-   . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","GPLMEDS",143,0)
-   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","GPLMEDS",144,0)
-   . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","GPLMEDS",145,0)
-   . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","GPLMEDS",146,0)
-   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","GPLMEDS",147,0)
-   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","GPLMEDS",148,0)
-   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","GPLMEDS",149,0)
-   . K @MEDARYTMP
-"RTN","GPLMEDS",150,0)
-   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","GPLMEDS",151,0)
-   . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","GPLMEDS",152,0)
-   . . ; W "FIRST ONE",!
-"RTN","GPLMEDS",153,0)
-   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","GPLMEDS",154,0)
-   . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","GPLMEDS",155,0)
-   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","GPLMEDS",156,0)
-   N MEDTMP,MEDI
-"RTN","GPLMEDS",157,0)
-   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLMEDS",158,0)
-   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLMEDS",159,0)
-   . W "MEDICATION MISSING ",!
-"RTN","GPLMEDS",160,0)
-   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","GPLMEDS",161,0)
-   Q
-"RTN","GPLMEDS",162,0)
-   ;
-"RTN","GPLMEDS",163,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","GPLMEDS",164,0)
-   ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","GPLMEDS",165,0)
-   N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","GPLMEDS",166,0)
-   S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","GPLMEDS",167,0)
-   Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","GPLMEDS",168,0)
-   ;
-"RTN","GPLPROBS")
-0^11^B25875394
-"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 9
-"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)
-          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","GPLPROBS",42,0)
-          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","GPLPROBS",43,0)
-          . S VMAP=$NA(@TVMAP@(J))
-"RTN","GPLPROBS",44,0)
-          . K @VMAP
-"RTN","GPLPROBS",45,0)
-          . I DEBUG W "VMAP= ",VMAP,!
-"RTN","GPLPROBS",46,0)
-          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","GPLPROBS",47,0)
-          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","GPLPROBS",48,0)
-          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","GPLPROBS",49,0)
-          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
-"RTN","GPLPROBS",50,0)
-          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","GPLPROBS",51,0)
-          . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","GPLPROBS",52,0)
-          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","GPLPROBS",53,0)
-          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
-"RTN","GPLPROBS",54,0)
-          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
-"RTN","GPLPROBS",55,0)
-          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","GPLPROBS",56,0)
-          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","GPLPROBS",57,0)
-          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","GPLPROBS",58,0)
-          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","GPLPROBS",59,0)
-          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","GPLPROBS",60,0)
-          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","GPLPROBS",61,0)
-          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","GPLPROBS",62,0)
-          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","GPLPROBS",63,0)
-          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","GPLPROBS",64,0)
-          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","GPLPROBS",65,0)
-          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
-"RTN","GPLPROBS",66,0)
-          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
-"RTN","GPLPROBS",67,0)
-          . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","GPLPROBS",68,0)
-          . ; W "ARYTMP= ",ARYTMP,!
-"RTN","GPLPROBS",69,0)
-          . K @ARYTMP
-"RTN","GPLPROBS",70,0)
-          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","GPLPROBS",71,0)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",72,0)
-          . . ; W "FIRST ONE",!
-"RTN","GPLPROBS",73,0)
-          . . D CP^GPLXPATH(ARYTMP,OUTXML)
-"RTN","GPLPROBS",74,0)
-          . . ; W "OUTXML ",OUTXML,!
-"RTN","GPLPROBS",75,0)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLPROBS",76,0)
-          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
-"RTN","GPLPROBS",77,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
-"RTN","GPLPROBS",78,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLPROBS",79,0)
-          ; ZWR @OUTXML
-"RTN","GPLPROBS",80,0)
-          ; $$HTML^DILF(
-"RTN","GPLPROBS",81,0)
-          ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","GPLPROBS",82,0)
-          I CCD D  ; IF THIS IS FOR A CCD
-"RTN","GPLPROBS",83,0)
-          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
-"RTN","GPLPROBS",84,0)
-          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","GPLPROBS",85,0)
-          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
-"RTN","GPLPROBS",86,0)
-          . . I DEBUG W "VMAP =",VMAP,!
-"RTN","GPLPROBS",87,0)
-          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","GPLPROBS",88,0)
-          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","GPLPROBS",89,0)
-          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
-"RTN","GPLPROBS",90,0)
-          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","GPLPROBS",91,0)
-          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","GPLPROBS",92,0)
-          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",93,0)
-          . . . D CP^GPLXPATH("HOUT","HTMLO")
-"RTN","GPLPROBS",94,0)
-          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","GPLPROBS",95,0)
-          . . . I DEBUG W "DOING INNER",!
-"RTN","GPLPROBS",96,0)
-          . . . N HTMLBLD,HTMLTMP
-"RTN","GPLPROBS",97,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","GPLPROBS",98,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","GPLPROBS",99,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","GPLPROBS",100,0)
-          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
-"RTN","GPLPROBS",101,0)
-          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
-"RTN","GPLPROBS",102,0)
-          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
-"RTN","GPLPROBS",103,0)
-          . I DEBUG D PARY^GPLXPATH("HTMLO")
-"RTN","GPLPROBS",104,0)
-          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","GPLPROBS",105,0)
-          N PROBSTMP,I
-"RTN","GPLPROBS",106,0)
-          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLPROBS",107,0)
-          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLPROBS",108,0)
-          . ; STRINGS MARKED AS @@X@@
-"RTN","GPLPROBS",109,0)
-          . W !,"PROBLEMS Missing list: ",!
-"RTN","GPLPROBS",110,0)
-          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","GPLPROBS",111,0)
-          Q
-"RTN","GPLPROBS",112,0)
-          ;
-"RTN","GPLRIMA")
-0^13^B214212612
-"RTN","GPLRIMA",1,0)
-GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-"RTN","GPLRIMA",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 9
-"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)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
-"RTN","GPLRIMA",63,0)
-    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","GPLRIMA",64,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
-"RTN","GPLRIMA",65,0)
-    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","GPLRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
-"RTN","GPLRIMA",67,0)
-    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","GPLRIMA",68,0)
-    . ;
-"RTN","GPLRIMA",69,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-"RTN","GPLRIMA",70,0)
-    . ;
-"RTN","GPLRIMA",71,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-"RTN","GPLRIMA",72,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","GPLRIMA",73,0)
-    . ;
-"RTN","GPLRIMA",74,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","GPLRIMA",75,0)
-    . ;
-"RTN","GPLRIMA",76,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","GPLRIMA",77,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","GPLRIMA",78,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","GPLRIMA",79,0)
-    . ;
-"RTN","GPLRIMA",80,0)
-    . N CATNAME,CATTBL
-"RTN","GPLRIMA",81,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","GPLRIMA",82,0)
-    . S CATNAME=""
-"RTN","GPLRIMA",83,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","GPLRIMA",84,0)
-    . W "CATEGORY NAME: ",CATNAME,!
-"RTN","GPLRIMA",85,0)
-    . ;
-"RTN","GPLRIMA",86,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
-"RTN","GPLRIMA",87,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","GPLRIMA",88,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","GPLRIMA",89,0)
-    . ; AND WE SKIP IT
-"RTN","GPLRIMA",90,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","GPLRIMA",91,0)
-    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","GPLRIMA",92,0)
-    Q
-"RTN","GPLRIMA",93,0)
-    ;
-"RTN","GPLRIMA",94,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","GPLRIMA",95,0)
-    N SBASE,SATTR
-"RTN","GPLRIMA",96,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","GPLRIMA",97,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","GPLRIMA",98,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","GPLRIMA",99,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","GPLRIMA",100,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","GPLRIMA",101,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","GPLRIMA",102,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","GPLRIMA",103,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","GPLRIMA",104,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",105,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","GPLRIMA",106,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",107,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",108,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","GPLRIMA",109,0)
-    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","GPLRIMA",110,0)
-    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","GPLRIMA",111,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","GPLRIMA",112,0)
-    Q SATTR
-"RTN","GPLRIMA",113,0)
-    ;
-"RTN","GPLRIMA",114,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","GPLRIMA",115,0)
-    K ^TMP("GPLRIM","RESUME")
-"RTN","GPLRIMA",116,0)
-    K ^TMP("GPLRIM")
-"RTN","GPLRIMA",117,0)
-    Q
-"RTN","GPLRIMA",118,0)
-    ;
-"RTN","GPLRIMA",119,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","GPLRIMA",120,0)
-    ;
-"RTN","GPLRIMA",121,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",122,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","GPLRIMA",123,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","GPLRIMA",124,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","GPLRIMA",125,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","GPLRIMA",126,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","GPLRIMA",127,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","GPLRIMA",128,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","GPLRIMA",129,0)
-    . W CLIDX,!
-"RTN","GPLRIMA",130,0)
-    ; D PARY^GPLXPATH(CLBASE)
-"RTN","GPLRIMA",131,0)
-    Q
-"RTN","GPLRIMA",132,0)
-    ;
-"RTN","GPLRIMA",133,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","GPLRIMA",134,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","GPLRIMA",135,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","GPLRIMA",136,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","GPLRIMA",137,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","GPLRIMA",138,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","GPLRIMA",139,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","GPLRIMA",140,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","GPLRIMA",141,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","GPLRIMA",142,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","GPLRIMA",143,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","GPLRIMA",144,0)
-    ;
-"RTN","GPLRIMA",145,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","GPLRIMA",146,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","GPLRIMA",147,0)
-    W "CBASE: ",CCTBL,!
-"RTN","GPLRIMA",148,0)
-    ;
-"RTN","GPLRIMA",149,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","GPLRIMA",150,0)
-    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","GPLRIMA",151,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","GPLRIMA",152,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","GPLRIMA",153,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","GPLRIMA",154,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","GPLRIMA",155,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","GPLRIMA",156,0)
-    ;
-"RTN","GPLRIMA",157,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","GPLRIMA",158,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",159,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","GPLRIMA",160,0)
-    ;
-"RTN","GPLRIMA",161,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","GPLRIMA",162,0)
-    ;
-"RTN","GPLRIMA",163,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","GPLRIMA",164,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","GPLRIMA",165,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","GPLRIMA",166,0)
-    ;
-"RTN","GPLRIMA",167,0)
-    Q
-"RTN","GPLRIMA",168,0)
-    ;
-"RTN","GPLRIMA",169,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","GPLRIMA",170,0)
-    ;
-"RTN","GPLRIMA",171,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",172,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","GPLRIMA",173,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",174,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",175,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","GPLRIMA",176,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","GPLRIMA",177,0)
-    . S ZCNT=0
-"RTN","GPLRIMA",178,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","GPLRIMA",179,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","GPLRIMA",180,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","GPLRIMA",181,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","GPLRIMA",182,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",183,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","GPLRIMA",184,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","GPLRIMA",185,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","GPLRIMA",186,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","GPLRIMA",187,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","GPLRIMA",188,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","GPLRIMA",189,0)
-    Q
-"RTN","GPLRIMA",190,0)
-    ;
-"RTN","GPLRIMA",191,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","GPLRIMA",192,0)
-    ; INLST IS PASSED BY NAME
-"RTN","GPLRIMA",193,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","GPLRIMA",194,0)
-    W INLST,!
-"RTN","GPLRIMA",195,0)
-    S ZCOUNT=0
-"RTN","GPLRIMA",196,0)
-    S ZDX=""
-"RTN","GPLRIMA",197,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","GPLRIMA",198,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","GPLRIMA",199,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","GPLRIMA",200,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","GPLRIMA",201,0)
-    Q ZCOUNT
-"RTN","GPLRIMA",202,0)
-    ;
-"RTN","GPLRIMA",203,0)
-XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN 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 ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",208,0)
-    S ZI=""
-"RTN","GPLRIMA",209,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",210,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",211,0)
-    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
-"RTN","GPLRIMA",212,0)
-    Q
-"RTN","GPLRIMA",213,0)
-    ;
-"RTN","GPLRIMA",214,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","GPLRIMA",215,0)
-    ;
-"RTN","GPLRIMA",216,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",217,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",218,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","GPLRIMA",219,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",220,0)
-    S ZI=""
-"RTN","GPLRIMA",221,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",222,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",223,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","GPLRIMA",224,0)
-    . W ZI," "
-"RTN","GPLRIMA",225,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","GPLRIMA",226,0)
-    . . S ZC=0
-"RTN","GPLRIMA",227,0)
-    . . W !
-"RTN","GPLRIMA",228,0)
-    Q
-"RTN","GPLRIMA",229,0)
-    ;
-"RTN","GPLRIMA",230,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","GPLRIMA",231,0)
-    ;
-"RTN","GPLRIMA",232,0)
-    N ATTR S ATTR=""
-"RTN","GPLRIMA",233,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",234,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","GPLRIMA",235,0)
-    S ATTR=^TMP("GPLRIM","ATTR",DFN)
-"RTN","GPLRIMA",236,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","GPLRIMA",237,0)
-    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","GPLRIMA",238,0)
-    . N CAT
-"RTN","GPLRIMA",239,0)
-    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","GPLRIMA",240,0)
-    . W CAT,": ",ATTR,!
-"RTN","GPLRIMA",241,0)
-    Q
-"RTN","GPLRIMA",242,0)
-    ;
-"RTN","GPLRIMA",243,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","GPLRIMA",244,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","GPLRIMA",245,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","GPLRIMA",246,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","GPLRIMA",247,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","GPLRIMA",248,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","GPLRIMA",249,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","GPLRIMA",250,0)
-    ;
-"RTN","GPLRIMA",251,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","GPLRIMA",252,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","GPLRIMA",253,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","GPLRIMA",254,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","GPLRIMA",255,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","GPLRIMA",256,0)
-    Q
-"RTN","GPLRIMA",257,0)
-    ;
-"RTN","GPLRIMA",258,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","GPLRIMA",259,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
-"RTN","GPLRIMA",260,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","GPLRIMA",261,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","GPLRIMA",262,0)
-      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","GPLRIMA",263,0)
-      Q
-"RTN","GPLRIMA",264,0)
-      ;
-"RTN","GPLRIMA",265,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","GPLRIMA",266,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",267,0)
-      K @RIMTBL
-"RTN","GPLRIMA",268,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","GPLRIMA",269,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","GPLRIMA",270,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","GPLRIMA",271,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","GPLRIMA",272,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","GPLRIMA",273,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","GPLRIMA",274,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","GPLRIMA",275,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","GPLRIMA",276,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","GPLRIMA",277,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","GPLRIMA",278,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","GPLRIMA",279,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","GPLRIMA",280,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","GPLRIMA",281,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","GPLRIMA",282,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","GPLRIMA",283,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","GPLRIMA",284,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","GPLRIMA",285,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","GPLRIMA",286,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","GPLRIMA",287,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","GPLRIMA",288,0)
-      Q
-"RTN","GPLRIMA",289,0)
-      ;
-"RTN","GPLRIMA",290,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","GPLRIMA",291,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","GPLRIMA",292,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","GPLRIMA",293,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","GPLRIMA",294,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","GPLRIMA",295,0)
-    N USETBL
-"RTN","GPLRIMA",296,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","GPLRIMA",297,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","GPLRIMA",298,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","GPLRIMA",299,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","GPLRIMA",300,0)
-    Q
-"RTN","GPLRIMA",301,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","GPLRIMA",302,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","GPLRIMA",303,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","GPLRIMA",304,0)
-    ; IN SECTION "MEDS"
-"RTN","GPLRIMA",305,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","GPLRIMA",306,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","GPLRIMA",307,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","GPLRIMA",308,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","GPLRIMA",309,0)
-    ;
-"RTN","GPLRIMA",310,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","GPLRIMA",311,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",312,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",313,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","GPLRIMA",314,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","GPLRIMA",315,0)
-    N ZZI,ZZS
-"RTN","GPLRIMA",316,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","GPLRIMA",317,0)
-    ; ZWR @ZZS@(1)
-"RTN","GPLRIMA",318,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","GPLRIMA",319,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","GPLRIMA",320,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","GPLRIMA",321,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","GPLRIMA",322,0)
-    Q
-"RTN","GPLRIMA",323,0)
-    ;
-"RTN","GPLRIMA",324,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","GPLRIMA",325,0)
-    ;
-"RTN","GPLRIMA",326,0)
-    N ZR
-"RTN","GPLRIMA",327,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","GPLRIMA",328,0)
-    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
-"RTN","GPLRIMA",329,0)
-    E  W "NOTHING RETURNED",!
-"RTN","GPLRIMA",330,0)
-    Q
-"RTN","GPLRIMA",331,0)
-    ;
-"RTN","GPLRIMA",332,0)
-CAGET(RTN,IATTR) ;
-"RTN","GPLRIMA",333,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",334,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","GPLRIMA",335,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","GPLRIMA",336,0)
-    Q
-"RTN","GPLRIMA",337,0)
-    ;
-"RTN","GPLRIMA",338,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",339,0)
-    ;
-"RTN","GPLRIMA",340,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",341,0)
-    N ZLST
-"RTN","GPLRIMA",342,0)
-    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
-"RTN","GPLRIMA",343,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",344,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",345,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","GPLRIMA",346,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","GPLRIMA",347,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","GPLRIMA",348,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","GPLRIMA",349,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","GPLRIMA",350,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","GPLRIMA",351,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","GPLRIMA",352,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","GPLRIMA",353,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","GPLRIMA",354,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","GPLRIMA",355,0)
-    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","GPLRIMA",356,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","GPLRIMA",357,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","GPLRIMA",358,0)
-    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","GPLRIMA",359,0)
-    . S ZCNT=ZCNT+1
-"RTN","GPLRIMA",360,0)
-    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","GPLRIMA",361,0)
-    Q
-"RTN","GPLRIMA",362,0)
-    ;
-"RTN","GPLRIMA",363,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","GPLRIMA",364,0)
-    ;
-"RTN","GPLRIMA",365,0)
-    N ZR
-"RTN","GPLRIMA",366,0)
-    D PCLST(.ZR,CATTR)
-"RTN","GPLRIMA",367,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","GPLRIMA",368,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","GPLRIMA",369,0)
-    E  D  ;
-"RTN","GPLRIMA",370,0)
-    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
-"RTN","GPLRIMA",371,0)
-    . W "COUNT=",ZR(0),!
-"RTN","GPLRIMA",372,0)
-    Q
-"RTN","GPLRIMA",373,0)
-    ;
-"RTN","GPLRIMA",374,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","GPLRIMA",375,0)
-    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","GPLRIMA",376,0)
-    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","GPLRIMA",377,0)
-    ; DFN IS THE PATIENT NUMBER.
-"RTN","GPLRIMA",378,0)
-    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",379,0)
-    ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","GPLRIMA",380,0)
-    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","GPLRIMA",381,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",382,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",383,0)
-    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","GPLRIMA",384,0)
-    N ZZGI
-"RTN","GPLRIMA",385,0)
-    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","GPLRIMA",386,0)
-    . F ZZGI="PROBLEMS","VITALS","MEDS" D  ; FOR EACH SECTION
-"RTN","GPLRIMA",387,0)
-    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","GPLRIMA",388,0)
-    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","GPLRIMA",389,0)
-    Q
-"RTN","GPLRIMA",390,0)
-    ;
-"RTN","GPLRIMA",391,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","GPLRIMA",392,0)
-    ;
-"RTN","GPLRIMA",393,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","GPLRIMA",394,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","GPLRIMA",395,0)
-    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","GPLRIMA",396,0)
-    E  D  ; VARS EXIST
-"RTN","GPLRIMA",397,0)
-    . N ZGVI
-"RTN","GPLRIMA",398,0)
-    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","GPLRIMA",399,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","GPLRIMA",400,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","GPLRIMA",401,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","GPLRIMA",402,0)
-    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","GPLRIMA",403,0)
-    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
-"RTN","GPLRIMA",404,0)
-    . . ; D PARY^GPLXPATH("ZZGA")
-"RTN","GPLRIMA",405,0)
-    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","GPLRIMA",406,0)
-    Q
-"RTN","GPLRIMA",407,0)
-    ;
-"RTN","GPLRIMA",408,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
-"RTN","GPLRIMA",409,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","GPLRIMA",410,0)
-    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",411,0)
-    N GTMP
-"RTN","GPLRIMA",412,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",413,0)
-    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","GPLRIMA",414,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","GPLRIMA",415,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","GPLRIMA",416,0)
-    D PARY^GPLXPATH("GTMP")
-"RTN","GPLRIMA",417,0)
-    Q
-"RTN","GPLRIMA",418,0)
-    ;
-"RTN","GPLUNIT")
-0^10^B31438520
-"RTN","GPLUNIT",1,0)
-GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-"RTN","GPLUNIT",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 9
-"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  Q ; TEST SECTION DOESN'T EXIST
-"RTN","GPLUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","GPLUNIT",83,0)
-          N FIRST,LAST
-"RTN","GPLUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","GPLUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","GPLUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
-"RTN","GPLUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","GPLUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",89,0)
-          . . ;  W ZP,!
-"RTN","GPLUNIT",90,0)
-          . . S ZX=ZP
-"RTN","GPLUNIT",91,0)
-          . . W "RUNNING: "_ZP
-"RTN","GPLUNIT",92,0)
-          . . X ZX
-"RTN","GPLUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
-"RTN","GPLUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-"RTN","GPLUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",96,0)
-          . . S ZX="S ZR="_ZP
-"RTN","GPLUNIT",97,0)
-          . . W "TRYING: "_ZP
-"RTN","GPLUNIT",98,0)
-          . . X ZX
-"RTN","GPLUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","GPLUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-"RTN","GPLUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
-"RTN","GPLUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
-"RTN","GPLUNIT",104,0)
-          Q
-"RTN","GPLUNIT",105,0)
-          ;
-"RTN","GPLUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
-"RTN","GPLUNIT",107,0)
-          N ZTMP
-"RTN","GPLUNIT",108,0)
-          D ZLOAD(.ZTMP)
-"RTN","GPLUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
-"RTN","GPLUNIT",110,0)
-          W "PASSED: ",TPASSED,!
-"RTN","GPLUNIT",111,0)
-          W "FAILED: ",TFAILED,!
-"RTN","GPLUNIT",112,0)
-          W !
-"RTN","GPLUNIT",113,0)
-          W "THE TESTS!",!
-"RTN","GPLUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
-"RTN","GPLUNIT",115,0)
-          Q
-"RTN","GPLUNIT",116,0)
-          ;
-"RTN","GPLUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","GPLUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",119,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",120,0)
-          . D PUSH^GPLXPATH(RTN,I)
-"RTN","GPLUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",122,0)
-          Q
-"RTN","GPLUNIT",123,0)
-          ;
-"RTN","GPLUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","GPLUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","GPLUNIT",126,0)
-          S TOTP=0 S TOTF=0
-"RTN","GPLUNIT",127,0)
-          D ZLOAD^GPLUNIT("TZTMP",RNM)
-"RTN","GPLUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
-"RTN","GPLUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",131,0)
-          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
-"RTN","GPLUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
-"RTN","GPLUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
-"RTN","GPLUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","GPLUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","GPLUNIT",136,0)
-          F I=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","GPLUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","GPLUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","GPLUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","GPLUNIT",141,0)
-          Q
-"RTN","GPLUNIT",142,0)
-          ;
-"RTN","GPLUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","GPLUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-"RTN","GPLUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
-"RTN","GPLUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",147,0)
-          S K=1
-"RTN","GPLUNIT",148,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",149,0)
-          . ; W "I IS NOW=",I,!
-"RTN","GPLUNIT",150,0)
-          . W I," "
-"RTN","GPLUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",152,0)
-          . S K=K+1 I K=6  D
-"RTN","GPLUNIT",153,0)
-          . . W !
-"RTN","GPLUNIT",154,0)
-          . . S K=1
-"RTN","GPLUNIT",155,0)
-          Q
-"RTN","GPLUNIT",156,0)
-          ;
-"RTN","GPLVITAL")
-0^12^B82628966
-"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 9
-"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)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","GPLVITAL",45,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","GPLVITAL",46,0)
- . I $D(VITRSLT(VSORT(J))) D
-"RTN","GPLVITAL",47,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","GPLVITAL",48,0)
- . . K @VITVMAP
-"RTN","GPLVITAL",49,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","GPLVITAL",50,0)
- . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","GPLVITAL",51,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","GPLVITAL",52,0)
- . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","GPLVITAL",53,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","GPLVITAL",54,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","GPLVITAL",55,0)
- . . I $P(VITPTMP,U,2)="HT" D
-"RTN","GPLVITAL",56,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",57,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",58,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",59,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",60,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",61,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",62,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",63,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-"RTN","GPLVITAL",64,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",65,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",66,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",67,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",68,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","GPLVITAL",69,0)
- . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","GPLVITAL",70,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",71,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",72,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",73,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",74,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",75,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",76,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",77,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-"RTN","GPLVITAL",78,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",79,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",80,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",81,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",82,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","GPLVITAL",83,0)
- . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","GPLVITAL",84,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",85,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",86,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",87,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",88,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",89,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",90,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",91,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-"RTN","GPLVITAL",92,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",93,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",94,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",95,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",96,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",97,0)
- . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","GPLVITAL",98,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",99,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",100,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",101,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",102,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",103,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",104,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",105,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-"RTN","GPLVITAL",106,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",107,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",108,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",109,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",110,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","GPLVITAL",111,0)
- . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","GPLVITAL",112,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",113,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",114,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",115,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",116,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",117,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",118,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",119,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-"RTN","GPLVITAL",120,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",121,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",122,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",123,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",124,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",125,0)
- . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","GPLVITAL",126,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",127,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",128,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",129,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",130,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",131,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",132,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",133,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-"RTN","GPLVITAL",134,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",135,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",136,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",137,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",138,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",139,0)
- . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","GPLVITAL",140,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",141,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",142,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",143,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",144,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",145,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",146,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",147,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-"RTN","GPLVITAL",148,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",149,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",150,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",151,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",152,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",153,0)
- . . E  D
-"RTN","GPLVITAL",154,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","GPLVITAL",155,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",156,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",157,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","GPLVITAL",158,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",159,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",160,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","GPLVITAL",161,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","GPLVITAL",162,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-"RTN","GPLVITAL",163,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-"RTN","GPLVITAL",164,0)
- . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",165,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",166,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",167,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","GPLVITAL",168,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","GPLVITAL",169,0)
- . . K @VITARYTMP
-"RTN","GPLVITAL",170,0)
- . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","GPLVITAL",171,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLVITAL",172,0)
- . . . ; W "FIRST ONE",!
-"RTN","GPLVITAL",173,0)
- . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-"RTN","GPLVITAL",174,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","GPLVITAL",175,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLVITAL",176,0)
- . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-"RTN","GPLVITAL",177,0)
- ; ZWR ^TMP($J,"VITALS",*)
-"RTN","GPLVITAL",178,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLVITAL",179,0)
- I DEBUG D PARY^GPLXPATH(VITOUTXML)
-"RTN","GPLVITAL",180,0)
- N VITTMP,I
-"RTN","GPLVITAL",181,0)
- D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLVITAL",182,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLVITAL",183,0)
- . W "VITALS MISSING ",!
-"RTN","GPLVITAL",184,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","GPLVITAL",185,0)
- Q
-"RTN","GPLVITAL",186,0)
- ;
-"RTN","GPLVITAL",187,0)
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","GPLVITAL",188,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","GPLVITAL",189,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","GPLVITAL",190,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","GPLVITAL",191,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","GPLVITAL",192,0)
- F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","GPLVITAL",193,0)
- . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","GPLVITAL",194,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","GPLVITAL",195,0)
- . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","GPLVITAL",196,0)
- S VDT(0)=VTDCNT
-"RTN","GPLVITAL",197,0)
- Q
-"RTN","GPLVITAL",198,0)
- ;
-"RTN","GPLXPAT0")
-0^19^B50983429
-"RTN","GPLXPAT0",1,0)
-GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-"RTN","GPLXPAT0",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 9
-"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)
- ;;><PUSHA>
-"RTN","GPLXPAT0",193,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","GPLXPAT0",195,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","A")
-"RTN","GPLXPAT0",196,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","B")
-"RTN","GPLXPAT0",197,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","C")
-"RTN","GPLXPAT0",198,0)
- ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
-"RTN","GPLXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","GPLXPAT0",200,0)
- ;;>>?GTMP(0)=3
-"RTN","GPLXPAT0",201,0)
- ;;><H2ARY>
-"RTN","GPLXPAT0",202,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","GPLXPAT0",204,0)
- ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","GPLXPAT0",206,0)
- ;;>>?GTMP2(1)="TEST1^1"
-"RTN","GPLXPAT0",207,0)
- ;;><XVARS>
-"RTN","GPLXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",209,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
-"RTN","GPLXPAT0",210,0)
- ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",211,0)
- ;;>>?GTMP2(1)="VAR1^"
-"RTN","GPLXPAT0",212,0)
- ;;></TEST>
-"RTN","GPLXPATH")
-0^9^B241520746
-"RTN","GPLXPATH",1,0)
-GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-"RTN","GPLXPATH",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 9
-"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)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","GPLXPATH",53,0)
- ;
-"RTN","GPLXPATH",54,0)
- N ZGI
-"RTN","GPLXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
-"RTN","GPLXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
-"RTN","GPLXPATH",57,0)
- Q
-"RTN","GPLXPATH",58,0)
- ;
-"RTN","GPLXPATH",59,0)
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","GPLXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","GPLXPATH",61,0)
- S RTN=""
-"RTN","GPLXPATH",62,0)
- N I
-"RTN","GPLXPATH",63,0)
- ; W "STK= ",STK,!
-"RTN","GPLXPATH",64,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",65,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","GPLXPATH",66,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","GPLXPATH",67,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","GPLXPATH",68,0)
- Q
-"RTN","GPLXPATH",69,0)
- ;
-"RTN","GPLXPATH",70,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","GPLXPATH",71,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","GPLXPATH",72,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","GPLXPATH",73,0)
- N CUR,TMP
-"RTN","GPLXPATH",74,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","GPLXPATH",75,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","GPLXPATH",76,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","GPLXPATH",77,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","GPLXPATH",78,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","GPLXPATH",79,0)
- ; W "CUR= ",CUR,!
-"RTN","GPLXPATH",80,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","GPLXPATH",81,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","GPLXPATH",82,0)
- ; W "CUR2= ",CUR,!
-"RTN","GPLXPATH",83,0)
- Q CUR
-"RTN","GPLXPATH",84,0)
- ;
-"RTN","GPLXPATH",85,0)
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
-"RTN","GPLXPATH",86,0)
- ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
-"RTN","GPLXPATH",87,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","GPLXPATH",88,0)
- ; XML SECTION
-"RTN","GPLXPATH",89,0)
- ; ZXML IS PASSED BY NAME
-"RTN","GPLXPATH",90,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
-"RTN","GPLXPATH",91,0)
- N GPLSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","GPLXPATH",92,0)
- I '$D(@ZXML@(0))  D  ; NO XML PASSED
-"RTN","GPLXPATH",93,0)
- . W "ERROR IN XML FILE",!
-"RTN","GPLXPATH",94,0)
- S GPLSTK(0)=0 ; INITIALIZE STACK
-"RTN","GPLXPATH",95,0)
- F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","GPLXPATH",96,0)
- . S LINE=@ZXML@(I)
-"RTN","GPLXPATH",97,0)
- . ;W LINE,!
-"RTN","GPLXPATH",98,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","GPLXPATH",99,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","GPLXPATH",100,0)
- . I FOUND'=1  D
-"RTN","GPLXPATH",101,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","GPLXPATH",102,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","GPLXPATH",103,0)
- . . . ; ON THE SAME LINE
-"RTN","GPLXPATH",104,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",105,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",106,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",107,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",108,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",109,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",110,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",111,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",112,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",113,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","GPLXPATH",114,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",115,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","GPLXPATH",116,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","GPLXPATH",117,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",118,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",119,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",120,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",121,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",122,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",123,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","GPLXPATH",124,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","GPLXPATH",125,0)
- . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","GPLXPATH",126,0)
- . . . . Q
-"RTN","GPLXPATH",127,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","GPLXPATH",128,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","GPLXPATH",129,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",130,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",131,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",132,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",133,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",134,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",135,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",136,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",137,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",138,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","GPLXPATH",139,0)
- S @ZXML@("INDEXED")=""
-"RTN","GPLXPATH",140,0)
- S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
-"RTN","GPLXPATH",141,0)
- Q
-"RTN","GPLXPATH",142,0)
- ;
-"RTN","GPLXPATH",143,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","GPLXPATH",144,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","GPLXPATH",145,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","GPLXPATH",146,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","GPLXPATH",147,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","GPLXPATH",148,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","GPLXPATH",149,0)
- N TMP,I,J,QXPATH
-"RTN","GPLXPATH",150,0)
- S FIRST=1
-"RTN","GPLXPATH",151,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","GPLXPATH",152,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","GPLXPATH",153,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","GPLXPATH",154,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","GPLXPATH",155,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","GPLXPATH",156,0)
- K @OARY
-"RTN","GPLXPATH",157,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","GPLXPATH",158,0)
- S J=1
-"RTN","GPLXPATH",159,0)
- FOR I=FIRST:1:LAST  D
-"RTN","GPLXPATH",160,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","GPLXPATH",161,0)
- . S J=J+1
-"RTN","GPLXPATH",162,0)
- ; ZWR OARY
-"RTN","GPLXPATH",163,0)
- Q
-"RTN","GPLXPATH",164,0)
- ;
-"RTN","GPLXPATH",165,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","GPLXPATH",166,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",167,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",168,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","GPLXPATH",169,0)
- ;
-"RTN","GPLXPATH",170,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","GPLXPATH",171,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",172,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",173,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","GPLXPATH",174,0)
- ;
-"RTN","GPLXPATH",175,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","GPLXPATH",176,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",177,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",178,0)
- Q $P(ISTR,";",2)
-"RTN","GPLXPATH",179,0)
- ;
-"RTN","GPLXPATH",180,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","GPLXPATH",181,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",182,0)
- Q $P(ISTR,";",3)
-"RTN","GPLXPATH",183,0)
- ;
-"RTN","GPLXPATH",184,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","GPLXPATH",185,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",186,0)
- Q $P(ISTR,";",1)
-"RTN","GPLXPATH",187,0)
- ;
-"RTN","GPLXPATH",188,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","GPLXPATH",189,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","GPLXPATH",190,0)
- ; DEST IS CLEARED TO START
-"RTN","GPLXPATH",191,0)
- ; USES PUSH TO DO THE COPY
-"RTN","GPLXPATH",192,0)
- N I
-"RTN","GPLXPATH",193,0)
- K @BDEST
-"RTN","GPLXPATH",194,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","GPLXPATH",195,0)
- . N J,ATMP
-"RTN","GPLXPATH",196,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","GPLXPATH",197,0)
- . I DEBUG W "ATMP=",ATMP,!
-"RTN","GPLXPATH",198,0)
- . I DEBUG W @BLIST@(I),!
-"RTN","GPLXPATH",199,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","GPLXPATH",200,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","GPLXPATH",201,0)
- . . I DEBUG W "BDEST= ",BDEST,!
-"RTN","GPLXPATH",202,0)
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
-"RTN","GPLXPATH",203,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","GPLXPATH",204,0)
- Q
-"RTN","GPLXPATH",205,0)
- ;
-"RTN","GPLXPATH",206,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","GPLXPATH",207,0)
- ;
-"RTN","GPLXPATH",208,0)
- I DEBUG W "QUEUEING ",BLST,!
-"RTN","GPLXPATH",209,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","GPLXPATH",210,0)
- Q
-"RTN","GPLXPATH",211,0)
- ;
-"RTN","GPLXPATH",212,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","GPLXPATH",213,0)
- ; KILLS CPDEST FIRST
-"RTN","GPLXPATH",214,0)
- N CPINSTR
-"RTN","GPLXPATH",215,0)
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","GPLXPATH",216,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","GPLXPATH",217,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","GPLXPATH",218,0)
- . Q
-"RTN","GPLXPATH",219,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","GPLXPATH",220,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","GPLXPATH",221,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","GPLXPATH",222,0)
- Q
-"RTN","GPLXPATH",223,0)
- ;
-"RTN","GPLXPATH",224,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","GPLXPATH",225,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","GPLXPATH",226,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","GPLXPATH",227,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","GPLXPATH",228,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",229,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","GPLXPATH",230,0)
- . Q
-"RTN","GPLXPATH",231,0)
- I DEBUG W "DOING QOPEN",!
-"RTN","GPLXPATH",232,0)
- N S1,E1,QOT,QOTMP
-"RTN","GPLXPATH",233,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","GPLXPATH",234,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",235,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","GPLXPATH",236,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","GPLXPATH",237,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",238,0)
- . S E1=@QOXML@(0)-1
-"RTN","GPLXPATH",239,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","GPLXPATH",240,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","GPLXPATH",241,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","GPLXPATH",242,0)
- Q
-"RTN","GPLXPATH",243,0)
- ;
-"RTN","GPLXPATH",244,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","GPLXPATH",245,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","GPLXPATH",246,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","GPLXPATH",247,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","GPLXPATH",248,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","GPLXPATH",249,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",250,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","GPLXPATH",251,0)
- I DEBUG W "GOING TO CLOSE",!
-"RTN","GPLXPATH",252,0)
- N S1,E1,QCT,QCTMP
-"RTN","GPLXPATH",253,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","GPLXPATH",254,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",255,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","GPLXPATH",256,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","GPLXPATH",257,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",258,0)
- . S S1=@QCXML@(0)
-"RTN","GPLXPATH",259,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","GPLXPATH",260,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","GPLXPATH",261,0)
- Q
-"RTN","GPLXPATH",262,0)
- ;
-"RTN","GPLXPATH",263,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","GPLXPATH",264,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","GPLXPATH",265,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","GPLXPATH",266,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","GPLXPATH",267,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","GPLXPATH",268,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","GPLXPATH",269,0)
- N INSBLD,INSTMP
-"RTN","GPLXPATH",270,0)
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","GPLXPATH",271,0)
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","GPLXPATH",272,0)
- I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","GPLXPATH",273,0)
- . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","GPLXPATH",274,0)
- I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",275,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",276,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","GPLXPATH",277,0)
- . . I DEBUG D PARY^GPLXPATH("INSBLD")
-"RTN","GPLXPATH",278,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",279,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","GPLXPATH",280,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","GPLXPATH",281,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",282,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","GPLXPATH",283,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",284,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","GPLXPATH",285,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","GPLXPATH",286,0)
- . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","GPLXPATH",287,0)
- Q
-"RTN","GPLXPATH",288,0)
- ;
-"RTN","GPLXPATH",289,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","GPLXPATH",290,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","GPLXPATH",291,0)
- ;
-"RTN","GPLXPATH",292,0)
- N INNBLD,UXPATH
-"RTN","GPLXPATH",293,0)
- N INNTBUF
-"RTN","GPLXPATH",294,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","GPLXPATH",295,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","GPLXPATH",296,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","GPLXPATH",297,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","GPLXPATH",298,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","GPLXPATH",299,0)
- . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","GPLXPATH",300,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","GPLXPATH",301,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","GPLXPATH",302,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","GPLXPATH",303,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","GPLXPATH",304,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","GPLXPATH",305,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","GPLXPATH",306,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","GPLXPATH",307,0)
- Q
-"RTN","GPLXPATH",308,0)
- ;
-"RTN","GPLXPATH",309,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","GPLXPATH",310,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","GPLXPATH",311,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",312,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","GPLXPATH",313,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","GPLXPATH",314,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","GPLXPATH",315,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",316,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","GPLXPATH",317,0)
- I DEBUG D PARY("XDEST")
-"RTN","GPLXPATH",318,0)
- Q
-"RTN","GPLXPATH",319,0)
- ;
-"RTN","GPLXPATH",320,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","GPLXPATH",321,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","GPLXPATH",322,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","GPLXPATH",323,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","GPLXPATH",324,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","GPLXPATH",325,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","GPLXPATH",326,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","GPLXPATH",327,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","GPLXPATH",328,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","GPLXPATH",329,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","GPLXPATH",330,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","GPLXPATH",331,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","GPLXPATH",332,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",333,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","GPLXPATH",334,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","GPLXPATH",335,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","GPLXPATH",336,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",337,0)
- I DEBUG W "REPLACE PREBUILD",!
-"RTN","GPLXPATH",338,0)
- I DEBUG D PARY("REBLD")
-"RTN","GPLXPATH",339,0)
- D BUILD("REBLD","RTMP")
-"RTN","GPLXPATH",340,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","GPLXPATH",341,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","GPLXPATH",342,0)
- Q
-"RTN","GPLXPATH",343,0)
- ;
-"RTN","GPLXPATH",344,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","GPLXPATH",345,0)
- ; W "Reporting on the missing",!
-"RTN","GPLXPATH",346,0)
- ; W OARY
-"RTN","GPLXPATH",347,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","GPLXPATH",348,0)
- N I
-"RTN","GPLXPATH",349,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","GPLXPATH",350,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",351,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","GPLXPATH",352,0)
- . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","GPLXPATH",353,0)
- . . Q
-"RTN","GPLXPATH",354,0)
- Q
-"RTN","GPLXPATH",355,0)
- ;
-"RTN","GPLXPATH",356,0)
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","GPLXPATH",357,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","GPLXPATH",358,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","GPLXPATH",359,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","GPLXPATH",360,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","GPLXPATH",361,0)
- S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
-"RTN","GPLXPATH",362,0)
- F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",363,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","GPLXPATH",364,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","GPLXPATH",365,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","GPLXPATH",366,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","GPLXPATH",367,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","GPLXPATH",368,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","GPLXPATH",369,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","GPLXPATH",370,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","GPLXPATH",371,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","GPLXPATH",372,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","GPLXPATH",373,0)
- . . . . E  D DOFLD ; PROCESS A FIELD
-"RTN","GPLXPATH",374,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","GPLXPATH",375,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","GPLXPATH",376,0)
- . . I DEBUG W TSTR
-"RTN","GPLXPATH",377,0)
- I DEBUG W "MAPPED",!
-"RTN","GPLXPATH",378,0)
- Q
-"RTN","GPLXPATH",379,0)
- ;
-"RTN","GPLXPATH",380,0)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
-"RTN","GPLXPATH",381,0)
- ;
-"RTN","GPLXPATH",382,0)
- Q
-"RTN","GPLXPATH",383,0)
- ;
-"RTN","GPLXPATH",384,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","GPLXPATH",385,0)
- ; THEXML IS PASSED BY NAME
-"RTN","GPLXPATH",386,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","GPLXPATH",387,0)
- S FOUND=0
-"RTN","GPLXPATH",388,0)
- S INTXT=0
-"RTN","GPLXPATH",389,0)
- I DEBUG W "DELETING EMPTY ELEMENTS",!
-"RTN","GPLXPATH",390,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","GPLXPATH",391,0)
- . S J=@THEXML@(I)
-"RTN","GPLXPATH",392,0)
- . I J["<text>" D
-"RTN","GPLXPATH",393,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","GPLXPATH",394,0)
- . . I DEBUG W "IN HTML SECTION",!
-"RTN","GPLXPATH",395,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","GPLXPATH",396,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","GPLXPATH",397,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","GPLXPATH",398,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","GPLXPATH",399,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","GPLXPATH",400,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","GPLXPATH",401,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","GPLXPATH",402,0)
- . . . I DEBUG W I,J,JP,!
-"RTN","GPLXPATH",403,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",404,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","GPLXPATH",405,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","GPLXPATH",406,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","GPLXPATH",407,0)
- . . . I DEBUG W I,J,!
-"RTN","GPLXPATH",408,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",409,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","GPLXPATH",410,0)
- . . . I JM=JPX D  ;
-"RTN","GPLXPATH",411,0)
- . . . . I DEBUG W I,JM_J_JPX,!
-"RTN","GPLXPATH",412,0)
- . . . . S DEL(I-1)=""
-"RTN","GPLXPATH",413,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","GPLXPATH",414,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","GPLXPATH",415,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","GPLXPATH",416,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","GPLXPATH",417,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","GPLXPATH",418,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","GPLXPATH",419,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","GPLXPATH",420,0)
- Q FOUND
-"RTN","GPLXPATH",421,0)
- ;
-"RTN","GPLXPATH",422,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","GPLXPATH",423,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","GPLXPATH",424,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",425,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","GPLXPATH",426,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",427,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","GPLXPATH",428,0)
- Q
-"RTN","GPLXPATH",429,0)
- ;
-"RTN","GPLXPATH",430,0)
-PARY(GLO)       ;PRINT AN ARRAY
-"RTN","GPLXPATH",431,0)
- N I
-"RTN","GPLXPATH",432,0)
- F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
-"RTN","GPLXPATH",433,0)
- Q
-"RTN","GPLXPATH",434,0)
- ;
-"RTN","GPLXPATH",435,0)
-H2ARY(IARYRTN,IHASH) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","GPLXPATH",436,0)
- ;
-"RTN","GPLXPATH",437,0)
- N H2I S H2I=""
-"RTN","GPLXPATH",438,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","GPLXPATH",439,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","GPLXPATH",440,0)
- . ; W H2I_"^"_@IHASH@(H2I),!
-"RTN","GPLXPATH",441,0)
- . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
-"RTN","GPLXPATH",442,0)
- . . W "GPLZZ",!
-"RTN","GPLXPATH",443,0)
- . . W $NA(@IHASH@(H2I)),!
-"RTN","GPLXPATH",444,0)
- . . Q  ;
-"RTN","GPLXPATH",445,0)
- . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
-"RTN","GPLXPATH",446,0)
- . ; W @IARYRTN@(0),!
-"RTN","GPLXPATH",447,0)
- Q
-"RTN","GPLXPATH",448,0)
- ;
-"RTN","GPLXPATH",449,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","GPLXPATH",450,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","GPLXPATH",451,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","GPLXPATH",452,0)
- ;
-"RTN","GPLXPATH",453,0)
- N XVI,XVTMP,XVT
-"RTN","GPLXPATH",454,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","GPLXPATH",455,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","GPLXPATH",456,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
-"RTN","GPLXPATH",457,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","GPLXPATH",458,0)
- Q
-"RTN","GPLXPATH",459,0)
- ;
-"RTN","GPLXPATH",460,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","GPLXPATH",461,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","GPLXPATH",462,0)
- ;
-"RTN","GPLXPATH",463,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","GPLXPATH",464,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","GPLXPATH",465,0)
- . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",466,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",467,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","GPLXPATH",468,0)
- . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",469,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",470,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","GPLXPATH",471,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","GPLXPATH",472,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","GPLXPATH",473,0)
- D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","GPLXPATH",474,0)
- Q
-"RTN","GPLXPATH",475,0)
- ;
-"RTN","GPLXPATH",476,0)
-TEST     ; Run all the test cases
-"RTN","GPLXPATH",477,0)
- D TESTALL^GPLUNIT("GPLXPAT0")
-"RTN","GPLXPATH",478,0)
- Q
-"RTN","GPLXPATH",479,0)
- ;
-"RTN","GPLXPATH",480,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","GPLXPATH",481,0)
- N ZTMP
-"RTN","GPLXPATH",482,0)
- S DEBUG=1
-"RTN","GPLXPATH",483,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",484,0)
- D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLXPATH",485,0)
- Q
-"RTN","GPLXPATH",486,0)
- ;
-"RTN","GPLXPATH",487,0)
-TLIST   ; LIST THE TESTS
-"RTN","GPLXPATH",488,0)
- N ZTMP
-"RTN","GPLXPATH",489,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",490,0)
- D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLXPATH",491,0)
- Q
-"RTN","GPLXPATH",492,0)
- ;
-"VER")
-8.0^22.0
-**END**
-**END**
Index: ccr/tags/CCR_1_0_7/p/CCR_1_0_5_T3_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_5_T3_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,9070 +1,0 @@
-KIDS Distribution saved on Oct 08, 2008@13:29:31
-fixes to Meds Directions xml generation
-**KIDS**:CCR*1.0*5^
-
-**INSTALL NAME**
-CCR*1.0*5
-"BLD",6955,0)
-CCR*1.0*5^^0^3081008^n
-"BLD",6955,1,0)
-^^23^23^3080923^
-"BLD",6955,1,1,0)
- 
-"BLD",6955,1,2,0)
-CCR AND CCD EXPORT TOOLS 
-"BLD",6955,1,3,0)
- 
-"BLD",6955,1,4,0)
-SINGLE XML EXPORT TO A HOST DIRECTORY AT 
-"BLD",6955,1,5,0)
- 
-"BLD",6955,1,6,0)
-BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
-"BLD",6955,1,7,0)
-DIRECTORY
-"BLD",6955,1,8,0)
- 
-"BLD",6955,1,9,0)
-EXPORT^GPLCRR FOR THE CCR
-"BLD",6955,1,10,0)
-EXPORT^GPLCCD FOR THE CCD
-"BLD",6955,1,11,0)
-XPAT^GPLCCR(DFN,"","") 
-"BLD",6955,1,12,0)
- 
-"BLD",6955,1,13,0)
-BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
-"BLD",6955,1,14,0)
- 
-"BLD",6955,1,15,0)
-ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
-"BLD",6955,1,16,0)
-RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
-"BLD",6955,1,17,0)
-ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
-"BLD",6955,1,18,0)
- 
-"BLD",6955,1,19,0)
-CLIST^GPLRIMA TO LIST CATEGORY TOTALS
-"BLD",6955,1,20,0)
-CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
-"BLD",6955,1,21,0)
-XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
-"BLD",6955,1,22,0)
- 
-"BLD",6955,1,23,0)
-TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
-"BLD",6955,4,0)
-^9.64PA^^
-"BLD",6955,6.3)
-10
-"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^B45805995
-"BLD",6955,"KRN",9.8,"NM",2,0)
-CCRDPTT^^0^B4791589
-"BLD",6955,"KRN",9.8,"NM",3,0)
-CCRMEDS^^0^B59807333
-"BLD",6955,"KRN",9.8,"NM",4,0)
-CCRSYS^^0^B5866233
-"BLD",6955,"KRN",9.8,"NM",5,0)
-CCRUNIT^^0^B8574
-"BLD",6955,"KRN",9.8,"NM",6,0)
-CCRUTIL^^0^B5927217
-"BLD",6955,"KRN",9.8,"NM",7,0)
-CCRVA200^^0^B35847405
-"BLD",6955,"KRN",9.8,"NM",8,0)
-GPLACTOR^^0^B52628160
-"BLD",6955,"KRN",9.8,"NM",9,0)
-GPLXPATH^^0^B241520746
-"BLD",6955,"KRN",9.8,"NM",10,0)
-GPLUNIT^^0^B31438520
-"BLD",6955,"KRN",9.8,"NM",11,0)
-GPLPROBS^^0^B25875394
-"BLD",6955,"KRN",9.8,"NM",12,0)
-GPLVITAL^^0^B82628966
-"BLD",6955,"KRN",9.8,"NM",13,0)
-GPLRIMA^^0^B214212612
-"BLD",6955,"KRN",9.8,"NM",14,0)
-GPLCCR^^0^B82192762
-"BLD",6955,"KRN",9.8,"NM",15,0)
-GPLCCR0^^0^B654252455
-"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^B55630630
-"BLD",6955,"KRN",9.8,"NM",19,0)
-GPLXPAT0^^0^B50983429
-"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^B45805995
-"RTN","CCRDPT",1,0)
-CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
-"RTN","CCRDPT",2,0)
- ;;0.2;CCRCCD;;Jun 15, 2008;Build 10
-"RTN","CCRDPT",3,0)
- ;
-"RTN","CCRDPT",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRDPT",5,0)
- ; General Public License. 
-"RTN","CCRDPT",6,0)
- ; 
-"RTN","CCRDPT",7,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRDPT",8,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRDPT",9,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRDPT",10,0)
- ; GNU General Public License for more details.
-"RTN","CCRDPT",11,0)
- ; 
-"RTN","CCRDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRDPT",14,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRDPT",15,0)
- ;
-"RTN","CCRDPT",16,0)
- ; CCRDPT       CCRCCD/SMH - Routines to Extract Patient Data for
-"RTN","CCRDPT",17,0)
- ; FAMILY       Family Name
-"RTN","CCRDPT",18,0)
- ; GIVEN        Given Name
-"RTN","CCRDPT",19,0)
- ; MIDDLE       Middle Name
-"RTN","CCRDPT",20,0)
- ; SUFFIX       Suffix Name
-"RTN","CCRDPT",21,0)
- ; DISPNAME     Display Name
-"RTN","CCRDPT",22,0)
- ; DOB          Date of Birth
-"RTN","CCRDPT",23,0)
- ; GENDER       Get Gender
-"RTN","CCRDPT",24,0)
- ; SSN          Get SSN for ID
-"RTN","CCRDPT",25,0)
- ; ADDRTYPE     Get Home Address
-"RTN","CCRDPT",26,0)
- ; ADDR1        Get Home Address line 1
-"RTN","CCRDPT",27,0)
- ; ADDR2        Get Home Address line 2
-"RTN","CCRDPT",28,0)
- ; CITY         Get City for Home Address
-"RTN","CCRDPT",29,0)
- ; STATE        Get State for Home Address
-"RTN","CCRDPT",30,0)
- ; ZIP          Get Zip code for Home Address
-"RTN","CCRDPT",31,0)
- ; COUNTY       Get County for our Address
-"RTN","CCRDPT",32,0)
- ; COUNTRY      Get Country for our Address
-"RTN","CCRDPT",33,0)
- ; RESTEL       Residential Telephone
-"RTN","CCRDPT",34,0)
- ; WORKTEL      Work Telephone
-"RTN","CCRDPT",35,0)
- ; EMAIL        Email Adddress
-"RTN","CCRDPT",36,0)
- ; CELLTEL      Cell Phone
-"RTN","CCRDPT",37,0)
- ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",38,0)
- ; NOK1GIV      NOK1 Given Name
-"RTN","CCRDPT",39,0)
- ; NOK1MID      NOK1 Middle Name
-"RTN","CCRDPT",40,0)
- ; NOK1SUF      NOK1 Suffi Name
-"RTN","CCRDPT",41,0)
- ; NOK1DISP     NOK1 Display Name
-"RTN","CCRDPT",42,0)
- ; NOK1REL      NOK1 Relationship to the patient
-"RTN","CCRDPT",43,0)
- ; NOK1ADD1     NOK1 Address 1
-"RTN","CCRDPT",44,0)
- ; NOK1ADD2     NOK1 Address 2
-"RTN","CCRDPT",45,0)
- ; NOK1CITY     NOK1 City
-"RTN","CCRDPT",46,0)
- ; NOK1STAT     NOK1 State
-"RTN","CCRDPT",47,0)
- ; NOK1ZIP      NOK1 Zip Code
-"RTN","CCRDPT",48,0)
- ; NOK1HTEL     NOK1 Home Telephone
-"RTN","CCRDPT",49,0)
- ; NOK1WTEL     NOK1 Work Telephone
-"RTN","CCRDPT",50,0)
- ; NOK1SAME     Is NOK1's Address the same the patient?
-"RTN","CCRDPT",51,0)
- ; NOK2FAM      NOK2 Family Name
-"RTN","CCRDPT",52,0)
- ; NOK2GIV      NOK2 Given Name
-"RTN","CCRDPT",53,0)
- ; NOK2MID      NOK2 Middle Name
-"RTN","CCRDPT",54,0)
- ; NOK2SUF      NOK2 Suffi Name
-"RTN","CCRDPT",55,0)
- ; NOK2DISP     NOK2 Display Name
-"RTN","CCRDPT",56,0)
- ; NOK2REL      NOK2 Relationship to the patient
-"RTN","CCRDPT",57,0)
- ; NOK2ADD1     NOK2 Address 1
-"RTN","CCRDPT",58,0)
- ; NOK2ADD2     NOK2 Address 2
-"RTN","CCRDPT",59,0)
- ; NOK2CITY     NOK2 City
-"RTN","CCRDPT",60,0)
- ; NOK2STAT     NOK2 State
-"RTN","CCRDPT",61,0)
- ; NOK2ZIP      NOK2 Zip Code
-"RTN","CCRDPT",62,0)
- ; NOK2HTEL     NOK2 Home Telephone
-"RTN","CCRDPT",63,0)
- ; NOK2WTEL     NOK2 Work Telephone
-"RTN","CCRDPT",64,0)
- ; NOK2SAME     Is NOK2's Address the same the patient?
-"RTN","CCRDPT",65,0)
- ; EMERFAM      Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",66,0)
- ; EMERGIV      EMER Given Name
-"RTN","CCRDPT",67,0)
- ; EMERMID      EMER Middle Name
-"RTN","CCRDPT",68,0)
- ; EMERSUF      EMER Suffi Name
-"RTN","CCRDPT",69,0)
- ; EMERDISP     EMER Display Name
-"RTN","CCRDPT",70,0)
- ; EMERREL      EMER Relationship to the patient
-"RTN","CCRDPT",71,0)
- ; EMERADD1     EMER Address 1
-"RTN","CCRDPT",72,0)
- ; EMERADD2     EMER Address 2
-"RTN","CCRDPT",73,0)
- ; EMERCITY     EMER City
-"RTN","CCRDPT",74,0)
- ; EMERSTAT     EMER State
-"RTN","CCRDPT",75,0)
- ; EMERZIP      EMER Zip Code
-"RTN","CCRDPT",76,0)
- ; EMERHTEL     EMER Home Telephone
-"RTN","CCRDPT",77,0)
- ; EMERWTEL     EMER Work Telephone
-"RTN","CCRDPT",78,0)
- ; EMERSAME     Is EMER's Address the same the NOK?
-"RTN","CCRDPT",79,0)
- ;
-"RTN","CCRDPT",80,0)
- W "No Entry at top!" Q
-"RTN","CCRDPT",81,0)
- ;
-"RTN","CCRDPT",82,0)
- ;**Revision History**
-"RTN","CCRDPT",83,0)
- ; - June 15, 08: v0.1 using merged global
-"RTN","CCRDPT",84,0)
- ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
-"RTN","CCRDPT",85,0)
- ;
-"RTN","CCRDPT",86,0)
- ; All methods are Public and Extrinsic
-"RTN","CCRDPT",87,0)
- ; All calls use Fileman file 2 (Patient).
-"RTN","CCRDPT",88,0)
- ; You can obtain field numbers using the data dictionary
-"RTN","CCRDPT",89,0)
- ;
-"RTN","CCRDPT",90,0)
-FAMILY(DFN) ; Family Name
-"RTN","CCRDPT",91,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",92,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",93,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",94,0)
-GIVEN(DFN) ; Given Name
-"RTN","CCRDPT",95,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",96,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",97,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",98,0)
-MIDDLE(DFN) ; Middle Name
-"RTN","CCRDPT",99,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",100,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",101,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",102,0)
-SUFFIX(DFN) ; Suffi Name
-"RTN","CCRDPT",103,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",104,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",105,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",106,0)
-DISPNAME(DFN) ; Display Name
-"RTN","CCRDPT",107,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",108,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",109,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",110,0)
-DOB(DFN) ; Date of Birth
-"RTN","CCRDPT",111,0)
- N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","CCRDPT",112,0)
- ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","CCRDPT",113,0)
- Q $$FMDTOUTC^CCRUTIL(DOB,"D")
-"RTN","CCRDPT",114,0)
-GENDER(DFN) ; Gender/Sex
-"RTN","CCRDPT",115,0)
- Q $$GET1^DIQ(2,DFN,.02) ;
-"RTN","CCRDPT",116,0)
-SSN(DFN) ; SSN
-"RTN","CCRDPT",117,0)
- Q $$GET1^DIQ(2,DFN,.09)
-"RTN","CCRDPT",118,0)
-ADDRTYPE(DFN) ; Address Type
-"RTN","CCRDPT",119,0)
- ; Vista only stores a home address for the patient.
-"RTN","CCRDPT",120,0)
- Q "Home"
-"RTN","CCRDPT",121,0)
-ADDR1(DFN) ; Get Home Address line 1
-"RTN","CCRDPT",122,0)
- Q $$GET1^DIQ(2,DFN,.111)
-"RTN","CCRDPT",123,0)
-ADDR2(DFN) ; Get Home Address line 2
-"RTN","CCRDPT",124,0)
- ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","CCRDPT",125,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",126,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","CCRDPT",127,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",128,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",129,0)
-CITY(DFN) ; Get City for Home Address
-"RTN","CCRDPT",130,0)
- Q $$GET1^DIQ(2,DFN,.114)
-"RTN","CCRDPT",131,0)
-STATE(DFN) ; Get State for Home Address
-"RTN","CCRDPT",132,0)
- Q $$GET1^DIQ(2,DFN,.115)
-"RTN","CCRDPT",133,0)
-ZIP(DFN) ; Get Zip code for Home Address
-"RTN","CCRDPT",134,0)
- Q $$GET1^DIQ(2,DFN,.116)
-"RTN","CCRDPT",135,0)
-COUNTY(DFN) ; Get County for our Address
-"RTN","CCRDPT",136,0)
- Q $$GET1^DIQ(2,DFN,.117)
-"RTN","CCRDPT",137,0)
-COUNTRY(DFN) ; Get Country for our Address
-"RTN","CCRDPT",138,0)
- ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","CCRDPT",139,0)
- Q "USA"
-"RTN","CCRDPT",140,0)
-RESTEL(DFN) ; Residential Telephone
-"RTN","CCRDPT",141,0)
- Q $$GET1^DIQ(2,DFN,.131)
-"RTN","CCRDPT",142,0)
-WORKTEL(DFN) ; Work Telephone
-"RTN","CCRDPT",143,0)
- Q $$GET1^DIQ(2,DFN,.132)
-"RTN","CCRDPT",144,0)
-EMAIL(DFN) ; Email Adddress
-"RTN","CCRDPT",145,0)
- Q $$GET1^DIQ(2,DFN,.133)
-"RTN","CCRDPT",146,0)
-CELLTEL(DFN) ; Cell Phone
-"RTN","CCRDPT",147,0)
- Q $$GET1^DIQ(2,DFN,.134)
-"RTN","CCRDPT",148,0)
-NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",149,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",150,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",151,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",152,0)
-NOK1GIV(DFN) ; NOK1 Given Name
-"RTN","CCRDPT",153,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",154,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",155,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",156,0)
-NOK1MID(DFN) ; NOK1 Middle Name
-"RTN","CCRDPT",157,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",158,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",159,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",160,0)
-NOK1SUF(DFN) ; NOK1 Suffi Name
-"RTN","CCRDPT",161,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",162,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",163,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",164,0)
-NOK1DISP(DFN) ; NOK1 Display Name
-"RTN","CCRDPT",165,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",166,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",167,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",168,0)
-NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","CCRDPT",169,0)
- Q $$GET1^DIQ(2,DFN,.212)
-"RTN","CCRDPT",170,0)
-NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","CCRDPT",171,0)
- Q $$GET1^DIQ(2,DFN,.213)
-"RTN","CCRDPT",172,0)
-NOK1ADD2(DFN) ; NOK1 Address 2 
-"RTN","CCRDPT",173,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",174,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","CCRDPT",175,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",176,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",177,0)
-NOK1CITY(DFN) ; NOK1 City
-"RTN","CCRDPT",178,0)
- Q $$GET1^DIQ(2,DFN,.216)
-"RTN","CCRDPT",179,0)
-NOK1STAT(DFN) ; NOK1 State
-"RTN","CCRDPT",180,0)
- Q $$GET1^DIQ(2,DFN,.217)
-"RTN","CCRDPT",181,0)
-NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","CCRDPT",182,0)
- Q $$GET1^DIQ(2,DFN,.218)
-"RTN","CCRDPT",183,0)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","CCRDPT",184,0)
- Q $$GET1^DIQ(2,DFN,.219)
-"RTN","CCRDPT",185,0)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","CCRDPT",186,0)
- Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","CCRDPT",187,0)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","CCRDPT",188,0)
- Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","CCRDPT",189,0)
-NOK2FAM(DFN) ; NOK2 Family Name
-"RTN","CCRDPT",190,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",191,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",192,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",193,0)
-NOK2GIV(DFN) ; NOK2 Given Name
-"RTN","CCRDPT",194,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",195,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",196,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",197,0)
-NOK2MID(DFN) ; NOK2 Middle Name
-"RTN","CCRDPT",198,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",199,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",200,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",201,0)
-NOK2SUF(DFN) ; NOK2 Suffi Name
-"RTN","CCRDPT",202,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",203,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",204,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",205,0)
-NOK2DISP(DFN) ; NOK2 Display Name
-"RTN","CCRDPT",206,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",207,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",208,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",209,0)
-NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","CCRDPT",210,0)
- Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","CCRDPT",211,0)
-NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","CCRDPT",212,0)
- Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","CCRDPT",213,0)
-NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","CCRDPT",214,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",215,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","CCRDPT",216,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",217,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",218,0)
-NOK2CITY(DFN) ; NOK2 City
-"RTN","CCRDPT",219,0)
- Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","CCRDPT",220,0)
-NOK2STAT(DFN) ; NOK2 State
-"RTN","CCRDPT",221,0)
- Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","CCRDPT",222,0)
-NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","CCRDPT",223,0)
- Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","CCRDPT",224,0)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","CCRDPT",225,0)
- Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","CCRDPT",226,0)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","CCRDPT",227,0)
- Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","CCRDPT",228,0)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","CCRDPT",229,0)
- Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","CCRDPT",230,0)
-EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",231,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",232,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",233,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",234,0)
-EMERGIV(DFN) ; EMER Given Name
-"RTN","CCRDPT",235,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",236,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",237,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",238,0)
-EMERMID(DFN) ; EMER Middle Name
-"RTN","CCRDPT",239,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",240,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",241,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",242,0)
-EMERSUF(DFN) ; EMER Suffi Name
-"RTN","CCRDPT",243,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",244,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",245,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",246,0)
-EMERDISP(DFN) ; EMER Display Name
-"RTN","CCRDPT",247,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",248,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",249,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",250,0)
-EMERREL(DFN) ; EMER Relationship to the patient
-"RTN","CCRDPT",251,0)
- Q $$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",252,0)
-EMERADD1(DFN) ; EMER Address 1
-"RTN","CCRDPT",253,0)
- Q $$GET1^DIQ(2,DFN,.333)
-"RTN","CCRDPT",254,0)
-EMERADD2(DFN) ; EMER Address 2
-"RTN","CCRDPT",255,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",256,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
-"RTN","CCRDPT",257,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",258,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",259,0)
-EMERCITY(DFN) ; EMER City
-"RTN","CCRDPT",260,0)
- Q $$GET1^DIQ(2,DFN,.336)
-"RTN","CCRDPT",261,0)
-EMERSTAT(DFN) ; EMER State
-"RTN","CCRDPT",262,0)
- Q $$GET1^DIQ(2,DFN,.337)
-"RTN","CCRDPT",263,0)
-EMERZIP(DFN) ; EMER Zip Code
-"RTN","CCRDPT",264,0)
- Q $$GET1^DIQ(2,DFN,.338)
-"RTN","CCRDPT",265,0)
-EMERHTEL(DFN) ; EMER Home Telephone
-"RTN","CCRDPT",266,0)
- Q $$GET1^DIQ(2,DFN,.339)
-"RTN","CCRDPT",267,0)
-EMERWTEL(DFN) ; EMER Work Telephone
-"RTN","CCRDPT",268,0)
- Q $$GET1^DIQ(2,DFN,.33011)
-"RTN","CCRDPT",269,0)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
-"RTN","CCRDPT",270,0)
- Q $$GET1^DIQ(2,DFN,.3305)
-"RTN","CCRDPTT")
-0^2^B4791589
-"RTN","CCRDPTT",1,0)
-CCRDPTT ; Unit Tester...
-"RTN","CCRDPTT",2,0)
-  ;;0.1;CCRCCD;;Jun 15, 2008;Build 10
-"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)
-          N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
-"RTN","CCRDPTT",39,0)
-          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
-"RTN","CCRDPTT",40,0)
-          . W "valued at "
-"RTN","CCRDPTT",41,0)
-    . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
-"RTN","CCRDPTT",42,0)
-          . W !
-"RTN","CCRDPTT",43,0)
-          Q
-"RTN","CCRMEDS")
-0^3^B59807333
-"RTN","CCRMEDS",1,0)
-CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
-"RTN","CCRMEDS",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 10
-"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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS",24,0)
- ;
-"RTN","CCRMEDS",25,0)
- ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS",26,0)
- ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS",27,0)
- ;
-"RTN","CCRMEDS",28,0)
- N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","CCRMEDS",29,0)
- N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","CCRMEDS",30,0)
- ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
-"RTN","CCRMEDS",31,0)
- ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
-"RTN","CCRMEDS",32,0)
- ; NON-VA MEDS IN EXTRACT^CCRMEDS3
-"RTN","CCRMEDS",33,0)
- ; INPATIENT MEDS IN EXTRACT^CCRMEDS4
-"RTN","CCRMEDS",34,0)
- ; ALL OTHERS HERE
-"RTN","CCRMEDS",35,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",36,0)
- K @MEDTVMAP ; CLEAR VARIABLE ARRAY
-"RTN","CCRMEDS",37,0)
- S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
-"RTN","CCRMEDS",38,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",39,0)
- K @MEDTARYTMP ; KILL XML ARRAY
-"RTN","CCRMEDS",40,0)
- D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",41,0)
- I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","CCRMEDS",42,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",43,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",44,0)
- . W MEDCNT,!
-"RTN","CCRMEDS",45,0)
- . W "HAS ACTIVE OP MEDS",!
-"RTN","CCRMEDS",46,0)
- N PENDINGXML,MEDPENDING
-"RTN","CCRMEDS",47,0)
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
-"RTN","CCRMEDS",48,0)
- D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",49,0)
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
-"RTN","CCRMEDS",50,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",51,0)
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
-"RTN","CCRMEDS",52,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
-"RTN","CCRMEDS",53,0)
- . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
-"RTN","CCRMEDS",54,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",55,0)
- . ; W MEDCNT,!
-"RTN","CCRMEDS",56,0)
- . W "HAS OP PENDING MEDS",!
-"RTN","CCRMEDS",57,0)
- N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","CCRMEDS",58,0)
- D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","CCRMEDS",59,0)
- I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","CCRMEDS",60,0)
- . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","CCRMEDS",61,0)
- . S @MEDOUTXML@(0)=0
-"RTN","CCRMEDS",62,0)
- . Q
-"RTN","CCRMEDS",63,0)
- ; I DEBUG ZWR MEDRSLT
-"RTN","CCRMEDS",64,0)
- M GPLMEDS=MEDRSLT
-"RTN","CCRMEDS",65,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",66,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",67,0)
- ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
-"RTN","CCRMEDS",68,0)
- ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","CCRMEDS",69,0)
- ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","CCRMEDS",70,0)
- N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","CCRMEDS",71,0)
- ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","CCRMEDS",72,0)
- S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","CCRMEDS",73,0)
- F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","CCRMEDS",74,0)
- . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","CCRMEDS",75,0)
- . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","CCRMEDS",76,0)
- . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","CCRMEDS",77,0)
- . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","CCRMEDS",78,0)
- . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","CCRMEDS",79,0)
- . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","CCRMEDS",80,0)
- . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","CCRMEDS",81,0)
- ;ZWR ZA
-"RTN","CCRMEDS",82,0)
- ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","CCRMEDS",83,0)
- F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","CCRMEDS",84,0)
- . I DEBUG W "ZI IS ",ZI,!
-"RTN","CCRMEDS",85,0)
- . ; W ZI," ",MEDCNT,!
-"RTN","CCRMEDS",86,0)
- . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","CCRMEDS",87,0)
- . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","CCRMEDS",88,0)
- . I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
-"RTN","CCRMEDS",89,0)
- . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
-"RTN","CCRMEDS",90,0)
- . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","CCRMEDS",91,0)
- . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
-"RTN","CCRMEDS",92,0)
- . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","CCRMEDS",93,0)
- . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","CCRMEDS",94,0)
- . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","CCRMEDS",95,0)
- . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","CCRMEDS",96,0)
- . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS",97,0)
- . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS",98,0)
- . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS",99,0)
- . S @MEDVMAP@("MEDRXNO")=""
-"RTN","CCRMEDS",100,0)
- . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","CCRMEDS",101,0)
- . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","CCRMEDS",102,0)
- . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","CCRMEDS",103,0)
- . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","CCRMEDS",104,0)
- . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","CCRMEDS",105,0)
- . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","CCRMEDS",106,0)
- . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","CCRMEDS",107,0)
- . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","CCRMEDS",108,0)
- . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","CCRMEDS",109,0)
- . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","CCRMEDS",110,0)
- . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","CCRMEDS",111,0)
- . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","CCRMEDS",112,0)
- . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","CCRMEDS",113,0)
- . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS",114,0)
- . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS",115,0)
- . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS",116,0)
- . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS",117,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS",118,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS",119,0)
- . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS",120,0)
- . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS",121,0)
- . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","CCRMEDS",122,0)
- . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","CCRMEDS",123,0)
- . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","CCRMEDS",124,0)
- . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","CCRMEDS",125,0)
- . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","CCRMEDS",126,0)
- . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","CCRMEDS",127,0)
- . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS",128,0)
- . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","CCRMEDS",129,0)
- . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","CCRMEDS",130,0)
- . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","CCRMEDS",131,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","CCRMEDS",132,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","CCRMEDS",133,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","CCRMEDS",134,0)
- . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","CCRMEDS",135,0)
- . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","CCRMEDS",136,0)
- . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","CCRMEDS",137,0)
- . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","CCRMEDS",138,0)
- . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","CCRMEDS",139,0)
- . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","CCRMEDS",140,0)
- . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","CCRMEDS",141,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","CCRMEDS",142,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS",143,0)
- . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS",144,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","CCRMEDS",145,0)
- . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","CCRMEDS",146,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","CCRMEDS",147,0)
- . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","CCRMEDS",148,0)
- . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","CCRMEDS",149,0)
- . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","CCRMEDS",150,0)
- . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","CCRMEDS",151,0)
- . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","CCRMEDS",152,0)
- . S @MEDVMAP@("MEDRFNO")=""
-"RTN","CCRMEDS",153,0)
- . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","CCRMEDS",154,0)
- . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","CCRMEDS",155,0)
- . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","CCRMEDS",156,0)
- . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","CCRMEDS",157,0)
- . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","CCRMEDS",158,0)
- . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","CCRMEDS",159,0)
- . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","CCRMEDS",160,0)
- . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","CCRMEDS",161,0)
- . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","CCRMEDS",162,0)
- . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","CCRMEDS",163,0)
- . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","CCRMEDS",164,0)
- . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","CCRMEDS",165,0)
- . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","CCRMEDS",166,0)
- . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","CCRMEDS",167,0)
- . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","CCRMEDS",168,0)
- . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","CCRMEDS",169,0)
- . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","CCRMEDS",170,0)
- . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","CCRMEDS",171,0)
- . K @MEDARYTMP
-"RTN","CCRMEDS",172,0)
- . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","CCRMEDS",173,0)
- . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","CCRMEDS",174,0)
- . . ; W "FIRST ONE",!
-"RTN","CCRMEDS",175,0)
- . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","CCRMEDS",176,0)
- . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","CCRMEDS",177,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","CCRMEDS",178,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS",179,0)
- D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS",180,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS",181,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS",182,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS",183,0)
- Q
-"RTN","CCRMEDS",184,0)
- ;
-"RTN","CCRMEDS",185,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","CCRMEDS",186,0)
- ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","CCRMEDS",187,0)
- N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","CCRMEDS",188,0)
- S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","CCRMEDS",189,0)
- Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","CCRMEDS",190,0)
- ;
-"RTN","CCRSYS")
-0^4^B5866233
-"RTN","CCRSYS",1,0)
-CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
-"RTN","CCRSYS",2,0)
-        ;;0.1;CCDCCR;;;Build 10
-"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 DFN="" Q 0  ; BAD DFN PASSED
-"RTN","CCRSYS",41,0)
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","CCRSYS",42,0)
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","CCRSYS",43,0)
-         ;
-"RTN","CCRSYS",44,0)
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","CCRSYS",45,0)
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","CCRSYS",46,0)
-         N DIERR,DATA
-"RTN","CCRSYS",47,0)
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","CCRSYS",48,0)
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","CCRSYS",49,0)
-         ; 1 = Test Patient
-"RTN","CCRSYS",50,0)
-         ; 0 = Non-test Patient
-"RTN","CCRSYS",51,0)
-         I DATA Q DATA
-"RTN","CCRSYS",52,0)
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","CCRSYS",53,0)
-         D CLEAN^DILF
-"RTN","CCRSYS",54,0)
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-"RTN","CCRSYS",55,0)
-         I $E(DATA,1,3)="000" Q 1
-"RTN","CCRSYS",56,0)
-         I $E(DATA,1,3)="666" Q 1
-"RTN","CCRSYS",57,0)
-         Q 0
-"RTN","CCRSYS",58,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 10
-"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)
-        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","CCRUNIT",12,0)
-        W "XPATH is: "_XPATH,!
-"RTN","CCRUNIT",13,0)
-        W "Getting Med Template into MINXML using",!
-"RTN","CCRUNIT",14,0)
-        W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
-"RTN","CCRUNIT",15,0)
-        D QUERY^GPLXPATH(T,XPATH,"MINXML")
-"RTN","CCRUNIT",16,0)
-  W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
-"RTN","CCRUNIT",17,0)
-        W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","CCRUNIT",18,0)
-        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","CCRUNIT",19,0)
-        D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
-"RTN","CCRUNIT",20,0)
-        Q
-"RTN","CCRUTIL")
-0^6^B5927217
-"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 10
-"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=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","CCRUTIL",61,0)
- F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-"RTN","CCRUTIL",62,0)
- . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-"RTN","CCRUTIL",63,0)
- . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","CCRUTIL",64,0)
- . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","CCRUTIL",65,0)
- . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","CCRUTIL",66,0)
- . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","CCRUTIL",67,0)
- N ZG
-"RTN","CCRUTIL",68,0)
- S ZG=$Q(VSRT(""))
-"RTN","CCRUTIL",69,0)
- F  D  Q:ZG=""  ;
-"RTN","CCRUTIL",70,0)
- . ; W ZG,!
-"RTN","CCRUTIL",71,0)
- . D PUSH^GPLXPATH("V1",@ZG)
-"RTN","CCRUTIL",72,0)
- . S ZG=$Q(@ZG)
-"RTN","CCRUTIL",73,0)
- I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-"RTN","CCRUTIL",74,0)
- . N ZG2
-"RTN","CCRUTIL",75,0)
- . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-"RTN","CCRUTIL",76,0)
- . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","CCRUTIL",77,0)
- . S ZG2(0)=V1(0)
-"RTN","CCRUTIL",78,0)
- . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","CCRUTIL",79,0)
- Q ZCNT
-"RTN","CCRUTIL",80,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 10
-"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^B52628160
-"RTN","GPLACTOR",1,0)
-GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
-"RTN","GPLACTOR",2,0)
- ;;0.4;CCDCCR;nopatch;noreleasedate;Build 10
-"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)
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
-"RTN","GPLACTOR",27,0)
- ;
-"RTN","GPLACTOR",28,0)
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-"RTN","GPLACTOR",29,0)
- ; IPXML is the Input Actor Template into which we  substitute values
-"RTN","GPLACTOR",30,0)
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
-"RTN","GPLACTOR",31,0)
- ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
-"RTN","GPLACTOR",32,0)
- ; ^TMP(7542,1,"ACTORS",0)=Count
-"RTN","GPLACTOR",33,0)
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-"RTN","GPLACTOR",34,0)
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-"RTN","GPLACTOR",35,0)
- ; AXML is the output arrary, to contain XML.
-"RTN","GPLACTOR",36,0)
- ;
-"RTN","GPLACTOR",37,0)
- N I,J,AMAP,AOID,ATYP,AIEN
-"RTN","GPLACTOR",38,0)
- D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-"RTN","GPLACTOR",39,0)
- D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-"RTN","GPLACTOR",40,0)
- I DEBUG W "PROCESSING ACTORS ",!
-"RTN","GPLACTOR",41,0)
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
-"RTN","GPLACTOR",42,0)
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",43,0)
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-"RTN","GPLACTOR",44,0)
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-"RTN","GPLACTOR",45,0)
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-"RTN","GPLACTOR",46,0)
- . I ATYP="" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",47,0)
- . ;
-"RTN","GPLACTOR",48,0)
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","GPLACTOR",49,0)
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
-"RTN","GPLACTOR",50,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-"RTN","GPLACTOR",51,0)
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",52,0)
- . ;
-"RTN","GPLACTOR",53,0)
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
-"RTN","GPLACTOR",54,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-"RTN","GPLACTOR",55,0)
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",56,0)
- . ;
-"RTN","GPLACTOR",57,0)
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
-"RTN","GPLACTOR",58,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-"RTN","GPLACTOR",59,0)
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",60,0)
- . ;
-"RTN","GPLACTOR",61,0)
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",62,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-"RTN","GPLACTOR",63,0)
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",64,0)
- . ;
-"RTN","GPLACTOR",65,0)
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",66,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-"RTN","GPLACTOR",67,0)
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",68,0)
- . ;
-"RTN","GPLACTOR",69,0)
- . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-"RTN","GPLACTOR",70,0)
- ;
-"RTN","GPLACTOR",71,0)
- N ACTTMP
-"RTN","GPLACTOR",72,0)
- D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLACTOR",73,0)
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLACTOR",74,0)
- . ; STRINGS MARKED AS @@X@@
-"RTN","GPLACTOR",75,0)
- . W "ACTORS Missing list: ",!
-"RTN","GPLACTOR",76,0)
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
-"RTN","GPLACTOR",77,0)
- Q
-"RTN","GPLACTOR",78,0)
- ;
-"RTN","GPLACTOR",79,0)
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"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)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",85,0)
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
-"RTN","GPLACTOR",86,0)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
-"RTN","GPLACTOR",87,0)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
-"RTN","GPLACTOR",88,0)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
-"RTN","GPLACTOR",89,0)
- S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
-"RTN","GPLACTOR",90,0)
- S @AMAP@("ACTORSSN")=""
-"RTN","GPLACTOR",91,0)
- S @AMAP@("ACTORSSNTEXT")=""
-"RTN","GPLACTOR",92,0)
- S @AMAP@("ACTORSSNSOURCEID")=""
-"RTN","GPLACTOR",93,0)
- S ZX=$$SSN^CCRDPT(AIEN)
-"RTN","GPLACTOR",94,0)
- I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
-"RTN","GPLACTOR",95,0)
- . S @AMAP@("ACTORSSN")=ZX
-"RTN","GPLACTOR",96,0)
- . S @AMAP@("ACTORSSNTEXT")="SSN"
-"RTN","GPLACTOR",97,0)
- . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","GPLACTOR",98,0)
- S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
-"RTN","GPLACTOR",99,0)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
-"RTN","GPLACTOR",100,0)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
-"RTN","GPLACTOR",101,0)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
-"RTN","GPLACTOR",102,0)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
-"RTN","GPLACTOR",103,0)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
-"RTN","GPLACTOR",104,0)
- S @AMAP@("ACTORRESTEL")=""
-"RTN","GPLACTOR",105,0)
- S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","GPLACTOR",106,0)
- S ZX=$$RESTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",107,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",108,0)
- . S @AMAP@("ACTORRESTEL")=ZX
-"RTN","GPLACTOR",109,0)
- . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","GPLACTOR",110,0)
- S @AMAP@("ACTORWORKTEL")=""
-"RTN","GPLACTOR",111,0)
- S @AMAP@("ACTORWORKTELTEXT")=""
-"RTN","GPLACTOR",112,0)
- S ZX=$$WORKTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",113,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",114,0)
- . S @AMAP@("ACTORWORKTEL")=ZX
-"RTN","GPLACTOR",115,0)
- . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","GPLACTOR",116,0)
- S @AMAP@("ACTORCELLTEL")=""
-"RTN","GPLACTOR",117,0)
- S @AMAP@("ACTORCELLTELTEXT")=""
-"RTN","GPLACTOR",118,0)
- S ZX=$$CELLTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",119,0)
- I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
-"RTN","GPLACTOR",120,0)
- . S @AMAP@("ACTORCELLTEL")=ZX
-"RTN","GPLACTOR",121,0)
- . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-"RTN","GPLACTOR",122,0)
- S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
-"RTN","GPLACTOR",123,0)
- S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-"RTN","GPLACTOR",124,0)
- S @AMAP@("ACTORIEN")=AIEN
-"RTN","GPLACTOR",125,0)
- S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
-"RTN","GPLACTOR",126,0)
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",127,0)
- D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",128,0)
- Q
-"RTN","GPLACTOR",129,0)
- ;
-"RTN","GPLACTOR",130,0)
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-"RTN","GPLACTOR",131,0)
-     ;
-"RTN","GPLACTOR",132,0)
-     ; N AMAP
-"RTN","GPLACTOR",133,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",134,0)
-     K @AMAP
-"RTN","GPLACTOR",135,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",136,0)
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
-"RTN","GPLACTOR",137,0)
-         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
-"RTN","GPLACTOR",138,0)
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-"RTN","GPLACTOR",139,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",140,0)
-     Q
-"RTN","GPLACTOR",141,0)
-     ;
-"RTN","GPLACTOR",142,0)
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-"RTN","GPLACTOR",143,0)
-     ;
-"RTN","GPLACTOR",144,0)
-     ; N AMAP
-"RTN","GPLACTOR",145,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",146,0)
-     K @AMAP
-"RTN","GPLACTOR",147,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",148,0)
-     S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","GPLACTOR",149,0)
-     S @AMAP@("ACTORRELATION")=""
-"RTN","GPLACTOR",150,0)
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-"RTN","GPLACTOR",151,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",152,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",153,0)
-     Q
-"RTN","GPLACTOR",154,0)
-     ;
-"RTN","GPLACTOR",155,0)
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-"RTN","GPLACTOR",156,0)
-     ;
-"RTN","GPLACTOR",157,0)
-     ; N AMAP
-"RTN","GPLACTOR",158,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",159,0)
-     K @AMAP
-"RTN","GPLACTOR",160,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",161,0)
-     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
-"RTN","GPLACTOR",162,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",163,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",164,0)
-     Q
-"RTN","GPLACTOR",165,0)
-     ;
-"RTN","GPLACTOR",166,0)
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-"RTN","GPLACTOR",167,0)
-     ;
-"RTN","GPLACTOR",168,0)
-     ; N AMAP
-"RTN","GPLACTOR",169,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",170,0)
-     K @AMAP
-"RTN","GPLACTOR",171,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",172,0)
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
-"RTN","GPLACTOR",173,0)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",174,0)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
-"RTN","GPLACTOR",175,0)
-         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",176,0)
-         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
-"RTN","GPLACTOR",177,0)
-         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
-"RTN","GPLACTOR",178,0)
-         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
-"RTN","GPLACTOR",179,0)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
-"RTN","GPLACTOR",180,0)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",181,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
-"RTN","GPLACTOR",182,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
-"RTN","GPLACTOR",183,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
-"RTN","GPLACTOR",184,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
-"RTN","GPLACTOR",185,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","GPLACTOR",186,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","GPLACTOR",187,0)
-     S ZX=$$TEL^CCRVA200(AIEN)
-"RTN","GPLACTOR",188,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","GPLACTOR",189,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","GPLACTOR",190,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",191,0)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
-"RTN","GPLACTOR",192,0)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",193,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",194,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",195,0)
-     Q
-"RTN","GPLACTOR",196,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 10
-"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 10
-"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^B82192762
-"RTN","GPLCCR",1,0)
-GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-"RTN","GPLCCR",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 10
-"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)
-       I '$D(DIR) S DIR=""
-"RTN","GPLCCR",35,0)
-       I '$D(FN) S FN=""
-"RTN","GPLCCR",36,0)
-       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-"RTN","GPLCCR",37,0)
-       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
-"RTN","GPLCCR",38,0)
-       S ONAM=FN
-"RTN","GPLCCR",39,0)
-       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_5.xml"
-"RTN","GPLCCR",40,0)
-       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
-"RTN","GPLCCR",41,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","GPLCCR",42,0)
-       . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","GPLCCR",43,0)
-       . ;S @ODIRGLB="/home/cedwards/"
-"RTN","GPLCCR",44,0)
-       . S @ODIRGLB="/opt/wv/p/"
-"RTN","GPLCCR",45,0)
-       S ODIR=DIR
-"RTN","GPLCCR",46,0)
-       I DIR="" S ODIR=@ODIRGLB
-"RTN","GPLCCR",47,0)
-       N ZY
-"RTN","GPLCCR",48,0)
-       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-"RTN","GPLCCR",49,0)
-       W !,$P(ZY,U,2),!
-"RTN","GPLCCR",50,0)
-       Q
-"RTN","GPLCCR",51,0)
-       ;
-"RTN","GPLCCR",52,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","GPLCCR",53,0)
-    ;
-"RTN","GPLCCR",54,0)
-    N G1
-"RTN","GPLCCR",55,0)
-    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
-"RTN","GPLCCR",56,0)
-    I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","GPLCCR",57,0)
-    . D PARY^GPLXPATH(G1)
-"RTN","GPLCCR",58,0)
-    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
-"RTN","GPLCCR",59,0)
-    Q
-"RTN","GPLCCR",60,0)
-    ;
-"RTN","GPLCCR",61,0)
-CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","GPLCCR",62,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-"RTN","GPLCCR",63,0)
-    ; DFN IS PATIENT IEN
-"RTN","GPLCCR",64,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","GPLCCR",65,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","GPLCCR",66,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-"RTN","GPLCCR",67,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-"RTN","GPLCCR",68,0)
-    ; - NULL MEANS NOW
-"RTN","GPLCCR",69,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-"RTN","GPLCCR",70,0)
-    ;    "TO" VARIABLES
-"RTN","GPLCCR",71,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-"RTN","GPLCCR",72,0)
-    I '$D(DEBUG) S DEBUG=0
-"RTN","GPLCCR",73,0)
-    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","GPLCCR",74,0)
-    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","GPLCCR",75,0)
-    I '$D(TESTALERT) S TESTALERT=0 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","GPLCCR",76,0)
-    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
-"RTN","GPLCCR",77,0)
-    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","GPLCCR",78,0)
-    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","GPLCCR",79,0)
-    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","GPLCCR",80,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","GPLCCR",81,0)
-    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-"RTN","GPLCCR",82,0)
-    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","GPLCCR",83,0)
-    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","GPLCCR",84,0)
-    ;
-"RTN","GPLCCR",85,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","GPLCCR",86,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","GPLCCR",87,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",88,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",89,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","GPLCCR",90,0)
-    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","GPLCCR",91,0)
-    ;
-"RTN","GPLCCR",92,0)
-    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-"RTN","GPLCCR",93,0)
-    ;
-"RTN","GPLCCR",94,0)
-    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","GPLCCR",95,0)
-    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","GPLCCR",96,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","GPLCCR",97,0)
-    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","GPLCCR",98,0)
-    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","GPLCCR",99,0)
-    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","GPLCCR",100,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","GPLCCR",101,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","GPLCCR",102,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","GPLCCR",103,0)
-    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","GPLCCR",104,0)
-    . S IXML="INXML"
-"RTN","GPLCCR",105,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","GPLCCR",106,0)
-    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","GPLCCR",107,0)
-    . ; W OXML,!
-"RTN","GPLCCR",108,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","GPLCCR",109,0)
-    . I DEBUG W "RUNNING ",CALL,!
-"RTN","GPLCCR",110,0)
-    . X CALL
-"RTN","GPLCCR",111,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","GPLCCR",112,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-"RTN","GPLCCR",113,0)
-    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",114,0)
-    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-"RTN","GPLCCR",115,0)
-    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","GPLCCR",116,0)
-    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","GPLCCR",117,0)
-    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","GPLCCR",118,0)
-    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",119,0)
-    N TRIMI,J,DONE S DONE=0
-"RTN","GPLCCR",120,0)
-    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","GPLCCR",121,0)
-    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","GPLCCR",122,0)
-    . I DEBUG W "TRIMMED",J,!
-"RTN","GPLCCR",123,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","GPLCCR",124,0)
-    Q
-"RTN","GPLCCR",125,0)
-    ;
-"RTN","GPLCCR",126,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","GPLCCR",127,0)
-    ; TAB IS PASSED BY NAME
-"RTN","GPLCCR",128,0)
-    I DEBUG W "TAB= ",TAB,!
-"RTN","GPLCCR",129,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","GPLCCR",130,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","GPLCCR",131,0)
-    I TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS1;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",132,0)
-    I 'TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",133,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
-"RTN","GPLCCR",134,0)
-    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
-"RTN","GPLCCR",135,0)
-    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
-"RTN","GPLCCR",136,0)
-    Q
-"RTN","GPLCCR",137,0)
-    ;
-"RTN","GPLCCR",138,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","GPLCCR",139,0)
-    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
-"RTN","GPLCCR",140,0)
-    ; K @VMAP
-"RTN","GPLCCR",141,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
-"RTN","GPLCCR",142,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","GPLCCR",143,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","GPLCCR",144,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","GPLCCR",145,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","GPLCCR",146,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-"RTN","GPLCCR",147,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",148,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",149,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","GPLCCR",150,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","GPLCCR",151,0)
-    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","GPLCCR",152,0)
-    N CTMP
-"RTN","GPLCCR",153,0)
-    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-"RTN","GPLCCR",154,0)
-    D CP^GPLXPATH("CTMP",CXML)
-"RTN","GPLCCR",155,0)
-    Q
-"RTN","GPLCCR",156,0)
-    ;
-"RTN","GPLCCR",157,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","GPLCCR",158,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","GPLCCR",159,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","GPLCCR",160,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","GPLCCR",161,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","GPLCCR",162,0)
-    ;OR INSTITUTION
-"RTN","GPLCCR",163,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","GPLCCR",164,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","GPLCCR",165,0)
-    N I,J,K,L
-"RTN","GPLCCR",166,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","GPLCCR",167,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","GPLCCR",168,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","GPLCCR",169,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","GPLCCR",170,0)
-    . . I DEBUG W "<ActorID>=>",J,!
-"RTN","GPLCCR",171,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","GPLCCR",172,0)
-    . . ;  TO GET RID OF DUPLICATES
-"RTN","GPLCCR",173,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","GPLCCR",174,0)
-    F J=0:0 D  Q:$O(K(I))=""
-"RTN","GPLCCR",175,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","GPLCCR",176,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","GPLCCR",177,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","GPLCCR",178,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","GPLCCR",179,0)
-    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","GPLCCR",180,0)
-    Q
-"RTN","GPLCCR",181,0)
-    ;
-"RTN","GPLCCR",182,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","GPLCCR",183,0)
-  D TESTALL^GPLUNIT("GPLCCR")
-"RTN","GPLCCR",184,0)
-  Q
-"RTN","GPLCCR",185,0)
-  ;
-"RTN","GPLCCR",186,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","GPLCCR",187,0)
-  N ZTMP
-"RTN","GPLCCR",188,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",189,0)
-  D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLCCR",190,0)
-  Q
-"RTN","GPLCCR",191,0)
-  ;
-"RTN","GPLCCR",192,0)
-TLIST  ; LIST THE TESTS
-"RTN","GPLCCR",193,0)
-  N ZTMP
-"RTN","GPLCCR",194,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",195,0)
-  D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLCCR",196,0)
-  Q
-"RTN","GPLCCR",197,0)
-  ;
-"RTN","GPLCCR",198,0)
- ;;><TEST>
-"RTN","GPLCCR",199,0)
- ;;><PROBLEMS>
-"RTN","GPLCCR",200,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",201,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
-"RTN","GPLCCR",202,0)
- ;;>>?@GPL@(@GPL@(0))["</Problems>"
-"RTN","GPLCCR",203,0)
- ;;><VITALS>
-"RTN","GPLCCR",204,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",205,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
-"RTN","GPLCCR",206,0)
- ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
-"RTN","GPLCCR",207,0)
- ;;><CCR>
-"RTN","GPLCCR",208,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",209,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",210,0)
- ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
-"RTN","GPLCCR",211,0)
- ;;><ACTLST>
-"RTN","GPLCCR",212,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",213,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",214,0)
- ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
-"RTN","GPLCCR",215,0)
- ;;><ACTORS>
-"RTN","GPLCCR",216,0)
- ;;>>>D ZTEST^GPLCCR("ACTLST")
-"RTN","GPLCCR",217,0)
- ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","GPLCCR",218,0)
- ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
-"RTN","GPLCCR",219,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","GPLCCR",220,0)
- ;;><TRIM>
-"RTN","GPLCCR",221,0)
- ;;>>>D ZTEST^GPLCCR("CCR")
-"RTN","GPLCCR",222,0)
- ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
-"RTN","GPLCCR",223,0)
- ;;><ALERTS>
-"RTN","GPLCCR",224,0)
- ;;>>>S TESTALERT=1
-"RTN","GPLCCR",225,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",226,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
-"RTN","GPLCCR",227,0)
- ;;>>?@GPL@(@GPL@(0))["</Alerts>"
-"RTN","GPLCCR",228,0)
- 
-"RTN","GPLCCR0")
-0^15^B654252455
-"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 10
-"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)
- ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
-"RTN","GPLCCR0",368,0)
- ;;</Frequency>
-"RTN","GPLCCR0",369,0)
- ;;<Interval>
-"RTN","GPLCCR0",370,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","GPLCCR0",371,0)
- ;;<Units>
-"RTN","GPLCCR0",372,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","GPLCCR0",373,0)
- ;;</Units>
-"RTN","GPLCCR0",374,0)
- ;;</Interval>
-"RTN","GPLCCR0",375,0)
- ;;<Duration>
-"RTN","GPLCCR0",376,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","GPLCCR0",377,0)
- ;;<Units>
-"RTN","GPLCCR0",378,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","GPLCCR0",379,0)
- ;;</Units>
-"RTN","GPLCCR0",380,0)
- ;;</Duration>
-"RTN","GPLCCR0",381,0)
- ;;<Indication>
-"RTN","GPLCCR0",382,0)
- ;;<PRNFlag>
-"RTN","GPLCCR0",383,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","GPLCCR0",384,0)
- ;;</PRNFlag>
-"RTN","GPLCCR0",385,0)
- ;;<Problem>
-"RTN","GPLCCR0",386,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",387,0)
- ;;<Type>
-"RTN","GPLCCR0",388,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","GPLCCR0",389,0)
- ;;</Type>
-"RTN","GPLCCR0",390,0)
- ;;<Description>
-"RTN","GPLCCR0",391,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","GPLCCR0",392,0)
- ;;<Code>
-"RTN","GPLCCR0",393,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","GPLCCR0",394,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",395,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","GPLCCR0",396,0)
- ;;</Code>
-"RTN","GPLCCR0",397,0)
- ;;</Description>
-"RTN","GPLCCR0",398,0)
- ;;<Source>
-"RTN","GPLCCR0",399,0)
- ;;<Actor>
-"RTN","GPLCCR0",400,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",401,0)
- ;;</Actor>
-"RTN","GPLCCR0",402,0)
- ;;</Source>
-"RTN","GPLCCR0",403,0)
- ;;</Problem>
-"RTN","GPLCCR0",404,0)
- ;;</Indication>
-"RTN","GPLCCR0",405,0)
- ;;<StopIndicator>
-"RTN","GPLCCR0",406,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","GPLCCR0",407,0)
- ;;</StopIndicator>
-"RTN","GPLCCR0",408,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","GPLCCR0",409,0)
- ;;<MultipleDirectionModifier>
-"RTN","GPLCCR0",410,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","GPLCCR0",411,0)
- ;;</MultipleDirectionModifier>
-"RTN","GPLCCR0",412,0)
- ;;</Direction>
-"RTN","GPLCCR0",413,0)
- ;;</Directions>
-"RTN","GPLCCR0",414,0)
- ;;<PatientInstructions>
-"RTN","GPLCCR0",415,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",416,0)
- ;;</PatientInstructions>
-"RTN","GPLCCR0",417,0)
- ;;<FullfillmentInstructions>
-"RTN","GPLCCR0",418,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",419,0)
- ;;</FullfillmentInstructions>
-"RTN","GPLCCR0",420,0)
- ;;<Refills>
-"RTN","GPLCCR0",421,0)
- ;;<Refill>
-"RTN","GPLCCR0",422,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","GPLCCR0",423,0)
- ;;</Refill>
-"RTN","GPLCCR0",424,0)
- ;;</Refills>
-"RTN","GPLCCR0",425,0)
- ;;</Medication>
-"RTN","GPLCCR0",426,0)
- ;;</Medications>
-"RTN","GPLCCR0",427,0)
- ;;<VitalSigns>
-"RTN","GPLCCR0",428,0)
- ;;<Result>
-"RTN","GPLCCR0",429,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",430,0)
- ;;<DateTime>
-"RTN","GPLCCR0",431,0)
- ;;<Type>
-"RTN","GPLCCR0",432,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","GPLCCR0",433,0)
- ;;</Type>
-"RTN","GPLCCR0",434,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",435,0)
- ;;</DateTime>
-"RTN","GPLCCR0",436,0)
- ;;<Description>
-"RTN","GPLCCR0",437,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",438,0)
- ;;</Description>
-"RTN","GPLCCR0",439,0)
- ;;<Source>
-"RTN","GPLCCR0",440,0)
- ;;<Actor>
-"RTN","GPLCCR0",441,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",442,0)
- ;;</Actor>
-"RTN","GPLCCR0",443,0)
- ;;</Source>
-"RTN","GPLCCR0",444,0)
- ;;<Test>
-"RTN","GPLCCR0",445,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",446,0)
- ;;<Type>
-"RTN","GPLCCR0",447,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","GPLCCR0",448,0)
- ;;</Type>
-"RTN","GPLCCR0",449,0)
- ;;<Description>
-"RTN","GPLCCR0",450,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",451,0)
- ;;<Code>
-"RTN","GPLCCR0",452,0)
- ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
-"RTN","GPLCCR0",453,0)
- ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",454,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","GPLCCR0",455,0)
- ;;</Code>
-"RTN","GPLCCR0",456,0)
- ;;</Description>
-"RTN","GPLCCR0",457,0)
- ;;<Source>
-"RTN","GPLCCR0",458,0)
- ;;<Actor>
-"RTN","GPLCCR0",459,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",460,0)
- ;;</Actor>
-"RTN","GPLCCR0",461,0)
- ;;</Source>
-"RTN","GPLCCR0",462,0)
- ;;<TestResult>
-"RTN","GPLCCR0",463,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","GPLCCR0",464,0)
- ;;<Units>
-"RTN","GPLCCR0",465,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","GPLCCR0",466,0)
- ;;</Units>
-"RTN","GPLCCR0",467,0)
- ;;</TestResult>
-"RTN","GPLCCR0",468,0)
- ;;</Test>
-"RTN","GPLCCR0",469,0)
- ;;</Result>
-"RTN","GPLCCR0",470,0)
- ;;</VitalSigns>
-"RTN","GPLCCR0",471,0)
- ;;<Results>
-"RTN","GPLCCR0",472,0)
- ;;<Result>
-"RTN","GPLCCR0",473,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",474,0)
- ;;<DateTime>
-"RTN","GPLCCR0",475,0)
- ;;<Type>
-"RTN","GPLCCR0",476,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",477,0)
- ;;</Type>
-"RTN","GPLCCR0",478,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",479,0)
- ;;</DateTime>
-"RTN","GPLCCR0",480,0)
- ;;<Description>
-"RTN","GPLCCR0",481,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",482,0)
- ;;<Code>
-"RTN","GPLCCR0",483,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","GPLCCR0",484,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",485,0)
- ;;</Code>
-"RTN","GPLCCR0",486,0)
- ;;</Description>
-"RTN","GPLCCR0",487,0)
- ;;<Status>
-"RTN","GPLCCR0",488,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","GPLCCR0",489,0)
- ;;</Status>
-"RTN","GPLCCR0",490,0)
- ;;<Source>
-"RTN","GPLCCR0",491,0)
- ;;<Actor>
-"RTN","GPLCCR0",492,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",493,0)
- ;;</Actor>
-"RTN","GPLCCR0",494,0)
- ;;</Source>
-"RTN","GPLCCR0",495,0)
- ;;<TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",496,0)
- ;;<Test>
-"RTN","GPLCCR0",497,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",498,0)
- ;;<DateTime>
-"RTN","GPLCCR0",499,0)
- ;;<Type>
-"RTN","GPLCCR0",500,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",501,0)
- ;;</Type>
-"RTN","GPLCCR0",502,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",503,0)
- ;;</DateTime>
-"RTN","GPLCCR0",504,0)
- ;;<Description>
-"RTN","GPLCCR0",505,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",506,0)
- ;;<Code>
-"RTN","GPLCCR0",507,0)
- ;;<Value>@@RESULTTESTCODE@@</Value>
-"RTN","GPLCCR0",508,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",509,0)
- ;;</Code>
-"RTN","GPLCCR0",510,0)
- ;;</Description>
-"RTN","GPLCCR0",511,0)
- ;;<Status>
-"RTN","GPLCCR0",512,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",513,0)
- ;;</Status>
-"RTN","GPLCCR0",514,0)
- ;;<Source>
-"RTN","GPLCCR0",515,0)
- ;;<Actor>
-"RTN","GPLCCR0",516,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",517,0)
- ;;</Actor>
-"RTN","GPLCCR0",518,0)
- ;;</Source>
-"RTN","GPLCCR0",519,0)
- ;;<TestResult>
-"RTN","GPLCCR0",520,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",521,0)
- ;;<Units>
-"RTN","GPLCCR0",522,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",523,0)
- ;;</Units>
-"RTN","GPLCCR0",524,0)
- ;;</TestResult>
-"RTN","GPLCCR0",525,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",526,0)
- ;;<Normal>
-"RTN","GPLCCR0",527,0)
- ;;<Description>
-"RTN","GPLCCR0",528,0)
- ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",529,0)
- ;;</Description>
-"RTN","GPLCCR0",530,0)
- ;;<Source>
-"RTN","GPLCCR0",531,0)
- ;;<Actor>
-"RTN","GPLCCR0",532,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",533,0)
- ;;</Actor>
-"RTN","GPLCCR0",534,0)
- ;;</Source>
-"RTN","GPLCCR0",535,0)
- ;;</Normal>
-"RTN","GPLCCR0",536,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",537,0)
- ;;<Flag>
-"RTN","GPLCCR0",538,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",539,0)
- ;;</Flag>
-"RTN","GPLCCR0",540,0)
- ;;</Test>
-"RTN","GPLCCR0",541,0)
- ;;</TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",542,0)
- ;;<TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",543,0)
- ;;<Test>
-"RTN","GPLCCR0",544,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",545,0)
- ;;<DateTime>
-"RTN","GPLCCR0",546,0)
- ;;<Type>
-"RTN","GPLCCR0",547,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",548,0)
- ;;</Type>
-"RTN","GPLCCR0",549,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",550,0)
- ;;</DateTime>
-"RTN","GPLCCR0",551,0)
- ;;<Description>
-"RTN","GPLCCR0",552,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",553,0)
- ;;<Code>
-"RTN","GPLCCR0",554,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",555,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",556,0)
- ;;</Code>
-"RTN","GPLCCR0",557,0)
- ;;</Description>
-"RTN","GPLCCR0",558,0)
- ;;<Status>
-"RTN","GPLCCR0",559,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",560,0)
- ;;</Status>
-"RTN","GPLCCR0",561,0)
- ;;<Source>
-"RTN","GPLCCR0",562,0)
- ;;<Actor>
-"RTN","GPLCCR0",563,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",564,0)
- ;;</Actor>
-"RTN","GPLCCR0",565,0)
- ;;</Source>
-"RTN","GPLCCR0",566,0)
- ;;<TestResult>
-"RTN","GPLCCR0",567,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",568,0)
- ;;<Units>
-"RTN","GPLCCR0",569,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",570,0)
- ;;</Units>
-"RTN","GPLCCR0",571,0)
- ;;</TestResult>
-"RTN","GPLCCR0",572,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",573,0)
- ;;<Normal>
-"RTN","GPLCCR0",574,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
-"RTN","GPLCCR0",575,0)
- ;;<Units>
-"RTN","GPLCCR0",576,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
-"RTN","GPLCCR0",577,0)
- ;;</Units>
-"RTN","GPLCCR0",578,0)
- ;;<ValueSequencePosition>1</ValueSequencePosition>
-"RTN","GPLCCR0",579,0)
- ;;<Source>
-"RTN","GPLCCR0",580,0)
- ;;<Actor>
-"RTN","GPLCCR0",581,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",582,0)
- ;;</Actor>
-"RTN","GPLCCR0",583,0)
- ;;</Source>
-"RTN","GPLCCR0",584,0)
- ;;</Normal>
-"RTN","GPLCCR0",585,0)
- ;;<Normal>
-"RTN","GPLCCR0",586,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
-"RTN","GPLCCR0",587,0)
- ;;<Units>
-"RTN","GPLCCR0",588,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
-"RTN","GPLCCR0",589,0)
- ;;</Units>
-"RTN","GPLCCR0",590,0)
- ;;<ValueSequencePosition>2</ValueSequencePosition>
-"RTN","GPLCCR0",591,0)
- ;;<VariableNomalModifier>
-"RTN","GPLCCR0",592,0)
- ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
-"RTN","GPLCCR0",593,0)
- ;;</VariableNomalModifier>
-"RTN","GPLCCR0",594,0)
- ;;<Source>
-"RTN","GPLCCR0",595,0)
- ;;<Actor>
-"RTN","GPLCCR0",596,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",597,0)
- ;;</Actor>
-"RTN","GPLCCR0",598,0)
- ;;</Source>
-"RTN","GPLCCR0",599,0)
- ;;</Normal>
-"RTN","GPLCCR0",600,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",601,0)
- ;;<Flag>
-"RTN","GPLCCR0",602,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",603,0)
- ;;</Flag>
-"RTN","GPLCCR0",604,0)
- ;;</Test>
-"RTN","GPLCCR0",605,0)
- ;;</TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",606,0)
- ;;</Result>
-"RTN","GPLCCR0",607,0)
- ;;</Results>
-"RTN","GPLCCR0",608,0)
- ;;<HealthCareProviders>
-"RTN","GPLCCR0",609,0)
- ;;<Provider>
-"RTN","GPLCCR0",610,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","GPLCCR0",611,0)
- ;;<ActorRole>
-"RTN","GPLCCR0",612,0)
- ;;<Text>Primary Provider</Text>
-"RTN","GPLCCR0",613,0)
- ;;</ActorRole>
-"RTN","GPLCCR0",614,0)
- ;;</Provider>
-"RTN","GPLCCR0",615,0)
- ;;</HealthCareProviders>
-"RTN","GPLCCR0",616,0)
- ;;</Body>
-"RTN","GPLCCR0",617,0)
- ;;<Actors>
-"RTN","GPLCCR0",618,0)
- ;;<ACTOR-PATIENT>
-"RTN","GPLCCR0",619,0)
- ;;<Actor>
-"RTN","GPLCCR0",620,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",621,0)
- ;;<Person>
-"RTN","GPLCCR0",622,0)
- ;;<Name>
-"RTN","GPLCCR0",623,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",624,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",625,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",626,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",627,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",628,0)
- ;;</Name>
-"RTN","GPLCCR0",629,0)
- ;;<DateOfBirth>
-"RTN","GPLCCR0",630,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","GPLCCR0",631,0)
- ;;</DateOfBirth>
-"RTN","GPLCCR0",632,0)
- ;;<Gender>
-"RTN","GPLCCR0",633,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","GPLCCR0",634,0)
- ;;<Code>
-"RTN","GPLCCR0",635,0)
- ;;<Value>@@ACTORGENDER@@</Value>
-"RTN","GPLCCR0",636,0)
- ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
-"RTN","GPLCCR0",637,0)
- ;;</Code>
-"RTN","GPLCCR0",638,0)
- ;;</Gender>
-"RTN","GPLCCR0",639,0)
- ;;</Person>
-"RTN","GPLCCR0",640,0)
- ;;<IDs>
-"RTN","GPLCCR0",641,0)
- ;;<Type>
-"RTN","GPLCCR0",642,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","GPLCCR0",643,0)
- ;;</Type>
-"RTN","GPLCCR0",644,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","GPLCCR0",645,0)
- ;;<Source>
-"RTN","GPLCCR0",646,0)
- ;;<Actor>
-"RTN","GPLCCR0",647,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","GPLCCR0",648,0)
- ;;</Actor>
-"RTN","GPLCCR0",649,0)
- ;;</Source>
-"RTN","GPLCCR0",650,0)
- ;;</IDs>
-"RTN","GPLCCR0",651,0)
- ;;<Address>
-"RTN","GPLCCR0",652,0)
- ;;<Type>
-"RTN","GPLCCR0",653,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",654,0)
- ;;</Type>
-"RTN","GPLCCR0",655,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",656,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","GPLCCR0",657,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",658,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",659,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","GPLCCR0",660,0)
- ;;</Address>
-"RTN","GPLCCR0",661,0)
- ;;<Telephone>
-"RTN","GPLCCR0",662,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","GPLCCR0",663,0)
- ;;<Type>
-"RTN","GPLCCR0",664,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","GPLCCR0",665,0)
- ;;</Type>
-"RTN","GPLCCR0",666,0)
- ;;</Telephone>
-"RTN","GPLCCR0",667,0)
- ;;<Telephone>
-"RTN","GPLCCR0",668,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","GPLCCR0",669,0)
- ;;<Type>
-"RTN","GPLCCR0",670,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","GPLCCR0",671,0)
- ;;</Type>
-"RTN","GPLCCR0",672,0)
- ;;</Telephone>
-"RTN","GPLCCR0",673,0)
- ;;<Telephone>
-"RTN","GPLCCR0",674,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","GPLCCR0",675,0)
- ;;<Type>
-"RTN","GPLCCR0",676,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","GPLCCR0",677,0)
- ;;</Type>
-"RTN","GPLCCR0",678,0)
- ;;</Telephone>
-"RTN","GPLCCR0",679,0)
- ;;<EMail>
-"RTN","GPLCCR0",680,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",681,0)
- ;;</EMail>
-"RTN","GPLCCR0",682,0)
- ;;<Source>
-"RTN","GPLCCR0",683,0)
- ;;<Actor>
-"RTN","GPLCCR0",684,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",685,0)
- ;;</Actor>
-"RTN","GPLCCR0",686,0)
- ;;</Source>
-"RTN","GPLCCR0",687,0)
- ;;</Actor>
-"RTN","GPLCCR0",688,0)
- ;;</ACTOR-PATIENT>
-"RTN","GPLCCR0",689,0)
- ;;<ACTOR-SYSTEM>
-"RTN","GPLCCR0",690,0)
- ;;<Actor>
-"RTN","GPLCCR0",691,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",692,0)
- ;;<InformationSystem>
-"RTN","GPLCCR0",693,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","GPLCCR0",694,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","GPLCCR0",695,0)
- ;;</InformationSystem>
-"RTN","GPLCCR0",696,0)
- ;;<Source>
-"RTN","GPLCCR0",697,0)
- ;;<Actor>
-"RTN","GPLCCR0",698,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",699,0)
- ;;</Actor>
-"RTN","GPLCCR0",700,0)
- ;;</Source>
-"RTN","GPLCCR0",701,0)
- ;;</Actor>
-"RTN","GPLCCR0",702,0)
- ;;</ACTOR-SYSTEM>
-"RTN","GPLCCR0",703,0)
- ;;<ACTOR-NOK>
-"RTN","GPLCCR0",704,0)
- ;;<Actor>
-"RTN","GPLCCR0",705,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","GPLCCR0",706,0)
- ;;<Person>
-"RTN","GPLCCR0",707,0)
- ;;<Name>
-"RTN","GPLCCR0",708,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","GPLCCR0",709,0)
- ;;</Name>
-"RTN","GPLCCR0",710,0)
- ;;</Person>
-"RTN","GPLCCR0",711,0)
- ;;<Relation>
-"RTN","GPLCCR0",712,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","GPLCCR0",713,0)
- ;;</Relation>
-"RTN","GPLCCR0",714,0)
- ;;<Source>
-"RTN","GPLCCR0",715,0)
- ;;<Actor>
-"RTN","GPLCCR0",716,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","GPLCCR0",717,0)
- ;;</Actor>
-"RTN","GPLCCR0",718,0)
- ;;</Source>
-"RTN","GPLCCR0",719,0)
- ;;</Actor>
-"RTN","GPLCCR0",720,0)
- ;;</ACTOR-NOK>
-"RTN","GPLCCR0",721,0)
- ;;<ACTOR-PROVIDER>
-"RTN","GPLCCR0",722,0)
- ;;<Actor>
-"RTN","GPLCCR0",723,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",724,0)
- ;;<Person>
-"RTN","GPLCCR0",725,0)
- ;;<Name>
-"RTN","GPLCCR0",726,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",727,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",728,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",729,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",730,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","GPLCCR0",731,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",732,0)
- ;;</Name>
-"RTN","GPLCCR0",733,0)
- ;;</Person>
-"RTN","GPLCCR0",734,0)
- ;;<IDs>
-"RTN","GPLCCR0",735,0)
- ;;<Type>
-"RTN","GPLCCR0",736,0)
- ;;<Text>@@IDTYPE@@</Text>
-"RTN","GPLCCR0",737,0)
- ;;</Type>
-"RTN","GPLCCR0",738,0)
- ;;<ID>@@ID@@</ID>
-"RTN","GPLCCR0",739,0)
- ;;<IssuedBy>
-"RTN","GPLCCR0",740,0)
- ;;<Description>
-"RTN","GPLCCR0",741,0)
- ;;<Text>@@IDDESC@@</Text>
-"RTN","GPLCCR0",742,0)
- ;;</Description>
-"RTN","GPLCCR0",743,0)
- ;;</IssuedBy>
-"RTN","GPLCCR0",744,0)
- ;;</IDs>
-"RTN","GPLCCR0",745,0)
- ;;<Specialty>
-"RTN","GPLCCR0",746,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","GPLCCR0",747,0)
- ;;</Specialty>
-"RTN","GPLCCR0",748,0)
- ;;<Address>
-"RTN","GPLCCR0",749,0)
- ;;<Type>
-"RTN","GPLCCR0",750,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",751,0)
- ;;</Type>
-"RTN","GPLCCR0",752,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",753,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",754,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",755,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","GPLCCR0",756,0)
- ;;</Address>
-"RTN","GPLCCR0",757,0)
- ;;<Telephone>
-"RTN","GPLCCR0",758,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","GPLCCR0",759,0)
- ;;<Type>
-"RTN","GPLCCR0",760,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","GPLCCR0",761,0)
- ;;</Type>
-"RTN","GPLCCR0",762,0)
- ;;</Telephone>
-"RTN","GPLCCR0",763,0)
- ;;<Email>
-"RTN","GPLCCR0",764,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",765,0)
- ;;</Email>
-"RTN","GPLCCR0",766,0)
- ;;<Source>
-"RTN","GPLCCR0",767,0)
- ;;<Actor>
-"RTN","GPLCCR0",768,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",769,0)
- ;;</Actor>
-"RTN","GPLCCR0",770,0)
- ;;</Source>
-"RTN","GPLCCR0",771,0)
- ;;</Actor>
-"RTN","GPLCCR0",772,0)
- ;;</ACTOR-PROVIDER>
-"RTN","GPLCCR0",773,0)
- ;;<ACTOR-ORG>
-"RTN","GPLCCR0",774,0)
- ;;<Actor>
-"RTN","GPLCCR0",775,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",776,0)
- ;;<Organization>
-"RTN","GPLCCR0",777,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","GPLCCR0",778,0)
- ;;</Organization>
-"RTN","GPLCCR0",779,0)
- ;;<Source>
-"RTN","GPLCCR0",780,0)
- ;;<Actor>
-"RTN","GPLCCR0",781,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",782,0)
- ;;</Actor>
-"RTN","GPLCCR0",783,0)
- ;;</Source>
-"RTN","GPLCCR0",784,0)
- ;;</Actor>
-"RTN","GPLCCR0",785,0)
- ;;</ACTOR-ORG>
-"RTN","GPLCCR0",786,0)
- ;;</Actors>
-"RTN","GPLCCR0",787,0)
- ;;<Signatures>
-"RTN","GPLCCR0",788,0)
- ;;<CCRSignature>
-"RTN","GPLCCR0",789,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","GPLCCR0",790,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","GPLCCR0",791,0)
- ;;<Source>
-"RTN","GPLCCR0",792,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","GPLCCR0",793,0)
- ;;</Source>
-"RTN","GPLCCR0",794,0)
- ;;<Signature>
-"RTN","GPLCCR0",795,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","GPLCCR0",796,0)
- ;;<SignedInfo>
-"RTN","GPLCCR0",797,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","GPLCCR0",798,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","GPLCCR0",799,0)
- ;;<Reference URI="">
-"RTN","GPLCCR0",800,0)
- ;;<Transforms>
-"RTN","GPLCCR0",801,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","GPLCCR0",802,0)
- ;;</Transforms>
-"RTN","GPLCCR0",803,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","GPLCCR0",804,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","GPLCCR0",805,0)
- ;;</Reference>
-"RTN","GPLCCR0",806,0)
- ;;</SignedInfo>
-"RTN","GPLCCR0",807,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","GPLCCR0",808,0)
- ;;<KeyInfo>
-"RTN","GPLCCR0",809,0)
- ;;<KeyValue>
-"RTN","GPLCCR0",810,0)
- ;;<RSAKeyValue>
-"RTN","GPLCCR0",811,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","GPLCCR0",812,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","GPLCCR0",813,0)
- ;;</RSAKeyValue>
-"RTN","GPLCCR0",814,0)
- ;;</KeyValue>
-"RTN","GPLCCR0",815,0)
- ;;</KeyInfo>
-"RTN","GPLCCR0",816,0)
- ;;</Signature>
-"RTN","GPLCCR0",817,0)
- ;;</Signature>
-"RTN","GPLCCR0",818,0)
- ;;</CCRSignature>
-"RTN","GPLCCR0",819,0)
- ;;</Signatures>
-"RTN","GPLCCR0",820,0)
- ;;</ContinuityOfCareRecord>
-"RTN","GPLCCR0",821,0)
- ;</TEMPLATE>
-"RTN","GPLMEDS")
-0^18^B55630630
-"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 10
-"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 HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","GPLMEDS",29,0)
-   N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","GPLMEDS",30,0)
-   ; OUTPATIENT MEDS ARE PROCESSED IN EXTRACT^CCRMEDS, ALL OTHERS HERE
-"RTN","GPLMEDS",31,0)
-   D EXTRACT^CCRMEDS(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","GPLMEDS",32,0)
-   I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","GPLMEDS",33,0)
-   . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","GPLMEDS",34,0)
-   . S MEDCNT=@MEDOUTXML@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","GPLMEDS",35,0)
-   . W "HAS ACTIVE OP MEDS",!
-"RTN","GPLMEDS",36,0)
-   N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","GPLMEDS",37,0)
-   D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","GPLMEDS",38,0)
-   I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","GPLMEDS",39,0)
-   . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","GPLMEDS",40,0)
-   . S @MEDOUTXML@(0)=0
-"RTN","GPLMEDS",41,0)
-   . Q
-"RTN","GPLMEDS",42,0)
-   ; I DEBUG ZWR MEDRSLT
-"RTN","GPLMEDS",43,0)
-   M GPLMEDS=MEDRSLT
-"RTN","GPLMEDS",44,0)
-   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","GPLMEDS",45,0)
-   S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","GPLMEDS",46,0)
-   I 'HASOP K @MEDTVMAP,@MEDTARYTMP
-"RTN","GPLMEDS",47,0)
-   ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","GPLMEDS",48,0)
-   ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","GPLMEDS",49,0)
-   N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","GPLMEDS",50,0)
-   ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","GPLMEDS",51,0)
-   S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","GPLMEDS",52,0)
-   F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","GPLMEDS",53,0)
-   . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","GPLMEDS",54,0)
-   . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","GPLMEDS",55,0)
-   . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","GPLMEDS",56,0)
-   . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","GPLMEDS",57,0)
-   . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","GPLMEDS",58,0)
-   . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","GPLMEDS",59,0)
-   . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","GPLMEDS",60,0)
-   ;ZWR ZA
-"RTN","GPLMEDS",61,0)
-   S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","GPLMEDS",62,0)
-   F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","GPLMEDS",63,0)
-   . I DEBUG W "ZI IS ",ZI,!
-"RTN","GPLMEDS",64,0)
-   . S MEDVMAP=$NA(@MEDTVMAP@(ZI+MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","GPLMEDS",65,0)
-   . K @MEDVMAP
-"RTN","GPLMEDS",66,0)
-   . I DEBUG W "VMAP= ",MEDVMAP,!
-"RTN","GPLMEDS",67,0)
-   . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","GPLMEDS",68,0)
-   . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","GPLMEDS",69,0)
-   . I $P(MEDPTMP,U,1)?1"~OP"&$P(MEDPTMP,"^",10)="ACTIVE" Q  ; SKIP OP ACTIVE
-"RTN","GPLMEDS",70,0)
-   . S @MEDVMAP@("MEDOBJECTID")="MED"_(ZI+MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","GPLMEDS",71,0)
-   . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","GPLMEDS",72,0)
-   . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","GPLMEDS",73,0)
-   . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","GPLMEDS",74,0)
-   . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","GPLMEDS",75,0)
-   . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","GPLMEDS",76,0)
-   . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","GPLMEDS",77,0)
-   . S @MEDVMAP@("MEDRXNO")=""
-"RTN","GPLMEDS",78,0)
-   . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","GPLMEDS",79,0)
-   . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","GPLMEDS",80,0)
-   . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","GPLMEDS",81,0)
-   . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","GPLMEDS",82,0)
-   . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","GPLMEDS",83,0)
-   . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","GPLMEDS",84,0)
-   . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","GPLMEDS",85,0)
-   . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","GPLMEDS",86,0)
-   . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","GPLMEDS",87,0)
-   . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","GPLMEDS",88,0)
-   . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","GPLMEDS",89,0)
-   . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","GPLMEDS",90,0)
-   . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","GPLMEDS",91,0)
-   . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","GPLMEDS",92,0)
-   . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","GPLMEDS",93,0)
-   . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","GPLMEDS",94,0)
-   . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","GPLMEDS",95,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","GPLMEDS",96,0)
-   . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","GPLMEDS",97,0)
-   . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","GPLMEDS",98,0)
-   . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","GPLMEDS",99,0)
-   . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","GPLMEDS",100,0)
-   . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","GPLMEDS",101,0)
-   . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","GPLMEDS",102,0)
-   . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","GPLMEDS",103,0)
-   . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","GPLMEDS",104,0)
-   . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","GPLMEDS",105,0)
-   . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","GPLMEDS",106,0)
-   . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","GPLMEDS",107,0)
-   . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLMEDS",108,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","GPLMEDS",109,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","GPLMEDS",110,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","GPLMEDS",111,0)
-   . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","GPLMEDS",112,0)
-   . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","GPLMEDS",113,0)
-   . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","GPLMEDS",114,0)
-   . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","GPLMEDS",115,0)
-   . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","GPLMEDS",116,0)
-   . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","GPLMEDS",117,0)
-   . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","GPLMEDS",118,0)
-   . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","GPLMEDS",119,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","GPLMEDS",120,0)
-   . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","GPLMEDS",121,0)
-   . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","GPLMEDS",122,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","GPLMEDS",123,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","GPLMEDS",124,0)
-   . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","GPLMEDS",125,0)
-   . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","GPLMEDS",126,0)
-   . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","GPLMEDS",127,0)
-   . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","GPLMEDS",128,0)
-   . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","GPLMEDS",129,0)
-   . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","GPLMEDS",130,0)
-   . S @MEDVMAP@("MEDRFNO")=""
-"RTN","GPLMEDS",131,0)
-   . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","GPLMEDS",132,0)
-   . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","GPLMEDS",133,0)
-   . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","GPLMEDS",134,0)
-   . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","GPLMEDS",135,0)
-   . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","GPLMEDS",136,0)
-   . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","GPLMEDS",137,0)
-   . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","GPLMEDS",138,0)
-   . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","GPLMEDS",139,0)
-   . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","GPLMEDS",140,0)
-   . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","GPLMEDS",141,0)
-   . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","GPLMEDS",142,0)
-   . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","GPLMEDS",143,0)
-   . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","GPLMEDS",144,0)
-   . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","GPLMEDS",145,0)
-   . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","GPLMEDS",146,0)
-   . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","GPLMEDS",147,0)
-   . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","GPLMEDS",148,0)
-   . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","GPLMEDS",149,0)
-   . K @MEDARYTMP
-"RTN","GPLMEDS",150,0)
-   . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","GPLMEDS",151,0)
-   . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","GPLMEDS",152,0)
-   . . ; W "FIRST ONE",!
-"RTN","GPLMEDS",153,0)
-   . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","GPLMEDS",154,0)
-   . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","GPLMEDS",155,0)
-   . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","GPLMEDS",156,0)
-   N MEDTMP,MEDI
-"RTN","GPLMEDS",157,0)
-   D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLMEDS",158,0)
-   I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLMEDS",159,0)
-   . W "MEDICATION MISSING ",!
-"RTN","GPLMEDS",160,0)
-   . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","GPLMEDS",161,0)
-   Q
-"RTN","GPLMEDS",162,0)
-   ;
-"RTN","GPLMEDS",163,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","GPLMEDS",164,0)
-   ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","GPLMEDS",165,0)
-   N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","GPLMEDS",166,0)
-   S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","GPLMEDS",167,0)
-   Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","GPLMEDS",168,0)
-   ;
-"RTN","GPLPROBS")
-0^11^B25875394
-"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 10
-"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)
-          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","GPLPROBS",42,0)
-          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","GPLPROBS",43,0)
-          . S VMAP=$NA(@TVMAP@(J))
-"RTN","GPLPROBS",44,0)
-          . K @VMAP
-"RTN","GPLPROBS",45,0)
-          . I DEBUG W "VMAP= ",VMAP,!
-"RTN","GPLPROBS",46,0)
-          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","GPLPROBS",47,0)
-          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","GPLPROBS",48,0)
-          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","GPLPROBS",49,0)
-          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
-"RTN","GPLPROBS",50,0)
-          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","GPLPROBS",51,0)
-          . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","GPLPROBS",52,0)
-          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","GPLPROBS",53,0)
-          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
-"RTN","GPLPROBS",54,0)
-          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
-"RTN","GPLPROBS",55,0)
-          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","GPLPROBS",56,0)
-          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","GPLPROBS",57,0)
-          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","GPLPROBS",58,0)
-          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","GPLPROBS",59,0)
-          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","GPLPROBS",60,0)
-          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","GPLPROBS",61,0)
-          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","GPLPROBS",62,0)
-          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","GPLPROBS",63,0)
-          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","GPLPROBS",64,0)
-          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","GPLPROBS",65,0)
-          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
-"RTN","GPLPROBS",66,0)
-          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
-"RTN","GPLPROBS",67,0)
-          . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","GPLPROBS",68,0)
-          . ; W "ARYTMP= ",ARYTMP,!
-"RTN","GPLPROBS",69,0)
-          . K @ARYTMP
-"RTN","GPLPROBS",70,0)
-          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","GPLPROBS",71,0)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",72,0)
-          . . ; W "FIRST ONE",!
-"RTN","GPLPROBS",73,0)
-          . . D CP^GPLXPATH(ARYTMP,OUTXML)
-"RTN","GPLPROBS",74,0)
-          . . ; W "OUTXML ",OUTXML,!
-"RTN","GPLPROBS",75,0)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLPROBS",76,0)
-          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
-"RTN","GPLPROBS",77,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
-"RTN","GPLPROBS",78,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLPROBS",79,0)
-          ; ZWR @OUTXML
-"RTN","GPLPROBS",80,0)
-          ; $$HTML^DILF(
-"RTN","GPLPROBS",81,0)
-          ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","GPLPROBS",82,0)
-          I CCD D  ; IF THIS IS FOR A CCD
-"RTN","GPLPROBS",83,0)
-          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
-"RTN","GPLPROBS",84,0)
-          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","GPLPROBS",85,0)
-          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
-"RTN","GPLPROBS",86,0)
-          . . I DEBUG W "VMAP =",VMAP,!
-"RTN","GPLPROBS",87,0)
-          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","GPLPROBS",88,0)
-          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","GPLPROBS",89,0)
-          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
-"RTN","GPLPROBS",90,0)
-          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","GPLPROBS",91,0)
-          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","GPLPROBS",92,0)
-          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",93,0)
-          . . . D CP^GPLXPATH("HOUT","HTMLO")
-"RTN","GPLPROBS",94,0)
-          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","GPLPROBS",95,0)
-          . . . I DEBUG W "DOING INNER",!
-"RTN","GPLPROBS",96,0)
-          . . . N HTMLBLD,HTMLTMP
-"RTN","GPLPROBS",97,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","GPLPROBS",98,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","GPLPROBS",99,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","GPLPROBS",100,0)
-          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
-"RTN","GPLPROBS",101,0)
-          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
-"RTN","GPLPROBS",102,0)
-          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
-"RTN","GPLPROBS",103,0)
-          . I DEBUG D PARY^GPLXPATH("HTMLO")
-"RTN","GPLPROBS",104,0)
-          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","GPLPROBS",105,0)
-          N PROBSTMP,I
-"RTN","GPLPROBS",106,0)
-          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLPROBS",107,0)
-          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLPROBS",108,0)
-          . ; STRINGS MARKED AS @@X@@
-"RTN","GPLPROBS",109,0)
-          . W !,"PROBLEMS Missing list: ",!
-"RTN","GPLPROBS",110,0)
-          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","GPLPROBS",111,0)
-          Q
-"RTN","GPLPROBS",112,0)
-          ;
-"RTN","GPLRIMA")
-0^13^B214212612
-"RTN","GPLRIMA",1,0)
-GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-"RTN","GPLRIMA",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 10
-"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)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
-"RTN","GPLRIMA",63,0)
-    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","GPLRIMA",64,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
-"RTN","GPLRIMA",65,0)
-    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","GPLRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
-"RTN","GPLRIMA",67,0)
-    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","GPLRIMA",68,0)
-    . ;
-"RTN","GPLRIMA",69,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-"RTN","GPLRIMA",70,0)
-    . ;
-"RTN","GPLRIMA",71,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-"RTN","GPLRIMA",72,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","GPLRIMA",73,0)
-    . ;
-"RTN","GPLRIMA",74,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","GPLRIMA",75,0)
-    . ;
-"RTN","GPLRIMA",76,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","GPLRIMA",77,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","GPLRIMA",78,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","GPLRIMA",79,0)
-    . ;
-"RTN","GPLRIMA",80,0)
-    . N CATNAME,CATTBL
-"RTN","GPLRIMA",81,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","GPLRIMA",82,0)
-    . S CATNAME=""
-"RTN","GPLRIMA",83,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","GPLRIMA",84,0)
-    . W "CATEGORY NAME: ",CATNAME,!
-"RTN","GPLRIMA",85,0)
-    . ;
-"RTN","GPLRIMA",86,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
-"RTN","GPLRIMA",87,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","GPLRIMA",88,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","GPLRIMA",89,0)
-    . ; AND WE SKIP IT
-"RTN","GPLRIMA",90,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","GPLRIMA",91,0)
-    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","GPLRIMA",92,0)
-    Q
-"RTN","GPLRIMA",93,0)
-    ;
-"RTN","GPLRIMA",94,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","GPLRIMA",95,0)
-    N SBASE,SATTR
-"RTN","GPLRIMA",96,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","GPLRIMA",97,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","GPLRIMA",98,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","GPLRIMA",99,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","GPLRIMA",100,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","GPLRIMA",101,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","GPLRIMA",102,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","GPLRIMA",103,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","GPLRIMA",104,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",105,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","GPLRIMA",106,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",107,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",108,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","GPLRIMA",109,0)
-    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","GPLRIMA",110,0)
-    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","GPLRIMA",111,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","GPLRIMA",112,0)
-    Q SATTR
-"RTN","GPLRIMA",113,0)
-    ;
-"RTN","GPLRIMA",114,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","GPLRIMA",115,0)
-    K ^TMP("GPLRIM","RESUME")
-"RTN","GPLRIMA",116,0)
-    K ^TMP("GPLRIM")
-"RTN","GPLRIMA",117,0)
-    Q
-"RTN","GPLRIMA",118,0)
-    ;
-"RTN","GPLRIMA",119,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","GPLRIMA",120,0)
-    ;
-"RTN","GPLRIMA",121,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",122,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","GPLRIMA",123,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","GPLRIMA",124,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","GPLRIMA",125,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","GPLRIMA",126,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","GPLRIMA",127,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","GPLRIMA",128,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","GPLRIMA",129,0)
-    . W CLIDX,!
-"RTN","GPLRIMA",130,0)
-    ; D PARY^GPLXPATH(CLBASE)
-"RTN","GPLRIMA",131,0)
-    Q
-"RTN","GPLRIMA",132,0)
-    ;
-"RTN","GPLRIMA",133,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","GPLRIMA",134,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","GPLRIMA",135,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","GPLRIMA",136,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","GPLRIMA",137,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","GPLRIMA",138,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","GPLRIMA",139,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","GPLRIMA",140,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","GPLRIMA",141,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","GPLRIMA",142,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","GPLRIMA",143,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","GPLRIMA",144,0)
-    ;
-"RTN","GPLRIMA",145,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","GPLRIMA",146,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","GPLRIMA",147,0)
-    W "CBASE: ",CCTBL,!
-"RTN","GPLRIMA",148,0)
-    ;
-"RTN","GPLRIMA",149,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","GPLRIMA",150,0)
-    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","GPLRIMA",151,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","GPLRIMA",152,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","GPLRIMA",153,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","GPLRIMA",154,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","GPLRIMA",155,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","GPLRIMA",156,0)
-    ;
-"RTN","GPLRIMA",157,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","GPLRIMA",158,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",159,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","GPLRIMA",160,0)
-    ;
-"RTN","GPLRIMA",161,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","GPLRIMA",162,0)
-    ;
-"RTN","GPLRIMA",163,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","GPLRIMA",164,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","GPLRIMA",165,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","GPLRIMA",166,0)
-    ;
-"RTN","GPLRIMA",167,0)
-    Q
-"RTN","GPLRIMA",168,0)
-    ;
-"RTN","GPLRIMA",169,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","GPLRIMA",170,0)
-    ;
-"RTN","GPLRIMA",171,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",172,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","GPLRIMA",173,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",174,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",175,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","GPLRIMA",176,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","GPLRIMA",177,0)
-    . S ZCNT=0
-"RTN","GPLRIMA",178,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","GPLRIMA",179,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","GPLRIMA",180,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","GPLRIMA",181,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","GPLRIMA",182,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",183,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","GPLRIMA",184,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","GPLRIMA",185,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","GPLRIMA",186,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","GPLRIMA",187,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","GPLRIMA",188,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","GPLRIMA",189,0)
-    Q
-"RTN","GPLRIMA",190,0)
-    ;
-"RTN","GPLRIMA",191,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","GPLRIMA",192,0)
-    ; INLST IS PASSED BY NAME
-"RTN","GPLRIMA",193,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","GPLRIMA",194,0)
-    W INLST,!
-"RTN","GPLRIMA",195,0)
-    S ZCOUNT=0
-"RTN","GPLRIMA",196,0)
-    S ZDX=""
-"RTN","GPLRIMA",197,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","GPLRIMA",198,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","GPLRIMA",199,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","GPLRIMA",200,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","GPLRIMA",201,0)
-    Q ZCOUNT
-"RTN","GPLRIMA",202,0)
-    ;
-"RTN","GPLRIMA",203,0)
-XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN 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 ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",208,0)
-    S ZI=""
-"RTN","GPLRIMA",209,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",210,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",211,0)
-    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
-"RTN","GPLRIMA",212,0)
-    Q
-"RTN","GPLRIMA",213,0)
-    ;
-"RTN","GPLRIMA",214,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","GPLRIMA",215,0)
-    ;
-"RTN","GPLRIMA",216,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",217,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",218,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","GPLRIMA",219,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",220,0)
-    S ZI=""
-"RTN","GPLRIMA",221,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",222,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",223,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","GPLRIMA",224,0)
-    . W ZI," "
-"RTN","GPLRIMA",225,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","GPLRIMA",226,0)
-    . . S ZC=0
-"RTN","GPLRIMA",227,0)
-    . . W !
-"RTN","GPLRIMA",228,0)
-    Q
-"RTN","GPLRIMA",229,0)
-    ;
-"RTN","GPLRIMA",230,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","GPLRIMA",231,0)
-    ;
-"RTN","GPLRIMA",232,0)
-    N ATTR S ATTR=""
-"RTN","GPLRIMA",233,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",234,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","GPLRIMA",235,0)
-    S ATTR=^TMP("GPLRIM","ATTR",DFN)
-"RTN","GPLRIMA",236,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","GPLRIMA",237,0)
-    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","GPLRIMA",238,0)
-    . N CAT
-"RTN","GPLRIMA",239,0)
-    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","GPLRIMA",240,0)
-    . W CAT,": ",ATTR,!
-"RTN","GPLRIMA",241,0)
-    Q
-"RTN","GPLRIMA",242,0)
-    ;
-"RTN","GPLRIMA",243,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","GPLRIMA",244,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","GPLRIMA",245,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","GPLRIMA",246,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","GPLRIMA",247,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","GPLRIMA",248,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","GPLRIMA",249,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","GPLRIMA",250,0)
-    ;
-"RTN","GPLRIMA",251,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","GPLRIMA",252,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","GPLRIMA",253,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","GPLRIMA",254,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","GPLRIMA",255,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","GPLRIMA",256,0)
-    Q
-"RTN","GPLRIMA",257,0)
-    ;
-"RTN","GPLRIMA",258,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","GPLRIMA",259,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
-"RTN","GPLRIMA",260,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","GPLRIMA",261,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","GPLRIMA",262,0)
-      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","GPLRIMA",263,0)
-      Q
-"RTN","GPLRIMA",264,0)
-      ;
-"RTN","GPLRIMA",265,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","GPLRIMA",266,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",267,0)
-      K @RIMTBL
-"RTN","GPLRIMA",268,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","GPLRIMA",269,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","GPLRIMA",270,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","GPLRIMA",271,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","GPLRIMA",272,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","GPLRIMA",273,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","GPLRIMA",274,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","GPLRIMA",275,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","GPLRIMA",276,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","GPLRIMA",277,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","GPLRIMA",278,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","GPLRIMA",279,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","GPLRIMA",280,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","GPLRIMA",281,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","GPLRIMA",282,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","GPLRIMA",283,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","GPLRIMA",284,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","GPLRIMA",285,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","GPLRIMA",286,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","GPLRIMA",287,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","GPLRIMA",288,0)
-      Q
-"RTN","GPLRIMA",289,0)
-      ;
-"RTN","GPLRIMA",290,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","GPLRIMA",291,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","GPLRIMA",292,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","GPLRIMA",293,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","GPLRIMA",294,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","GPLRIMA",295,0)
-    N USETBL
-"RTN","GPLRIMA",296,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","GPLRIMA",297,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","GPLRIMA",298,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","GPLRIMA",299,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","GPLRIMA",300,0)
-    Q
-"RTN","GPLRIMA",301,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","GPLRIMA",302,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","GPLRIMA",303,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","GPLRIMA",304,0)
-    ; IN SECTION "MEDS"
-"RTN","GPLRIMA",305,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","GPLRIMA",306,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","GPLRIMA",307,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","GPLRIMA",308,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","GPLRIMA",309,0)
-    ;
-"RTN","GPLRIMA",310,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","GPLRIMA",311,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",312,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",313,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","GPLRIMA",314,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","GPLRIMA",315,0)
-    N ZZI,ZZS
-"RTN","GPLRIMA",316,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","GPLRIMA",317,0)
-    ; ZWR @ZZS@(1)
-"RTN","GPLRIMA",318,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","GPLRIMA",319,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","GPLRIMA",320,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","GPLRIMA",321,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","GPLRIMA",322,0)
-    Q
-"RTN","GPLRIMA",323,0)
-    ;
-"RTN","GPLRIMA",324,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","GPLRIMA",325,0)
-    ;
-"RTN","GPLRIMA",326,0)
-    N ZR
-"RTN","GPLRIMA",327,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","GPLRIMA",328,0)
-    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
-"RTN","GPLRIMA",329,0)
-    E  W "NOTHING RETURNED",!
-"RTN","GPLRIMA",330,0)
-    Q
-"RTN","GPLRIMA",331,0)
-    ;
-"RTN","GPLRIMA",332,0)
-CAGET(RTN,IATTR) ;
-"RTN","GPLRIMA",333,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",334,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","GPLRIMA",335,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","GPLRIMA",336,0)
-    Q
-"RTN","GPLRIMA",337,0)
-    ;
-"RTN","GPLRIMA",338,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",339,0)
-    ;
-"RTN","GPLRIMA",340,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",341,0)
-    N ZLST
-"RTN","GPLRIMA",342,0)
-    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
-"RTN","GPLRIMA",343,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",344,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",345,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","GPLRIMA",346,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","GPLRIMA",347,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","GPLRIMA",348,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","GPLRIMA",349,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","GPLRIMA",350,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","GPLRIMA",351,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","GPLRIMA",352,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","GPLRIMA",353,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","GPLRIMA",354,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","GPLRIMA",355,0)
-    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","GPLRIMA",356,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","GPLRIMA",357,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","GPLRIMA",358,0)
-    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","GPLRIMA",359,0)
-    . S ZCNT=ZCNT+1
-"RTN","GPLRIMA",360,0)
-    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","GPLRIMA",361,0)
-    Q
-"RTN","GPLRIMA",362,0)
-    ;
-"RTN","GPLRIMA",363,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","GPLRIMA",364,0)
-    ;
-"RTN","GPLRIMA",365,0)
-    N ZR
-"RTN","GPLRIMA",366,0)
-    D PCLST(.ZR,CATTR)
-"RTN","GPLRIMA",367,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","GPLRIMA",368,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","GPLRIMA",369,0)
-    E  D  ;
-"RTN","GPLRIMA",370,0)
-    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
-"RTN","GPLRIMA",371,0)
-    . W "COUNT=",ZR(0),!
-"RTN","GPLRIMA",372,0)
-    Q
-"RTN","GPLRIMA",373,0)
-    ;
-"RTN","GPLRIMA",374,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","GPLRIMA",375,0)
-    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","GPLRIMA",376,0)
-    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","GPLRIMA",377,0)
-    ; DFN IS THE PATIENT NUMBER.
-"RTN","GPLRIMA",378,0)
-    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",379,0)
-    ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","GPLRIMA",380,0)
-    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","GPLRIMA",381,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",382,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",383,0)
-    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","GPLRIMA",384,0)
-    N ZZGI
-"RTN","GPLRIMA",385,0)
-    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","GPLRIMA",386,0)
-    . F ZZGI="PROBLEMS","VITALS","MEDS" D  ; FOR EACH SECTION
-"RTN","GPLRIMA",387,0)
-    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","GPLRIMA",388,0)
-    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","GPLRIMA",389,0)
-    Q
-"RTN","GPLRIMA",390,0)
-    ;
-"RTN","GPLRIMA",391,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","GPLRIMA",392,0)
-    ;
-"RTN","GPLRIMA",393,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","GPLRIMA",394,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","GPLRIMA",395,0)
-    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","GPLRIMA",396,0)
-    E  D  ; VARS EXIST
-"RTN","GPLRIMA",397,0)
-    . N ZGVI
-"RTN","GPLRIMA",398,0)
-    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","GPLRIMA",399,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","GPLRIMA",400,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","GPLRIMA",401,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","GPLRIMA",402,0)
-    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","GPLRIMA",403,0)
-    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
-"RTN","GPLRIMA",404,0)
-    . . ; D PARY^GPLXPATH("ZZGA")
-"RTN","GPLRIMA",405,0)
-    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","GPLRIMA",406,0)
-    Q
-"RTN","GPLRIMA",407,0)
-    ;
-"RTN","GPLRIMA",408,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
-"RTN","GPLRIMA",409,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","GPLRIMA",410,0)
-    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",411,0)
-    N GTMP
-"RTN","GPLRIMA",412,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",413,0)
-    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","GPLRIMA",414,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","GPLRIMA",415,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","GPLRIMA",416,0)
-    D PARY^GPLXPATH("GTMP")
-"RTN","GPLRIMA",417,0)
-    Q
-"RTN","GPLRIMA",418,0)
-    ;
-"RTN","GPLUNIT")
-0^10^B31438520
-"RTN","GPLUNIT",1,0)
-GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-"RTN","GPLUNIT",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 10
-"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  Q ; TEST SECTION DOESN'T EXIST
-"RTN","GPLUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","GPLUNIT",83,0)
-          N FIRST,LAST
-"RTN","GPLUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","GPLUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","GPLUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
-"RTN","GPLUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","GPLUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",89,0)
-          . . ;  W ZP,!
-"RTN","GPLUNIT",90,0)
-          . . S ZX=ZP
-"RTN","GPLUNIT",91,0)
-          . . W "RUNNING: "_ZP
-"RTN","GPLUNIT",92,0)
-          . . X ZX
-"RTN","GPLUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
-"RTN","GPLUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-"RTN","GPLUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",96,0)
-          . . S ZX="S ZR="_ZP
-"RTN","GPLUNIT",97,0)
-          . . W "TRYING: "_ZP
-"RTN","GPLUNIT",98,0)
-          . . X ZX
-"RTN","GPLUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","GPLUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-"RTN","GPLUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
-"RTN","GPLUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
-"RTN","GPLUNIT",104,0)
-          Q
-"RTN","GPLUNIT",105,0)
-          ;
-"RTN","GPLUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
-"RTN","GPLUNIT",107,0)
-          N ZTMP
-"RTN","GPLUNIT",108,0)
-          D ZLOAD(.ZTMP)
-"RTN","GPLUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
-"RTN","GPLUNIT",110,0)
-          W "PASSED: ",TPASSED,!
-"RTN","GPLUNIT",111,0)
-          W "FAILED: ",TFAILED,!
-"RTN","GPLUNIT",112,0)
-          W !
-"RTN","GPLUNIT",113,0)
-          W "THE TESTS!",!
-"RTN","GPLUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
-"RTN","GPLUNIT",115,0)
-          Q
-"RTN","GPLUNIT",116,0)
-          ;
-"RTN","GPLUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","GPLUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",119,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",120,0)
-          . D PUSH^GPLXPATH(RTN,I)
-"RTN","GPLUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",122,0)
-          Q
-"RTN","GPLUNIT",123,0)
-          ;
-"RTN","GPLUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","GPLUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","GPLUNIT",126,0)
-          S TOTP=0 S TOTF=0
-"RTN","GPLUNIT",127,0)
-          D ZLOAD^GPLUNIT("TZTMP",RNM)
-"RTN","GPLUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
-"RTN","GPLUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",131,0)
-          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
-"RTN","GPLUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
-"RTN","GPLUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
-"RTN","GPLUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","GPLUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","GPLUNIT",136,0)
-          F I=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","GPLUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","GPLUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","GPLUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","GPLUNIT",141,0)
-          Q
-"RTN","GPLUNIT",142,0)
-          ;
-"RTN","GPLUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","GPLUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-"RTN","GPLUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
-"RTN","GPLUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",147,0)
-          S K=1
-"RTN","GPLUNIT",148,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",149,0)
-          . ; W "I IS NOW=",I,!
-"RTN","GPLUNIT",150,0)
-          . W I," "
-"RTN","GPLUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",152,0)
-          . S K=K+1 I K=6  D
-"RTN","GPLUNIT",153,0)
-          . . W !
-"RTN","GPLUNIT",154,0)
-          . . S K=1
-"RTN","GPLUNIT",155,0)
-          Q
-"RTN","GPLUNIT",156,0)
-          ;
-"RTN","GPLVITAL")
-0^12^B82628966
-"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 10
-"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)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","GPLVITAL",45,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","GPLVITAL",46,0)
- . I $D(VITRSLT(VSORT(J))) D
-"RTN","GPLVITAL",47,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","GPLVITAL",48,0)
- . . K @VITVMAP
-"RTN","GPLVITAL",49,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","GPLVITAL",50,0)
- . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","GPLVITAL",51,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","GPLVITAL",52,0)
- . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","GPLVITAL",53,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","GPLVITAL",54,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","GPLVITAL",55,0)
- . . I $P(VITPTMP,U,2)="HT" D
-"RTN","GPLVITAL",56,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",57,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",58,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",59,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",60,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",61,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",62,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",63,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-"RTN","GPLVITAL",64,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",65,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",66,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",67,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",68,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","GPLVITAL",69,0)
- . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","GPLVITAL",70,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",71,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",72,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",73,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",74,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",75,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",76,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",77,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-"RTN","GPLVITAL",78,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",79,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",80,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",81,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",82,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","GPLVITAL",83,0)
- . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","GPLVITAL",84,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",85,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",86,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",87,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",88,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",89,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",90,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",91,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-"RTN","GPLVITAL",92,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",93,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",94,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",95,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",96,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",97,0)
- . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","GPLVITAL",98,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",99,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",100,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",101,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",102,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",103,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",104,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",105,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-"RTN","GPLVITAL",106,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",107,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",108,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",109,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",110,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","GPLVITAL",111,0)
- . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","GPLVITAL",112,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",113,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",114,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",115,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",116,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",117,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",118,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",119,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-"RTN","GPLVITAL",120,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",121,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",122,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",123,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",124,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",125,0)
- . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","GPLVITAL",126,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",127,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",128,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",129,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",130,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",131,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",132,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",133,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-"RTN","GPLVITAL",134,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",135,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",136,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",137,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",138,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",139,0)
- . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","GPLVITAL",140,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",141,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",142,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",143,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",144,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",145,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",146,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",147,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-"RTN","GPLVITAL",148,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",149,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",150,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",151,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",152,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",153,0)
- . . E  D
-"RTN","GPLVITAL",154,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","GPLVITAL",155,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",156,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",157,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","GPLVITAL",158,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",159,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",160,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","GPLVITAL",161,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","GPLVITAL",162,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-"RTN","GPLVITAL",163,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-"RTN","GPLVITAL",164,0)
- . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",165,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",166,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",167,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","GPLVITAL",168,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","GPLVITAL",169,0)
- . . K @VITARYTMP
-"RTN","GPLVITAL",170,0)
- . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","GPLVITAL",171,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLVITAL",172,0)
- . . . ; W "FIRST ONE",!
-"RTN","GPLVITAL",173,0)
- . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-"RTN","GPLVITAL",174,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","GPLVITAL",175,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLVITAL",176,0)
- . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-"RTN","GPLVITAL",177,0)
- ; ZWR ^TMP($J,"VITALS",*)
-"RTN","GPLVITAL",178,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLVITAL",179,0)
- I DEBUG D PARY^GPLXPATH(VITOUTXML)
-"RTN","GPLVITAL",180,0)
- N VITTMP,I
-"RTN","GPLVITAL",181,0)
- D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLVITAL",182,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLVITAL",183,0)
- . W "VITALS MISSING ",!
-"RTN","GPLVITAL",184,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","GPLVITAL",185,0)
- Q
-"RTN","GPLVITAL",186,0)
- ;
-"RTN","GPLVITAL",187,0)
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","GPLVITAL",188,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","GPLVITAL",189,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","GPLVITAL",190,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","GPLVITAL",191,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","GPLVITAL",192,0)
- F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","GPLVITAL",193,0)
- . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","GPLVITAL",194,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","GPLVITAL",195,0)
- . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","GPLVITAL",196,0)
- S VDT(0)=VTDCNT
-"RTN","GPLVITAL",197,0)
- Q
-"RTN","GPLVITAL",198,0)
- ;
-"RTN","GPLXPAT0")
-0^19^B50983429
-"RTN","GPLXPAT0",1,0)
-GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-"RTN","GPLXPAT0",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 10
-"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)
- ;;><PUSHA>
-"RTN","GPLXPAT0",193,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","GPLXPAT0",195,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","A")
-"RTN","GPLXPAT0",196,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","B")
-"RTN","GPLXPAT0",197,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","C")
-"RTN","GPLXPAT0",198,0)
- ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
-"RTN","GPLXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","GPLXPAT0",200,0)
- ;;>>?GTMP(0)=3
-"RTN","GPLXPAT0",201,0)
- ;;><H2ARY>
-"RTN","GPLXPAT0",202,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","GPLXPAT0",204,0)
- ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","GPLXPAT0",206,0)
- ;;>>?GTMP2(1)="TEST1^1"
-"RTN","GPLXPAT0",207,0)
- ;;><XVARS>
-"RTN","GPLXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",209,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
-"RTN","GPLXPAT0",210,0)
- ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",211,0)
- ;;>>?GTMP2(1)="VAR1^"
-"RTN","GPLXPAT0",212,0)
- ;;></TEST>
-"RTN","GPLXPATH")
-0^9^B241520746
-"RTN","GPLXPATH",1,0)
-GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-"RTN","GPLXPATH",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 10
-"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)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","GPLXPATH",53,0)
- ;
-"RTN","GPLXPATH",54,0)
- N ZGI
-"RTN","GPLXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
-"RTN","GPLXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
-"RTN","GPLXPATH",57,0)
- Q
-"RTN","GPLXPATH",58,0)
- ;
-"RTN","GPLXPATH",59,0)
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","GPLXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","GPLXPATH",61,0)
- S RTN=""
-"RTN","GPLXPATH",62,0)
- N I
-"RTN","GPLXPATH",63,0)
- ; W "STK= ",STK,!
-"RTN","GPLXPATH",64,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",65,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","GPLXPATH",66,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","GPLXPATH",67,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","GPLXPATH",68,0)
- Q
-"RTN","GPLXPATH",69,0)
- ;
-"RTN","GPLXPATH",70,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","GPLXPATH",71,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","GPLXPATH",72,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","GPLXPATH",73,0)
- N CUR,TMP
-"RTN","GPLXPATH",74,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","GPLXPATH",75,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","GPLXPATH",76,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","GPLXPATH",77,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","GPLXPATH",78,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","GPLXPATH",79,0)
- ; W "CUR= ",CUR,!
-"RTN","GPLXPATH",80,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","GPLXPATH",81,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","GPLXPATH",82,0)
- ; W "CUR2= ",CUR,!
-"RTN","GPLXPATH",83,0)
- Q CUR
-"RTN","GPLXPATH",84,0)
- ;
-"RTN","GPLXPATH",85,0)
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
-"RTN","GPLXPATH",86,0)
- ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
-"RTN","GPLXPATH",87,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","GPLXPATH",88,0)
- ; XML SECTION
-"RTN","GPLXPATH",89,0)
- ; ZXML IS PASSED BY NAME
-"RTN","GPLXPATH",90,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
-"RTN","GPLXPATH",91,0)
- N GPLSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","GPLXPATH",92,0)
- I '$D(@ZXML@(0))  D  ; NO XML PASSED
-"RTN","GPLXPATH",93,0)
- . W "ERROR IN XML FILE",!
-"RTN","GPLXPATH",94,0)
- S GPLSTK(0)=0 ; INITIALIZE STACK
-"RTN","GPLXPATH",95,0)
- F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","GPLXPATH",96,0)
- . S LINE=@ZXML@(I)
-"RTN","GPLXPATH",97,0)
- . ;W LINE,!
-"RTN","GPLXPATH",98,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","GPLXPATH",99,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","GPLXPATH",100,0)
- . I FOUND'=1  D
-"RTN","GPLXPATH",101,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","GPLXPATH",102,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","GPLXPATH",103,0)
- . . . ; ON THE SAME LINE
-"RTN","GPLXPATH",104,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",105,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",106,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",107,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",108,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",109,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",110,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",111,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",112,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",113,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","GPLXPATH",114,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",115,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","GPLXPATH",116,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","GPLXPATH",117,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",118,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",119,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",120,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",121,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",122,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",123,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","GPLXPATH",124,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","GPLXPATH",125,0)
- . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","GPLXPATH",126,0)
- . . . . Q
-"RTN","GPLXPATH",127,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","GPLXPATH",128,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","GPLXPATH",129,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",130,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",131,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",132,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",133,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",134,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",135,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",136,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",137,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",138,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","GPLXPATH",139,0)
- S @ZXML@("INDEXED")=""
-"RTN","GPLXPATH",140,0)
- S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
-"RTN","GPLXPATH",141,0)
- Q
-"RTN","GPLXPATH",142,0)
- ;
-"RTN","GPLXPATH",143,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","GPLXPATH",144,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","GPLXPATH",145,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","GPLXPATH",146,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","GPLXPATH",147,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","GPLXPATH",148,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","GPLXPATH",149,0)
- N TMP,I,J,QXPATH
-"RTN","GPLXPATH",150,0)
- S FIRST=1
-"RTN","GPLXPATH",151,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","GPLXPATH",152,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","GPLXPATH",153,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","GPLXPATH",154,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","GPLXPATH",155,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","GPLXPATH",156,0)
- K @OARY
-"RTN","GPLXPATH",157,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","GPLXPATH",158,0)
- S J=1
-"RTN","GPLXPATH",159,0)
- FOR I=FIRST:1:LAST  D
-"RTN","GPLXPATH",160,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","GPLXPATH",161,0)
- . S J=J+1
-"RTN","GPLXPATH",162,0)
- ; ZWR OARY
-"RTN","GPLXPATH",163,0)
- Q
-"RTN","GPLXPATH",164,0)
- ;
-"RTN","GPLXPATH",165,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","GPLXPATH",166,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",167,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",168,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","GPLXPATH",169,0)
- ;
-"RTN","GPLXPATH",170,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","GPLXPATH",171,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",172,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",173,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","GPLXPATH",174,0)
- ;
-"RTN","GPLXPATH",175,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","GPLXPATH",176,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",177,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",178,0)
- Q $P(ISTR,";",2)
-"RTN","GPLXPATH",179,0)
- ;
-"RTN","GPLXPATH",180,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","GPLXPATH",181,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",182,0)
- Q $P(ISTR,";",3)
-"RTN","GPLXPATH",183,0)
- ;
-"RTN","GPLXPATH",184,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","GPLXPATH",185,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",186,0)
- Q $P(ISTR,";",1)
-"RTN","GPLXPATH",187,0)
- ;
-"RTN","GPLXPATH",188,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","GPLXPATH",189,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","GPLXPATH",190,0)
- ; DEST IS CLEARED TO START
-"RTN","GPLXPATH",191,0)
- ; USES PUSH TO DO THE COPY
-"RTN","GPLXPATH",192,0)
- N I
-"RTN","GPLXPATH",193,0)
- K @BDEST
-"RTN","GPLXPATH",194,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","GPLXPATH",195,0)
- . N J,ATMP
-"RTN","GPLXPATH",196,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","GPLXPATH",197,0)
- . I DEBUG W "ATMP=",ATMP,!
-"RTN","GPLXPATH",198,0)
- . I DEBUG W @BLIST@(I),!
-"RTN","GPLXPATH",199,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","GPLXPATH",200,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","GPLXPATH",201,0)
- . . I DEBUG W "BDEST= ",BDEST,!
-"RTN","GPLXPATH",202,0)
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
-"RTN","GPLXPATH",203,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","GPLXPATH",204,0)
- Q
-"RTN","GPLXPATH",205,0)
- ;
-"RTN","GPLXPATH",206,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","GPLXPATH",207,0)
- ;
-"RTN","GPLXPATH",208,0)
- I DEBUG W "QUEUEING ",BLST,!
-"RTN","GPLXPATH",209,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","GPLXPATH",210,0)
- Q
-"RTN","GPLXPATH",211,0)
- ;
-"RTN","GPLXPATH",212,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","GPLXPATH",213,0)
- ; KILLS CPDEST FIRST
-"RTN","GPLXPATH",214,0)
- N CPINSTR
-"RTN","GPLXPATH",215,0)
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","GPLXPATH",216,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","GPLXPATH",217,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","GPLXPATH",218,0)
- . Q
-"RTN","GPLXPATH",219,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","GPLXPATH",220,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","GPLXPATH",221,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","GPLXPATH",222,0)
- Q
-"RTN","GPLXPATH",223,0)
- ;
-"RTN","GPLXPATH",224,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","GPLXPATH",225,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","GPLXPATH",226,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","GPLXPATH",227,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","GPLXPATH",228,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",229,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","GPLXPATH",230,0)
- . Q
-"RTN","GPLXPATH",231,0)
- I DEBUG W "DOING QOPEN",!
-"RTN","GPLXPATH",232,0)
- N S1,E1,QOT,QOTMP
-"RTN","GPLXPATH",233,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","GPLXPATH",234,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",235,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","GPLXPATH",236,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","GPLXPATH",237,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",238,0)
- . S E1=@QOXML@(0)-1
-"RTN","GPLXPATH",239,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","GPLXPATH",240,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","GPLXPATH",241,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","GPLXPATH",242,0)
- Q
-"RTN","GPLXPATH",243,0)
- ;
-"RTN","GPLXPATH",244,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","GPLXPATH",245,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","GPLXPATH",246,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","GPLXPATH",247,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","GPLXPATH",248,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","GPLXPATH",249,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",250,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","GPLXPATH",251,0)
- I DEBUG W "GOING TO CLOSE",!
-"RTN","GPLXPATH",252,0)
- N S1,E1,QCT,QCTMP
-"RTN","GPLXPATH",253,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","GPLXPATH",254,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",255,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","GPLXPATH",256,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","GPLXPATH",257,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",258,0)
- . S S1=@QCXML@(0)
-"RTN","GPLXPATH",259,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","GPLXPATH",260,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","GPLXPATH",261,0)
- Q
-"RTN","GPLXPATH",262,0)
- ;
-"RTN","GPLXPATH",263,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","GPLXPATH",264,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","GPLXPATH",265,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","GPLXPATH",266,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","GPLXPATH",267,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","GPLXPATH",268,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","GPLXPATH",269,0)
- N INSBLD,INSTMP
-"RTN","GPLXPATH",270,0)
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","GPLXPATH",271,0)
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","GPLXPATH",272,0)
- I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","GPLXPATH",273,0)
- . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","GPLXPATH",274,0)
- I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",275,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",276,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","GPLXPATH",277,0)
- . . I DEBUG D PARY^GPLXPATH("INSBLD")
-"RTN","GPLXPATH",278,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",279,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","GPLXPATH",280,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","GPLXPATH",281,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",282,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","GPLXPATH",283,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",284,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","GPLXPATH",285,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","GPLXPATH",286,0)
- . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","GPLXPATH",287,0)
- Q
-"RTN","GPLXPATH",288,0)
- ;
-"RTN","GPLXPATH",289,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","GPLXPATH",290,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","GPLXPATH",291,0)
- ;
-"RTN","GPLXPATH",292,0)
- N INNBLD,UXPATH
-"RTN","GPLXPATH",293,0)
- N INNTBUF
-"RTN","GPLXPATH",294,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","GPLXPATH",295,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","GPLXPATH",296,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","GPLXPATH",297,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","GPLXPATH",298,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","GPLXPATH",299,0)
- . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","GPLXPATH",300,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","GPLXPATH",301,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","GPLXPATH",302,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","GPLXPATH",303,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","GPLXPATH",304,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","GPLXPATH",305,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","GPLXPATH",306,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","GPLXPATH",307,0)
- Q
-"RTN","GPLXPATH",308,0)
- ;
-"RTN","GPLXPATH",309,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","GPLXPATH",310,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","GPLXPATH",311,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",312,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","GPLXPATH",313,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","GPLXPATH",314,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","GPLXPATH",315,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",316,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","GPLXPATH",317,0)
- I DEBUG D PARY("XDEST")
-"RTN","GPLXPATH",318,0)
- Q
-"RTN","GPLXPATH",319,0)
- ;
-"RTN","GPLXPATH",320,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","GPLXPATH",321,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","GPLXPATH",322,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","GPLXPATH",323,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","GPLXPATH",324,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","GPLXPATH",325,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","GPLXPATH",326,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","GPLXPATH",327,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","GPLXPATH",328,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","GPLXPATH",329,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","GPLXPATH",330,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","GPLXPATH",331,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","GPLXPATH",332,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",333,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","GPLXPATH",334,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","GPLXPATH",335,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","GPLXPATH",336,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",337,0)
- I DEBUG W "REPLACE PREBUILD",!
-"RTN","GPLXPATH",338,0)
- I DEBUG D PARY("REBLD")
-"RTN","GPLXPATH",339,0)
- D BUILD("REBLD","RTMP")
-"RTN","GPLXPATH",340,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","GPLXPATH",341,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","GPLXPATH",342,0)
- Q
-"RTN","GPLXPATH",343,0)
- ;
-"RTN","GPLXPATH",344,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","GPLXPATH",345,0)
- ; W "Reporting on the missing",!
-"RTN","GPLXPATH",346,0)
- ; W OARY
-"RTN","GPLXPATH",347,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","GPLXPATH",348,0)
- N I
-"RTN","GPLXPATH",349,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","GPLXPATH",350,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",351,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","GPLXPATH",352,0)
- . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","GPLXPATH",353,0)
- . . Q
-"RTN","GPLXPATH",354,0)
- Q
-"RTN","GPLXPATH",355,0)
- ;
-"RTN","GPLXPATH",356,0)
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","GPLXPATH",357,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","GPLXPATH",358,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","GPLXPATH",359,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","GPLXPATH",360,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","GPLXPATH",361,0)
- S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
-"RTN","GPLXPATH",362,0)
- F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",363,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","GPLXPATH",364,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","GPLXPATH",365,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","GPLXPATH",366,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","GPLXPATH",367,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","GPLXPATH",368,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","GPLXPATH",369,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","GPLXPATH",370,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","GPLXPATH",371,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","GPLXPATH",372,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","GPLXPATH",373,0)
- . . . . E  D DOFLD ; PROCESS A FIELD
-"RTN","GPLXPATH",374,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","GPLXPATH",375,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","GPLXPATH",376,0)
- . . I DEBUG W TSTR
-"RTN","GPLXPATH",377,0)
- I DEBUG W "MAPPED",!
-"RTN","GPLXPATH",378,0)
- Q
-"RTN","GPLXPATH",379,0)
- ;
-"RTN","GPLXPATH",380,0)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
-"RTN","GPLXPATH",381,0)
- ;
-"RTN","GPLXPATH",382,0)
- Q
-"RTN","GPLXPATH",383,0)
- ;
-"RTN","GPLXPATH",384,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","GPLXPATH",385,0)
- ; THEXML IS PASSED BY NAME
-"RTN","GPLXPATH",386,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","GPLXPATH",387,0)
- S FOUND=0
-"RTN","GPLXPATH",388,0)
- S INTXT=0
-"RTN","GPLXPATH",389,0)
- I DEBUG W "DELETING EMPTY ELEMENTS",!
-"RTN","GPLXPATH",390,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","GPLXPATH",391,0)
- . S J=@THEXML@(I)
-"RTN","GPLXPATH",392,0)
- . I J["<text>" D
-"RTN","GPLXPATH",393,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","GPLXPATH",394,0)
- . . I DEBUG W "IN HTML SECTION",!
-"RTN","GPLXPATH",395,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","GPLXPATH",396,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","GPLXPATH",397,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","GPLXPATH",398,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","GPLXPATH",399,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","GPLXPATH",400,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","GPLXPATH",401,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","GPLXPATH",402,0)
- . . . I DEBUG W I,J,JP,!
-"RTN","GPLXPATH",403,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",404,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","GPLXPATH",405,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","GPLXPATH",406,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","GPLXPATH",407,0)
- . . . I DEBUG W I,J,!
-"RTN","GPLXPATH",408,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",409,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","GPLXPATH",410,0)
- . . . I JM=JPX D  ;
-"RTN","GPLXPATH",411,0)
- . . . . I DEBUG W I,JM_J_JPX,!
-"RTN","GPLXPATH",412,0)
- . . . . S DEL(I-1)=""
-"RTN","GPLXPATH",413,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","GPLXPATH",414,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","GPLXPATH",415,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","GPLXPATH",416,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","GPLXPATH",417,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","GPLXPATH",418,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","GPLXPATH",419,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","GPLXPATH",420,0)
- Q FOUND
-"RTN","GPLXPATH",421,0)
- ;
-"RTN","GPLXPATH",422,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","GPLXPATH",423,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","GPLXPATH",424,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",425,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","GPLXPATH",426,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",427,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","GPLXPATH",428,0)
- Q
-"RTN","GPLXPATH",429,0)
- ;
-"RTN","GPLXPATH",430,0)
-PARY(GLO)       ;PRINT AN ARRAY
-"RTN","GPLXPATH",431,0)
- N I
-"RTN","GPLXPATH",432,0)
- F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
-"RTN","GPLXPATH",433,0)
- Q
-"RTN","GPLXPATH",434,0)
- ;
-"RTN","GPLXPATH",435,0)
-H2ARY(IARYRTN,IHASH) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","GPLXPATH",436,0)
- ;
-"RTN","GPLXPATH",437,0)
- N H2I S H2I=""
-"RTN","GPLXPATH",438,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","GPLXPATH",439,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","GPLXPATH",440,0)
- . ; W H2I_"^"_@IHASH@(H2I),!
-"RTN","GPLXPATH",441,0)
- . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
-"RTN","GPLXPATH",442,0)
- . . W "GPLZZ",!
-"RTN","GPLXPATH",443,0)
- . . W $NA(@IHASH@(H2I)),!
-"RTN","GPLXPATH",444,0)
- . . Q  ;
-"RTN","GPLXPATH",445,0)
- . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
-"RTN","GPLXPATH",446,0)
- . ; W @IARYRTN@(0),!
-"RTN","GPLXPATH",447,0)
- Q
-"RTN","GPLXPATH",448,0)
- ;
-"RTN","GPLXPATH",449,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","GPLXPATH",450,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","GPLXPATH",451,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","GPLXPATH",452,0)
- ;
-"RTN","GPLXPATH",453,0)
- N XVI,XVTMP,XVT
-"RTN","GPLXPATH",454,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","GPLXPATH",455,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","GPLXPATH",456,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
-"RTN","GPLXPATH",457,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","GPLXPATH",458,0)
- Q
-"RTN","GPLXPATH",459,0)
- ;
-"RTN","GPLXPATH",460,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","GPLXPATH",461,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","GPLXPATH",462,0)
- ;
-"RTN","GPLXPATH",463,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","GPLXPATH",464,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","GPLXPATH",465,0)
- . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",466,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",467,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","GPLXPATH",468,0)
- . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",469,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",470,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","GPLXPATH",471,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","GPLXPATH",472,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","GPLXPATH",473,0)
- D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","GPLXPATH",474,0)
- Q
-"RTN","GPLXPATH",475,0)
- ;
-"RTN","GPLXPATH",476,0)
-TEST     ; Run all the test cases
-"RTN","GPLXPATH",477,0)
- D TESTALL^GPLUNIT("GPLXPAT0")
-"RTN","GPLXPATH",478,0)
- Q
-"RTN","GPLXPATH",479,0)
- ;
-"RTN","GPLXPATH",480,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","GPLXPATH",481,0)
- N ZTMP
-"RTN","GPLXPATH",482,0)
- S DEBUG=1
-"RTN","GPLXPATH",483,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",484,0)
- D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLXPATH",485,0)
- Q
-"RTN","GPLXPATH",486,0)
- ;
-"RTN","GPLXPATH",487,0)
-TLIST   ; LIST THE TESTS
-"RTN","GPLXPATH",488,0)
- N ZTMP
-"RTN","GPLXPATH",489,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",490,0)
- D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLXPATH",491,0)
- Q
-"RTN","GPLXPATH",492,0)
- ;
-"VER")
-8.0^22.0
-**END**
-**END**
Index: ccr/tags/CCR_1_0_7/p/CCR_1_0_5_T4_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_5_T4_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,9700 +1,0 @@
-KIDS Distribution saved on Oct 09, 2008@16:24:27
-included missing routines
-**KIDS**:CCR*1.0*5^
-
-**INSTALL NAME**
-CCR*1.0*5
-"BLD",6955,0)
-CCR*1.0*5^^0^3081009^n
-"BLD",6955,1,0)
-^^23^23^3080923^
-"BLD",6955,1,1,0)
- 
-"BLD",6955,1,2,0)
-CCR AND CCD EXPORT TOOLS 
-"BLD",6955,1,3,0)
- 
-"BLD",6955,1,4,0)
-SINGLE XML EXPORT TO A HOST DIRECTORY AT 
-"BLD",6955,1,5,0)
- 
-"BLD",6955,1,6,0)
-BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
-"BLD",6955,1,7,0)
-DIRECTORY
-"BLD",6955,1,8,0)
- 
-"BLD",6955,1,9,0)
-EXPORT^GPLCRR FOR THE CCR
-"BLD",6955,1,10,0)
-EXPORT^GPLCCD FOR THE CCD
-"BLD",6955,1,11,0)
-XPAT^GPLCCR(DFN,"","") 
-"BLD",6955,1,12,0)
- 
-"BLD",6955,1,13,0)
-BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
-"BLD",6955,1,14,0)
- 
-"BLD",6955,1,15,0)
-ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
-"BLD",6955,1,16,0)
-RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
-"BLD",6955,1,17,0)
-ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
-"BLD",6955,1,18,0)
- 
-"BLD",6955,1,19,0)
-CLIST^GPLRIMA TO LIST CATEGORY TOTALS
-"BLD",6955,1,20,0)
-CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
-"BLD",6955,1,21,0)
-XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
-"BLD",6955,1,22,0)
- 
-"BLD",6955,1,23,0)
-TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
-"BLD",6955,4,0)
-^9.64PA^^
-"BLD",6955,6.3)
-12
-"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^21^21
-"BLD",6955,"KRN",9.8,"NM",1,0)
-CCRDPT^^0^B45805995
-"BLD",6955,"KRN",9.8,"NM",2,0)
-CCRDPTT^^0^B4791589
-"BLD",6955,"KRN",9.8,"NM",3,0)
-CCRMEDS^^0^B59807333
-"BLD",6955,"KRN",9.8,"NM",4,0)
-CCRSYS^^0^B5866233
-"BLD",6955,"KRN",9.8,"NM",5,0)
-CCRUNIT^^0^B8574
-"BLD",6955,"KRN",9.8,"NM",6,0)
-CCRUTIL^^0^B5927217
-"BLD",6955,"KRN",9.8,"NM",7,0)
-CCRVA200^^0^B35847405
-"BLD",6955,"KRN",9.8,"NM",8,0)
-GPLCCD^^0^B114413975
-"BLD",6955,"KRN",9.8,"NM",9,0)
-GPLXPATH^^0^B241520746
-"BLD",6955,"KRN",9.8,"NM",10,0)
-CCRMEDS1^^0^B80043311
-"BLD",6955,"KRN",9.8,"NM",11,0)
-CCRMEDS2^^0^B99730224
-"BLD",6955,"KRN",9.8,"NM",12,0)
-GPLUNIT^^0^B31438520
-"BLD",6955,"KRN",9.8,"NM",13,0)
-GPLCCR^^0^B82192762
-"BLD",6955,"KRN",9.8,"NM",14,0)
-GPLCCR0^^0^B654252455
-"BLD",6955,"KRN",9.8,"NM",15,0)
-GPLCCD1^^0^B100039732
-"BLD",6955,"KRN",9.8,"NM",16,0)
-GPLACTOR^^0^B52628160
-"BLD",6955,"KRN",9.8,"NM",17,0)
-GPLVITAL^^0^B82628966
-"BLD",6955,"KRN",9.8,"NM",18,0)
-GPLRIMA^^0^B214212612
-"BLD",6955,"KRN",9.8,"NM",19,0)
-GPLALERT^^0^B13662473
-"BLD",6955,"KRN",9.8,"NM",20,0)
-GPLPROBS^^0^B25875394
-"BLD",6955,"KRN",9.8,"NM",21,0)
-GPLXPAT0^^0^B50983429
-"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","CCRMEDS1",10)
-
-"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS2",11)
-
-"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",16)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLALERT",19)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",8)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",15)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",13)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",14)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",20)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",18)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",12)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",17)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",21)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
-
-"BLD",6955,"KRN",19,0)
-19
-"BLD",6955,"KRN",19,"NM",0)
-^9.68A^^
-"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")
-21
-"RTN","CCRDPT")
-0^1^B45805995
-"RTN","CCRDPT",1,0)
-CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
-"RTN","CCRDPT",2,0)
- ;;0.2;CCRCCD;;Jun 15, 2008;Build 12
-"RTN","CCRDPT",3,0)
- ;
-"RTN","CCRDPT",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRDPT",5,0)
- ; General Public License. 
-"RTN","CCRDPT",6,0)
- ; 
-"RTN","CCRDPT",7,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRDPT",8,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRDPT",9,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRDPT",10,0)
- ; GNU General Public License for more details.
-"RTN","CCRDPT",11,0)
- ; 
-"RTN","CCRDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRDPT",14,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRDPT",15,0)
- ;
-"RTN","CCRDPT",16,0)
- ; CCRDPT       CCRCCD/SMH - Routines to Extract Patient Data for
-"RTN","CCRDPT",17,0)
- ; FAMILY       Family Name
-"RTN","CCRDPT",18,0)
- ; GIVEN        Given Name
-"RTN","CCRDPT",19,0)
- ; MIDDLE       Middle Name
-"RTN","CCRDPT",20,0)
- ; SUFFIX       Suffix Name
-"RTN","CCRDPT",21,0)
- ; DISPNAME     Display Name
-"RTN","CCRDPT",22,0)
- ; DOB          Date of Birth
-"RTN","CCRDPT",23,0)
- ; GENDER       Get Gender
-"RTN","CCRDPT",24,0)
- ; SSN          Get SSN for ID
-"RTN","CCRDPT",25,0)
- ; ADDRTYPE     Get Home Address
-"RTN","CCRDPT",26,0)
- ; ADDR1        Get Home Address line 1
-"RTN","CCRDPT",27,0)
- ; ADDR2        Get Home Address line 2
-"RTN","CCRDPT",28,0)
- ; CITY         Get City for Home Address
-"RTN","CCRDPT",29,0)
- ; STATE        Get State for Home Address
-"RTN","CCRDPT",30,0)
- ; ZIP          Get Zip code for Home Address
-"RTN","CCRDPT",31,0)
- ; COUNTY       Get County for our Address
-"RTN","CCRDPT",32,0)
- ; COUNTRY      Get Country for our Address
-"RTN","CCRDPT",33,0)
- ; RESTEL       Residential Telephone
-"RTN","CCRDPT",34,0)
- ; WORKTEL      Work Telephone
-"RTN","CCRDPT",35,0)
- ; EMAIL        Email Adddress
-"RTN","CCRDPT",36,0)
- ; CELLTEL      Cell Phone
-"RTN","CCRDPT",37,0)
- ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",38,0)
- ; NOK1GIV      NOK1 Given Name
-"RTN","CCRDPT",39,0)
- ; NOK1MID      NOK1 Middle Name
-"RTN","CCRDPT",40,0)
- ; NOK1SUF      NOK1 Suffi Name
-"RTN","CCRDPT",41,0)
- ; NOK1DISP     NOK1 Display Name
-"RTN","CCRDPT",42,0)
- ; NOK1REL      NOK1 Relationship to the patient
-"RTN","CCRDPT",43,0)
- ; NOK1ADD1     NOK1 Address 1
-"RTN","CCRDPT",44,0)
- ; NOK1ADD2     NOK1 Address 2
-"RTN","CCRDPT",45,0)
- ; NOK1CITY     NOK1 City
-"RTN","CCRDPT",46,0)
- ; NOK1STAT     NOK1 State
-"RTN","CCRDPT",47,0)
- ; NOK1ZIP      NOK1 Zip Code
-"RTN","CCRDPT",48,0)
- ; NOK1HTEL     NOK1 Home Telephone
-"RTN","CCRDPT",49,0)
- ; NOK1WTEL     NOK1 Work Telephone
-"RTN","CCRDPT",50,0)
- ; NOK1SAME     Is NOK1's Address the same the patient?
-"RTN","CCRDPT",51,0)
- ; NOK2FAM      NOK2 Family Name
-"RTN","CCRDPT",52,0)
- ; NOK2GIV      NOK2 Given Name
-"RTN","CCRDPT",53,0)
- ; NOK2MID      NOK2 Middle Name
-"RTN","CCRDPT",54,0)
- ; NOK2SUF      NOK2 Suffi Name
-"RTN","CCRDPT",55,0)
- ; NOK2DISP     NOK2 Display Name
-"RTN","CCRDPT",56,0)
- ; NOK2REL      NOK2 Relationship to the patient
-"RTN","CCRDPT",57,0)
- ; NOK2ADD1     NOK2 Address 1
-"RTN","CCRDPT",58,0)
- ; NOK2ADD2     NOK2 Address 2
-"RTN","CCRDPT",59,0)
- ; NOK2CITY     NOK2 City
-"RTN","CCRDPT",60,0)
- ; NOK2STAT     NOK2 State
-"RTN","CCRDPT",61,0)
- ; NOK2ZIP      NOK2 Zip Code
-"RTN","CCRDPT",62,0)
- ; NOK2HTEL     NOK2 Home Telephone
-"RTN","CCRDPT",63,0)
- ; NOK2WTEL     NOK2 Work Telephone
-"RTN","CCRDPT",64,0)
- ; NOK2SAME     Is NOK2's Address the same the patient?
-"RTN","CCRDPT",65,0)
- ; EMERFAM      Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",66,0)
- ; EMERGIV      EMER Given Name
-"RTN","CCRDPT",67,0)
- ; EMERMID      EMER Middle Name
-"RTN","CCRDPT",68,0)
- ; EMERSUF      EMER Suffi Name
-"RTN","CCRDPT",69,0)
- ; EMERDISP     EMER Display Name
-"RTN","CCRDPT",70,0)
- ; EMERREL      EMER Relationship to the patient
-"RTN","CCRDPT",71,0)
- ; EMERADD1     EMER Address 1
-"RTN","CCRDPT",72,0)
- ; EMERADD2     EMER Address 2
-"RTN","CCRDPT",73,0)
- ; EMERCITY     EMER City
-"RTN","CCRDPT",74,0)
- ; EMERSTAT     EMER State
-"RTN","CCRDPT",75,0)
- ; EMERZIP      EMER Zip Code
-"RTN","CCRDPT",76,0)
- ; EMERHTEL     EMER Home Telephone
-"RTN","CCRDPT",77,0)
- ; EMERWTEL     EMER Work Telephone
-"RTN","CCRDPT",78,0)
- ; EMERSAME     Is EMER's Address the same the NOK?
-"RTN","CCRDPT",79,0)
- ;
-"RTN","CCRDPT",80,0)
- W "No Entry at top!" Q
-"RTN","CCRDPT",81,0)
- ;
-"RTN","CCRDPT",82,0)
- ;**Revision History**
-"RTN","CCRDPT",83,0)
- ; - June 15, 08: v0.1 using merged global
-"RTN","CCRDPT",84,0)
- ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
-"RTN","CCRDPT",85,0)
- ;
-"RTN","CCRDPT",86,0)
- ; All methods are Public and Extrinsic
-"RTN","CCRDPT",87,0)
- ; All calls use Fileman file 2 (Patient).
-"RTN","CCRDPT",88,0)
- ; You can obtain field numbers using the data dictionary
-"RTN","CCRDPT",89,0)
- ;
-"RTN","CCRDPT",90,0)
-FAMILY(DFN) ; Family Name
-"RTN","CCRDPT",91,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",92,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",93,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",94,0)
-GIVEN(DFN) ; Given Name
-"RTN","CCRDPT",95,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",96,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",97,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",98,0)
-MIDDLE(DFN) ; Middle Name
-"RTN","CCRDPT",99,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",100,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",101,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",102,0)
-SUFFIX(DFN) ; Suffi Name
-"RTN","CCRDPT",103,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",104,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",105,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",106,0)
-DISPNAME(DFN) ; Display Name
-"RTN","CCRDPT",107,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",108,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",109,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",110,0)
-DOB(DFN) ; Date of Birth
-"RTN","CCRDPT",111,0)
- N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","CCRDPT",112,0)
- ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","CCRDPT",113,0)
- Q $$FMDTOUTC^CCRUTIL(DOB,"D")
-"RTN","CCRDPT",114,0)
-GENDER(DFN) ; Gender/Sex
-"RTN","CCRDPT",115,0)
- Q $$GET1^DIQ(2,DFN,.02) ;
-"RTN","CCRDPT",116,0)
-SSN(DFN) ; SSN
-"RTN","CCRDPT",117,0)
- Q $$GET1^DIQ(2,DFN,.09)
-"RTN","CCRDPT",118,0)
-ADDRTYPE(DFN) ; Address Type
-"RTN","CCRDPT",119,0)
- ; Vista only stores a home address for the patient.
-"RTN","CCRDPT",120,0)
- Q "Home"
-"RTN","CCRDPT",121,0)
-ADDR1(DFN) ; Get Home Address line 1
-"RTN","CCRDPT",122,0)
- Q $$GET1^DIQ(2,DFN,.111)
-"RTN","CCRDPT",123,0)
-ADDR2(DFN) ; Get Home Address line 2
-"RTN","CCRDPT",124,0)
- ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","CCRDPT",125,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",126,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","CCRDPT",127,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",128,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",129,0)
-CITY(DFN) ; Get City for Home Address
-"RTN","CCRDPT",130,0)
- Q $$GET1^DIQ(2,DFN,.114)
-"RTN","CCRDPT",131,0)
-STATE(DFN) ; Get State for Home Address
-"RTN","CCRDPT",132,0)
- Q $$GET1^DIQ(2,DFN,.115)
-"RTN","CCRDPT",133,0)
-ZIP(DFN) ; Get Zip code for Home Address
-"RTN","CCRDPT",134,0)
- Q $$GET1^DIQ(2,DFN,.116)
-"RTN","CCRDPT",135,0)
-COUNTY(DFN) ; Get County for our Address
-"RTN","CCRDPT",136,0)
- Q $$GET1^DIQ(2,DFN,.117)
-"RTN","CCRDPT",137,0)
-COUNTRY(DFN) ; Get Country for our Address
-"RTN","CCRDPT",138,0)
- ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","CCRDPT",139,0)
- Q "USA"
-"RTN","CCRDPT",140,0)
-RESTEL(DFN) ; Residential Telephone
-"RTN","CCRDPT",141,0)
- Q $$GET1^DIQ(2,DFN,.131)
-"RTN","CCRDPT",142,0)
-WORKTEL(DFN) ; Work Telephone
-"RTN","CCRDPT",143,0)
- Q $$GET1^DIQ(2,DFN,.132)
-"RTN","CCRDPT",144,0)
-EMAIL(DFN) ; Email Adddress
-"RTN","CCRDPT",145,0)
- Q $$GET1^DIQ(2,DFN,.133)
-"RTN","CCRDPT",146,0)
-CELLTEL(DFN) ; Cell Phone
-"RTN","CCRDPT",147,0)
- Q $$GET1^DIQ(2,DFN,.134)
-"RTN","CCRDPT",148,0)
-NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",149,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",150,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",151,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",152,0)
-NOK1GIV(DFN) ; NOK1 Given Name
-"RTN","CCRDPT",153,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",154,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",155,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",156,0)
-NOK1MID(DFN) ; NOK1 Middle Name
-"RTN","CCRDPT",157,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",158,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",159,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",160,0)
-NOK1SUF(DFN) ; NOK1 Suffi Name
-"RTN","CCRDPT",161,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",162,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",163,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",164,0)
-NOK1DISP(DFN) ; NOK1 Display Name
-"RTN","CCRDPT",165,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",166,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",167,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",168,0)
-NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","CCRDPT",169,0)
- Q $$GET1^DIQ(2,DFN,.212)
-"RTN","CCRDPT",170,0)
-NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","CCRDPT",171,0)
- Q $$GET1^DIQ(2,DFN,.213)
-"RTN","CCRDPT",172,0)
-NOK1ADD2(DFN) ; NOK1 Address 2 
-"RTN","CCRDPT",173,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",174,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","CCRDPT",175,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",176,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",177,0)
-NOK1CITY(DFN) ; NOK1 City
-"RTN","CCRDPT",178,0)
- Q $$GET1^DIQ(2,DFN,.216)
-"RTN","CCRDPT",179,0)
-NOK1STAT(DFN) ; NOK1 State
-"RTN","CCRDPT",180,0)
- Q $$GET1^DIQ(2,DFN,.217)
-"RTN","CCRDPT",181,0)
-NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","CCRDPT",182,0)
- Q $$GET1^DIQ(2,DFN,.218)
-"RTN","CCRDPT",183,0)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","CCRDPT",184,0)
- Q $$GET1^DIQ(2,DFN,.219)
-"RTN","CCRDPT",185,0)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","CCRDPT",186,0)
- Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","CCRDPT",187,0)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","CCRDPT",188,0)
- Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","CCRDPT",189,0)
-NOK2FAM(DFN) ; NOK2 Family Name
-"RTN","CCRDPT",190,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",191,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",192,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",193,0)
-NOK2GIV(DFN) ; NOK2 Given Name
-"RTN","CCRDPT",194,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",195,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",196,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",197,0)
-NOK2MID(DFN) ; NOK2 Middle Name
-"RTN","CCRDPT",198,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",199,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",200,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",201,0)
-NOK2SUF(DFN) ; NOK2 Suffi Name
-"RTN","CCRDPT",202,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",203,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",204,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",205,0)
-NOK2DISP(DFN) ; NOK2 Display Name
-"RTN","CCRDPT",206,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",207,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",208,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",209,0)
-NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","CCRDPT",210,0)
- Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","CCRDPT",211,0)
-NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","CCRDPT",212,0)
- Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","CCRDPT",213,0)
-NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","CCRDPT",214,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",215,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","CCRDPT",216,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",217,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",218,0)
-NOK2CITY(DFN) ; NOK2 City
-"RTN","CCRDPT",219,0)
- Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","CCRDPT",220,0)
-NOK2STAT(DFN) ; NOK2 State
-"RTN","CCRDPT",221,0)
- Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","CCRDPT",222,0)
-NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","CCRDPT",223,0)
- Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","CCRDPT",224,0)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","CCRDPT",225,0)
- Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","CCRDPT",226,0)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","CCRDPT",227,0)
- Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","CCRDPT",228,0)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","CCRDPT",229,0)
- Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","CCRDPT",230,0)
-EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",231,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",232,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",233,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",234,0)
-EMERGIV(DFN) ; EMER Given Name
-"RTN","CCRDPT",235,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",236,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",237,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",238,0)
-EMERMID(DFN) ; EMER Middle Name
-"RTN","CCRDPT",239,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",240,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",241,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",242,0)
-EMERSUF(DFN) ; EMER Suffi Name
-"RTN","CCRDPT",243,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",244,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",245,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",246,0)
-EMERDISP(DFN) ; EMER Display Name
-"RTN","CCRDPT",247,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",248,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",249,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",250,0)
-EMERREL(DFN) ; EMER Relationship to the patient
-"RTN","CCRDPT",251,0)
- Q $$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",252,0)
-EMERADD1(DFN) ; EMER Address 1
-"RTN","CCRDPT",253,0)
- Q $$GET1^DIQ(2,DFN,.333)
-"RTN","CCRDPT",254,0)
-EMERADD2(DFN) ; EMER Address 2
-"RTN","CCRDPT",255,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",256,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
-"RTN","CCRDPT",257,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",258,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",259,0)
-EMERCITY(DFN) ; EMER City
-"RTN","CCRDPT",260,0)
- Q $$GET1^DIQ(2,DFN,.336)
-"RTN","CCRDPT",261,0)
-EMERSTAT(DFN) ; EMER State
-"RTN","CCRDPT",262,0)
- Q $$GET1^DIQ(2,DFN,.337)
-"RTN","CCRDPT",263,0)
-EMERZIP(DFN) ; EMER Zip Code
-"RTN","CCRDPT",264,0)
- Q $$GET1^DIQ(2,DFN,.338)
-"RTN","CCRDPT",265,0)
-EMERHTEL(DFN) ; EMER Home Telephone
-"RTN","CCRDPT",266,0)
- Q $$GET1^DIQ(2,DFN,.339)
-"RTN","CCRDPT",267,0)
-EMERWTEL(DFN) ; EMER Work Telephone
-"RTN","CCRDPT",268,0)
- Q $$GET1^DIQ(2,DFN,.33011)
-"RTN","CCRDPT",269,0)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
-"RTN","CCRDPT",270,0)
- Q $$GET1^DIQ(2,DFN,.3305)
-"RTN","CCRDPTT")
-0^2^B4791589
-"RTN","CCRDPTT",1,0)
-CCRDPTT ; Unit Tester...
-"RTN","CCRDPTT",2,0)
-  ;;0.1;CCRCCD;;Jun 15, 2008;Build 12
-"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)
-          N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
-"RTN","CCRDPTT",39,0)
-          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
-"RTN","CCRDPTT",40,0)
-          . W "valued at "
-"RTN","CCRDPTT",41,0)
-    . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
-"RTN","CCRDPTT",42,0)
-          . W !
-"RTN","CCRDPTT",43,0)
-          Q
-"RTN","CCRMEDS")
-0^3^B59807333
-"RTN","CCRMEDS",1,0)
-CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
-"RTN","CCRMEDS",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 12
-"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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS",24,0)
- ;
-"RTN","CCRMEDS",25,0)
- ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS",26,0)
- ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS",27,0)
- ;
-"RTN","CCRMEDS",28,0)
- N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","CCRMEDS",29,0)
- N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","CCRMEDS",30,0)
- ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
-"RTN","CCRMEDS",31,0)
- ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
-"RTN","CCRMEDS",32,0)
- ; NON-VA MEDS IN EXTRACT^CCRMEDS3
-"RTN","CCRMEDS",33,0)
- ; INPATIENT MEDS IN EXTRACT^CCRMEDS4
-"RTN","CCRMEDS",34,0)
- ; ALL OTHERS HERE
-"RTN","CCRMEDS",35,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",36,0)
- K @MEDTVMAP ; CLEAR VARIABLE ARRAY
-"RTN","CCRMEDS",37,0)
- S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
-"RTN","CCRMEDS",38,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",39,0)
- K @MEDTARYTMP ; KILL XML ARRAY
-"RTN","CCRMEDS",40,0)
- D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",41,0)
- I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","CCRMEDS",42,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",43,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",44,0)
- . W MEDCNT,!
-"RTN","CCRMEDS",45,0)
- . W "HAS ACTIVE OP MEDS",!
-"RTN","CCRMEDS",46,0)
- N PENDINGXML,MEDPENDING
-"RTN","CCRMEDS",47,0)
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
-"RTN","CCRMEDS",48,0)
- D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",49,0)
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
-"RTN","CCRMEDS",50,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",51,0)
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
-"RTN","CCRMEDS",52,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
-"RTN","CCRMEDS",53,0)
- . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
-"RTN","CCRMEDS",54,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",55,0)
- . ; W MEDCNT,!
-"RTN","CCRMEDS",56,0)
- . W "HAS OP PENDING MEDS",!
-"RTN","CCRMEDS",57,0)
- N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","CCRMEDS",58,0)
- D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","CCRMEDS",59,0)
- I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","CCRMEDS",60,0)
- . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","CCRMEDS",61,0)
- . S @MEDOUTXML@(0)=0
-"RTN","CCRMEDS",62,0)
- . Q
-"RTN","CCRMEDS",63,0)
- ; I DEBUG ZWR MEDRSLT
-"RTN","CCRMEDS",64,0)
- M GPLMEDS=MEDRSLT
-"RTN","CCRMEDS",65,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",66,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",67,0)
- ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
-"RTN","CCRMEDS",68,0)
- ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","CCRMEDS",69,0)
- ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","CCRMEDS",70,0)
- N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","CCRMEDS",71,0)
- ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","CCRMEDS",72,0)
- S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","CCRMEDS",73,0)
- F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","CCRMEDS",74,0)
- . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","CCRMEDS",75,0)
- . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","CCRMEDS",76,0)
- . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","CCRMEDS",77,0)
- . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","CCRMEDS",78,0)
- . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","CCRMEDS",79,0)
- . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","CCRMEDS",80,0)
- . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","CCRMEDS",81,0)
- ;ZWR ZA
-"RTN","CCRMEDS",82,0)
- ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","CCRMEDS",83,0)
- F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","CCRMEDS",84,0)
- . I DEBUG W "ZI IS ",ZI,!
-"RTN","CCRMEDS",85,0)
- . ; W ZI," ",MEDCNT,!
-"RTN","CCRMEDS",86,0)
- . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","CCRMEDS",87,0)
- . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","CCRMEDS",88,0)
- . I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
-"RTN","CCRMEDS",89,0)
- . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
-"RTN","CCRMEDS",90,0)
- . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","CCRMEDS",91,0)
- . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
-"RTN","CCRMEDS",92,0)
- . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","CCRMEDS",93,0)
- . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","CCRMEDS",94,0)
- . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","CCRMEDS",95,0)
- . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","CCRMEDS",96,0)
- . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS",97,0)
- . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS",98,0)
- . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS",99,0)
- . S @MEDVMAP@("MEDRXNO")=""
-"RTN","CCRMEDS",100,0)
- . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","CCRMEDS",101,0)
- . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","CCRMEDS",102,0)
- . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","CCRMEDS",103,0)
- . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","CCRMEDS",104,0)
- . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","CCRMEDS",105,0)
- . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","CCRMEDS",106,0)
- . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","CCRMEDS",107,0)
- . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","CCRMEDS",108,0)
- . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","CCRMEDS",109,0)
- . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","CCRMEDS",110,0)
- . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","CCRMEDS",111,0)
- . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","CCRMEDS",112,0)
- . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","CCRMEDS",113,0)
- . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS",114,0)
- . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS",115,0)
- . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS",116,0)
- . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS",117,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS",118,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS",119,0)
- . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS",120,0)
- . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS",121,0)
- . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","CCRMEDS",122,0)
- . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","CCRMEDS",123,0)
- . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","CCRMEDS",124,0)
- . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","CCRMEDS",125,0)
- . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","CCRMEDS",126,0)
- . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","CCRMEDS",127,0)
- . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS",128,0)
- . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","CCRMEDS",129,0)
- . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","CCRMEDS",130,0)
- . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","CCRMEDS",131,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","CCRMEDS",132,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","CCRMEDS",133,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","CCRMEDS",134,0)
- . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","CCRMEDS",135,0)
- . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","CCRMEDS",136,0)
- . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","CCRMEDS",137,0)
- . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","CCRMEDS",138,0)
- . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","CCRMEDS",139,0)
- . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","CCRMEDS",140,0)
- . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","CCRMEDS",141,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","CCRMEDS",142,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS",143,0)
- . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS",144,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","CCRMEDS",145,0)
- . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","CCRMEDS",146,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","CCRMEDS",147,0)
- . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","CCRMEDS",148,0)
- . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","CCRMEDS",149,0)
- . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","CCRMEDS",150,0)
- . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","CCRMEDS",151,0)
- . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","CCRMEDS",152,0)
- . S @MEDVMAP@("MEDRFNO")=""
-"RTN","CCRMEDS",153,0)
- . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","CCRMEDS",154,0)
- . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","CCRMEDS",155,0)
- . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","CCRMEDS",156,0)
- . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","CCRMEDS",157,0)
- . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","CCRMEDS",158,0)
- . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","CCRMEDS",159,0)
- . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","CCRMEDS",160,0)
- . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","CCRMEDS",161,0)
- . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","CCRMEDS",162,0)
- . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","CCRMEDS",163,0)
- . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","CCRMEDS",164,0)
- . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","CCRMEDS",165,0)
- . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","CCRMEDS",166,0)
- . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","CCRMEDS",167,0)
- . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","CCRMEDS",168,0)
- . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","CCRMEDS",169,0)
- . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","CCRMEDS",170,0)
- . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","CCRMEDS",171,0)
- . K @MEDARYTMP
-"RTN","CCRMEDS",172,0)
- . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","CCRMEDS",173,0)
- . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","CCRMEDS",174,0)
- . . ; W "FIRST ONE",!
-"RTN","CCRMEDS",175,0)
- . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","CCRMEDS",176,0)
- . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","CCRMEDS",177,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","CCRMEDS",178,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS",179,0)
- D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS",180,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS",181,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS",182,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS",183,0)
- Q
-"RTN","CCRMEDS",184,0)
- ;
-"RTN","CCRMEDS",185,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","CCRMEDS",186,0)
- ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","CCRMEDS",187,0)
- N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","CCRMEDS",188,0)
- S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","CCRMEDS",189,0)
- Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","CCRMEDS",190,0)
- ;
-"RTN","CCRMEDS1")
-0^10^B80043311
-"RTN","CCRMEDS1",1,0)
-CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
-"RTN","CCRMEDS1",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 12
-"RTN","CCRMEDS1",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRMEDS1",4,0)
- ; General Public License See attached copy of the License.
-"RTN","CCRMEDS1",5,0)
- ;
-"RTN","CCRMEDS1",6,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","CCRMEDS1",7,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","CCRMEDS1",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","CCRMEDS1",9,0)
- ; (at your option) any later version.
-"RTN","CCRMEDS1",10,0)
- ;
-"RTN","CCRMEDS1",11,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRMEDS1",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRMEDS1",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRMEDS1",14,0)
- ; GNU General Public License for more details.
-"RTN","CCRMEDS1",15,0)
- ;
-"RTN","CCRMEDS1",16,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRMEDS1",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRMEDS1",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRMEDS1",19,0)
- ;
-"RTN","CCRMEDS1",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","CCRMEDS1",21,0)
- Q
-"RTN","CCRMEDS1",22,0)
- ;
-"RTN","CCRMEDS1",23,0)
-EXTRACT(MINXML,DFN,OUTXML)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS1",24,0)
- ;
-"RTN","CCRMEDS1",25,0)
- ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS1",26,0)
- ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS1",27,0)
- ;
-"RTN","CCRMEDS1",28,0)
- ; MEDS is return array from RPC.
-"RTN","CCRMEDS1",29,0)
- ; MAP is a mapping variable map (store result) for each med
-"RTN","CCRMEDS1",30,0)
- ; MED is holds each array element from MEDS(J), one medicine
-"RTN","CCRMEDS1",31,0)
- ; J is a counter.
-"RTN","CCRMEDS1",32,0)
- ;
-"RTN","CCRMEDS1",33,0)
- ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
-"RTN","CCRMEDS1",34,0)
- ; med data available.
-"RTN","CCRMEDS1",35,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","CCRMEDS1",36,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","CCRMEDS1",37,0)
- ; D PARY^GPLXPATH(MINXML)
-"RTN","CCRMEDS1",38,0)
- N MEDS,MAP
-"RTN","CCRMEDS1",39,0)
- K ^TMP($J)
-"RTN","CCRMEDS1",40,0)
- D RX^PSO52API(DFN,"CCDCCR")
-"RTN","CCRMEDS1",41,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","CCRMEDS1",42,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","CCRMEDS1",43,0)
- ; If it is -1, we quit.
-"RTN","CCRMEDS1",44,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-"RTN","CCRMEDS1",45,0)
- I DEBUG ZWR MEDS
-"RTN","CCRMEDS1",46,0)
- N RXIEN S RXIEN=0
-"RTN","CCRMEDS1",47,0)
- N MEDCOUNT S MEDCOUNT=0
-"RTN","CCRMEDS1",48,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
-"RTN","CCRMEDS1",49,0)
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
-"RTN","CCRMEDS1",50,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS1",51,0)
- . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS1",52,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS1",53,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS1",54,0)
- . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS
-"RTN","CCRMEDS1",55,0)
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
-"RTN","CCRMEDS1",56,0)
- . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS1",57,0)
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","CCRMEDS1",58,0)
- . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","CCRMEDS1",59,0)
- . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
-"RTN","CCRMEDS1",60,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","CCRMEDS1",61,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
-"RTN","CCRMEDS1",62,0)
- . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-"RTN","CCRMEDS1",63,0)
- . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
-"RTN","CCRMEDS1",64,0)
- . S @MAP@("MEDRXNOTXT")="Prescription Number"
-"RTN","CCRMEDS1",65,0)
- . S @MAP@("MEDRXNO")=MED(.01)
-"RTN","CCRMEDS1",66,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS1",67,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS1",68,0)
- . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
-"RTN","CCRMEDS1",69,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
-"RTN","CCRMEDS1",70,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
-"RTN","CCRMEDS1",71,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
-"RTN","CCRMEDS1",72,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS1",73,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
-"RTN","CCRMEDS1",74,0)
- . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
-"RTN","CCRMEDS1",75,0)
- . N MEDIEN S MEDIEN=$P(MED(6),U)
-"RTN","CCRMEDS1",76,0)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS1",77,0)
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS1",78,0)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","CCRMEDS1",79,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","CCRMEDS1",80,0)
- . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS1",81,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS1",82,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS1",83,0)
- . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS1",84,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS1",85,0)
- . ; Documented in the same manual.
-"RTN","CCRMEDS1",86,0)
- . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS1",87,0)
- . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS1",88,0)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS1",89,0)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS1",90,0)
- . N CONCDATA
-"RTN","CCRMEDS1",91,0)
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS1",92,0)
- . ; and this will crash the call. So...
-"RTN","CCRMEDS1",93,0)
- . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS1",94,0)
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS1",95,0)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","CCRMEDS1",96,0)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","CCRMEDS1",97,0)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","CCRMEDS1",98,0)
- . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
-"RTN","CCRMEDS1",99,0)
- . S @MAP@("MEDQUANTITYVALUE")=MED(7)
-"RTN","CCRMEDS1",100,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS1",101,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS1",102,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS1",103,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS1",104,0)
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS1",105,0)
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS1",106,0)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS1",107,0)
- . ;
-"RTN","CCRMEDS1",108,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS1",109,0)
- . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-"RTN","CCRMEDS1",110,0)
- . ; we want the compoenents.
-"RTN","CCRMEDS1",111,0)
- . ; It's in node 6 of ^PSRX(IEN)
-"RTN","CCRMEDS1",112,0)
- . ; So, here we go again
-"RTN","CCRMEDS1",113,0)
- . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
-"RTN","CCRMEDS1",114,0)
- . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
-"RTN","CCRMEDS1",115,0)
- . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
-"RTN","CCRMEDS1",116,0)
- . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
-"RTN","CCRMEDS1",117,0)
- . ;
-"RTN","CCRMEDS1",118,0)
- . N DIRNUM S DIRNUM=0 ; Sigline number
-"RTN","CCRMEDS1",119,0)
- . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
-"RTN","CCRMEDS1",120,0)
- . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
-"RTN","CCRMEDS1",121,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","CCRMEDS1",122,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","CCRMEDS1",123,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","CCRMEDS1",124,0)
- . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
-"RTN","CCRMEDS1",125,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
-"RTN","CCRMEDS1",126,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
-"RTN","CCRMEDS1",127,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","CCRMEDS1",128,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","CCRMEDS1",129,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","CCRMEDS1",130,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","CCRMEDS1",131,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
-"RTN","CCRMEDS1",132,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
-"RTN","CCRMEDS1",133,0)
- . . ; Invervals... again another call.
-"RTN","CCRMEDS1",134,0)
- . . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","CCRMEDS1",135,0)
- . . ; However, it gets translated by a call to the administration schedule file
-"RTN","CCRMEDS1",136,0)
- . . ; to see if that schedule exists.
-"RTN","CCRMEDS1",137,0)
- . . ; That's the same thing I am going to do.
-"RTN","CCRMEDS1",138,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","CCRMEDS1",139,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","CCRMEDS1",140,0)
- . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
-"RTN","CCRMEDS1",141,0)
- . . ; So...
-"RTN","CCRMEDS1",142,0)
- . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
-"RTN","CCRMEDS1",143,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","CCRMEDS1",144,0)
- . . N INTERVAL
-"RTN","CCRMEDS1",145,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","CCRMEDS1",146,0)
- . . E  D
-"RTN","CCRMEDS1",147,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","CCRMEDS1",148,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","CCRMEDS1",149,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","CCRMEDS1",150,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","CCRMEDS1",151,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
-"RTN","CCRMEDS1",152,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-"RTN","CCRMEDS1",153,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
-"RTN","CCRMEDS1",154,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS1",155,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS1",156,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS1",157,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS1",158,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS1",159,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS1",160,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS1",161,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS1",162,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","CCRMEDS1",163,0)
- . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
-"RTN","CCRMEDS1",164,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
-"RTN","CCRMEDS1",165,0)
- . ;
-"RTN","CCRMEDS1",166,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS1",167,0)
- . ;
-"RTN","CCRMEDS1",168,0)
- . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
-"RTN","CCRMEDS1",169,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
-"RTN","CCRMEDS1",170,0)
- . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
-"RTN","CCRMEDS1",171,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
-"RTN","CCRMEDS1",172,0)
- . S @MAP@("MEDRFNO")=MED(9)
-"RTN","CCRMEDS1",173,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","CCRMEDS1",174,0)
- . K @RESULT
-"RTN","CCRMEDS1",175,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS1",176,0)
- . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS1",177,0)
- . ; MAPPING DIRECTIONS
-"RTN","CCRMEDS1",178,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","CCRMEDS1",179,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","CCRMEDS1",180,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","CCRMEDS1",181,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","CCRMEDS1",182,0)
- . ; N MDZ1,MDZNA
-"RTN","CCRMEDS1",183,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","CCRMEDS1",184,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","CCRMEDS1",185,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","CCRMEDS1",186,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","CCRMEDS1",187,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","CCRMEDS1",188,0)
- . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS1",189,0)
- . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","CCRMEDS1",190,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS1",191,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS1",192,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS1",193,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS1",194,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS1",195,0)
- Q
-"RTN","CCRMEDS1",196,0)
- ;
-"RTN","CCRMEDS2")
-0^11^B99730224
-"RTN","CCRMEDS2",1,0)
-CCRMEDS2         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;08/24/08
-"RTN","CCRMEDS2",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 12
-"RTN","CCRMEDS2",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRMEDS2",4,0)
- ; General Public License See attached copy of the License.
-"RTN","CCRMEDS2",5,0)
- ;
-"RTN","CCRMEDS2",6,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","CCRMEDS2",7,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","CCRMEDS2",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","CCRMEDS2",9,0)
- ; (at your option) any later version.
-"RTN","CCRMEDS2",10,0)
- ;
-"RTN","CCRMEDS2",11,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRMEDS2",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRMEDS2",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRMEDS2",14,0)
- ; GNU General Public License for more details.
-"RTN","CCRMEDS2",15,0)
- ;
-"RTN","CCRMEDS2",16,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRMEDS2",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRMEDS2",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRMEDS2",19,0)
- ;
-"RTN","CCRMEDS2",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","CCRMEDS2",21,0)
- Q
-"RTN","CCRMEDS2",22,0)
- ;
-"RTN","CCRMEDS2",23,0)
-EXTRACT(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS2",24,0)
- ;
-"RTN","CCRMEDS2",25,0)
- ; MINXML is the Input XML Template, passed by name
-"RTN","CCRMEDS2",26,0)
- ; DFN is Patient IEN
-"RTN","CCRMEDS2",27,0)
- ; OUTXML is the resultant XML.
-"RTN","CCRMEDS2",28,0)
- ;
-"RTN","CCRMEDS2",29,0)
- ; MEDS is return array from RPC.
-"RTN","CCRMEDS2",30,0)
- ; MAP is a mapping variable map (store result) for each med
-"RTN","CCRMEDS2",31,0)
- ; MED is holds each array element from MEDS, one medicine
-"RTN","CCRMEDS2",32,0)
- ;
-"RTN","CCRMEDS2",33,0)
- ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
-"RTN","CCRMEDS2",34,0)
- ; meds data available.
-"RTN","CCRMEDS2",35,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","CCRMEDS2",36,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","CCRMEDS2",37,0)
- ; File for pending meds is 52.41
-"RTN","CCRMEDS2",38,0)
- ; Unfortuantely, API does not supply us with any useful info beyond
-"RTN","CCRMEDS2",39,0)
- ; the IEN in 52.41, and the Med Name, and route.
-"RTN","CCRMEDS2",40,0)
- ; So, most of the info is going to get pulled from 52.41.
-"RTN","CCRMEDS2",41,0)
- N MEDS,MAP
-"RTN","CCRMEDS2",42,0)
- K ^TMP($J)
-"RTN","CCRMEDS2",43,0)
- D PEN^PSO5241(DFN,"CCDCCR")
-"RTN","CCRMEDS2",44,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","CCRMEDS2",45,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","CCRMEDS2",46,0)
- ; If it is -1, we quit.
-"RTN","CCRMEDS2",47,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-"RTN","CCRMEDS2",48,0)
- I DEBUG ZWR MEDS
-"RTN","CCRMEDS2",49,0)
- N RXIEN S RXIEN=0
-"RTN","CCRMEDS2",50,0)
- N MEDCOUNT S MEDCOUNT=0
-"RTN","CCRMEDS2",51,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
-"RTN","CCRMEDS2",52,0)
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
-"RTN","CCRMEDS2",53,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS2",54,0)
- . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
-"RTN","CCRMEDS2",55,0)
- . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS2",56,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS2",57,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS2",58,0)
- . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN CCRMEDS
-"RTN","CCRMEDS2",59,0)
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
-"RTN","CCRMEDS2",60,0)
- . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS2",61,0)
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","CCRMEDS2",62,0)
- . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","CCRMEDS2",63,0)
- . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
-"RTN","CCRMEDS2",64,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","CCRMEDS2",65,0)
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
-"RTN","CCRMEDS2",66,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"))
-"RTN","CCRMEDS2",67,0)
- . ; Med never filled; next 4 fields are not applicable.
-"RTN","CCRMEDS2",68,0)
- . S @MAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS2",69,0)
- . S @MAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS2",70,0)
- . S @MAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS2",71,0)
- . S @MAP@("MEDRXNO")=""
-"RTN","CCRMEDS2",72,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS2",73,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS2",74,0)
- . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
-"RTN","CCRMEDS2",75,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
-"RTN","CCRMEDS2",76,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
-"RTN","CCRMEDS2",77,0)
- . ; NDC not supplied in API, but is rather trivial to obtain
-"RTN","CCRMEDS2",78,0)
- . ; MED(11) piece 1 has the IEN of the drug (file 50)
-"RTN","CCRMEDS2",79,0)
- . ; IEN is field 31 in the drug file.
-"RTN","CCRMEDS2",80,0)
- . N MEDIEN S MEDIEN=$P(MED(11),U)
-"RTN","CCRMEDS2",81,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E")
-"RTN","CCRMEDS2",82,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS2",83,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
-"RTN","CCRMEDS2",84,0)
- . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS2",85,0)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS2",86,0)
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS2",87,0)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","CCRMEDS2",88,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","CCRMEDS2",89,0)
- . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS2",90,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS2",91,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS2",92,0)
- . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS2",93,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS2",94,0)
- . ; Documented in the same manual.
-"RTN","CCRMEDS2",95,0)
- . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS2",96,0)
- . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS2",97,0)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS2",98,0)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS2",99,0)
- . N CONCDATA
-"RTN","CCRMEDS2",100,0)
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS2",101,0)
- . ; and this will crash the call. So...
-"RTN","CCRMEDS2",102,0)
- . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS2",103,0)
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS2",104,0)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","CCRMEDS2",105,0)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","CCRMEDS2",106,0)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","CCRMEDS2",107,0)
- . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
-"RTN","CCRMEDS2",108,0)
- . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
-"RTN","CCRMEDS2",109,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS2",110,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS2",111,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS2",112,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS2",113,0)
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS2",114,0)
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS2",115,0)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS2",116,0)
- . ;
-"RTN","CCRMEDS2",117,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS2",118,0)
- . ; Sig data is not in any API. We obtain it using the IEN from
-"RTN","CCRMEDS2",119,0)
- . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
-"RTN","CCRMEDS2",120,0)
- . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
-"RTN","CCRMEDS2",121,0)
- . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
-"RTN","CCRMEDS2",122,0)
- . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
-"RTN","CCRMEDS2",123,0)
- . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
-"RTN","CCRMEDS2",124,0)
- . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-"RTN","CCRMEDS2",125,0)
- . ; DIRNUM will be first piece for IEN.
-"RTN","CCRMEDS2",126,0)
- . ; DIRNUM is the proper Sigline numer.
-"RTN","CCRMEDS2",127,0)
- . ; SIGDATA is the simplfied array. Subscripts are really field numbers
-"RTN","CCRMEDS2",128,0)
- . ; in subfile 52.413.
-"RTN","CCRMEDS2",129,0)
- . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
-"RTN","CCRMEDS2",130,0)
- . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
-"RTN","CCRMEDS2",131,0)
- . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
-"RTN","CCRMEDS2",132,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","CCRMEDS2",133,0)
- . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
-"RTN","CCRMEDS2",134,0)
- . . ; If this is an order for a refill; it's not really a new order; move on to next
-"RTN","CCRMEDS2",135,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","CCRMEDS2",136,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","CCRMEDS2",137,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
-"RTN","CCRMEDS2",138,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
-"RTN","CCRMEDS2",139,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","CCRMEDS2",140,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","CCRMEDS2",141,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","CCRMEDS2",142,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","CCRMEDS2",143,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
-"RTN","CCRMEDS2",144,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
-"RTN","CCRMEDS2",145,0)
- . . ; Invervals... again another call.
-"RTN","CCRMEDS2",146,0)
- . . ; The schedule is a free text field
-"RTN","CCRMEDS2",147,0)
- . . ; However, it gets translated by a call to the administration
-"RTN","CCRMEDS2",148,0)
- . . ; schedule file to see if that schedule exists.
-"RTN","CCRMEDS2",149,0)
- . . ; That's the same thing I am going to do.
-"RTN","CCRMEDS2",150,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","CCRMEDS2",151,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","CCRMEDS2",152,0)
- . . ; I looked), PSSFT is the name,
-"RTN","CCRMEDS2",153,0)
- . . ; and list is the ^TMP name to store the data in.
-"RTN","CCRMEDS2",154,0)
- . . ; Also, freqency may have "PRN" in it, so strip that out
-"RTN","CCRMEDS2",155,0)
- . . N FREQ S FREQ=SIGDATA(1)
-"RTN","CCRMEDS2",156,0)
- . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
-"RTN","CCRMEDS2",157,0)
- . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
-"RTN","CCRMEDS2",158,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","CCRMEDS2",159,0)
- . . N INTERVAL
-"RTN","CCRMEDS2",160,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","CCRMEDS2",161,0)
- . . E  D
-"RTN","CCRMEDS2",162,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","CCRMEDS2",163,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","CCRMEDS2",164,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","CCRMEDS2",165,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","CCRMEDS2",166,0)
- . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
-"RTN","CCRMEDS2",167,0)
- . . N DUR S DUR=SIGDATA(2)
-"RTN","CCRMEDS2",168,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
-"RTN","CCRMEDS2",169,0)
- . . N DURUNIT S DURUNIT=$E(DUR)
-"RTN","CCRMEDS2",170,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
-"RTN","CCRMEDS2",171,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
-"RTN","CCRMEDS2",172,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS2",173,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS2",174,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS2",175,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS2",176,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS2",177,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS2",178,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS2",179,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
-"RTN","CCRMEDS2",180,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","CCRMEDS2",181,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
-"RTN","CCRMEDS2",182,0)
- . ;
-"RTN","CCRMEDS2",183,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS2",184,0)
- . ;
-"RTN","CCRMEDS2",185,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","CCRMEDS2",186,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
-"RTN","CCRMEDS2",187,0)
- . ; W @MAP@("MEDPTINSTRUCTIONS"),!
-"RTN","CCRMEDS2",188,0)
- . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
-"RTN","CCRMEDS2",189,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
-"RTN","CCRMEDS2",190,0)
- . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
-"RTN","CCRMEDS2",191,0)
- . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
-"RTN","CCRMEDS2",192,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","CCRMEDS2",193,0)
- . K @RESULT
-"RTN","CCRMEDS2",194,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS2",195,0)
- . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS2",196,0)
- . ; MAPPING DIRECTIONS
-"RTN","CCRMEDS2",197,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","CCRMEDS2",198,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","CCRMEDS2",199,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","CCRMEDS2",200,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","CCRMEDS2",201,0)
- . ; N MDZ1,MDZNA
-"RTN","CCRMEDS2",202,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","CCRMEDS2",203,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","CCRMEDS2",204,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","CCRMEDS2",205,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","CCRMEDS2",206,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","CCRMEDS2",207,0)
- . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS2",208,0)
- . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","CCRMEDS2",209,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS2",210,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS2",211,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS2",212,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS2",213,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS2",214,0)
- Q
-"RTN","CCRMEDS2",215,0)
- ;
-"RTN","CCRSYS")
-0^4^B5866233
-"RTN","CCRSYS",1,0)
-CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
-"RTN","CCRSYS",2,0)
-        ;;0.1;CCDCCR;;;Build 12
-"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 DFN="" Q 0  ; BAD DFN PASSED
-"RTN","CCRSYS",41,0)
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","CCRSYS",42,0)
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","CCRSYS",43,0)
-         ;
-"RTN","CCRSYS",44,0)
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","CCRSYS",45,0)
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","CCRSYS",46,0)
-         N DIERR,DATA
-"RTN","CCRSYS",47,0)
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","CCRSYS",48,0)
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","CCRSYS",49,0)
-         ; 1 = Test Patient
-"RTN","CCRSYS",50,0)
-         ; 0 = Non-test Patient
-"RTN","CCRSYS",51,0)
-         I DATA Q DATA
-"RTN","CCRSYS",52,0)
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","CCRSYS",53,0)
-         D CLEAN^DILF
-"RTN","CCRSYS",54,0)
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-"RTN","CCRSYS",55,0)
-         I $E(DATA,1,3)="000" Q 1
-"RTN","CCRSYS",56,0)
-         I $E(DATA,1,3)="666" Q 1
-"RTN","CCRSYS",57,0)
-         Q 0
-"RTN","CCRSYS",58,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 12
-"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)
-        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","CCRUNIT",12,0)
-        W "XPATH is: "_XPATH,!
-"RTN","CCRUNIT",13,0)
-        W "Getting Med Template into MINXML using",!
-"RTN","CCRUNIT",14,0)
-        W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
-"RTN","CCRUNIT",15,0)
-        D QUERY^GPLXPATH(T,XPATH,"MINXML")
-"RTN","CCRUNIT",16,0)
-  W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
-"RTN","CCRUNIT",17,0)
-        W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","CCRUNIT",18,0)
-        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","CCRUNIT",19,0)
-        D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
-"RTN","CCRUNIT",20,0)
-        Q
-"RTN","CCRUTIL")
-0^6^B5927217
-"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 12
-"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=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","CCRUTIL",61,0)
- F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-"RTN","CCRUTIL",62,0)
- . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-"RTN","CCRUTIL",63,0)
- . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","CCRUTIL",64,0)
- . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","CCRUTIL",65,0)
- . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","CCRUTIL",66,0)
- . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","CCRUTIL",67,0)
- N ZG
-"RTN","CCRUTIL",68,0)
- S ZG=$Q(VSRT(""))
-"RTN","CCRUTIL",69,0)
- F  D  Q:ZG=""  ;
-"RTN","CCRUTIL",70,0)
- . ; W ZG,!
-"RTN","CCRUTIL",71,0)
- . D PUSH^GPLXPATH("V1",@ZG)
-"RTN","CCRUTIL",72,0)
- . S ZG=$Q(@ZG)
-"RTN","CCRUTIL",73,0)
- I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-"RTN","CCRUTIL",74,0)
- . N ZG2
-"RTN","CCRUTIL",75,0)
- . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-"RTN","CCRUTIL",76,0)
- . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","CCRUTIL",77,0)
- . S ZG2(0)=V1(0)
-"RTN","CCRUTIL",78,0)
- . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","CCRUTIL",79,0)
- Q ZCNT
-"RTN","CCRUTIL",80,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 12
-"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^16^B52628160
-"RTN","GPLACTOR",1,0)
-GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
-"RTN","GPLACTOR",2,0)
- ;;0.4;CCDCCR;nopatch;noreleasedate;Build 12
-"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)
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
-"RTN","GPLACTOR",27,0)
- ;
-"RTN","GPLACTOR",28,0)
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-"RTN","GPLACTOR",29,0)
- ; IPXML is the Input Actor Template into which we  substitute values
-"RTN","GPLACTOR",30,0)
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
-"RTN","GPLACTOR",31,0)
- ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
-"RTN","GPLACTOR",32,0)
- ; ^TMP(7542,1,"ACTORS",0)=Count
-"RTN","GPLACTOR",33,0)
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-"RTN","GPLACTOR",34,0)
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-"RTN","GPLACTOR",35,0)
- ; AXML is the output arrary, to contain XML.
-"RTN","GPLACTOR",36,0)
- ;
-"RTN","GPLACTOR",37,0)
- N I,J,AMAP,AOID,ATYP,AIEN
-"RTN","GPLACTOR",38,0)
- D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-"RTN","GPLACTOR",39,0)
- D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-"RTN","GPLACTOR",40,0)
- I DEBUG W "PROCESSING ACTORS ",!
-"RTN","GPLACTOR",41,0)
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
-"RTN","GPLACTOR",42,0)
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",43,0)
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-"RTN","GPLACTOR",44,0)
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-"RTN","GPLACTOR",45,0)
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-"RTN","GPLACTOR",46,0)
- . I ATYP="" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",47,0)
- . ;
-"RTN","GPLACTOR",48,0)
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","GPLACTOR",49,0)
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
-"RTN","GPLACTOR",50,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-"RTN","GPLACTOR",51,0)
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",52,0)
- . ;
-"RTN","GPLACTOR",53,0)
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
-"RTN","GPLACTOR",54,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-"RTN","GPLACTOR",55,0)
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",56,0)
- . ;
-"RTN","GPLACTOR",57,0)
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
-"RTN","GPLACTOR",58,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-"RTN","GPLACTOR",59,0)
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",60,0)
- . ;
-"RTN","GPLACTOR",61,0)
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",62,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-"RTN","GPLACTOR",63,0)
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",64,0)
- . ;
-"RTN","GPLACTOR",65,0)
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",66,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-"RTN","GPLACTOR",67,0)
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",68,0)
- . ;
-"RTN","GPLACTOR",69,0)
- . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-"RTN","GPLACTOR",70,0)
- ;
-"RTN","GPLACTOR",71,0)
- N ACTTMP
-"RTN","GPLACTOR",72,0)
- D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLACTOR",73,0)
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLACTOR",74,0)
- . ; STRINGS MARKED AS @@X@@
-"RTN","GPLACTOR",75,0)
- . W "ACTORS Missing list: ",!
-"RTN","GPLACTOR",76,0)
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
-"RTN","GPLACTOR",77,0)
- Q
-"RTN","GPLACTOR",78,0)
- ;
-"RTN","GPLACTOR",79,0)
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"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)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",85,0)
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
-"RTN","GPLACTOR",86,0)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
-"RTN","GPLACTOR",87,0)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
-"RTN","GPLACTOR",88,0)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
-"RTN","GPLACTOR",89,0)
- S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
-"RTN","GPLACTOR",90,0)
- S @AMAP@("ACTORSSN")=""
-"RTN","GPLACTOR",91,0)
- S @AMAP@("ACTORSSNTEXT")=""
-"RTN","GPLACTOR",92,0)
- S @AMAP@("ACTORSSNSOURCEID")=""
-"RTN","GPLACTOR",93,0)
- S ZX=$$SSN^CCRDPT(AIEN)
-"RTN","GPLACTOR",94,0)
- I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
-"RTN","GPLACTOR",95,0)
- . S @AMAP@("ACTORSSN")=ZX
-"RTN","GPLACTOR",96,0)
- . S @AMAP@("ACTORSSNTEXT")="SSN"
-"RTN","GPLACTOR",97,0)
- . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","GPLACTOR",98,0)
- S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
-"RTN","GPLACTOR",99,0)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
-"RTN","GPLACTOR",100,0)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
-"RTN","GPLACTOR",101,0)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
-"RTN","GPLACTOR",102,0)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
-"RTN","GPLACTOR",103,0)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
-"RTN","GPLACTOR",104,0)
- S @AMAP@("ACTORRESTEL")=""
-"RTN","GPLACTOR",105,0)
- S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","GPLACTOR",106,0)
- S ZX=$$RESTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",107,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",108,0)
- . S @AMAP@("ACTORRESTEL")=ZX
-"RTN","GPLACTOR",109,0)
- . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","GPLACTOR",110,0)
- S @AMAP@("ACTORWORKTEL")=""
-"RTN","GPLACTOR",111,0)
- S @AMAP@("ACTORWORKTELTEXT")=""
-"RTN","GPLACTOR",112,0)
- S ZX=$$WORKTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",113,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",114,0)
- . S @AMAP@("ACTORWORKTEL")=ZX
-"RTN","GPLACTOR",115,0)
- . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","GPLACTOR",116,0)
- S @AMAP@("ACTORCELLTEL")=""
-"RTN","GPLACTOR",117,0)
- S @AMAP@("ACTORCELLTELTEXT")=""
-"RTN","GPLACTOR",118,0)
- S ZX=$$CELLTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",119,0)
- I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
-"RTN","GPLACTOR",120,0)
- . S @AMAP@("ACTORCELLTEL")=ZX
-"RTN","GPLACTOR",121,0)
- . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-"RTN","GPLACTOR",122,0)
- S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
-"RTN","GPLACTOR",123,0)
- S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-"RTN","GPLACTOR",124,0)
- S @AMAP@("ACTORIEN")=AIEN
-"RTN","GPLACTOR",125,0)
- S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
-"RTN","GPLACTOR",126,0)
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",127,0)
- D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",128,0)
- Q
-"RTN","GPLACTOR",129,0)
- ;
-"RTN","GPLACTOR",130,0)
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-"RTN","GPLACTOR",131,0)
-     ;
-"RTN","GPLACTOR",132,0)
-     ; N AMAP
-"RTN","GPLACTOR",133,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",134,0)
-     K @AMAP
-"RTN","GPLACTOR",135,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",136,0)
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
-"RTN","GPLACTOR",137,0)
-         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
-"RTN","GPLACTOR",138,0)
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-"RTN","GPLACTOR",139,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",140,0)
-     Q
-"RTN","GPLACTOR",141,0)
-     ;
-"RTN","GPLACTOR",142,0)
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-"RTN","GPLACTOR",143,0)
-     ;
-"RTN","GPLACTOR",144,0)
-     ; N AMAP
-"RTN","GPLACTOR",145,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",146,0)
-     K @AMAP
-"RTN","GPLACTOR",147,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",148,0)
-     S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","GPLACTOR",149,0)
-     S @AMAP@("ACTORRELATION")=""
-"RTN","GPLACTOR",150,0)
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-"RTN","GPLACTOR",151,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",152,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",153,0)
-     Q
-"RTN","GPLACTOR",154,0)
-     ;
-"RTN","GPLACTOR",155,0)
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-"RTN","GPLACTOR",156,0)
-     ;
-"RTN","GPLACTOR",157,0)
-     ; N AMAP
-"RTN","GPLACTOR",158,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",159,0)
-     K @AMAP
-"RTN","GPLACTOR",160,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",161,0)
-     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
-"RTN","GPLACTOR",162,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",163,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",164,0)
-     Q
-"RTN","GPLACTOR",165,0)
-     ;
-"RTN","GPLACTOR",166,0)
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-"RTN","GPLACTOR",167,0)
-     ;
-"RTN","GPLACTOR",168,0)
-     ; N AMAP
-"RTN","GPLACTOR",169,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",170,0)
-     K @AMAP
-"RTN","GPLACTOR",171,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",172,0)
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
-"RTN","GPLACTOR",173,0)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",174,0)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
-"RTN","GPLACTOR",175,0)
-         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",176,0)
-         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
-"RTN","GPLACTOR",177,0)
-         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
-"RTN","GPLACTOR",178,0)
-         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
-"RTN","GPLACTOR",179,0)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
-"RTN","GPLACTOR",180,0)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",181,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
-"RTN","GPLACTOR",182,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
-"RTN","GPLACTOR",183,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
-"RTN","GPLACTOR",184,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
-"RTN","GPLACTOR",185,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","GPLACTOR",186,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","GPLACTOR",187,0)
-     S ZX=$$TEL^CCRVA200(AIEN)
-"RTN","GPLACTOR",188,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","GPLACTOR",189,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","GPLACTOR",190,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",191,0)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
-"RTN","GPLACTOR",192,0)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",193,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",194,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",195,0)
-     Q
-"RTN","GPLACTOR",196,0)
-     ;
-"RTN","GPLALERT")
-0^19^B13662473
-"RTN","GPLALERT",1,0)
-GPLALERT  ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
-"RTN","GPLALERT",2,0)
-          ;;0.1;CCDCCR;;SEP 11,2008;Build 12
-"RTN","GPLALERT",3,0)
-          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","GPLALERT",4,0)
-          ;General Public License See attached copy of the License.
-"RTN","GPLALERT",5,0)
-          ;
-"RTN","GPLALERT",6,0)
-          ;This program is free software; you can redistribute it and/or modify
-"RTN","GPLALERT",7,0)
-          ;it under the terms of the GNU General Public License as published by
-"RTN","GPLALERT",8,0)
-          ;the Free Software Foundation; either version 2 of the License, or
-"RTN","GPLALERT",9,0)
-          ;(at your option) any later version.
-"RTN","GPLALERT",10,0)
-          ;
-"RTN","GPLALERT",11,0)
-          ;This program is distributed in the hope that it will be useful,
-"RTN","GPLALERT",12,0)
-          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","GPLALERT",13,0)
-          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","GPLALERT",14,0)
-          ;GNU General Public License for more details.
-"RTN","GPLALERT",15,0)
-          ;
-"RTN","GPLALERT",16,0)
-          ;You should have received a copy of the GNU General Public License along
-"RTN","GPLALERT",17,0)
-          ;with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","GPLALERT",18,0)
-          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","GPLALERT",19,0)
-          ;
-"RTN","GPLALERT",20,0)
-          W "NO ENTRY FROM TOP",!
-"RTN","GPLALERT",21,0)
-          Q
-"RTN","GPLALERT",22,0)
-          ;
-"RTN","GPLALERT",23,0)
-EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
-"RTN","GPLALERT",24,0)
-          ;
-"RTN","GPLALERT",25,0)
-          ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","GPLALERT",26,0)
-          ;
-"RTN","GPLALERT",27,0)
-   ; GET ADVERSE REACTIONS AND ALLERGIES
-"RTN","GPLALERT",28,0)
-          N GMRA,GMRAL S GMRA="0^0^111"
-"RTN","GPLALERT",29,0)
-          D EN1^GMRADPT
-"RTN","GPLALERT",30,0)
-          I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
-"RTN","GPLALERT",31,0)
-   . S @ALTOUTXML@(0)=0 
-"RTN","GPLALERT",32,0)
- 
-"RTN","GPLALERT",33,0)
-   ; DEFINE MAPPING
-"RTN","GPLALERT",34,0)
-   N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
-"RTN","GPLALERT",35,0)
-   S ALTTVMAP=$NA(^TMP("GPLALERT",$J,"ALERTS"))
-"RTN","GPLALERT",36,0)
-          S ALTTARYTMP=$NA(^TMP("GPLALERT",$J,"ALERTSARYTMP"))
-"RTN","GPLALERT",37,0)
-          K @ALTTVMAP,@ALTTARYTMP
-"RTN","GPLALERT",38,0)
-          N ALTTMP,ALTCNT S ALTTMP=$NA(GMRAL),ALTCNT=1
-"RTN","GPLALERT",39,0)
-   F  S ALTTMP=$Q(@ALTTMP) Q:ALTTMP=""  D
-"RTN","GPLALERT",40,0)
-          . I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
-"RTN","GPLALERT",41,0)
-   . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
-"RTN","GPLALERT",42,0)
-          . K @ALTVMAP
-"RTN","GPLALERT",43,0)
-          . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
-"RTN","GPLALERT",44,0)
-          . N ALERTDESCRIPTIONTEXT S ALERTDESCRIPTIONTEXT="Patient has an " ; X $ZINT H 5
-"RTN","GPLALERT",45,0)
-          . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_$S($P(@ALTTMP,U,4)=1:"ADVERSE",$P(@ALTTMP,U,5)=1:"ALLERGIC",1:"UNKNOWN")
-"RTN","GPLALERT",46,0)
-          . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_" reaction to "_$P(@ALTTMP,U,2)_"."
-"RTN","GPLALERT",47,0)
-          . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ALERTDESCRIPTIONTEXT
-"RTN","GPLALERT",48,0)
-          . S @ALTVMAP@("ALERTCODEVALUE")="ALERT CODE VALUE"
-"RTN","GPLALERT",49,0)
-          . S @ALTVMAP@("ALERTCODESYSTEM")="ALERT CODE SYSTEM"
-"RTN","GPLALERT",50,0)
-          . S @ALTVMAP@("ALERTSTATUSTEXT")="ALERT STATUS TEXT"
-"RTN","GPLALERT",51,0)
-          . S @ALTVMAP@("ALERTSOURCEID")="ALERT SOURCE ID"
-"RTN","GPLALERT",52,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="ALERT AGENT PRODUCT OBJECT ID"
-"RTN","GPLALERT",53,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="A"
-"RTN","GPLALERT",54,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")="B"
-"RTN","GPLALERT",55,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="C"
-"RTN","GPLALERT",56,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="D"
-"RTN","GPLALERT",57,0)
-          . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
-"RTN","GPLALERT",58,0)
-          . K @ALTARYTMP
-"RTN","GPLALERT",59,0)
-          . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
-"RTN","GPLALERT",60,0)
-          . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)
-"RTN","GPLALERT",61,0)
-          . I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP)
-"RTN","GPLALERT",62,0)
-          . S ALTCNT=ALTCNT+1
-"RTN","GPLALERT",63,0)
- 
-"RTN","GPLALERT",64,0)
-          Q
-"RTN","GPLALERT",65,0)
- 
-"RTN","GPLCCD")
-0^8^B114413975
-"RTN","GPLCCD",1,0)
-GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
-"RTN","GPLCCD",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 12
-"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^15^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 12
-"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^13^B82192762
-"RTN","GPLCCR",1,0)
-GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-"RTN","GPLCCR",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 12
-"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)
-       I '$D(DIR) S DIR=""
-"RTN","GPLCCR",35,0)
-       I '$D(FN) S FN=""
-"RTN","GPLCCR",36,0)
-       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-"RTN","GPLCCR",37,0)
-       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
-"RTN","GPLCCR",38,0)
-       S ONAM=FN
-"RTN","GPLCCR",39,0)
-       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_5.xml"
-"RTN","GPLCCR",40,0)
-       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
-"RTN","GPLCCR",41,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","GPLCCR",42,0)
-       . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","GPLCCR",43,0)
-       . ;S @ODIRGLB="/home/cedwards/"
-"RTN","GPLCCR",44,0)
-       . S @ODIRGLB="/opt/wv/p/"
-"RTN","GPLCCR",45,0)
-       S ODIR=DIR
-"RTN","GPLCCR",46,0)
-       I DIR="" S ODIR=@ODIRGLB
-"RTN","GPLCCR",47,0)
-       N ZY
-"RTN","GPLCCR",48,0)
-       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-"RTN","GPLCCR",49,0)
-       W !,$P(ZY,U,2),!
-"RTN","GPLCCR",50,0)
-       Q
-"RTN","GPLCCR",51,0)
-       ;
-"RTN","GPLCCR",52,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","GPLCCR",53,0)
-    ;
-"RTN","GPLCCR",54,0)
-    N G1
-"RTN","GPLCCR",55,0)
-    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
-"RTN","GPLCCR",56,0)
-    I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","GPLCCR",57,0)
-    . D PARY^GPLXPATH(G1)
-"RTN","GPLCCR",58,0)
-    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
-"RTN","GPLCCR",59,0)
-    Q
-"RTN","GPLCCR",60,0)
-    ;
-"RTN","GPLCCR",61,0)
-CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","GPLCCR",62,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-"RTN","GPLCCR",63,0)
-    ; DFN IS PATIENT IEN
-"RTN","GPLCCR",64,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","GPLCCR",65,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","GPLCCR",66,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-"RTN","GPLCCR",67,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-"RTN","GPLCCR",68,0)
-    ; - NULL MEANS NOW
-"RTN","GPLCCR",69,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-"RTN","GPLCCR",70,0)
-    ;    "TO" VARIABLES
-"RTN","GPLCCR",71,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-"RTN","GPLCCR",72,0)
-    I '$D(DEBUG) S DEBUG=0
-"RTN","GPLCCR",73,0)
-    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","GPLCCR",74,0)
-    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","GPLCCR",75,0)
-    I '$D(TESTALERT) S TESTALERT=0 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","GPLCCR",76,0)
-    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
-"RTN","GPLCCR",77,0)
-    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","GPLCCR",78,0)
-    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","GPLCCR",79,0)
-    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","GPLCCR",80,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","GPLCCR",81,0)
-    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-"RTN","GPLCCR",82,0)
-    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","GPLCCR",83,0)
-    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","GPLCCR",84,0)
-    ;
-"RTN","GPLCCR",85,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","GPLCCR",86,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","GPLCCR",87,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",88,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",89,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","GPLCCR",90,0)
-    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","GPLCCR",91,0)
-    ;
-"RTN","GPLCCR",92,0)
-    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-"RTN","GPLCCR",93,0)
-    ;
-"RTN","GPLCCR",94,0)
-    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","GPLCCR",95,0)
-    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","GPLCCR",96,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","GPLCCR",97,0)
-    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","GPLCCR",98,0)
-    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","GPLCCR",99,0)
-    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","GPLCCR",100,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","GPLCCR",101,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","GPLCCR",102,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","GPLCCR",103,0)
-    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","GPLCCR",104,0)
-    . S IXML="INXML"
-"RTN","GPLCCR",105,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","GPLCCR",106,0)
-    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","GPLCCR",107,0)
-    . ; W OXML,!
-"RTN","GPLCCR",108,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","GPLCCR",109,0)
-    . I DEBUG W "RUNNING ",CALL,!
-"RTN","GPLCCR",110,0)
-    . X CALL
-"RTN","GPLCCR",111,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","GPLCCR",112,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-"RTN","GPLCCR",113,0)
-    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",114,0)
-    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-"RTN","GPLCCR",115,0)
-    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","GPLCCR",116,0)
-    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","GPLCCR",117,0)
-    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","GPLCCR",118,0)
-    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",119,0)
-    N TRIMI,J,DONE S DONE=0
-"RTN","GPLCCR",120,0)
-    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","GPLCCR",121,0)
-    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","GPLCCR",122,0)
-    . I DEBUG W "TRIMMED",J,!
-"RTN","GPLCCR",123,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","GPLCCR",124,0)
-    Q
-"RTN","GPLCCR",125,0)
-    ;
-"RTN","GPLCCR",126,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","GPLCCR",127,0)
-    ; TAB IS PASSED BY NAME
-"RTN","GPLCCR",128,0)
-    I DEBUG W "TAB= ",TAB,!
-"RTN","GPLCCR",129,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","GPLCCR",130,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","GPLCCR",131,0)
-    I TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS1;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",132,0)
-    I 'TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",133,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
-"RTN","GPLCCR",134,0)
-    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
-"RTN","GPLCCR",135,0)
-    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
-"RTN","GPLCCR",136,0)
-    Q
-"RTN","GPLCCR",137,0)
-    ;
-"RTN","GPLCCR",138,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","GPLCCR",139,0)
-    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
-"RTN","GPLCCR",140,0)
-    ; K @VMAP
-"RTN","GPLCCR",141,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
-"RTN","GPLCCR",142,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","GPLCCR",143,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","GPLCCR",144,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","GPLCCR",145,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","GPLCCR",146,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-"RTN","GPLCCR",147,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",148,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",149,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","GPLCCR",150,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","GPLCCR",151,0)
-    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","GPLCCR",152,0)
-    N CTMP
-"RTN","GPLCCR",153,0)
-    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-"RTN","GPLCCR",154,0)
-    D CP^GPLXPATH("CTMP",CXML)
-"RTN","GPLCCR",155,0)
-    Q
-"RTN","GPLCCR",156,0)
-    ;
-"RTN","GPLCCR",157,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","GPLCCR",158,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","GPLCCR",159,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","GPLCCR",160,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","GPLCCR",161,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","GPLCCR",162,0)
-    ;OR INSTITUTION
-"RTN","GPLCCR",163,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","GPLCCR",164,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","GPLCCR",165,0)
-    N I,J,K,L
-"RTN","GPLCCR",166,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","GPLCCR",167,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","GPLCCR",168,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","GPLCCR",169,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","GPLCCR",170,0)
-    . . I DEBUG W "<ActorID>=>",J,!
-"RTN","GPLCCR",171,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","GPLCCR",172,0)
-    . . ;  TO GET RID OF DUPLICATES
-"RTN","GPLCCR",173,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","GPLCCR",174,0)
-    F J=0:0 D  Q:$O(K(I))=""
-"RTN","GPLCCR",175,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","GPLCCR",176,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","GPLCCR",177,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","GPLCCR",178,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","GPLCCR",179,0)
-    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","GPLCCR",180,0)
-    Q
-"RTN","GPLCCR",181,0)
-    ;
-"RTN","GPLCCR",182,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","GPLCCR",183,0)
-  D TESTALL^GPLUNIT("GPLCCR")
-"RTN","GPLCCR",184,0)
-  Q
-"RTN","GPLCCR",185,0)
-  ;
-"RTN","GPLCCR",186,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","GPLCCR",187,0)
-  N ZTMP
-"RTN","GPLCCR",188,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",189,0)
-  D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLCCR",190,0)
-  Q
-"RTN","GPLCCR",191,0)
-  ;
-"RTN","GPLCCR",192,0)
-TLIST  ; LIST THE TESTS
-"RTN","GPLCCR",193,0)
-  N ZTMP
-"RTN","GPLCCR",194,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",195,0)
-  D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLCCR",196,0)
-  Q
-"RTN","GPLCCR",197,0)
-  ;
-"RTN","GPLCCR",198,0)
- ;;><TEST>
-"RTN","GPLCCR",199,0)
- ;;><PROBLEMS>
-"RTN","GPLCCR",200,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",201,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
-"RTN","GPLCCR",202,0)
- ;;>>?@GPL@(@GPL@(0))["</Problems>"
-"RTN","GPLCCR",203,0)
- ;;><VITALS>
-"RTN","GPLCCR",204,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",205,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
-"RTN","GPLCCR",206,0)
- ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
-"RTN","GPLCCR",207,0)
- ;;><CCR>
-"RTN","GPLCCR",208,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",209,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",210,0)
- ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
-"RTN","GPLCCR",211,0)
- ;;><ACTLST>
-"RTN","GPLCCR",212,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",213,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",214,0)
- ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
-"RTN","GPLCCR",215,0)
- ;;><ACTORS>
-"RTN","GPLCCR",216,0)
- ;;>>>D ZTEST^GPLCCR("ACTLST")
-"RTN","GPLCCR",217,0)
- ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","GPLCCR",218,0)
- ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
-"RTN","GPLCCR",219,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","GPLCCR",220,0)
- ;;><TRIM>
-"RTN","GPLCCR",221,0)
- ;;>>>D ZTEST^GPLCCR("CCR")
-"RTN","GPLCCR",222,0)
- ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
-"RTN","GPLCCR",223,0)
- ;;><ALERTS>
-"RTN","GPLCCR",224,0)
- ;;>>>S TESTALERT=1
-"RTN","GPLCCR",225,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",226,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
-"RTN","GPLCCR",227,0)
- ;;>>?@GPL@(@GPL@(0))["</Alerts>"
-"RTN","GPLCCR",228,0)
- 
-"RTN","GPLCCR0")
-0^14^B654252455
-"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 12
-"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)
- ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
-"RTN","GPLCCR0",368,0)
- ;;</Frequency>
-"RTN","GPLCCR0",369,0)
- ;;<Interval>
-"RTN","GPLCCR0",370,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","GPLCCR0",371,0)
- ;;<Units>
-"RTN","GPLCCR0",372,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","GPLCCR0",373,0)
- ;;</Units>
-"RTN","GPLCCR0",374,0)
- ;;</Interval>
-"RTN","GPLCCR0",375,0)
- ;;<Duration>
-"RTN","GPLCCR0",376,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","GPLCCR0",377,0)
- ;;<Units>
-"RTN","GPLCCR0",378,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","GPLCCR0",379,0)
- ;;</Units>
-"RTN","GPLCCR0",380,0)
- ;;</Duration>
-"RTN","GPLCCR0",381,0)
- ;;<Indication>
-"RTN","GPLCCR0",382,0)
- ;;<PRNFlag>
-"RTN","GPLCCR0",383,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","GPLCCR0",384,0)
- ;;</PRNFlag>
-"RTN","GPLCCR0",385,0)
- ;;<Problem>
-"RTN","GPLCCR0",386,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",387,0)
- ;;<Type>
-"RTN","GPLCCR0",388,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","GPLCCR0",389,0)
- ;;</Type>
-"RTN","GPLCCR0",390,0)
- ;;<Description>
-"RTN","GPLCCR0",391,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","GPLCCR0",392,0)
- ;;<Code>
-"RTN","GPLCCR0",393,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","GPLCCR0",394,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",395,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","GPLCCR0",396,0)
- ;;</Code>
-"RTN","GPLCCR0",397,0)
- ;;</Description>
-"RTN","GPLCCR0",398,0)
- ;;<Source>
-"RTN","GPLCCR0",399,0)
- ;;<Actor>
-"RTN","GPLCCR0",400,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",401,0)
- ;;</Actor>
-"RTN","GPLCCR0",402,0)
- ;;</Source>
-"RTN","GPLCCR0",403,0)
- ;;</Problem>
-"RTN","GPLCCR0",404,0)
- ;;</Indication>
-"RTN","GPLCCR0",405,0)
- ;;<StopIndicator>
-"RTN","GPLCCR0",406,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","GPLCCR0",407,0)
- ;;</StopIndicator>
-"RTN","GPLCCR0",408,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","GPLCCR0",409,0)
- ;;<MultipleDirectionModifier>
-"RTN","GPLCCR0",410,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","GPLCCR0",411,0)
- ;;</MultipleDirectionModifier>
-"RTN","GPLCCR0",412,0)
- ;;</Direction>
-"RTN","GPLCCR0",413,0)
- ;;</Directions>
-"RTN","GPLCCR0",414,0)
- ;;<PatientInstructions>
-"RTN","GPLCCR0",415,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",416,0)
- ;;</PatientInstructions>
-"RTN","GPLCCR0",417,0)
- ;;<FullfillmentInstructions>
-"RTN","GPLCCR0",418,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",419,0)
- ;;</FullfillmentInstructions>
-"RTN","GPLCCR0",420,0)
- ;;<Refills>
-"RTN","GPLCCR0",421,0)
- ;;<Refill>
-"RTN","GPLCCR0",422,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","GPLCCR0",423,0)
- ;;</Refill>
-"RTN","GPLCCR0",424,0)
- ;;</Refills>
-"RTN","GPLCCR0",425,0)
- ;;</Medication>
-"RTN","GPLCCR0",426,0)
- ;;</Medications>
-"RTN","GPLCCR0",427,0)
- ;;<VitalSigns>
-"RTN","GPLCCR0",428,0)
- ;;<Result>
-"RTN","GPLCCR0",429,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",430,0)
- ;;<DateTime>
-"RTN","GPLCCR0",431,0)
- ;;<Type>
-"RTN","GPLCCR0",432,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","GPLCCR0",433,0)
- ;;</Type>
-"RTN","GPLCCR0",434,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",435,0)
- ;;</DateTime>
-"RTN","GPLCCR0",436,0)
- ;;<Description>
-"RTN","GPLCCR0",437,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",438,0)
- ;;</Description>
-"RTN","GPLCCR0",439,0)
- ;;<Source>
-"RTN","GPLCCR0",440,0)
- ;;<Actor>
-"RTN","GPLCCR0",441,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",442,0)
- ;;</Actor>
-"RTN","GPLCCR0",443,0)
- ;;</Source>
-"RTN","GPLCCR0",444,0)
- ;;<Test>
-"RTN","GPLCCR0",445,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",446,0)
- ;;<Type>
-"RTN","GPLCCR0",447,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","GPLCCR0",448,0)
- ;;</Type>
-"RTN","GPLCCR0",449,0)
- ;;<Description>
-"RTN","GPLCCR0",450,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",451,0)
- ;;<Code>
-"RTN","GPLCCR0",452,0)
- ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
-"RTN","GPLCCR0",453,0)
- ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",454,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","GPLCCR0",455,0)
- ;;</Code>
-"RTN","GPLCCR0",456,0)
- ;;</Description>
-"RTN","GPLCCR0",457,0)
- ;;<Source>
-"RTN","GPLCCR0",458,0)
- ;;<Actor>
-"RTN","GPLCCR0",459,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",460,0)
- ;;</Actor>
-"RTN","GPLCCR0",461,0)
- ;;</Source>
-"RTN","GPLCCR0",462,0)
- ;;<TestResult>
-"RTN","GPLCCR0",463,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","GPLCCR0",464,0)
- ;;<Units>
-"RTN","GPLCCR0",465,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","GPLCCR0",466,0)
- ;;</Units>
-"RTN","GPLCCR0",467,0)
- ;;</TestResult>
-"RTN","GPLCCR0",468,0)
- ;;</Test>
-"RTN","GPLCCR0",469,0)
- ;;</Result>
-"RTN","GPLCCR0",470,0)
- ;;</VitalSigns>
-"RTN","GPLCCR0",471,0)
- ;;<Results>
-"RTN","GPLCCR0",472,0)
- ;;<Result>
-"RTN","GPLCCR0",473,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",474,0)
- ;;<DateTime>
-"RTN","GPLCCR0",475,0)
- ;;<Type>
-"RTN","GPLCCR0",476,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",477,0)
- ;;</Type>
-"RTN","GPLCCR0",478,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",479,0)
- ;;</DateTime>
-"RTN","GPLCCR0",480,0)
- ;;<Description>
-"RTN","GPLCCR0",481,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",482,0)
- ;;<Code>
-"RTN","GPLCCR0",483,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","GPLCCR0",484,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",485,0)
- ;;</Code>
-"RTN","GPLCCR0",486,0)
- ;;</Description>
-"RTN","GPLCCR0",487,0)
- ;;<Status>
-"RTN","GPLCCR0",488,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","GPLCCR0",489,0)
- ;;</Status>
-"RTN","GPLCCR0",490,0)
- ;;<Source>
-"RTN","GPLCCR0",491,0)
- ;;<Actor>
-"RTN","GPLCCR0",492,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",493,0)
- ;;</Actor>
-"RTN","GPLCCR0",494,0)
- ;;</Source>
-"RTN","GPLCCR0",495,0)
- ;;<TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",496,0)
- ;;<Test>
-"RTN","GPLCCR0",497,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",498,0)
- ;;<DateTime>
-"RTN","GPLCCR0",499,0)
- ;;<Type>
-"RTN","GPLCCR0",500,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",501,0)
- ;;</Type>
-"RTN","GPLCCR0",502,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",503,0)
- ;;</DateTime>
-"RTN","GPLCCR0",504,0)
- ;;<Description>
-"RTN","GPLCCR0",505,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",506,0)
- ;;<Code>
-"RTN","GPLCCR0",507,0)
- ;;<Value>@@RESULTTESTCODE@@</Value>
-"RTN","GPLCCR0",508,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",509,0)
- ;;</Code>
-"RTN","GPLCCR0",510,0)
- ;;</Description>
-"RTN","GPLCCR0",511,0)
- ;;<Status>
-"RTN","GPLCCR0",512,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",513,0)
- ;;</Status>
-"RTN","GPLCCR0",514,0)
- ;;<Source>
-"RTN","GPLCCR0",515,0)
- ;;<Actor>
-"RTN","GPLCCR0",516,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",517,0)
- ;;</Actor>
-"RTN","GPLCCR0",518,0)
- ;;</Source>
-"RTN","GPLCCR0",519,0)
- ;;<TestResult>
-"RTN","GPLCCR0",520,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",521,0)
- ;;<Units>
-"RTN","GPLCCR0",522,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",523,0)
- ;;</Units>
-"RTN","GPLCCR0",524,0)
- ;;</TestResult>
-"RTN","GPLCCR0",525,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",526,0)
- ;;<Normal>
-"RTN","GPLCCR0",527,0)
- ;;<Description>
-"RTN","GPLCCR0",528,0)
- ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",529,0)
- ;;</Description>
-"RTN","GPLCCR0",530,0)
- ;;<Source>
-"RTN","GPLCCR0",531,0)
- ;;<Actor>
-"RTN","GPLCCR0",532,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",533,0)
- ;;</Actor>
-"RTN","GPLCCR0",534,0)
- ;;</Source>
-"RTN","GPLCCR0",535,0)
- ;;</Normal>
-"RTN","GPLCCR0",536,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",537,0)
- ;;<Flag>
-"RTN","GPLCCR0",538,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",539,0)
- ;;</Flag>
-"RTN","GPLCCR0",540,0)
- ;;</Test>
-"RTN","GPLCCR0",541,0)
- ;;</TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",542,0)
- ;;<TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",543,0)
- ;;<Test>
-"RTN","GPLCCR0",544,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",545,0)
- ;;<DateTime>
-"RTN","GPLCCR0",546,0)
- ;;<Type>
-"RTN","GPLCCR0",547,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",548,0)
- ;;</Type>
-"RTN","GPLCCR0",549,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",550,0)
- ;;</DateTime>
-"RTN","GPLCCR0",551,0)
- ;;<Description>
-"RTN","GPLCCR0",552,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",553,0)
- ;;<Code>
-"RTN","GPLCCR0",554,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",555,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",556,0)
- ;;</Code>
-"RTN","GPLCCR0",557,0)
- ;;</Description>
-"RTN","GPLCCR0",558,0)
- ;;<Status>
-"RTN","GPLCCR0",559,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",560,0)
- ;;</Status>
-"RTN","GPLCCR0",561,0)
- ;;<Source>
-"RTN","GPLCCR0",562,0)
- ;;<Actor>
-"RTN","GPLCCR0",563,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",564,0)
- ;;</Actor>
-"RTN","GPLCCR0",565,0)
- ;;</Source>
-"RTN","GPLCCR0",566,0)
- ;;<TestResult>
-"RTN","GPLCCR0",567,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",568,0)
- ;;<Units>
-"RTN","GPLCCR0",569,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",570,0)
- ;;</Units>
-"RTN","GPLCCR0",571,0)
- ;;</TestResult>
-"RTN","GPLCCR0",572,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",573,0)
- ;;<Normal>
-"RTN","GPLCCR0",574,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
-"RTN","GPLCCR0",575,0)
- ;;<Units>
-"RTN","GPLCCR0",576,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
-"RTN","GPLCCR0",577,0)
- ;;</Units>
-"RTN","GPLCCR0",578,0)
- ;;<ValueSequencePosition>1</ValueSequencePosition>
-"RTN","GPLCCR0",579,0)
- ;;<Source>
-"RTN","GPLCCR0",580,0)
- ;;<Actor>
-"RTN","GPLCCR0",581,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",582,0)
- ;;</Actor>
-"RTN","GPLCCR0",583,0)
- ;;</Source>
-"RTN","GPLCCR0",584,0)
- ;;</Normal>
-"RTN","GPLCCR0",585,0)
- ;;<Normal>
-"RTN","GPLCCR0",586,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
-"RTN","GPLCCR0",587,0)
- ;;<Units>
-"RTN","GPLCCR0",588,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
-"RTN","GPLCCR0",589,0)
- ;;</Units>
-"RTN","GPLCCR0",590,0)
- ;;<ValueSequencePosition>2</ValueSequencePosition>
-"RTN","GPLCCR0",591,0)
- ;;<VariableNomalModifier>
-"RTN","GPLCCR0",592,0)
- ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
-"RTN","GPLCCR0",593,0)
- ;;</VariableNomalModifier>
-"RTN","GPLCCR0",594,0)
- ;;<Source>
-"RTN","GPLCCR0",595,0)
- ;;<Actor>
-"RTN","GPLCCR0",596,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",597,0)
- ;;</Actor>
-"RTN","GPLCCR0",598,0)
- ;;</Source>
-"RTN","GPLCCR0",599,0)
- ;;</Normal>
-"RTN","GPLCCR0",600,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",601,0)
- ;;<Flag>
-"RTN","GPLCCR0",602,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",603,0)
- ;;</Flag>
-"RTN","GPLCCR0",604,0)
- ;;</Test>
-"RTN","GPLCCR0",605,0)
- ;;</TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",606,0)
- ;;</Result>
-"RTN","GPLCCR0",607,0)
- ;;</Results>
-"RTN","GPLCCR0",608,0)
- ;;<HealthCareProviders>
-"RTN","GPLCCR0",609,0)
- ;;<Provider>
-"RTN","GPLCCR0",610,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","GPLCCR0",611,0)
- ;;<ActorRole>
-"RTN","GPLCCR0",612,0)
- ;;<Text>Primary Provider</Text>
-"RTN","GPLCCR0",613,0)
- ;;</ActorRole>
-"RTN","GPLCCR0",614,0)
- ;;</Provider>
-"RTN","GPLCCR0",615,0)
- ;;</HealthCareProviders>
-"RTN","GPLCCR0",616,0)
- ;;</Body>
-"RTN","GPLCCR0",617,0)
- ;;<Actors>
-"RTN","GPLCCR0",618,0)
- ;;<ACTOR-PATIENT>
-"RTN","GPLCCR0",619,0)
- ;;<Actor>
-"RTN","GPLCCR0",620,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",621,0)
- ;;<Person>
-"RTN","GPLCCR0",622,0)
- ;;<Name>
-"RTN","GPLCCR0",623,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",624,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",625,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",626,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",627,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",628,0)
- ;;</Name>
-"RTN","GPLCCR0",629,0)
- ;;<DateOfBirth>
-"RTN","GPLCCR0",630,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","GPLCCR0",631,0)
- ;;</DateOfBirth>
-"RTN","GPLCCR0",632,0)
- ;;<Gender>
-"RTN","GPLCCR0",633,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","GPLCCR0",634,0)
- ;;<Code>
-"RTN","GPLCCR0",635,0)
- ;;<Value>@@ACTORGENDER@@</Value>
-"RTN","GPLCCR0",636,0)
- ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
-"RTN","GPLCCR0",637,0)
- ;;</Code>
-"RTN","GPLCCR0",638,0)
- ;;</Gender>
-"RTN","GPLCCR0",639,0)
- ;;</Person>
-"RTN","GPLCCR0",640,0)
- ;;<IDs>
-"RTN","GPLCCR0",641,0)
- ;;<Type>
-"RTN","GPLCCR0",642,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","GPLCCR0",643,0)
- ;;</Type>
-"RTN","GPLCCR0",644,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","GPLCCR0",645,0)
- ;;<Source>
-"RTN","GPLCCR0",646,0)
- ;;<Actor>
-"RTN","GPLCCR0",647,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","GPLCCR0",648,0)
- ;;</Actor>
-"RTN","GPLCCR0",649,0)
- ;;</Source>
-"RTN","GPLCCR0",650,0)
- ;;</IDs>
-"RTN","GPLCCR0",651,0)
- ;;<Address>
-"RTN","GPLCCR0",652,0)
- ;;<Type>
-"RTN","GPLCCR0",653,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",654,0)
- ;;</Type>
-"RTN","GPLCCR0",655,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",656,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","GPLCCR0",657,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",658,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",659,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","GPLCCR0",660,0)
- ;;</Address>
-"RTN","GPLCCR0",661,0)
- ;;<Telephone>
-"RTN","GPLCCR0",662,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","GPLCCR0",663,0)
- ;;<Type>
-"RTN","GPLCCR0",664,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","GPLCCR0",665,0)
- ;;</Type>
-"RTN","GPLCCR0",666,0)
- ;;</Telephone>
-"RTN","GPLCCR0",667,0)
- ;;<Telephone>
-"RTN","GPLCCR0",668,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","GPLCCR0",669,0)
- ;;<Type>
-"RTN","GPLCCR0",670,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","GPLCCR0",671,0)
- ;;</Type>
-"RTN","GPLCCR0",672,0)
- ;;</Telephone>
-"RTN","GPLCCR0",673,0)
- ;;<Telephone>
-"RTN","GPLCCR0",674,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","GPLCCR0",675,0)
- ;;<Type>
-"RTN","GPLCCR0",676,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","GPLCCR0",677,0)
- ;;</Type>
-"RTN","GPLCCR0",678,0)
- ;;</Telephone>
-"RTN","GPLCCR0",679,0)
- ;;<EMail>
-"RTN","GPLCCR0",680,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",681,0)
- ;;</EMail>
-"RTN","GPLCCR0",682,0)
- ;;<Source>
-"RTN","GPLCCR0",683,0)
- ;;<Actor>
-"RTN","GPLCCR0",684,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",685,0)
- ;;</Actor>
-"RTN","GPLCCR0",686,0)
- ;;</Source>
-"RTN","GPLCCR0",687,0)
- ;;</Actor>
-"RTN","GPLCCR0",688,0)
- ;;</ACTOR-PATIENT>
-"RTN","GPLCCR0",689,0)
- ;;<ACTOR-SYSTEM>
-"RTN","GPLCCR0",690,0)
- ;;<Actor>
-"RTN","GPLCCR0",691,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",692,0)
- ;;<InformationSystem>
-"RTN","GPLCCR0",693,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","GPLCCR0",694,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","GPLCCR0",695,0)
- ;;</InformationSystem>
-"RTN","GPLCCR0",696,0)
- ;;<Source>
-"RTN","GPLCCR0",697,0)
- ;;<Actor>
-"RTN","GPLCCR0",698,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",699,0)
- ;;</Actor>
-"RTN","GPLCCR0",700,0)
- ;;</Source>
-"RTN","GPLCCR0",701,0)
- ;;</Actor>
-"RTN","GPLCCR0",702,0)
- ;;</ACTOR-SYSTEM>
-"RTN","GPLCCR0",703,0)
- ;;<ACTOR-NOK>
-"RTN","GPLCCR0",704,0)
- ;;<Actor>
-"RTN","GPLCCR0",705,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","GPLCCR0",706,0)
- ;;<Person>
-"RTN","GPLCCR0",707,0)
- ;;<Name>
-"RTN","GPLCCR0",708,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","GPLCCR0",709,0)
- ;;</Name>
-"RTN","GPLCCR0",710,0)
- ;;</Person>
-"RTN","GPLCCR0",711,0)
- ;;<Relation>
-"RTN","GPLCCR0",712,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","GPLCCR0",713,0)
- ;;</Relation>
-"RTN","GPLCCR0",714,0)
- ;;<Source>
-"RTN","GPLCCR0",715,0)
- ;;<Actor>
-"RTN","GPLCCR0",716,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","GPLCCR0",717,0)
- ;;</Actor>
-"RTN","GPLCCR0",718,0)
- ;;</Source>
-"RTN","GPLCCR0",719,0)
- ;;</Actor>
-"RTN","GPLCCR0",720,0)
- ;;</ACTOR-NOK>
-"RTN","GPLCCR0",721,0)
- ;;<ACTOR-PROVIDER>
-"RTN","GPLCCR0",722,0)
- ;;<Actor>
-"RTN","GPLCCR0",723,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",724,0)
- ;;<Person>
-"RTN","GPLCCR0",725,0)
- ;;<Name>
-"RTN","GPLCCR0",726,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",727,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",728,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",729,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",730,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","GPLCCR0",731,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",732,0)
- ;;</Name>
-"RTN","GPLCCR0",733,0)
- ;;</Person>
-"RTN","GPLCCR0",734,0)
- ;;<IDs>
-"RTN","GPLCCR0",735,0)
- ;;<Type>
-"RTN","GPLCCR0",736,0)
- ;;<Text>@@IDTYPE@@</Text>
-"RTN","GPLCCR0",737,0)
- ;;</Type>
-"RTN","GPLCCR0",738,0)
- ;;<ID>@@ID@@</ID>
-"RTN","GPLCCR0",739,0)
- ;;<IssuedBy>
-"RTN","GPLCCR0",740,0)
- ;;<Description>
-"RTN","GPLCCR0",741,0)
- ;;<Text>@@IDDESC@@</Text>
-"RTN","GPLCCR0",742,0)
- ;;</Description>
-"RTN","GPLCCR0",743,0)
- ;;</IssuedBy>
-"RTN","GPLCCR0",744,0)
- ;;</IDs>
-"RTN","GPLCCR0",745,0)
- ;;<Specialty>
-"RTN","GPLCCR0",746,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","GPLCCR0",747,0)
- ;;</Specialty>
-"RTN","GPLCCR0",748,0)
- ;;<Address>
-"RTN","GPLCCR0",749,0)
- ;;<Type>
-"RTN","GPLCCR0",750,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",751,0)
- ;;</Type>
-"RTN","GPLCCR0",752,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",753,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",754,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",755,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","GPLCCR0",756,0)
- ;;</Address>
-"RTN","GPLCCR0",757,0)
- ;;<Telephone>
-"RTN","GPLCCR0",758,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","GPLCCR0",759,0)
- ;;<Type>
-"RTN","GPLCCR0",760,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","GPLCCR0",761,0)
- ;;</Type>
-"RTN","GPLCCR0",762,0)
- ;;</Telephone>
-"RTN","GPLCCR0",763,0)
- ;;<Email>
-"RTN","GPLCCR0",764,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",765,0)
- ;;</Email>
-"RTN","GPLCCR0",766,0)
- ;;<Source>
-"RTN","GPLCCR0",767,0)
- ;;<Actor>
-"RTN","GPLCCR0",768,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",769,0)
- ;;</Actor>
-"RTN","GPLCCR0",770,0)
- ;;</Source>
-"RTN","GPLCCR0",771,0)
- ;;</Actor>
-"RTN","GPLCCR0",772,0)
- ;;</ACTOR-PROVIDER>
-"RTN","GPLCCR0",773,0)
- ;;<ACTOR-ORG>
-"RTN","GPLCCR0",774,0)
- ;;<Actor>
-"RTN","GPLCCR0",775,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",776,0)
- ;;<Organization>
-"RTN","GPLCCR0",777,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","GPLCCR0",778,0)
- ;;</Organization>
-"RTN","GPLCCR0",779,0)
- ;;<Source>
-"RTN","GPLCCR0",780,0)
- ;;<Actor>
-"RTN","GPLCCR0",781,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",782,0)
- ;;</Actor>
-"RTN","GPLCCR0",783,0)
- ;;</Source>
-"RTN","GPLCCR0",784,0)
- ;;</Actor>
-"RTN","GPLCCR0",785,0)
- ;;</ACTOR-ORG>
-"RTN","GPLCCR0",786,0)
- ;;</Actors>
-"RTN","GPLCCR0",787,0)
- ;;<Signatures>
-"RTN","GPLCCR0",788,0)
- ;;<CCRSignature>
-"RTN","GPLCCR0",789,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","GPLCCR0",790,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","GPLCCR0",791,0)
- ;;<Source>
-"RTN","GPLCCR0",792,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","GPLCCR0",793,0)
- ;;</Source>
-"RTN","GPLCCR0",794,0)
- ;;<Signature>
-"RTN","GPLCCR0",795,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","GPLCCR0",796,0)
- ;;<SignedInfo>
-"RTN","GPLCCR0",797,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","GPLCCR0",798,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","GPLCCR0",799,0)
- ;;<Reference URI="">
-"RTN","GPLCCR0",800,0)
- ;;<Transforms>
-"RTN","GPLCCR0",801,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","GPLCCR0",802,0)
- ;;</Transforms>
-"RTN","GPLCCR0",803,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","GPLCCR0",804,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","GPLCCR0",805,0)
- ;;</Reference>
-"RTN","GPLCCR0",806,0)
- ;;</SignedInfo>
-"RTN","GPLCCR0",807,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","GPLCCR0",808,0)
- ;;<KeyInfo>
-"RTN","GPLCCR0",809,0)
- ;;<KeyValue>
-"RTN","GPLCCR0",810,0)
- ;;<RSAKeyValue>
-"RTN","GPLCCR0",811,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","GPLCCR0",812,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","GPLCCR0",813,0)
- ;;</RSAKeyValue>
-"RTN","GPLCCR0",814,0)
- ;;</KeyValue>
-"RTN","GPLCCR0",815,0)
- ;;</KeyInfo>
-"RTN","GPLCCR0",816,0)
- ;;</Signature>
-"RTN","GPLCCR0",817,0)
- ;;</Signature>
-"RTN","GPLCCR0",818,0)
- ;;</CCRSignature>
-"RTN","GPLCCR0",819,0)
- ;;</Signatures>
-"RTN","GPLCCR0",820,0)
- ;;</ContinuityOfCareRecord>
-"RTN","GPLCCR0",821,0)
- ;</TEMPLATE>
-"RTN","GPLPROBS")
-0^20^B25875394
-"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 12
-"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)
-          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","GPLPROBS",42,0)
-          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","GPLPROBS",43,0)
-          . S VMAP=$NA(@TVMAP@(J))
-"RTN","GPLPROBS",44,0)
-          . K @VMAP
-"RTN","GPLPROBS",45,0)
-          . I DEBUG W "VMAP= ",VMAP,!
-"RTN","GPLPROBS",46,0)
-          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","GPLPROBS",47,0)
-          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","GPLPROBS",48,0)
-          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","GPLPROBS",49,0)
-          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
-"RTN","GPLPROBS",50,0)
-          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","GPLPROBS",51,0)
-          . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","GPLPROBS",52,0)
-          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","GPLPROBS",53,0)
-          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
-"RTN","GPLPROBS",54,0)
-          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
-"RTN","GPLPROBS",55,0)
-          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","GPLPROBS",56,0)
-          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","GPLPROBS",57,0)
-          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","GPLPROBS",58,0)
-          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","GPLPROBS",59,0)
-          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","GPLPROBS",60,0)
-          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","GPLPROBS",61,0)
-          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","GPLPROBS",62,0)
-          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","GPLPROBS",63,0)
-          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","GPLPROBS",64,0)
-          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","GPLPROBS",65,0)
-          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
-"RTN","GPLPROBS",66,0)
-          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
-"RTN","GPLPROBS",67,0)
-          . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","GPLPROBS",68,0)
-          . ; W "ARYTMP= ",ARYTMP,!
-"RTN","GPLPROBS",69,0)
-          . K @ARYTMP
-"RTN","GPLPROBS",70,0)
-          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","GPLPROBS",71,0)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",72,0)
-          . . ; W "FIRST ONE",!
-"RTN","GPLPROBS",73,0)
-          . . D CP^GPLXPATH(ARYTMP,OUTXML)
-"RTN","GPLPROBS",74,0)
-          . . ; W "OUTXML ",OUTXML,!
-"RTN","GPLPROBS",75,0)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLPROBS",76,0)
-          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
-"RTN","GPLPROBS",77,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
-"RTN","GPLPROBS",78,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLPROBS",79,0)
-          ; ZWR @OUTXML
-"RTN","GPLPROBS",80,0)
-          ; $$HTML^DILF(
-"RTN","GPLPROBS",81,0)
-          ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","GPLPROBS",82,0)
-          I CCD D  ; IF THIS IS FOR A CCD
-"RTN","GPLPROBS",83,0)
-          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
-"RTN","GPLPROBS",84,0)
-          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","GPLPROBS",85,0)
-          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
-"RTN","GPLPROBS",86,0)
-          . . I DEBUG W "VMAP =",VMAP,!
-"RTN","GPLPROBS",87,0)
-          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","GPLPROBS",88,0)
-          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","GPLPROBS",89,0)
-          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
-"RTN","GPLPROBS",90,0)
-          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","GPLPROBS",91,0)
-          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","GPLPROBS",92,0)
-          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",93,0)
-          . . . D CP^GPLXPATH("HOUT","HTMLO")
-"RTN","GPLPROBS",94,0)
-          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","GPLPROBS",95,0)
-          . . . I DEBUG W "DOING INNER",!
-"RTN","GPLPROBS",96,0)
-          . . . N HTMLBLD,HTMLTMP
-"RTN","GPLPROBS",97,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","GPLPROBS",98,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","GPLPROBS",99,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","GPLPROBS",100,0)
-          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
-"RTN","GPLPROBS",101,0)
-          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
-"RTN","GPLPROBS",102,0)
-          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
-"RTN","GPLPROBS",103,0)
-          . I DEBUG D PARY^GPLXPATH("HTMLO")
-"RTN","GPLPROBS",104,0)
-          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","GPLPROBS",105,0)
-          N PROBSTMP,I
-"RTN","GPLPROBS",106,0)
-          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLPROBS",107,0)
-          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLPROBS",108,0)
-          . ; STRINGS MARKED AS @@X@@
-"RTN","GPLPROBS",109,0)
-          . W !,"PROBLEMS Missing list: ",!
-"RTN","GPLPROBS",110,0)
-          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","GPLPROBS",111,0)
-          Q
-"RTN","GPLPROBS",112,0)
-          ;
-"RTN","GPLRIMA")
-0^18^B214212612
-"RTN","GPLRIMA",1,0)
-GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-"RTN","GPLRIMA",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 12
-"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)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
-"RTN","GPLRIMA",63,0)
-    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","GPLRIMA",64,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
-"RTN","GPLRIMA",65,0)
-    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","GPLRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
-"RTN","GPLRIMA",67,0)
-    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","GPLRIMA",68,0)
-    . ;
-"RTN","GPLRIMA",69,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-"RTN","GPLRIMA",70,0)
-    . ;
-"RTN","GPLRIMA",71,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-"RTN","GPLRIMA",72,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","GPLRIMA",73,0)
-    . ;
-"RTN","GPLRIMA",74,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","GPLRIMA",75,0)
-    . ;
-"RTN","GPLRIMA",76,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","GPLRIMA",77,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","GPLRIMA",78,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","GPLRIMA",79,0)
-    . ;
-"RTN","GPLRIMA",80,0)
-    . N CATNAME,CATTBL
-"RTN","GPLRIMA",81,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","GPLRIMA",82,0)
-    . S CATNAME=""
-"RTN","GPLRIMA",83,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","GPLRIMA",84,0)
-    . W "CATEGORY NAME: ",CATNAME,!
-"RTN","GPLRIMA",85,0)
-    . ;
-"RTN","GPLRIMA",86,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
-"RTN","GPLRIMA",87,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","GPLRIMA",88,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","GPLRIMA",89,0)
-    . ; AND WE SKIP IT
-"RTN","GPLRIMA",90,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","GPLRIMA",91,0)
-    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","GPLRIMA",92,0)
-    Q
-"RTN","GPLRIMA",93,0)
-    ;
-"RTN","GPLRIMA",94,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","GPLRIMA",95,0)
-    N SBASE,SATTR
-"RTN","GPLRIMA",96,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","GPLRIMA",97,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","GPLRIMA",98,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","GPLRIMA",99,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","GPLRIMA",100,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","GPLRIMA",101,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","GPLRIMA",102,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","GPLRIMA",103,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","GPLRIMA",104,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",105,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","GPLRIMA",106,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",107,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",108,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","GPLRIMA",109,0)
-    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","GPLRIMA",110,0)
-    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","GPLRIMA",111,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","GPLRIMA",112,0)
-    Q SATTR
-"RTN","GPLRIMA",113,0)
-    ;
-"RTN","GPLRIMA",114,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","GPLRIMA",115,0)
-    K ^TMP("GPLRIM","RESUME")
-"RTN","GPLRIMA",116,0)
-    K ^TMP("GPLRIM")
-"RTN","GPLRIMA",117,0)
-    Q
-"RTN","GPLRIMA",118,0)
-    ;
-"RTN","GPLRIMA",119,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","GPLRIMA",120,0)
-    ;
-"RTN","GPLRIMA",121,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",122,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","GPLRIMA",123,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","GPLRIMA",124,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","GPLRIMA",125,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","GPLRIMA",126,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","GPLRIMA",127,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","GPLRIMA",128,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","GPLRIMA",129,0)
-    . W CLIDX,!
-"RTN","GPLRIMA",130,0)
-    ; D PARY^GPLXPATH(CLBASE)
-"RTN","GPLRIMA",131,0)
-    Q
-"RTN","GPLRIMA",132,0)
-    ;
-"RTN","GPLRIMA",133,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","GPLRIMA",134,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","GPLRIMA",135,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","GPLRIMA",136,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","GPLRIMA",137,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","GPLRIMA",138,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","GPLRIMA",139,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","GPLRIMA",140,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","GPLRIMA",141,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","GPLRIMA",142,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","GPLRIMA",143,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","GPLRIMA",144,0)
-    ;
-"RTN","GPLRIMA",145,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","GPLRIMA",146,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","GPLRIMA",147,0)
-    W "CBASE: ",CCTBL,!
-"RTN","GPLRIMA",148,0)
-    ;
-"RTN","GPLRIMA",149,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","GPLRIMA",150,0)
-    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","GPLRIMA",151,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","GPLRIMA",152,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","GPLRIMA",153,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","GPLRIMA",154,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","GPLRIMA",155,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","GPLRIMA",156,0)
-    ;
-"RTN","GPLRIMA",157,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","GPLRIMA",158,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",159,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","GPLRIMA",160,0)
-    ;
-"RTN","GPLRIMA",161,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","GPLRIMA",162,0)
-    ;
-"RTN","GPLRIMA",163,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","GPLRIMA",164,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","GPLRIMA",165,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","GPLRIMA",166,0)
-    ;
-"RTN","GPLRIMA",167,0)
-    Q
-"RTN","GPLRIMA",168,0)
-    ;
-"RTN","GPLRIMA",169,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","GPLRIMA",170,0)
-    ;
-"RTN","GPLRIMA",171,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",172,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","GPLRIMA",173,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",174,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",175,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","GPLRIMA",176,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","GPLRIMA",177,0)
-    . S ZCNT=0
-"RTN","GPLRIMA",178,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","GPLRIMA",179,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","GPLRIMA",180,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","GPLRIMA",181,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","GPLRIMA",182,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",183,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","GPLRIMA",184,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","GPLRIMA",185,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","GPLRIMA",186,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","GPLRIMA",187,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","GPLRIMA",188,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","GPLRIMA",189,0)
-    Q
-"RTN","GPLRIMA",190,0)
-    ;
-"RTN","GPLRIMA",191,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","GPLRIMA",192,0)
-    ; INLST IS PASSED BY NAME
-"RTN","GPLRIMA",193,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","GPLRIMA",194,0)
-    W INLST,!
-"RTN","GPLRIMA",195,0)
-    S ZCOUNT=0
-"RTN","GPLRIMA",196,0)
-    S ZDX=""
-"RTN","GPLRIMA",197,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","GPLRIMA",198,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","GPLRIMA",199,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","GPLRIMA",200,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","GPLRIMA",201,0)
-    Q ZCOUNT
-"RTN","GPLRIMA",202,0)
-    ;
-"RTN","GPLRIMA",203,0)
-XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN 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 ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",208,0)
-    S ZI=""
-"RTN","GPLRIMA",209,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",210,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",211,0)
-    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
-"RTN","GPLRIMA",212,0)
-    Q
-"RTN","GPLRIMA",213,0)
-    ;
-"RTN","GPLRIMA",214,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","GPLRIMA",215,0)
-    ;
-"RTN","GPLRIMA",216,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",217,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",218,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","GPLRIMA",219,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",220,0)
-    S ZI=""
-"RTN","GPLRIMA",221,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",222,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",223,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","GPLRIMA",224,0)
-    . W ZI," "
-"RTN","GPLRIMA",225,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","GPLRIMA",226,0)
-    . . S ZC=0
-"RTN","GPLRIMA",227,0)
-    . . W !
-"RTN","GPLRIMA",228,0)
-    Q
-"RTN","GPLRIMA",229,0)
-    ;
-"RTN","GPLRIMA",230,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","GPLRIMA",231,0)
-    ;
-"RTN","GPLRIMA",232,0)
-    N ATTR S ATTR=""
-"RTN","GPLRIMA",233,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",234,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","GPLRIMA",235,0)
-    S ATTR=^TMP("GPLRIM","ATTR",DFN)
-"RTN","GPLRIMA",236,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","GPLRIMA",237,0)
-    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","GPLRIMA",238,0)
-    . N CAT
-"RTN","GPLRIMA",239,0)
-    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","GPLRIMA",240,0)
-    . W CAT,": ",ATTR,!
-"RTN","GPLRIMA",241,0)
-    Q
-"RTN","GPLRIMA",242,0)
-    ;
-"RTN","GPLRIMA",243,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","GPLRIMA",244,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","GPLRIMA",245,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","GPLRIMA",246,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","GPLRIMA",247,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","GPLRIMA",248,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","GPLRIMA",249,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","GPLRIMA",250,0)
-    ;
-"RTN","GPLRIMA",251,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","GPLRIMA",252,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","GPLRIMA",253,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","GPLRIMA",254,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","GPLRIMA",255,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","GPLRIMA",256,0)
-    Q
-"RTN","GPLRIMA",257,0)
-    ;
-"RTN","GPLRIMA",258,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","GPLRIMA",259,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
-"RTN","GPLRIMA",260,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","GPLRIMA",261,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","GPLRIMA",262,0)
-      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","GPLRIMA",263,0)
-      Q
-"RTN","GPLRIMA",264,0)
-      ;
-"RTN","GPLRIMA",265,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","GPLRIMA",266,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",267,0)
-      K @RIMTBL
-"RTN","GPLRIMA",268,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","GPLRIMA",269,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","GPLRIMA",270,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","GPLRIMA",271,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","GPLRIMA",272,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","GPLRIMA",273,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","GPLRIMA",274,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","GPLRIMA",275,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","GPLRIMA",276,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","GPLRIMA",277,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","GPLRIMA",278,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","GPLRIMA",279,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","GPLRIMA",280,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","GPLRIMA",281,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","GPLRIMA",282,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","GPLRIMA",283,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","GPLRIMA",284,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","GPLRIMA",285,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","GPLRIMA",286,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","GPLRIMA",287,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","GPLRIMA",288,0)
-      Q
-"RTN","GPLRIMA",289,0)
-      ;
-"RTN","GPLRIMA",290,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","GPLRIMA",291,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","GPLRIMA",292,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","GPLRIMA",293,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","GPLRIMA",294,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","GPLRIMA",295,0)
-    N USETBL
-"RTN","GPLRIMA",296,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","GPLRIMA",297,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","GPLRIMA",298,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","GPLRIMA",299,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","GPLRIMA",300,0)
-    Q
-"RTN","GPLRIMA",301,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","GPLRIMA",302,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","GPLRIMA",303,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","GPLRIMA",304,0)
-    ; IN SECTION "MEDS"
-"RTN","GPLRIMA",305,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","GPLRIMA",306,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","GPLRIMA",307,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","GPLRIMA",308,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","GPLRIMA",309,0)
-    ;
-"RTN","GPLRIMA",310,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","GPLRIMA",311,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",312,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",313,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","GPLRIMA",314,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","GPLRIMA",315,0)
-    N ZZI,ZZS
-"RTN","GPLRIMA",316,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","GPLRIMA",317,0)
-    ; ZWR @ZZS@(1)
-"RTN","GPLRIMA",318,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","GPLRIMA",319,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","GPLRIMA",320,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","GPLRIMA",321,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","GPLRIMA",322,0)
-    Q
-"RTN","GPLRIMA",323,0)
-    ;
-"RTN","GPLRIMA",324,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","GPLRIMA",325,0)
-    ;
-"RTN","GPLRIMA",326,0)
-    N ZR
-"RTN","GPLRIMA",327,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","GPLRIMA",328,0)
-    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
-"RTN","GPLRIMA",329,0)
-    E  W "NOTHING RETURNED",!
-"RTN","GPLRIMA",330,0)
-    Q
-"RTN","GPLRIMA",331,0)
-    ;
-"RTN","GPLRIMA",332,0)
-CAGET(RTN,IATTR) ;
-"RTN","GPLRIMA",333,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",334,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","GPLRIMA",335,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","GPLRIMA",336,0)
-    Q
-"RTN","GPLRIMA",337,0)
-    ;
-"RTN","GPLRIMA",338,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",339,0)
-    ;
-"RTN","GPLRIMA",340,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",341,0)
-    N ZLST
-"RTN","GPLRIMA",342,0)
-    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
-"RTN","GPLRIMA",343,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",344,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",345,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","GPLRIMA",346,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","GPLRIMA",347,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","GPLRIMA",348,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","GPLRIMA",349,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","GPLRIMA",350,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","GPLRIMA",351,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","GPLRIMA",352,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","GPLRIMA",353,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","GPLRIMA",354,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","GPLRIMA",355,0)
-    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","GPLRIMA",356,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","GPLRIMA",357,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","GPLRIMA",358,0)
-    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","GPLRIMA",359,0)
-    . S ZCNT=ZCNT+1
-"RTN","GPLRIMA",360,0)
-    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","GPLRIMA",361,0)
-    Q
-"RTN","GPLRIMA",362,0)
-    ;
-"RTN","GPLRIMA",363,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","GPLRIMA",364,0)
-    ;
-"RTN","GPLRIMA",365,0)
-    N ZR
-"RTN","GPLRIMA",366,0)
-    D PCLST(.ZR,CATTR)
-"RTN","GPLRIMA",367,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","GPLRIMA",368,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","GPLRIMA",369,0)
-    E  D  ;
-"RTN","GPLRIMA",370,0)
-    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
-"RTN","GPLRIMA",371,0)
-    . W "COUNT=",ZR(0),!
-"RTN","GPLRIMA",372,0)
-    Q
-"RTN","GPLRIMA",373,0)
-    ;
-"RTN","GPLRIMA",374,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","GPLRIMA",375,0)
-    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","GPLRIMA",376,0)
-    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","GPLRIMA",377,0)
-    ; DFN IS THE PATIENT NUMBER.
-"RTN","GPLRIMA",378,0)
-    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",379,0)
-    ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","GPLRIMA",380,0)
-    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","GPLRIMA",381,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",382,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",383,0)
-    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","GPLRIMA",384,0)
-    N ZZGI
-"RTN","GPLRIMA",385,0)
-    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","GPLRIMA",386,0)
-    . F ZZGI="PROBLEMS","VITALS","MEDS" D  ; FOR EACH SECTION
-"RTN","GPLRIMA",387,0)
-    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","GPLRIMA",388,0)
-    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","GPLRIMA",389,0)
-    Q
-"RTN","GPLRIMA",390,0)
-    ;
-"RTN","GPLRIMA",391,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","GPLRIMA",392,0)
-    ;
-"RTN","GPLRIMA",393,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","GPLRIMA",394,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","GPLRIMA",395,0)
-    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","GPLRIMA",396,0)
-    E  D  ; VARS EXIST
-"RTN","GPLRIMA",397,0)
-    . N ZGVI
-"RTN","GPLRIMA",398,0)
-    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","GPLRIMA",399,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","GPLRIMA",400,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","GPLRIMA",401,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","GPLRIMA",402,0)
-    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","GPLRIMA",403,0)
-    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
-"RTN","GPLRIMA",404,0)
-    . . ; D PARY^GPLXPATH("ZZGA")
-"RTN","GPLRIMA",405,0)
-    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","GPLRIMA",406,0)
-    Q
-"RTN","GPLRIMA",407,0)
-    ;
-"RTN","GPLRIMA",408,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
-"RTN","GPLRIMA",409,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","GPLRIMA",410,0)
-    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",411,0)
-    N GTMP
-"RTN","GPLRIMA",412,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",413,0)
-    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","GPLRIMA",414,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","GPLRIMA",415,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","GPLRIMA",416,0)
-    D PARY^GPLXPATH("GTMP")
-"RTN","GPLRIMA",417,0)
-    Q
-"RTN","GPLRIMA",418,0)
-    ;
-"RTN","GPLUNIT")
-0^12^B31438520
-"RTN","GPLUNIT",1,0)
-GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-"RTN","GPLUNIT",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 12
-"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  Q ; TEST SECTION DOESN'T EXIST
-"RTN","GPLUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","GPLUNIT",83,0)
-          N FIRST,LAST
-"RTN","GPLUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","GPLUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","GPLUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
-"RTN","GPLUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","GPLUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",89,0)
-          . . ;  W ZP,!
-"RTN","GPLUNIT",90,0)
-          . . S ZX=ZP
-"RTN","GPLUNIT",91,0)
-          . . W "RUNNING: "_ZP
-"RTN","GPLUNIT",92,0)
-          . . X ZX
-"RTN","GPLUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
-"RTN","GPLUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-"RTN","GPLUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",96,0)
-          . . S ZX="S ZR="_ZP
-"RTN","GPLUNIT",97,0)
-          . . W "TRYING: "_ZP
-"RTN","GPLUNIT",98,0)
-          . . X ZX
-"RTN","GPLUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","GPLUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-"RTN","GPLUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
-"RTN","GPLUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
-"RTN","GPLUNIT",104,0)
-          Q
-"RTN","GPLUNIT",105,0)
-          ;
-"RTN","GPLUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
-"RTN","GPLUNIT",107,0)
-          N ZTMP
-"RTN","GPLUNIT",108,0)
-          D ZLOAD(.ZTMP)
-"RTN","GPLUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
-"RTN","GPLUNIT",110,0)
-          W "PASSED: ",TPASSED,!
-"RTN","GPLUNIT",111,0)
-          W "FAILED: ",TFAILED,!
-"RTN","GPLUNIT",112,0)
-          W !
-"RTN","GPLUNIT",113,0)
-          W "THE TESTS!",!
-"RTN","GPLUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
-"RTN","GPLUNIT",115,0)
-          Q
-"RTN","GPLUNIT",116,0)
-          ;
-"RTN","GPLUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","GPLUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",119,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",120,0)
-          . D PUSH^GPLXPATH(RTN,I)
-"RTN","GPLUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",122,0)
-          Q
-"RTN","GPLUNIT",123,0)
-          ;
-"RTN","GPLUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","GPLUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","GPLUNIT",126,0)
-          S TOTP=0 S TOTF=0
-"RTN","GPLUNIT",127,0)
-          D ZLOAD^GPLUNIT("TZTMP",RNM)
-"RTN","GPLUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
-"RTN","GPLUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",131,0)
-          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
-"RTN","GPLUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
-"RTN","GPLUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
-"RTN","GPLUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","GPLUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","GPLUNIT",136,0)
-          F I=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","GPLUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","GPLUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","GPLUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","GPLUNIT",141,0)
-          Q
-"RTN","GPLUNIT",142,0)
-          ;
-"RTN","GPLUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","GPLUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-"RTN","GPLUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
-"RTN","GPLUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",147,0)
-          S K=1
-"RTN","GPLUNIT",148,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",149,0)
-          . ; W "I IS NOW=",I,!
-"RTN","GPLUNIT",150,0)
-          . W I," "
-"RTN","GPLUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",152,0)
-          . S K=K+1 I K=6  D
-"RTN","GPLUNIT",153,0)
-          . . W !
-"RTN","GPLUNIT",154,0)
-          . . S K=1
-"RTN","GPLUNIT",155,0)
-          Q
-"RTN","GPLUNIT",156,0)
-          ;
-"RTN","GPLVITAL")
-0^17^B82628966
-"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 12
-"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)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","GPLVITAL",45,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","GPLVITAL",46,0)
- . I $D(VITRSLT(VSORT(J))) D
-"RTN","GPLVITAL",47,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","GPLVITAL",48,0)
- . . K @VITVMAP
-"RTN","GPLVITAL",49,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","GPLVITAL",50,0)
- . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","GPLVITAL",51,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","GPLVITAL",52,0)
- . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","GPLVITAL",53,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","GPLVITAL",54,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","GPLVITAL",55,0)
- . . I $P(VITPTMP,U,2)="HT" D
-"RTN","GPLVITAL",56,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",57,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",58,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",59,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",60,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",61,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",62,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",63,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-"RTN","GPLVITAL",64,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",65,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",66,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",67,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",68,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","GPLVITAL",69,0)
- . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","GPLVITAL",70,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",71,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",72,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",73,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",74,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",75,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",76,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",77,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-"RTN","GPLVITAL",78,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",79,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",80,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",81,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",82,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","GPLVITAL",83,0)
- . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","GPLVITAL",84,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",85,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",86,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",87,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",88,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",89,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",90,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",91,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-"RTN","GPLVITAL",92,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",93,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",94,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",95,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",96,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",97,0)
- . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","GPLVITAL",98,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",99,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",100,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",101,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",102,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",103,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",104,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",105,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-"RTN","GPLVITAL",106,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",107,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",108,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",109,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",110,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","GPLVITAL",111,0)
- . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","GPLVITAL",112,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",113,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",114,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",115,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",116,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",117,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",118,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",119,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-"RTN","GPLVITAL",120,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",121,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",122,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",123,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",124,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",125,0)
- . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","GPLVITAL",126,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",127,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",128,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",129,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",130,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",131,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",132,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",133,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-"RTN","GPLVITAL",134,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",135,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",136,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",137,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",138,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",139,0)
- . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","GPLVITAL",140,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",141,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",142,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",143,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",144,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",145,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",146,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",147,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-"RTN","GPLVITAL",148,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",149,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",150,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",151,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",152,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",153,0)
- . . E  D
-"RTN","GPLVITAL",154,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","GPLVITAL",155,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",156,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",157,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","GPLVITAL",158,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",159,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",160,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","GPLVITAL",161,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","GPLVITAL",162,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-"RTN","GPLVITAL",163,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-"RTN","GPLVITAL",164,0)
- . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",165,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",166,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",167,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","GPLVITAL",168,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","GPLVITAL",169,0)
- . . K @VITARYTMP
-"RTN","GPLVITAL",170,0)
- . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","GPLVITAL",171,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLVITAL",172,0)
- . . . ; W "FIRST ONE",!
-"RTN","GPLVITAL",173,0)
- . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-"RTN","GPLVITAL",174,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","GPLVITAL",175,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLVITAL",176,0)
- . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-"RTN","GPLVITAL",177,0)
- ; ZWR ^TMP($J,"VITALS",*)
-"RTN","GPLVITAL",178,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLVITAL",179,0)
- I DEBUG D PARY^GPLXPATH(VITOUTXML)
-"RTN","GPLVITAL",180,0)
- N VITTMP,I
-"RTN","GPLVITAL",181,0)
- D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLVITAL",182,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLVITAL",183,0)
- . W "VITALS MISSING ",!
-"RTN","GPLVITAL",184,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","GPLVITAL",185,0)
- Q
-"RTN","GPLVITAL",186,0)
- ;
-"RTN","GPLVITAL",187,0)
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","GPLVITAL",188,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","GPLVITAL",189,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","GPLVITAL",190,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","GPLVITAL",191,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","GPLVITAL",192,0)
- F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","GPLVITAL",193,0)
- . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","GPLVITAL",194,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","GPLVITAL",195,0)
- . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","GPLVITAL",196,0)
- S VDT(0)=VTDCNT
-"RTN","GPLVITAL",197,0)
- Q
-"RTN","GPLVITAL",198,0)
- ;
-"RTN","GPLXPAT0")
-0^21^B50983429
-"RTN","GPLXPAT0",1,0)
-GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-"RTN","GPLXPAT0",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 12
-"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)
- ;;><PUSHA>
-"RTN","GPLXPAT0",193,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","GPLXPAT0",195,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","A")
-"RTN","GPLXPAT0",196,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","B")
-"RTN","GPLXPAT0",197,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","C")
-"RTN","GPLXPAT0",198,0)
- ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
-"RTN","GPLXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","GPLXPAT0",200,0)
- ;;>>?GTMP(0)=3
-"RTN","GPLXPAT0",201,0)
- ;;><H2ARY>
-"RTN","GPLXPAT0",202,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","GPLXPAT0",204,0)
- ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","GPLXPAT0",206,0)
- ;;>>?GTMP2(1)="TEST1^1"
-"RTN","GPLXPAT0",207,0)
- ;;><XVARS>
-"RTN","GPLXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",209,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
-"RTN","GPLXPAT0",210,0)
- ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",211,0)
- ;;>>?GTMP2(1)="VAR1^"
-"RTN","GPLXPAT0",212,0)
- ;;></TEST>
-"RTN","GPLXPATH")
-0^9^B241520746
-"RTN","GPLXPATH",1,0)
-GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-"RTN","GPLXPATH",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 12
-"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)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","GPLXPATH",53,0)
- ;
-"RTN","GPLXPATH",54,0)
- N ZGI
-"RTN","GPLXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
-"RTN","GPLXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
-"RTN","GPLXPATH",57,0)
- Q
-"RTN","GPLXPATH",58,0)
- ;
-"RTN","GPLXPATH",59,0)
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","GPLXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","GPLXPATH",61,0)
- S RTN=""
-"RTN","GPLXPATH",62,0)
- N I
-"RTN","GPLXPATH",63,0)
- ; W "STK= ",STK,!
-"RTN","GPLXPATH",64,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",65,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","GPLXPATH",66,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","GPLXPATH",67,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","GPLXPATH",68,0)
- Q
-"RTN","GPLXPATH",69,0)
- ;
-"RTN","GPLXPATH",70,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","GPLXPATH",71,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","GPLXPATH",72,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","GPLXPATH",73,0)
- N CUR,TMP
-"RTN","GPLXPATH",74,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","GPLXPATH",75,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","GPLXPATH",76,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","GPLXPATH",77,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","GPLXPATH",78,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","GPLXPATH",79,0)
- ; W "CUR= ",CUR,!
-"RTN","GPLXPATH",80,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","GPLXPATH",81,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","GPLXPATH",82,0)
- ; W "CUR2= ",CUR,!
-"RTN","GPLXPATH",83,0)
- Q CUR
-"RTN","GPLXPATH",84,0)
- ;
-"RTN","GPLXPATH",85,0)
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
-"RTN","GPLXPATH",86,0)
- ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
-"RTN","GPLXPATH",87,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","GPLXPATH",88,0)
- ; XML SECTION
-"RTN","GPLXPATH",89,0)
- ; ZXML IS PASSED BY NAME
-"RTN","GPLXPATH",90,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
-"RTN","GPLXPATH",91,0)
- N GPLSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","GPLXPATH",92,0)
- I '$D(@ZXML@(0))  D  ; NO XML PASSED
-"RTN","GPLXPATH",93,0)
- . W "ERROR IN XML FILE",!
-"RTN","GPLXPATH",94,0)
- S GPLSTK(0)=0 ; INITIALIZE STACK
-"RTN","GPLXPATH",95,0)
- F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","GPLXPATH",96,0)
- . S LINE=@ZXML@(I)
-"RTN","GPLXPATH",97,0)
- . ;W LINE,!
-"RTN","GPLXPATH",98,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","GPLXPATH",99,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","GPLXPATH",100,0)
- . I FOUND'=1  D
-"RTN","GPLXPATH",101,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","GPLXPATH",102,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","GPLXPATH",103,0)
- . . . ; ON THE SAME LINE
-"RTN","GPLXPATH",104,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",105,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",106,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",107,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",108,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",109,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",110,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",111,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",112,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",113,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","GPLXPATH",114,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",115,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","GPLXPATH",116,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","GPLXPATH",117,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",118,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",119,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",120,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",121,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",122,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",123,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","GPLXPATH",124,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","GPLXPATH",125,0)
- . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","GPLXPATH",126,0)
- . . . . Q
-"RTN","GPLXPATH",127,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","GPLXPATH",128,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","GPLXPATH",129,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",130,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",131,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",132,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",133,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",134,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",135,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",136,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",137,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",138,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","GPLXPATH",139,0)
- S @ZXML@("INDEXED")=""
-"RTN","GPLXPATH",140,0)
- S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
-"RTN","GPLXPATH",141,0)
- Q
-"RTN","GPLXPATH",142,0)
- ;
-"RTN","GPLXPATH",143,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","GPLXPATH",144,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","GPLXPATH",145,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","GPLXPATH",146,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","GPLXPATH",147,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","GPLXPATH",148,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","GPLXPATH",149,0)
- N TMP,I,J,QXPATH
-"RTN","GPLXPATH",150,0)
- S FIRST=1
-"RTN","GPLXPATH",151,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","GPLXPATH",152,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","GPLXPATH",153,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","GPLXPATH",154,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","GPLXPATH",155,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","GPLXPATH",156,0)
- K @OARY
-"RTN","GPLXPATH",157,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","GPLXPATH",158,0)
- S J=1
-"RTN","GPLXPATH",159,0)
- FOR I=FIRST:1:LAST  D
-"RTN","GPLXPATH",160,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","GPLXPATH",161,0)
- . S J=J+1
-"RTN","GPLXPATH",162,0)
- ; ZWR OARY
-"RTN","GPLXPATH",163,0)
- Q
-"RTN","GPLXPATH",164,0)
- ;
-"RTN","GPLXPATH",165,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","GPLXPATH",166,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",167,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",168,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","GPLXPATH",169,0)
- ;
-"RTN","GPLXPATH",170,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","GPLXPATH",171,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",172,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",173,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","GPLXPATH",174,0)
- ;
-"RTN","GPLXPATH",175,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","GPLXPATH",176,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",177,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",178,0)
- Q $P(ISTR,";",2)
-"RTN","GPLXPATH",179,0)
- ;
-"RTN","GPLXPATH",180,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","GPLXPATH",181,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",182,0)
- Q $P(ISTR,";",3)
-"RTN","GPLXPATH",183,0)
- ;
-"RTN","GPLXPATH",184,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","GPLXPATH",185,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",186,0)
- Q $P(ISTR,";",1)
-"RTN","GPLXPATH",187,0)
- ;
-"RTN","GPLXPATH",188,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","GPLXPATH",189,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","GPLXPATH",190,0)
- ; DEST IS CLEARED TO START
-"RTN","GPLXPATH",191,0)
- ; USES PUSH TO DO THE COPY
-"RTN","GPLXPATH",192,0)
- N I
-"RTN","GPLXPATH",193,0)
- K @BDEST
-"RTN","GPLXPATH",194,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","GPLXPATH",195,0)
- . N J,ATMP
-"RTN","GPLXPATH",196,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","GPLXPATH",197,0)
- . I DEBUG W "ATMP=",ATMP,!
-"RTN","GPLXPATH",198,0)
- . I DEBUG W @BLIST@(I),!
-"RTN","GPLXPATH",199,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","GPLXPATH",200,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","GPLXPATH",201,0)
- . . I DEBUG W "BDEST= ",BDEST,!
-"RTN","GPLXPATH",202,0)
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
-"RTN","GPLXPATH",203,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","GPLXPATH",204,0)
- Q
-"RTN","GPLXPATH",205,0)
- ;
-"RTN","GPLXPATH",206,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","GPLXPATH",207,0)
- ;
-"RTN","GPLXPATH",208,0)
- I DEBUG W "QUEUEING ",BLST,!
-"RTN","GPLXPATH",209,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","GPLXPATH",210,0)
- Q
-"RTN","GPLXPATH",211,0)
- ;
-"RTN","GPLXPATH",212,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","GPLXPATH",213,0)
- ; KILLS CPDEST FIRST
-"RTN","GPLXPATH",214,0)
- N CPINSTR
-"RTN","GPLXPATH",215,0)
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","GPLXPATH",216,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","GPLXPATH",217,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","GPLXPATH",218,0)
- . Q
-"RTN","GPLXPATH",219,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","GPLXPATH",220,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","GPLXPATH",221,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","GPLXPATH",222,0)
- Q
-"RTN","GPLXPATH",223,0)
- ;
-"RTN","GPLXPATH",224,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","GPLXPATH",225,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","GPLXPATH",226,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","GPLXPATH",227,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","GPLXPATH",228,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",229,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","GPLXPATH",230,0)
- . Q
-"RTN","GPLXPATH",231,0)
- I DEBUG W "DOING QOPEN",!
-"RTN","GPLXPATH",232,0)
- N S1,E1,QOT,QOTMP
-"RTN","GPLXPATH",233,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","GPLXPATH",234,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",235,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","GPLXPATH",236,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","GPLXPATH",237,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",238,0)
- . S E1=@QOXML@(0)-1
-"RTN","GPLXPATH",239,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","GPLXPATH",240,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","GPLXPATH",241,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","GPLXPATH",242,0)
- Q
-"RTN","GPLXPATH",243,0)
- ;
-"RTN","GPLXPATH",244,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","GPLXPATH",245,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","GPLXPATH",246,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","GPLXPATH",247,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","GPLXPATH",248,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","GPLXPATH",249,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",250,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","GPLXPATH",251,0)
- I DEBUG W "GOING TO CLOSE",!
-"RTN","GPLXPATH",252,0)
- N S1,E1,QCT,QCTMP
-"RTN","GPLXPATH",253,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","GPLXPATH",254,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",255,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","GPLXPATH",256,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","GPLXPATH",257,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",258,0)
- . S S1=@QCXML@(0)
-"RTN","GPLXPATH",259,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","GPLXPATH",260,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","GPLXPATH",261,0)
- Q
-"RTN","GPLXPATH",262,0)
- ;
-"RTN","GPLXPATH",263,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","GPLXPATH",264,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","GPLXPATH",265,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","GPLXPATH",266,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","GPLXPATH",267,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","GPLXPATH",268,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","GPLXPATH",269,0)
- N INSBLD,INSTMP
-"RTN","GPLXPATH",270,0)
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","GPLXPATH",271,0)
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","GPLXPATH",272,0)
- I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","GPLXPATH",273,0)
- . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","GPLXPATH",274,0)
- I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",275,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",276,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","GPLXPATH",277,0)
- . . I DEBUG D PARY^GPLXPATH("INSBLD")
-"RTN","GPLXPATH",278,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",279,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","GPLXPATH",280,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","GPLXPATH",281,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",282,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","GPLXPATH",283,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",284,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","GPLXPATH",285,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","GPLXPATH",286,0)
- . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","GPLXPATH",287,0)
- Q
-"RTN","GPLXPATH",288,0)
- ;
-"RTN","GPLXPATH",289,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","GPLXPATH",290,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","GPLXPATH",291,0)
- ;
-"RTN","GPLXPATH",292,0)
- N INNBLD,UXPATH
-"RTN","GPLXPATH",293,0)
- N INNTBUF
-"RTN","GPLXPATH",294,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","GPLXPATH",295,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","GPLXPATH",296,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","GPLXPATH",297,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","GPLXPATH",298,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","GPLXPATH",299,0)
- . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","GPLXPATH",300,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","GPLXPATH",301,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","GPLXPATH",302,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","GPLXPATH",303,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","GPLXPATH",304,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","GPLXPATH",305,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","GPLXPATH",306,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","GPLXPATH",307,0)
- Q
-"RTN","GPLXPATH",308,0)
- ;
-"RTN","GPLXPATH",309,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","GPLXPATH",310,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","GPLXPATH",311,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",312,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","GPLXPATH",313,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","GPLXPATH",314,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","GPLXPATH",315,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",316,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","GPLXPATH",317,0)
- I DEBUG D PARY("XDEST")
-"RTN","GPLXPATH",318,0)
- Q
-"RTN","GPLXPATH",319,0)
- ;
-"RTN","GPLXPATH",320,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","GPLXPATH",321,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","GPLXPATH",322,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","GPLXPATH",323,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","GPLXPATH",324,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","GPLXPATH",325,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","GPLXPATH",326,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","GPLXPATH",327,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","GPLXPATH",328,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","GPLXPATH",329,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","GPLXPATH",330,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","GPLXPATH",331,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","GPLXPATH",332,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",333,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","GPLXPATH",334,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","GPLXPATH",335,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","GPLXPATH",336,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",337,0)
- I DEBUG W "REPLACE PREBUILD",!
-"RTN","GPLXPATH",338,0)
- I DEBUG D PARY("REBLD")
-"RTN","GPLXPATH",339,0)
- D BUILD("REBLD","RTMP")
-"RTN","GPLXPATH",340,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","GPLXPATH",341,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","GPLXPATH",342,0)
- Q
-"RTN","GPLXPATH",343,0)
- ;
-"RTN","GPLXPATH",344,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","GPLXPATH",345,0)
- ; W "Reporting on the missing",!
-"RTN","GPLXPATH",346,0)
- ; W OARY
-"RTN","GPLXPATH",347,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","GPLXPATH",348,0)
- N I
-"RTN","GPLXPATH",349,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","GPLXPATH",350,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",351,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","GPLXPATH",352,0)
- . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","GPLXPATH",353,0)
- . . Q
-"RTN","GPLXPATH",354,0)
- Q
-"RTN","GPLXPATH",355,0)
- ;
-"RTN","GPLXPATH",356,0)
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","GPLXPATH",357,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","GPLXPATH",358,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","GPLXPATH",359,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","GPLXPATH",360,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","GPLXPATH",361,0)
- S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
-"RTN","GPLXPATH",362,0)
- F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",363,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","GPLXPATH",364,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","GPLXPATH",365,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","GPLXPATH",366,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","GPLXPATH",367,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","GPLXPATH",368,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","GPLXPATH",369,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","GPLXPATH",370,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","GPLXPATH",371,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","GPLXPATH",372,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","GPLXPATH",373,0)
- . . . . E  D DOFLD ; PROCESS A FIELD
-"RTN","GPLXPATH",374,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","GPLXPATH",375,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","GPLXPATH",376,0)
- . . I DEBUG W TSTR
-"RTN","GPLXPATH",377,0)
- I DEBUG W "MAPPED",!
-"RTN","GPLXPATH",378,0)
- Q
-"RTN","GPLXPATH",379,0)
- ;
-"RTN","GPLXPATH",380,0)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
-"RTN","GPLXPATH",381,0)
- ;
-"RTN","GPLXPATH",382,0)
- Q
-"RTN","GPLXPATH",383,0)
- ;
-"RTN","GPLXPATH",384,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","GPLXPATH",385,0)
- ; THEXML IS PASSED BY NAME
-"RTN","GPLXPATH",386,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","GPLXPATH",387,0)
- S FOUND=0
-"RTN","GPLXPATH",388,0)
- S INTXT=0
-"RTN","GPLXPATH",389,0)
- I DEBUG W "DELETING EMPTY ELEMENTS",!
-"RTN","GPLXPATH",390,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","GPLXPATH",391,0)
- . S J=@THEXML@(I)
-"RTN","GPLXPATH",392,0)
- . I J["<text>" D
-"RTN","GPLXPATH",393,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","GPLXPATH",394,0)
- . . I DEBUG W "IN HTML SECTION",!
-"RTN","GPLXPATH",395,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","GPLXPATH",396,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","GPLXPATH",397,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","GPLXPATH",398,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","GPLXPATH",399,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","GPLXPATH",400,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","GPLXPATH",401,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","GPLXPATH",402,0)
- . . . I DEBUG W I,J,JP,!
-"RTN","GPLXPATH",403,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",404,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","GPLXPATH",405,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","GPLXPATH",406,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","GPLXPATH",407,0)
- . . . I DEBUG W I,J,!
-"RTN","GPLXPATH",408,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",409,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","GPLXPATH",410,0)
- . . . I JM=JPX D  ;
-"RTN","GPLXPATH",411,0)
- . . . . I DEBUG W I,JM_J_JPX,!
-"RTN","GPLXPATH",412,0)
- . . . . S DEL(I-1)=""
-"RTN","GPLXPATH",413,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","GPLXPATH",414,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","GPLXPATH",415,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","GPLXPATH",416,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","GPLXPATH",417,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","GPLXPATH",418,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","GPLXPATH",419,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","GPLXPATH",420,0)
- Q FOUND
-"RTN","GPLXPATH",421,0)
- ;
-"RTN","GPLXPATH",422,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","GPLXPATH",423,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","GPLXPATH",424,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",425,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","GPLXPATH",426,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",427,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","GPLXPATH",428,0)
- Q
-"RTN","GPLXPATH",429,0)
- ;
-"RTN","GPLXPATH",430,0)
-PARY(GLO)       ;PRINT AN ARRAY
-"RTN","GPLXPATH",431,0)
- N I
-"RTN","GPLXPATH",432,0)
- F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
-"RTN","GPLXPATH",433,0)
- Q
-"RTN","GPLXPATH",434,0)
- ;
-"RTN","GPLXPATH",435,0)
-H2ARY(IARYRTN,IHASH) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","GPLXPATH",436,0)
- ;
-"RTN","GPLXPATH",437,0)
- N H2I S H2I=""
-"RTN","GPLXPATH",438,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","GPLXPATH",439,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","GPLXPATH",440,0)
- . ; W H2I_"^"_@IHASH@(H2I),!
-"RTN","GPLXPATH",441,0)
- . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
-"RTN","GPLXPATH",442,0)
- . . W "GPLZZ",!
-"RTN","GPLXPATH",443,0)
- . . W $NA(@IHASH@(H2I)),!
-"RTN","GPLXPATH",444,0)
- . . Q  ;
-"RTN","GPLXPATH",445,0)
- . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
-"RTN","GPLXPATH",446,0)
- . ; W @IARYRTN@(0),!
-"RTN","GPLXPATH",447,0)
- Q
-"RTN","GPLXPATH",448,0)
- ;
-"RTN","GPLXPATH",449,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","GPLXPATH",450,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","GPLXPATH",451,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","GPLXPATH",452,0)
- ;
-"RTN","GPLXPATH",453,0)
- N XVI,XVTMP,XVT
-"RTN","GPLXPATH",454,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","GPLXPATH",455,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","GPLXPATH",456,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
-"RTN","GPLXPATH",457,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","GPLXPATH",458,0)
- Q
-"RTN","GPLXPATH",459,0)
- ;
-"RTN","GPLXPATH",460,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","GPLXPATH",461,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","GPLXPATH",462,0)
- ;
-"RTN","GPLXPATH",463,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","GPLXPATH",464,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","GPLXPATH",465,0)
- . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",466,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",467,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","GPLXPATH",468,0)
- . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",469,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",470,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","GPLXPATH",471,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","GPLXPATH",472,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","GPLXPATH",473,0)
- D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","GPLXPATH",474,0)
- Q
-"RTN","GPLXPATH",475,0)
- ;
-"RTN","GPLXPATH",476,0)
-TEST     ; Run all the test cases
-"RTN","GPLXPATH",477,0)
- D TESTALL^GPLUNIT("GPLXPAT0")
-"RTN","GPLXPATH",478,0)
- Q
-"RTN","GPLXPATH",479,0)
- ;
-"RTN","GPLXPATH",480,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","GPLXPATH",481,0)
- N ZTMP
-"RTN","GPLXPATH",482,0)
- S DEBUG=1
-"RTN","GPLXPATH",483,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",484,0)
- D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLXPATH",485,0)
- Q
-"RTN","GPLXPATH",486,0)
- ;
-"RTN","GPLXPATH",487,0)
-TLIST   ; LIST THE TESTS
-"RTN","GPLXPATH",488,0)
- N ZTMP
-"RTN","GPLXPATH",489,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",490,0)
- D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLXPATH",491,0)
- Q
-"RTN","GPLXPATH",492,0)
- ;
-"VER")
-8.0^22.0
-**END**
-**END**
Index: ccr/tags/CCR_1_0_7/p/CCR_1_0_5_T6_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_5_T6_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,9700 +1,0 @@
-KIDS Distribution saved on Oct 10, 2008@15:06:02
-fix for false multiple patients in ACTORS
-**KIDS**:CCR*1.0*5^
-
-**INSTALL NAME**
-CCR*1.0*5
-"BLD",6955,0)
-CCR*1.0*5^^0^3081010^n
-"BLD",6955,1,0)
-^^23^23^3080923^
-"BLD",6955,1,1,0)
- 
-"BLD",6955,1,2,0)
-CCR AND CCD EXPORT TOOLS 
-"BLD",6955,1,3,0)
- 
-"BLD",6955,1,4,0)
-SINGLE XML EXPORT TO A HOST DIRECTORY AT 
-"BLD",6955,1,5,0)
- 
-"BLD",6955,1,6,0)
-BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
-"BLD",6955,1,7,0)
-DIRECTORY
-"BLD",6955,1,8,0)
- 
-"BLD",6955,1,9,0)
-EXPORT^GPLCRR FOR THE CCR
-"BLD",6955,1,10,0)
-EXPORT^GPLCCD FOR THE CCD
-"BLD",6955,1,11,0)
-XPAT^GPLCCR(DFN,"","") 
-"BLD",6955,1,12,0)
- 
-"BLD",6955,1,13,0)
-BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
-"BLD",6955,1,14,0)
- 
-"BLD",6955,1,15,0)
-ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
-"BLD",6955,1,16,0)
-RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
-"BLD",6955,1,17,0)
-ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
-"BLD",6955,1,18,0)
- 
-"BLD",6955,1,19,0)
-CLIST^GPLRIMA TO LIST CATEGORY TOTALS
-"BLD",6955,1,20,0)
-CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
-"BLD",6955,1,21,0)
-XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
-"BLD",6955,1,22,0)
- 
-"BLD",6955,1,23,0)
-TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
-"BLD",6955,4,0)
-^9.64PA^^
-"BLD",6955,6.3)
-13
-"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^21^21
-"BLD",6955,"KRN",9.8,"NM",1,0)
-CCRDPT^^0^B45805995
-"BLD",6955,"KRN",9.8,"NM",2,0)
-CCRDPTT^^0^B4791589
-"BLD",6955,"KRN",9.8,"NM",3,0)
-CCRMEDS^^0^B59807333
-"BLD",6955,"KRN",9.8,"NM",4,0)
-CCRSYS^^0^B5866233
-"BLD",6955,"KRN",9.8,"NM",5,0)
-CCRUNIT^^0^B8574
-"BLD",6955,"KRN",9.8,"NM",6,0)
-CCRUTIL^^0^B5927217
-"BLD",6955,"KRN",9.8,"NM",7,0)
-CCRVA200^^0^B35847405
-"BLD",6955,"KRN",9.8,"NM",8,0)
-GPLCCD^^0^B114413975
-"BLD",6955,"KRN",9.8,"NM",9,0)
-GPLXPATH^^0^B241520746
-"BLD",6955,"KRN",9.8,"NM",10,0)
-CCRMEDS1^^0^B80043311
-"BLD",6955,"KRN",9.8,"NM",11,0)
-CCRMEDS2^^0^B99730224
-"BLD",6955,"KRN",9.8,"NM",12,0)
-GPLUNIT^^0^B31438520
-"BLD",6955,"KRN",9.8,"NM",13,0)
-GPLCCR^^0^B82192762
-"BLD",6955,"KRN",9.8,"NM",14,0)
-GPLCCR0^^0^B654252455
-"BLD",6955,"KRN",9.8,"NM",15,0)
-GPLCCD1^^0^B100039732
-"BLD",6955,"KRN",9.8,"NM",16,0)
-GPLACTOR^^0^B52628160
-"BLD",6955,"KRN",9.8,"NM",17,0)
-GPLVITAL^^0^B82628966
-"BLD",6955,"KRN",9.8,"NM",18,0)
-GPLRIMA^^0^B214212612
-"BLD",6955,"KRN",9.8,"NM",19,0)
-GPLALERT^^0^B13662473
-"BLD",6955,"KRN",9.8,"NM",20,0)
-GPLPROBS^^0^B25875394
-"BLD",6955,"KRN",9.8,"NM",21,0)
-GPLXPAT0^^0^B50983429
-"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","CCRMEDS1",10)
-
-"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS2",11)
-
-"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",16)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLALERT",19)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",8)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",15)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",13)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",14)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",20)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",18)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",12)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",17)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",21)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
-
-"BLD",6955,"KRN",19,0)
-19
-"BLD",6955,"KRN",19,"NM",0)
-^9.68A^^
-"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")
-21
-"RTN","CCRDPT")
-0^1^B45805995
-"RTN","CCRDPT",1,0)
-CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
-"RTN","CCRDPT",2,0)
- ;;0.2;CCRCCD;;Jun 15, 2008;Build 13
-"RTN","CCRDPT",3,0)
- ;
-"RTN","CCRDPT",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRDPT",5,0)
- ; General Public License. 
-"RTN","CCRDPT",6,0)
- ; 
-"RTN","CCRDPT",7,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRDPT",8,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRDPT",9,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRDPT",10,0)
- ; GNU General Public License for more details.
-"RTN","CCRDPT",11,0)
- ; 
-"RTN","CCRDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRDPT",14,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRDPT",15,0)
- ;
-"RTN","CCRDPT",16,0)
- ; CCRDPT       CCRCCD/SMH - Routines to Extract Patient Data for
-"RTN","CCRDPT",17,0)
- ; FAMILY       Family Name
-"RTN","CCRDPT",18,0)
- ; GIVEN        Given Name
-"RTN","CCRDPT",19,0)
- ; MIDDLE       Middle Name
-"RTN","CCRDPT",20,0)
- ; SUFFIX       Suffix Name
-"RTN","CCRDPT",21,0)
- ; DISPNAME     Display Name
-"RTN","CCRDPT",22,0)
- ; DOB          Date of Birth
-"RTN","CCRDPT",23,0)
- ; GENDER       Get Gender
-"RTN","CCRDPT",24,0)
- ; SSN          Get SSN for ID
-"RTN","CCRDPT",25,0)
- ; ADDRTYPE     Get Home Address
-"RTN","CCRDPT",26,0)
- ; ADDR1        Get Home Address line 1
-"RTN","CCRDPT",27,0)
- ; ADDR2        Get Home Address line 2
-"RTN","CCRDPT",28,0)
- ; CITY         Get City for Home Address
-"RTN","CCRDPT",29,0)
- ; STATE        Get State for Home Address
-"RTN","CCRDPT",30,0)
- ; ZIP          Get Zip code for Home Address
-"RTN","CCRDPT",31,0)
- ; COUNTY       Get County for our Address
-"RTN","CCRDPT",32,0)
- ; COUNTRY      Get Country for our Address
-"RTN","CCRDPT",33,0)
- ; RESTEL       Residential Telephone
-"RTN","CCRDPT",34,0)
- ; WORKTEL      Work Telephone
-"RTN","CCRDPT",35,0)
- ; EMAIL        Email Adddress
-"RTN","CCRDPT",36,0)
- ; CELLTEL      Cell Phone
-"RTN","CCRDPT",37,0)
- ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",38,0)
- ; NOK1GIV      NOK1 Given Name
-"RTN","CCRDPT",39,0)
- ; NOK1MID      NOK1 Middle Name
-"RTN","CCRDPT",40,0)
- ; NOK1SUF      NOK1 Suffi Name
-"RTN","CCRDPT",41,0)
- ; NOK1DISP     NOK1 Display Name
-"RTN","CCRDPT",42,0)
- ; NOK1REL      NOK1 Relationship to the patient
-"RTN","CCRDPT",43,0)
- ; NOK1ADD1     NOK1 Address 1
-"RTN","CCRDPT",44,0)
- ; NOK1ADD2     NOK1 Address 2
-"RTN","CCRDPT",45,0)
- ; NOK1CITY     NOK1 City
-"RTN","CCRDPT",46,0)
- ; NOK1STAT     NOK1 State
-"RTN","CCRDPT",47,0)
- ; NOK1ZIP      NOK1 Zip Code
-"RTN","CCRDPT",48,0)
- ; NOK1HTEL     NOK1 Home Telephone
-"RTN","CCRDPT",49,0)
- ; NOK1WTEL     NOK1 Work Telephone
-"RTN","CCRDPT",50,0)
- ; NOK1SAME     Is NOK1's Address the same the patient?
-"RTN","CCRDPT",51,0)
- ; NOK2FAM      NOK2 Family Name
-"RTN","CCRDPT",52,0)
- ; NOK2GIV      NOK2 Given Name
-"RTN","CCRDPT",53,0)
- ; NOK2MID      NOK2 Middle Name
-"RTN","CCRDPT",54,0)
- ; NOK2SUF      NOK2 Suffi Name
-"RTN","CCRDPT",55,0)
- ; NOK2DISP     NOK2 Display Name
-"RTN","CCRDPT",56,0)
- ; NOK2REL      NOK2 Relationship to the patient
-"RTN","CCRDPT",57,0)
- ; NOK2ADD1     NOK2 Address 1
-"RTN","CCRDPT",58,0)
- ; NOK2ADD2     NOK2 Address 2
-"RTN","CCRDPT",59,0)
- ; NOK2CITY     NOK2 City
-"RTN","CCRDPT",60,0)
- ; NOK2STAT     NOK2 State
-"RTN","CCRDPT",61,0)
- ; NOK2ZIP      NOK2 Zip Code
-"RTN","CCRDPT",62,0)
- ; NOK2HTEL     NOK2 Home Telephone
-"RTN","CCRDPT",63,0)
- ; NOK2WTEL     NOK2 Work Telephone
-"RTN","CCRDPT",64,0)
- ; NOK2SAME     Is NOK2's Address the same the patient?
-"RTN","CCRDPT",65,0)
- ; EMERFAM      Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",66,0)
- ; EMERGIV      EMER Given Name
-"RTN","CCRDPT",67,0)
- ; EMERMID      EMER Middle Name
-"RTN","CCRDPT",68,0)
- ; EMERSUF      EMER Suffi Name
-"RTN","CCRDPT",69,0)
- ; EMERDISP     EMER Display Name
-"RTN","CCRDPT",70,0)
- ; EMERREL      EMER Relationship to the patient
-"RTN","CCRDPT",71,0)
- ; EMERADD1     EMER Address 1
-"RTN","CCRDPT",72,0)
- ; EMERADD2     EMER Address 2
-"RTN","CCRDPT",73,0)
- ; EMERCITY     EMER City
-"RTN","CCRDPT",74,0)
- ; EMERSTAT     EMER State
-"RTN","CCRDPT",75,0)
- ; EMERZIP      EMER Zip Code
-"RTN","CCRDPT",76,0)
- ; EMERHTEL     EMER Home Telephone
-"RTN","CCRDPT",77,0)
- ; EMERWTEL     EMER Work Telephone
-"RTN","CCRDPT",78,0)
- ; EMERSAME     Is EMER's Address the same the NOK?
-"RTN","CCRDPT",79,0)
- ;
-"RTN","CCRDPT",80,0)
- W "No Entry at top!" Q
-"RTN","CCRDPT",81,0)
- ;
-"RTN","CCRDPT",82,0)
- ;**Revision History**
-"RTN","CCRDPT",83,0)
- ; - June 15, 08: v0.1 using merged global
-"RTN","CCRDPT",84,0)
- ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
-"RTN","CCRDPT",85,0)
- ;
-"RTN","CCRDPT",86,0)
- ; All methods are Public and Extrinsic
-"RTN","CCRDPT",87,0)
- ; All calls use Fileman file 2 (Patient).
-"RTN","CCRDPT",88,0)
- ; You can obtain field numbers using the data dictionary
-"RTN","CCRDPT",89,0)
- ;
-"RTN","CCRDPT",90,0)
-FAMILY(DFN) ; Family Name
-"RTN","CCRDPT",91,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",92,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",93,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",94,0)
-GIVEN(DFN) ; Given Name
-"RTN","CCRDPT",95,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",96,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",97,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",98,0)
-MIDDLE(DFN) ; Middle Name
-"RTN","CCRDPT",99,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",100,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",101,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",102,0)
-SUFFIX(DFN) ; Suffi Name
-"RTN","CCRDPT",103,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",104,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",105,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",106,0)
-DISPNAME(DFN) ; Display Name
-"RTN","CCRDPT",107,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",108,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",109,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",110,0)
-DOB(DFN) ; Date of Birth
-"RTN","CCRDPT",111,0)
- N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","CCRDPT",112,0)
- ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","CCRDPT",113,0)
- Q $$FMDTOUTC^CCRUTIL(DOB,"D")
-"RTN","CCRDPT",114,0)
-GENDER(DFN) ; Gender/Sex
-"RTN","CCRDPT",115,0)
- Q $$GET1^DIQ(2,DFN,.02) ;
-"RTN","CCRDPT",116,0)
-SSN(DFN) ; SSN
-"RTN","CCRDPT",117,0)
- Q $$GET1^DIQ(2,DFN,.09)
-"RTN","CCRDPT",118,0)
-ADDRTYPE(DFN) ; Address Type
-"RTN","CCRDPT",119,0)
- ; Vista only stores a home address for the patient.
-"RTN","CCRDPT",120,0)
- Q "Home"
-"RTN","CCRDPT",121,0)
-ADDR1(DFN) ; Get Home Address line 1
-"RTN","CCRDPT",122,0)
- Q $$GET1^DIQ(2,DFN,.111)
-"RTN","CCRDPT",123,0)
-ADDR2(DFN) ; Get Home Address line 2
-"RTN","CCRDPT",124,0)
- ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","CCRDPT",125,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",126,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","CCRDPT",127,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",128,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",129,0)
-CITY(DFN) ; Get City for Home Address
-"RTN","CCRDPT",130,0)
- Q $$GET1^DIQ(2,DFN,.114)
-"RTN","CCRDPT",131,0)
-STATE(DFN) ; Get State for Home Address
-"RTN","CCRDPT",132,0)
- Q $$GET1^DIQ(2,DFN,.115)
-"RTN","CCRDPT",133,0)
-ZIP(DFN) ; Get Zip code for Home Address
-"RTN","CCRDPT",134,0)
- Q $$GET1^DIQ(2,DFN,.116)
-"RTN","CCRDPT",135,0)
-COUNTY(DFN) ; Get County for our Address
-"RTN","CCRDPT",136,0)
- Q $$GET1^DIQ(2,DFN,.117)
-"RTN","CCRDPT",137,0)
-COUNTRY(DFN) ; Get Country for our Address
-"RTN","CCRDPT",138,0)
- ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","CCRDPT",139,0)
- Q "USA"
-"RTN","CCRDPT",140,0)
-RESTEL(DFN) ; Residential Telephone
-"RTN","CCRDPT",141,0)
- Q $$GET1^DIQ(2,DFN,.131)
-"RTN","CCRDPT",142,0)
-WORKTEL(DFN) ; Work Telephone
-"RTN","CCRDPT",143,0)
- Q $$GET1^DIQ(2,DFN,.132)
-"RTN","CCRDPT",144,0)
-EMAIL(DFN) ; Email Adddress
-"RTN","CCRDPT",145,0)
- Q $$GET1^DIQ(2,DFN,.133)
-"RTN","CCRDPT",146,0)
-CELLTEL(DFN) ; Cell Phone
-"RTN","CCRDPT",147,0)
- Q $$GET1^DIQ(2,DFN,.134)
-"RTN","CCRDPT",148,0)
-NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",149,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",150,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",151,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",152,0)
-NOK1GIV(DFN) ; NOK1 Given Name
-"RTN","CCRDPT",153,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",154,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",155,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",156,0)
-NOK1MID(DFN) ; NOK1 Middle Name
-"RTN","CCRDPT",157,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",158,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",159,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",160,0)
-NOK1SUF(DFN) ; NOK1 Suffi Name
-"RTN","CCRDPT",161,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",162,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",163,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",164,0)
-NOK1DISP(DFN) ; NOK1 Display Name
-"RTN","CCRDPT",165,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",166,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",167,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",168,0)
-NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","CCRDPT",169,0)
- Q $$GET1^DIQ(2,DFN,.212)
-"RTN","CCRDPT",170,0)
-NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","CCRDPT",171,0)
- Q $$GET1^DIQ(2,DFN,.213)
-"RTN","CCRDPT",172,0)
-NOK1ADD2(DFN) ; NOK1 Address 2 
-"RTN","CCRDPT",173,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",174,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","CCRDPT",175,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",176,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",177,0)
-NOK1CITY(DFN) ; NOK1 City
-"RTN","CCRDPT",178,0)
- Q $$GET1^DIQ(2,DFN,.216)
-"RTN","CCRDPT",179,0)
-NOK1STAT(DFN) ; NOK1 State
-"RTN","CCRDPT",180,0)
- Q $$GET1^DIQ(2,DFN,.217)
-"RTN","CCRDPT",181,0)
-NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","CCRDPT",182,0)
- Q $$GET1^DIQ(2,DFN,.218)
-"RTN","CCRDPT",183,0)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","CCRDPT",184,0)
- Q $$GET1^DIQ(2,DFN,.219)
-"RTN","CCRDPT",185,0)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","CCRDPT",186,0)
- Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","CCRDPT",187,0)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","CCRDPT",188,0)
- Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","CCRDPT",189,0)
-NOK2FAM(DFN) ; NOK2 Family Name
-"RTN","CCRDPT",190,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",191,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",192,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",193,0)
-NOK2GIV(DFN) ; NOK2 Given Name
-"RTN","CCRDPT",194,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",195,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",196,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",197,0)
-NOK2MID(DFN) ; NOK2 Middle Name
-"RTN","CCRDPT",198,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",199,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",200,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",201,0)
-NOK2SUF(DFN) ; NOK2 Suffi Name
-"RTN","CCRDPT",202,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",203,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",204,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",205,0)
-NOK2DISP(DFN) ; NOK2 Display Name
-"RTN","CCRDPT",206,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",207,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",208,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",209,0)
-NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","CCRDPT",210,0)
- Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","CCRDPT",211,0)
-NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","CCRDPT",212,0)
- Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","CCRDPT",213,0)
-NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","CCRDPT",214,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",215,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","CCRDPT",216,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",217,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",218,0)
-NOK2CITY(DFN) ; NOK2 City
-"RTN","CCRDPT",219,0)
- Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","CCRDPT",220,0)
-NOK2STAT(DFN) ; NOK2 State
-"RTN","CCRDPT",221,0)
- Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","CCRDPT",222,0)
-NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","CCRDPT",223,0)
- Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","CCRDPT",224,0)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","CCRDPT",225,0)
- Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","CCRDPT",226,0)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","CCRDPT",227,0)
- Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","CCRDPT",228,0)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","CCRDPT",229,0)
- Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","CCRDPT",230,0)
-EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",231,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",232,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",233,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",234,0)
-EMERGIV(DFN) ; EMER Given Name
-"RTN","CCRDPT",235,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",236,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",237,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",238,0)
-EMERMID(DFN) ; EMER Middle Name
-"RTN","CCRDPT",239,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",240,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",241,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",242,0)
-EMERSUF(DFN) ; EMER Suffi Name
-"RTN","CCRDPT",243,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",244,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",245,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",246,0)
-EMERDISP(DFN) ; EMER Display Name
-"RTN","CCRDPT",247,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",248,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",249,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",250,0)
-EMERREL(DFN) ; EMER Relationship to the patient
-"RTN","CCRDPT",251,0)
- Q $$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",252,0)
-EMERADD1(DFN) ; EMER Address 1
-"RTN","CCRDPT",253,0)
- Q $$GET1^DIQ(2,DFN,.333)
-"RTN","CCRDPT",254,0)
-EMERADD2(DFN) ; EMER Address 2
-"RTN","CCRDPT",255,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",256,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
-"RTN","CCRDPT",257,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",258,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",259,0)
-EMERCITY(DFN) ; EMER City
-"RTN","CCRDPT",260,0)
- Q $$GET1^DIQ(2,DFN,.336)
-"RTN","CCRDPT",261,0)
-EMERSTAT(DFN) ; EMER State
-"RTN","CCRDPT",262,0)
- Q $$GET1^DIQ(2,DFN,.337)
-"RTN","CCRDPT",263,0)
-EMERZIP(DFN) ; EMER Zip Code
-"RTN","CCRDPT",264,0)
- Q $$GET1^DIQ(2,DFN,.338)
-"RTN","CCRDPT",265,0)
-EMERHTEL(DFN) ; EMER Home Telephone
-"RTN","CCRDPT",266,0)
- Q $$GET1^DIQ(2,DFN,.339)
-"RTN","CCRDPT",267,0)
-EMERWTEL(DFN) ; EMER Work Telephone
-"RTN","CCRDPT",268,0)
- Q $$GET1^DIQ(2,DFN,.33011)
-"RTN","CCRDPT",269,0)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
-"RTN","CCRDPT",270,0)
- Q $$GET1^DIQ(2,DFN,.3305)
-"RTN","CCRDPTT")
-0^2^B4791589
-"RTN","CCRDPTT",1,0)
-CCRDPTT ; Unit Tester...
-"RTN","CCRDPTT",2,0)
-  ;;0.1;CCRCCD;;Jun 15, 2008;Build 13
-"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)
-          N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
-"RTN","CCRDPTT",39,0)
-          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
-"RTN","CCRDPTT",40,0)
-          . W "valued at "
-"RTN","CCRDPTT",41,0)
-    . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
-"RTN","CCRDPTT",42,0)
-          . W !
-"RTN","CCRDPTT",43,0)
-          Q
-"RTN","CCRMEDS")
-0^3^B59807333
-"RTN","CCRMEDS",1,0)
-CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
-"RTN","CCRMEDS",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 13
-"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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS",24,0)
- ;
-"RTN","CCRMEDS",25,0)
- ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS",26,0)
- ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS",27,0)
- ;
-"RTN","CCRMEDS",28,0)
- N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","CCRMEDS",29,0)
- N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","CCRMEDS",30,0)
- ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
-"RTN","CCRMEDS",31,0)
- ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
-"RTN","CCRMEDS",32,0)
- ; NON-VA MEDS IN EXTRACT^CCRMEDS3
-"RTN","CCRMEDS",33,0)
- ; INPATIENT MEDS IN EXTRACT^CCRMEDS4
-"RTN","CCRMEDS",34,0)
- ; ALL OTHERS HERE
-"RTN","CCRMEDS",35,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",36,0)
- K @MEDTVMAP ; CLEAR VARIABLE ARRAY
-"RTN","CCRMEDS",37,0)
- S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
-"RTN","CCRMEDS",38,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",39,0)
- K @MEDTARYTMP ; KILL XML ARRAY
-"RTN","CCRMEDS",40,0)
- D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",41,0)
- I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","CCRMEDS",42,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",43,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",44,0)
- . W MEDCNT,!
-"RTN","CCRMEDS",45,0)
- . W "HAS ACTIVE OP MEDS",!
-"RTN","CCRMEDS",46,0)
- N PENDINGXML,MEDPENDING
-"RTN","CCRMEDS",47,0)
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
-"RTN","CCRMEDS",48,0)
- D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",49,0)
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
-"RTN","CCRMEDS",50,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",51,0)
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
-"RTN","CCRMEDS",52,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
-"RTN","CCRMEDS",53,0)
- . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
-"RTN","CCRMEDS",54,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",55,0)
- . ; W MEDCNT,!
-"RTN","CCRMEDS",56,0)
- . W "HAS OP PENDING MEDS",!
-"RTN","CCRMEDS",57,0)
- N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","CCRMEDS",58,0)
- D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","CCRMEDS",59,0)
- I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","CCRMEDS",60,0)
- . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","CCRMEDS",61,0)
- . S @MEDOUTXML@(0)=0
-"RTN","CCRMEDS",62,0)
- . Q
-"RTN","CCRMEDS",63,0)
- ; I DEBUG ZWR MEDRSLT
-"RTN","CCRMEDS",64,0)
- M GPLMEDS=MEDRSLT
-"RTN","CCRMEDS",65,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",66,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",67,0)
- ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
-"RTN","CCRMEDS",68,0)
- ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","CCRMEDS",69,0)
- ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","CCRMEDS",70,0)
- N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","CCRMEDS",71,0)
- ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","CCRMEDS",72,0)
- S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","CCRMEDS",73,0)
- F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","CCRMEDS",74,0)
- . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","CCRMEDS",75,0)
- . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","CCRMEDS",76,0)
- . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","CCRMEDS",77,0)
- . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","CCRMEDS",78,0)
- . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","CCRMEDS",79,0)
- . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","CCRMEDS",80,0)
- . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","CCRMEDS",81,0)
- ;ZWR ZA
-"RTN","CCRMEDS",82,0)
- ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","CCRMEDS",83,0)
- F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","CCRMEDS",84,0)
- . I DEBUG W "ZI IS ",ZI,!
-"RTN","CCRMEDS",85,0)
- . ; W ZI," ",MEDCNT,!
-"RTN","CCRMEDS",86,0)
- . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","CCRMEDS",87,0)
- . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","CCRMEDS",88,0)
- . I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
-"RTN","CCRMEDS",89,0)
- . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
-"RTN","CCRMEDS",90,0)
- . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","CCRMEDS",91,0)
- . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
-"RTN","CCRMEDS",92,0)
- . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","CCRMEDS",93,0)
- . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","CCRMEDS",94,0)
- . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","CCRMEDS",95,0)
- . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","CCRMEDS",96,0)
- . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS",97,0)
- . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS",98,0)
- . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS",99,0)
- . S @MEDVMAP@("MEDRXNO")=""
-"RTN","CCRMEDS",100,0)
- . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","CCRMEDS",101,0)
- . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","CCRMEDS",102,0)
- . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","CCRMEDS",103,0)
- . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","CCRMEDS",104,0)
- . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","CCRMEDS",105,0)
- . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","CCRMEDS",106,0)
- . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","CCRMEDS",107,0)
- . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","CCRMEDS",108,0)
- . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","CCRMEDS",109,0)
- . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","CCRMEDS",110,0)
- . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","CCRMEDS",111,0)
- . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","CCRMEDS",112,0)
- . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","CCRMEDS",113,0)
- . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS",114,0)
- . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS",115,0)
- . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS",116,0)
- . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS",117,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS",118,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS",119,0)
- . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS",120,0)
- . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS",121,0)
- . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","CCRMEDS",122,0)
- . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","CCRMEDS",123,0)
- . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","CCRMEDS",124,0)
- . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","CCRMEDS",125,0)
- . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","CCRMEDS",126,0)
- . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","CCRMEDS",127,0)
- . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS",128,0)
- . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","CCRMEDS",129,0)
- . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","CCRMEDS",130,0)
- . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","CCRMEDS",131,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","CCRMEDS",132,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","CCRMEDS",133,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","CCRMEDS",134,0)
- . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","CCRMEDS",135,0)
- . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","CCRMEDS",136,0)
- . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","CCRMEDS",137,0)
- . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","CCRMEDS",138,0)
- . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","CCRMEDS",139,0)
- . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","CCRMEDS",140,0)
- . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","CCRMEDS",141,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","CCRMEDS",142,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS",143,0)
- . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS",144,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","CCRMEDS",145,0)
- . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","CCRMEDS",146,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","CCRMEDS",147,0)
- . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","CCRMEDS",148,0)
- . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","CCRMEDS",149,0)
- . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","CCRMEDS",150,0)
- . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","CCRMEDS",151,0)
- . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","CCRMEDS",152,0)
- . S @MEDVMAP@("MEDRFNO")=""
-"RTN","CCRMEDS",153,0)
- . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","CCRMEDS",154,0)
- . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","CCRMEDS",155,0)
- . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","CCRMEDS",156,0)
- . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","CCRMEDS",157,0)
- . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","CCRMEDS",158,0)
- . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","CCRMEDS",159,0)
- . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","CCRMEDS",160,0)
- . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","CCRMEDS",161,0)
- . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","CCRMEDS",162,0)
- . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","CCRMEDS",163,0)
- . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","CCRMEDS",164,0)
- . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","CCRMEDS",165,0)
- . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","CCRMEDS",166,0)
- . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","CCRMEDS",167,0)
- . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","CCRMEDS",168,0)
- . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","CCRMEDS",169,0)
- . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","CCRMEDS",170,0)
- . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","CCRMEDS",171,0)
- . K @MEDARYTMP
-"RTN","CCRMEDS",172,0)
- . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","CCRMEDS",173,0)
- . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","CCRMEDS",174,0)
- . . ; W "FIRST ONE",!
-"RTN","CCRMEDS",175,0)
- . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","CCRMEDS",176,0)
- . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","CCRMEDS",177,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","CCRMEDS",178,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS",179,0)
- D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS",180,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS",181,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS",182,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS",183,0)
- Q
-"RTN","CCRMEDS",184,0)
- ;
-"RTN","CCRMEDS",185,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","CCRMEDS",186,0)
- ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","CCRMEDS",187,0)
- N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","CCRMEDS",188,0)
- S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","CCRMEDS",189,0)
- Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","CCRMEDS",190,0)
- ;
-"RTN","CCRMEDS1")
-0^10^B80043311
-"RTN","CCRMEDS1",1,0)
-CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
-"RTN","CCRMEDS1",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 13
-"RTN","CCRMEDS1",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRMEDS1",4,0)
- ; General Public License See attached copy of the License.
-"RTN","CCRMEDS1",5,0)
- ;
-"RTN","CCRMEDS1",6,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","CCRMEDS1",7,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","CCRMEDS1",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","CCRMEDS1",9,0)
- ; (at your option) any later version.
-"RTN","CCRMEDS1",10,0)
- ;
-"RTN","CCRMEDS1",11,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRMEDS1",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRMEDS1",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRMEDS1",14,0)
- ; GNU General Public License for more details.
-"RTN","CCRMEDS1",15,0)
- ;
-"RTN","CCRMEDS1",16,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRMEDS1",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRMEDS1",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRMEDS1",19,0)
- ;
-"RTN","CCRMEDS1",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","CCRMEDS1",21,0)
- Q
-"RTN","CCRMEDS1",22,0)
- ;
-"RTN","CCRMEDS1",23,0)
-EXTRACT(MINXML,DFN,OUTXML)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS1",24,0)
- ;
-"RTN","CCRMEDS1",25,0)
- ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS1",26,0)
- ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS1",27,0)
- ;
-"RTN","CCRMEDS1",28,0)
- ; MEDS is return array from RPC.
-"RTN","CCRMEDS1",29,0)
- ; MAP is a mapping variable map (store result) for each med
-"RTN","CCRMEDS1",30,0)
- ; MED is holds each array element from MEDS(J), one medicine
-"RTN","CCRMEDS1",31,0)
- ; J is a counter.
-"RTN","CCRMEDS1",32,0)
- ;
-"RTN","CCRMEDS1",33,0)
- ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
-"RTN","CCRMEDS1",34,0)
- ; med data available.
-"RTN","CCRMEDS1",35,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","CCRMEDS1",36,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","CCRMEDS1",37,0)
- ; D PARY^GPLXPATH(MINXML)
-"RTN","CCRMEDS1",38,0)
- N MEDS,MAP
-"RTN","CCRMEDS1",39,0)
- K ^TMP($J)
-"RTN","CCRMEDS1",40,0)
- D RX^PSO52API(DFN,"CCDCCR")
-"RTN","CCRMEDS1",41,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","CCRMEDS1",42,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","CCRMEDS1",43,0)
- ; If it is -1, we quit.
-"RTN","CCRMEDS1",44,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-"RTN","CCRMEDS1",45,0)
- I DEBUG ZWR MEDS
-"RTN","CCRMEDS1",46,0)
- N RXIEN S RXIEN=0
-"RTN","CCRMEDS1",47,0)
- N MEDCOUNT S MEDCOUNT=0
-"RTN","CCRMEDS1",48,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
-"RTN","CCRMEDS1",49,0)
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
-"RTN","CCRMEDS1",50,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS1",51,0)
- . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS1",52,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS1",53,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS1",54,0)
- . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS
-"RTN","CCRMEDS1",55,0)
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
-"RTN","CCRMEDS1",56,0)
- . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS1",57,0)
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","CCRMEDS1",58,0)
- . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","CCRMEDS1",59,0)
- . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
-"RTN","CCRMEDS1",60,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","CCRMEDS1",61,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
-"RTN","CCRMEDS1",62,0)
- . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-"RTN","CCRMEDS1",63,0)
- . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
-"RTN","CCRMEDS1",64,0)
- . S @MAP@("MEDRXNOTXT")="Prescription Number"
-"RTN","CCRMEDS1",65,0)
- . S @MAP@("MEDRXNO")=MED(.01)
-"RTN","CCRMEDS1",66,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS1",67,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS1",68,0)
- . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
-"RTN","CCRMEDS1",69,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
-"RTN","CCRMEDS1",70,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
-"RTN","CCRMEDS1",71,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
-"RTN","CCRMEDS1",72,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS1",73,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
-"RTN","CCRMEDS1",74,0)
- . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
-"RTN","CCRMEDS1",75,0)
- . N MEDIEN S MEDIEN=$P(MED(6),U)
-"RTN","CCRMEDS1",76,0)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS1",77,0)
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS1",78,0)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","CCRMEDS1",79,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","CCRMEDS1",80,0)
- . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS1",81,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS1",82,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS1",83,0)
- . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS1",84,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS1",85,0)
- . ; Documented in the same manual.
-"RTN","CCRMEDS1",86,0)
- . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS1",87,0)
- . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS1",88,0)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS1",89,0)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS1",90,0)
- . N CONCDATA
-"RTN","CCRMEDS1",91,0)
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS1",92,0)
- . ; and this will crash the call. So...
-"RTN","CCRMEDS1",93,0)
- . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS1",94,0)
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS1",95,0)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","CCRMEDS1",96,0)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","CCRMEDS1",97,0)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","CCRMEDS1",98,0)
- . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
-"RTN","CCRMEDS1",99,0)
- . S @MAP@("MEDQUANTITYVALUE")=MED(7)
-"RTN","CCRMEDS1",100,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS1",101,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS1",102,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS1",103,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS1",104,0)
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS1",105,0)
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS1",106,0)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS1",107,0)
- . ;
-"RTN","CCRMEDS1",108,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS1",109,0)
- . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-"RTN","CCRMEDS1",110,0)
- . ; we want the compoenents.
-"RTN","CCRMEDS1",111,0)
- . ; It's in node 6 of ^PSRX(IEN)
-"RTN","CCRMEDS1",112,0)
- . ; So, here we go again
-"RTN","CCRMEDS1",113,0)
- . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
-"RTN","CCRMEDS1",114,0)
- . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
-"RTN","CCRMEDS1",115,0)
- . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
-"RTN","CCRMEDS1",116,0)
- . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
-"RTN","CCRMEDS1",117,0)
- . ;
-"RTN","CCRMEDS1",118,0)
- . N DIRNUM S DIRNUM=0 ; Sigline number
-"RTN","CCRMEDS1",119,0)
- . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
-"RTN","CCRMEDS1",120,0)
- . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
-"RTN","CCRMEDS1",121,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","CCRMEDS1",122,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","CCRMEDS1",123,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","CCRMEDS1",124,0)
- . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
-"RTN","CCRMEDS1",125,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
-"RTN","CCRMEDS1",126,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
-"RTN","CCRMEDS1",127,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","CCRMEDS1",128,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","CCRMEDS1",129,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","CCRMEDS1",130,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","CCRMEDS1",131,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
-"RTN","CCRMEDS1",132,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
-"RTN","CCRMEDS1",133,0)
- . . ; Invervals... again another call.
-"RTN","CCRMEDS1",134,0)
- . . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","CCRMEDS1",135,0)
- . . ; However, it gets translated by a call to the administration schedule file
-"RTN","CCRMEDS1",136,0)
- . . ; to see if that schedule exists.
-"RTN","CCRMEDS1",137,0)
- . . ; That's the same thing I am going to do.
-"RTN","CCRMEDS1",138,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","CCRMEDS1",139,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","CCRMEDS1",140,0)
- . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
-"RTN","CCRMEDS1",141,0)
- . . ; So...
-"RTN","CCRMEDS1",142,0)
- . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
-"RTN","CCRMEDS1",143,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","CCRMEDS1",144,0)
- . . N INTERVAL
-"RTN","CCRMEDS1",145,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","CCRMEDS1",146,0)
- . . E  D
-"RTN","CCRMEDS1",147,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","CCRMEDS1",148,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","CCRMEDS1",149,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","CCRMEDS1",150,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","CCRMEDS1",151,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
-"RTN","CCRMEDS1",152,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-"RTN","CCRMEDS1",153,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
-"RTN","CCRMEDS1",154,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS1",155,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS1",156,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS1",157,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS1",158,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS1",159,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS1",160,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS1",161,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS1",162,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","CCRMEDS1",163,0)
- . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
-"RTN","CCRMEDS1",164,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
-"RTN","CCRMEDS1",165,0)
- . ;
-"RTN","CCRMEDS1",166,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS1",167,0)
- . ;
-"RTN","CCRMEDS1",168,0)
- . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
-"RTN","CCRMEDS1",169,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
-"RTN","CCRMEDS1",170,0)
- . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
-"RTN","CCRMEDS1",171,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
-"RTN","CCRMEDS1",172,0)
- . S @MAP@("MEDRFNO")=MED(9)
-"RTN","CCRMEDS1",173,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","CCRMEDS1",174,0)
- . K @RESULT
-"RTN","CCRMEDS1",175,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS1",176,0)
- . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS1",177,0)
- . ; MAPPING DIRECTIONS
-"RTN","CCRMEDS1",178,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","CCRMEDS1",179,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","CCRMEDS1",180,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","CCRMEDS1",181,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","CCRMEDS1",182,0)
- . ; N MDZ1,MDZNA
-"RTN","CCRMEDS1",183,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","CCRMEDS1",184,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","CCRMEDS1",185,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","CCRMEDS1",186,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","CCRMEDS1",187,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","CCRMEDS1",188,0)
- . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS1",189,0)
- . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","CCRMEDS1",190,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS1",191,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS1",192,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS1",193,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS1",194,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS1",195,0)
- Q
-"RTN","CCRMEDS1",196,0)
- ;
-"RTN","CCRMEDS2")
-0^11^B99730224
-"RTN","CCRMEDS2",1,0)
-CCRMEDS2         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;08/24/08
-"RTN","CCRMEDS2",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 13
-"RTN","CCRMEDS2",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRMEDS2",4,0)
- ; General Public License See attached copy of the License.
-"RTN","CCRMEDS2",5,0)
- ;
-"RTN","CCRMEDS2",6,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","CCRMEDS2",7,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","CCRMEDS2",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","CCRMEDS2",9,0)
- ; (at your option) any later version.
-"RTN","CCRMEDS2",10,0)
- ;
-"RTN","CCRMEDS2",11,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRMEDS2",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRMEDS2",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRMEDS2",14,0)
- ; GNU General Public License for more details.
-"RTN","CCRMEDS2",15,0)
- ;
-"RTN","CCRMEDS2",16,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRMEDS2",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRMEDS2",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRMEDS2",19,0)
- ;
-"RTN","CCRMEDS2",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","CCRMEDS2",21,0)
- Q
-"RTN","CCRMEDS2",22,0)
- ;
-"RTN","CCRMEDS2",23,0)
-EXTRACT(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS2",24,0)
- ;
-"RTN","CCRMEDS2",25,0)
- ; MINXML is the Input XML Template, passed by name
-"RTN","CCRMEDS2",26,0)
- ; DFN is Patient IEN
-"RTN","CCRMEDS2",27,0)
- ; OUTXML is the resultant XML.
-"RTN","CCRMEDS2",28,0)
- ;
-"RTN","CCRMEDS2",29,0)
- ; MEDS is return array from RPC.
-"RTN","CCRMEDS2",30,0)
- ; MAP is a mapping variable map (store result) for each med
-"RTN","CCRMEDS2",31,0)
- ; MED is holds each array element from MEDS, one medicine
-"RTN","CCRMEDS2",32,0)
- ;
-"RTN","CCRMEDS2",33,0)
- ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
-"RTN","CCRMEDS2",34,0)
- ; meds data available.
-"RTN","CCRMEDS2",35,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","CCRMEDS2",36,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","CCRMEDS2",37,0)
- ; File for pending meds is 52.41
-"RTN","CCRMEDS2",38,0)
- ; Unfortuantely, API does not supply us with any useful info beyond
-"RTN","CCRMEDS2",39,0)
- ; the IEN in 52.41, and the Med Name, and route.
-"RTN","CCRMEDS2",40,0)
- ; So, most of the info is going to get pulled from 52.41.
-"RTN","CCRMEDS2",41,0)
- N MEDS,MAP
-"RTN","CCRMEDS2",42,0)
- K ^TMP($J)
-"RTN","CCRMEDS2",43,0)
- D PEN^PSO5241(DFN,"CCDCCR")
-"RTN","CCRMEDS2",44,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","CCRMEDS2",45,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","CCRMEDS2",46,0)
- ; If it is -1, we quit.
-"RTN","CCRMEDS2",47,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-"RTN","CCRMEDS2",48,0)
- I DEBUG ZWR MEDS
-"RTN","CCRMEDS2",49,0)
- N RXIEN S RXIEN=0
-"RTN","CCRMEDS2",50,0)
- N MEDCOUNT S MEDCOUNT=0
-"RTN","CCRMEDS2",51,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
-"RTN","CCRMEDS2",52,0)
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
-"RTN","CCRMEDS2",53,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS2",54,0)
- . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
-"RTN","CCRMEDS2",55,0)
- . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS2",56,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS2",57,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS2",58,0)
- . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN CCRMEDS
-"RTN","CCRMEDS2",59,0)
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
-"RTN","CCRMEDS2",60,0)
- . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS2",61,0)
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","CCRMEDS2",62,0)
- . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","CCRMEDS2",63,0)
- . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
-"RTN","CCRMEDS2",64,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","CCRMEDS2",65,0)
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
-"RTN","CCRMEDS2",66,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"))
-"RTN","CCRMEDS2",67,0)
- . ; Med never filled; next 4 fields are not applicable.
-"RTN","CCRMEDS2",68,0)
- . S @MAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS2",69,0)
- . S @MAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS2",70,0)
- . S @MAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS2",71,0)
- . S @MAP@("MEDRXNO")=""
-"RTN","CCRMEDS2",72,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS2",73,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS2",74,0)
- . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
-"RTN","CCRMEDS2",75,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
-"RTN","CCRMEDS2",76,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
-"RTN","CCRMEDS2",77,0)
- . ; NDC not supplied in API, but is rather trivial to obtain
-"RTN","CCRMEDS2",78,0)
- . ; MED(11) piece 1 has the IEN of the drug (file 50)
-"RTN","CCRMEDS2",79,0)
- . ; IEN is field 31 in the drug file.
-"RTN","CCRMEDS2",80,0)
- . N MEDIEN S MEDIEN=$P(MED(11),U)
-"RTN","CCRMEDS2",81,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E")
-"RTN","CCRMEDS2",82,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS2",83,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
-"RTN","CCRMEDS2",84,0)
- . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS2",85,0)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS2",86,0)
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS2",87,0)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","CCRMEDS2",88,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","CCRMEDS2",89,0)
- . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS2",90,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS2",91,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS2",92,0)
- . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS2",93,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS2",94,0)
- . ; Documented in the same manual.
-"RTN","CCRMEDS2",95,0)
- . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS2",96,0)
- . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS2",97,0)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS2",98,0)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS2",99,0)
- . N CONCDATA
-"RTN","CCRMEDS2",100,0)
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS2",101,0)
- . ; and this will crash the call. So...
-"RTN","CCRMEDS2",102,0)
- . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS2",103,0)
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS2",104,0)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","CCRMEDS2",105,0)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","CCRMEDS2",106,0)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","CCRMEDS2",107,0)
- . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
-"RTN","CCRMEDS2",108,0)
- . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
-"RTN","CCRMEDS2",109,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS2",110,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS2",111,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS2",112,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS2",113,0)
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS2",114,0)
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS2",115,0)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS2",116,0)
- . ;
-"RTN","CCRMEDS2",117,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS2",118,0)
- . ; Sig data is not in any API. We obtain it using the IEN from
-"RTN","CCRMEDS2",119,0)
- . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
-"RTN","CCRMEDS2",120,0)
- . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
-"RTN","CCRMEDS2",121,0)
- . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
-"RTN","CCRMEDS2",122,0)
- . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
-"RTN","CCRMEDS2",123,0)
- . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
-"RTN","CCRMEDS2",124,0)
- . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-"RTN","CCRMEDS2",125,0)
- . ; DIRNUM will be first piece for IEN.
-"RTN","CCRMEDS2",126,0)
- . ; DIRNUM is the proper Sigline numer.
-"RTN","CCRMEDS2",127,0)
- . ; SIGDATA is the simplfied array. Subscripts are really field numbers
-"RTN","CCRMEDS2",128,0)
- . ; in subfile 52.413.
-"RTN","CCRMEDS2",129,0)
- . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
-"RTN","CCRMEDS2",130,0)
- . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
-"RTN","CCRMEDS2",131,0)
- . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
-"RTN","CCRMEDS2",132,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","CCRMEDS2",133,0)
- . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
-"RTN","CCRMEDS2",134,0)
- . . ; If this is an order for a refill; it's not really a new order; move on to next
-"RTN","CCRMEDS2",135,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","CCRMEDS2",136,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","CCRMEDS2",137,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
-"RTN","CCRMEDS2",138,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
-"RTN","CCRMEDS2",139,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","CCRMEDS2",140,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","CCRMEDS2",141,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","CCRMEDS2",142,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","CCRMEDS2",143,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
-"RTN","CCRMEDS2",144,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
-"RTN","CCRMEDS2",145,0)
- . . ; Invervals... again another call.
-"RTN","CCRMEDS2",146,0)
- . . ; The schedule is a free text field
-"RTN","CCRMEDS2",147,0)
- . . ; However, it gets translated by a call to the administration
-"RTN","CCRMEDS2",148,0)
- . . ; schedule file to see if that schedule exists.
-"RTN","CCRMEDS2",149,0)
- . . ; That's the same thing I am going to do.
-"RTN","CCRMEDS2",150,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","CCRMEDS2",151,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","CCRMEDS2",152,0)
- . . ; I looked), PSSFT is the name,
-"RTN","CCRMEDS2",153,0)
- . . ; and list is the ^TMP name to store the data in.
-"RTN","CCRMEDS2",154,0)
- . . ; Also, freqency may have "PRN" in it, so strip that out
-"RTN","CCRMEDS2",155,0)
- . . N FREQ S FREQ=SIGDATA(1)
-"RTN","CCRMEDS2",156,0)
- . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
-"RTN","CCRMEDS2",157,0)
- . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
-"RTN","CCRMEDS2",158,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","CCRMEDS2",159,0)
- . . N INTERVAL
-"RTN","CCRMEDS2",160,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","CCRMEDS2",161,0)
- . . E  D
-"RTN","CCRMEDS2",162,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","CCRMEDS2",163,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","CCRMEDS2",164,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","CCRMEDS2",165,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","CCRMEDS2",166,0)
- . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
-"RTN","CCRMEDS2",167,0)
- . . N DUR S DUR=SIGDATA(2)
-"RTN","CCRMEDS2",168,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
-"RTN","CCRMEDS2",169,0)
- . . N DURUNIT S DURUNIT=$E(DUR)
-"RTN","CCRMEDS2",170,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
-"RTN","CCRMEDS2",171,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
-"RTN","CCRMEDS2",172,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS2",173,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS2",174,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS2",175,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS2",176,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS2",177,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS2",178,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS2",179,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
-"RTN","CCRMEDS2",180,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","CCRMEDS2",181,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
-"RTN","CCRMEDS2",182,0)
- . ;
-"RTN","CCRMEDS2",183,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS2",184,0)
- . ;
-"RTN","CCRMEDS2",185,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","CCRMEDS2",186,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
-"RTN","CCRMEDS2",187,0)
- . ; W @MAP@("MEDPTINSTRUCTIONS"),!
-"RTN","CCRMEDS2",188,0)
- . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
-"RTN","CCRMEDS2",189,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
-"RTN","CCRMEDS2",190,0)
- . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
-"RTN","CCRMEDS2",191,0)
- . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
-"RTN","CCRMEDS2",192,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","CCRMEDS2",193,0)
- . K @RESULT
-"RTN","CCRMEDS2",194,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS2",195,0)
- . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS2",196,0)
- . ; MAPPING DIRECTIONS
-"RTN","CCRMEDS2",197,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","CCRMEDS2",198,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","CCRMEDS2",199,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","CCRMEDS2",200,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","CCRMEDS2",201,0)
- . ; N MDZ1,MDZNA
-"RTN","CCRMEDS2",202,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","CCRMEDS2",203,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","CCRMEDS2",204,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","CCRMEDS2",205,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","CCRMEDS2",206,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","CCRMEDS2",207,0)
- . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS2",208,0)
- . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","CCRMEDS2",209,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS2",210,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS2",211,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS2",212,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS2",213,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS2",214,0)
- Q
-"RTN","CCRMEDS2",215,0)
- ;
-"RTN","CCRSYS")
-0^4^B5866233
-"RTN","CCRSYS",1,0)
-CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
-"RTN","CCRSYS",2,0)
-        ;;0.1;CCDCCR;;;Build 13
-"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 DFN="" Q 0  ; BAD DFN PASSED
-"RTN","CCRSYS",41,0)
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","CCRSYS",42,0)
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","CCRSYS",43,0)
-         ;
-"RTN","CCRSYS",44,0)
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","CCRSYS",45,0)
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","CCRSYS",46,0)
-         N DIERR,DATA
-"RTN","CCRSYS",47,0)
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","CCRSYS",48,0)
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","CCRSYS",49,0)
-         ; 1 = Test Patient
-"RTN","CCRSYS",50,0)
-         ; 0 = Non-test Patient
-"RTN","CCRSYS",51,0)
-         I DATA Q DATA
-"RTN","CCRSYS",52,0)
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","CCRSYS",53,0)
-         D CLEAN^DILF
-"RTN","CCRSYS",54,0)
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-"RTN","CCRSYS",55,0)
-         I $E(DATA,1,3)="000" Q 1
-"RTN","CCRSYS",56,0)
-         I $E(DATA,1,3)="666" Q 1
-"RTN","CCRSYS",57,0)
-         Q 0
-"RTN","CCRSYS",58,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 13
-"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)
-        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","CCRUNIT",12,0)
-        W "XPATH is: "_XPATH,!
-"RTN","CCRUNIT",13,0)
-        W "Getting Med Template into MINXML using",!
-"RTN","CCRUNIT",14,0)
-        W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
-"RTN","CCRUNIT",15,0)
-        D QUERY^GPLXPATH(T,XPATH,"MINXML")
-"RTN","CCRUNIT",16,0)
-  W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
-"RTN","CCRUNIT",17,0)
-        W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","CCRUNIT",18,0)
-        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","CCRUNIT",19,0)
-        D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
-"RTN","CCRUNIT",20,0)
-        Q
-"RTN","CCRUTIL")
-0^6^B5927217
-"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 13
-"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=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","CCRUTIL",61,0)
- F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-"RTN","CCRUTIL",62,0)
- . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-"RTN","CCRUTIL",63,0)
- . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","CCRUTIL",64,0)
- . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","CCRUTIL",65,0)
- . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","CCRUTIL",66,0)
- . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","CCRUTIL",67,0)
- N ZG
-"RTN","CCRUTIL",68,0)
- S ZG=$Q(VSRT(""))
-"RTN","CCRUTIL",69,0)
- F  D  Q:ZG=""  ;
-"RTN","CCRUTIL",70,0)
- . ; W ZG,!
-"RTN","CCRUTIL",71,0)
- . D PUSH^GPLXPATH("V1",@ZG)
-"RTN","CCRUTIL",72,0)
- . S ZG=$Q(@ZG)
-"RTN","CCRUTIL",73,0)
- I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-"RTN","CCRUTIL",74,0)
- . N ZG2
-"RTN","CCRUTIL",75,0)
- . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-"RTN","CCRUTIL",76,0)
- . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","CCRUTIL",77,0)
- . S ZG2(0)=V1(0)
-"RTN","CCRUTIL",78,0)
- . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","CCRUTIL",79,0)
- Q ZCNT
-"RTN","CCRUTIL",80,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 13
-"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^16^B52628160
-"RTN","GPLACTOR",1,0)
-GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
-"RTN","GPLACTOR",2,0)
- ;;0.4;CCDCCR;nopatch;noreleasedate;Build 13
-"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)
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
-"RTN","GPLACTOR",27,0)
- ;
-"RTN","GPLACTOR",28,0)
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-"RTN","GPLACTOR",29,0)
- ; IPXML is the Input Actor Template into which we  substitute values
-"RTN","GPLACTOR",30,0)
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
-"RTN","GPLACTOR",31,0)
- ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
-"RTN","GPLACTOR",32,0)
- ; ^TMP(7542,1,"ACTORS",0)=Count
-"RTN","GPLACTOR",33,0)
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-"RTN","GPLACTOR",34,0)
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-"RTN","GPLACTOR",35,0)
- ; AXML is the output arrary, to contain XML.
-"RTN","GPLACTOR",36,0)
- ;
-"RTN","GPLACTOR",37,0)
- N I,J,AMAP,AOID,ATYP,AIEN
-"RTN","GPLACTOR",38,0)
- D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-"RTN","GPLACTOR",39,0)
- D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-"RTN","GPLACTOR",40,0)
- I DEBUG W "PROCESSING ACTORS ",!
-"RTN","GPLACTOR",41,0)
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
-"RTN","GPLACTOR",42,0)
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",43,0)
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-"RTN","GPLACTOR",44,0)
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-"RTN","GPLACTOR",45,0)
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-"RTN","GPLACTOR",46,0)
- . I ATYP="" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",47,0)
- . ;
-"RTN","GPLACTOR",48,0)
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","GPLACTOR",49,0)
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
-"RTN","GPLACTOR",50,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-"RTN","GPLACTOR",51,0)
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",52,0)
- . ;
-"RTN","GPLACTOR",53,0)
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
-"RTN","GPLACTOR",54,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-"RTN","GPLACTOR",55,0)
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",56,0)
- . ;
-"RTN","GPLACTOR",57,0)
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
-"RTN","GPLACTOR",58,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-"RTN","GPLACTOR",59,0)
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",60,0)
- . ;
-"RTN","GPLACTOR",61,0)
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",62,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-"RTN","GPLACTOR",63,0)
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",64,0)
- . ;
-"RTN","GPLACTOR",65,0)
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",66,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-"RTN","GPLACTOR",67,0)
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",68,0)
- . ;
-"RTN","GPLACTOR",69,0)
- . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-"RTN","GPLACTOR",70,0)
- ;
-"RTN","GPLACTOR",71,0)
- N ACTTMP
-"RTN","GPLACTOR",72,0)
- D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLACTOR",73,0)
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLACTOR",74,0)
- . ; STRINGS MARKED AS @@X@@
-"RTN","GPLACTOR",75,0)
- . W "ACTORS Missing list: ",!
-"RTN","GPLACTOR",76,0)
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
-"RTN","GPLACTOR",77,0)
- Q
-"RTN","GPLACTOR",78,0)
- ;
-"RTN","GPLACTOR",79,0)
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"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)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",85,0)
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
-"RTN","GPLACTOR",86,0)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
-"RTN","GPLACTOR",87,0)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
-"RTN","GPLACTOR",88,0)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
-"RTN","GPLACTOR",89,0)
- S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
-"RTN","GPLACTOR",90,0)
- S @AMAP@("ACTORSSN")=""
-"RTN","GPLACTOR",91,0)
- S @AMAP@("ACTORSSNTEXT")=""
-"RTN","GPLACTOR",92,0)
- S @AMAP@("ACTORSSNSOURCEID")=""
-"RTN","GPLACTOR",93,0)
- S ZX=$$SSN^CCRDPT(AIEN)
-"RTN","GPLACTOR",94,0)
- I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
-"RTN","GPLACTOR",95,0)
- . S @AMAP@("ACTORSSN")=ZX
-"RTN","GPLACTOR",96,0)
- . S @AMAP@("ACTORSSNTEXT")="SSN"
-"RTN","GPLACTOR",97,0)
- . S @AMAP@("ACTORSSNSOURCEID")=AOID
-"RTN","GPLACTOR",98,0)
- S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
-"RTN","GPLACTOR",99,0)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
-"RTN","GPLACTOR",100,0)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
-"RTN","GPLACTOR",101,0)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
-"RTN","GPLACTOR",102,0)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
-"RTN","GPLACTOR",103,0)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
-"RTN","GPLACTOR",104,0)
- S @AMAP@("ACTORRESTEL")=""
-"RTN","GPLACTOR",105,0)
- S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","GPLACTOR",106,0)
- S ZX=$$RESTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",107,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",108,0)
- . S @AMAP@("ACTORRESTEL")=ZX
-"RTN","GPLACTOR",109,0)
- . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-"RTN","GPLACTOR",110,0)
- S @AMAP@("ACTORWORKTEL")=""
-"RTN","GPLACTOR",111,0)
- S @AMAP@("ACTORWORKTELTEXT")=""
-"RTN","GPLACTOR",112,0)
- S ZX=$$WORKTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",113,0)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-"RTN","GPLACTOR",114,0)
- . S @AMAP@("ACTORWORKTEL")=ZX
-"RTN","GPLACTOR",115,0)
- . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-"RTN","GPLACTOR",116,0)
- S @AMAP@("ACTORCELLTEL")=""
-"RTN","GPLACTOR",117,0)
- S @AMAP@("ACTORCELLTELTEXT")=""
-"RTN","GPLACTOR",118,0)
- S ZX=$$CELLTEL^CCRDPT(AIEN)
-"RTN","GPLACTOR",119,0)
- I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
-"RTN","GPLACTOR",120,0)
- . S @AMAP@("ACTORCELLTEL")=ZX
-"RTN","GPLACTOR",121,0)
- . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-"RTN","GPLACTOR",122,0)
- S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
-"RTN","GPLACTOR",123,0)
- S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-"RTN","GPLACTOR",124,0)
- S @AMAP@("ACTORIEN")=AIEN
-"RTN","GPLACTOR",125,0)
- S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
-"RTN","GPLACTOR",126,0)
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",127,0)
- D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",128,0)
- Q
-"RTN","GPLACTOR",129,0)
- ;
-"RTN","GPLACTOR",130,0)
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-"RTN","GPLACTOR",131,0)
-     ;
-"RTN","GPLACTOR",132,0)
-     ; N AMAP
-"RTN","GPLACTOR",133,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",134,0)
-     K @AMAP
-"RTN","GPLACTOR",135,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",136,0)
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
-"RTN","GPLACTOR",137,0)
-         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
-"RTN","GPLACTOR",138,0)
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-"RTN","GPLACTOR",139,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",140,0)
-     Q
-"RTN","GPLACTOR",141,0)
-     ;
-"RTN","GPLACTOR",142,0)
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-"RTN","GPLACTOR",143,0)
-     ;
-"RTN","GPLACTOR",144,0)
-     ; N AMAP
-"RTN","GPLACTOR",145,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",146,0)
-     K @AMAP
-"RTN","GPLACTOR",147,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",148,0)
-     S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","GPLACTOR",149,0)
-     S @AMAP@("ACTORRELATION")=""
-"RTN","GPLACTOR",150,0)
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-"RTN","GPLACTOR",151,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",152,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",153,0)
-     Q
-"RTN","GPLACTOR",154,0)
-     ;
-"RTN","GPLACTOR",155,0)
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-"RTN","GPLACTOR",156,0)
-     ;
-"RTN","GPLACTOR",157,0)
-     ; N AMAP
-"RTN","GPLACTOR",158,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",159,0)
-     K @AMAP
-"RTN","GPLACTOR",160,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",161,0)
-     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
-"RTN","GPLACTOR",162,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",163,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",164,0)
-     Q
-"RTN","GPLACTOR",165,0)
-     ;
-"RTN","GPLACTOR",166,0)
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-"RTN","GPLACTOR",167,0)
-     ;
-"RTN","GPLACTOR",168,0)
-     ; N AMAP
-"RTN","GPLACTOR",169,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",170,0)
-     K @AMAP
-"RTN","GPLACTOR",171,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",172,0)
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
-"RTN","GPLACTOR",173,0)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",174,0)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
-"RTN","GPLACTOR",175,0)
-         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",176,0)
-         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
-"RTN","GPLACTOR",177,0)
-         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
-"RTN","GPLACTOR",178,0)
-         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
-"RTN","GPLACTOR",179,0)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
-"RTN","GPLACTOR",180,0)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",181,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
-"RTN","GPLACTOR",182,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
-"RTN","GPLACTOR",183,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
-"RTN","GPLACTOR",184,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
-"RTN","GPLACTOR",185,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","GPLACTOR",186,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","GPLACTOR",187,0)
-     S ZX=$$TEL^CCRVA200(AIEN)
-"RTN","GPLACTOR",188,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","GPLACTOR",189,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","GPLACTOR",190,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",191,0)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
-"RTN","GPLACTOR",192,0)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",193,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",194,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",195,0)
-     Q
-"RTN","GPLACTOR",196,0)
-     ;
-"RTN","GPLALERT")
-0^19^B13662473
-"RTN","GPLALERT",1,0)
-GPLALERT  ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
-"RTN","GPLALERT",2,0)
-          ;;0.1;CCDCCR;;SEP 11,2008;Build 13
-"RTN","GPLALERT",3,0)
-          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","GPLALERT",4,0)
-          ;General Public License See attached copy of the License.
-"RTN","GPLALERT",5,0)
-          ;
-"RTN","GPLALERT",6,0)
-          ;This program is free software; you can redistribute it and/or modify
-"RTN","GPLALERT",7,0)
-          ;it under the terms of the GNU General Public License as published by
-"RTN","GPLALERT",8,0)
-          ;the Free Software Foundation; either version 2 of the License, or
-"RTN","GPLALERT",9,0)
-          ;(at your option) any later version.
-"RTN","GPLALERT",10,0)
-          ;
-"RTN","GPLALERT",11,0)
-          ;This program is distributed in the hope that it will be useful,
-"RTN","GPLALERT",12,0)
-          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","GPLALERT",13,0)
-          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","GPLALERT",14,0)
-          ;GNU General Public License for more details.
-"RTN","GPLALERT",15,0)
-          ;
-"RTN","GPLALERT",16,0)
-          ;You should have received a copy of the GNU General Public License along
-"RTN","GPLALERT",17,0)
-          ;with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","GPLALERT",18,0)
-          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","GPLALERT",19,0)
-          ;
-"RTN","GPLALERT",20,0)
-          W "NO ENTRY FROM TOP",!
-"RTN","GPLALERT",21,0)
-          Q
-"RTN","GPLALERT",22,0)
-          ;
-"RTN","GPLALERT",23,0)
-EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
-"RTN","GPLALERT",24,0)
-          ;
-"RTN","GPLALERT",25,0)
-          ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","GPLALERT",26,0)
-          ;
-"RTN","GPLALERT",27,0)
-   ; GET ADVERSE REACTIONS AND ALLERGIES
-"RTN","GPLALERT",28,0)
-          N GMRA,GMRAL S GMRA="0^0^111"
-"RTN","GPLALERT",29,0)
-          D EN1^GMRADPT
-"RTN","GPLALERT",30,0)
-          I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
-"RTN","GPLALERT",31,0)
-   . S @ALTOUTXML@(0)=0 
-"RTN","GPLALERT",32,0)
- 
-"RTN","GPLALERT",33,0)
-   ; DEFINE MAPPING
-"RTN","GPLALERT",34,0)
-   N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
-"RTN","GPLALERT",35,0)
-   S ALTTVMAP=$NA(^TMP("GPLALERT",$J,"ALERTS"))
-"RTN","GPLALERT",36,0)
-          S ALTTARYTMP=$NA(^TMP("GPLALERT",$J,"ALERTSARYTMP"))
-"RTN","GPLALERT",37,0)
-          K @ALTTVMAP,@ALTTARYTMP
-"RTN","GPLALERT",38,0)
-          N ALTTMP,ALTCNT S ALTTMP=$NA(GMRAL),ALTCNT=1
-"RTN","GPLALERT",39,0)
-   F  S ALTTMP=$Q(@ALTTMP) Q:ALTTMP=""  D
-"RTN","GPLALERT",40,0)
-          . I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
-"RTN","GPLALERT",41,0)
-   . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
-"RTN","GPLALERT",42,0)
-          . K @ALTVMAP
-"RTN","GPLALERT",43,0)
-          . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
-"RTN","GPLALERT",44,0)
-          . N ALERTDESCRIPTIONTEXT S ALERTDESCRIPTIONTEXT="Patient has an " ; X $ZINT H 5
-"RTN","GPLALERT",45,0)
-          . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_$S($P(@ALTTMP,U,4)=1:"ADVERSE",$P(@ALTTMP,U,5)=1:"ALLERGIC",1:"UNKNOWN")
-"RTN","GPLALERT",46,0)
-          . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_" reaction to "_$P(@ALTTMP,U,2)_"."
-"RTN","GPLALERT",47,0)
-          . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ALERTDESCRIPTIONTEXT
-"RTN","GPLALERT",48,0)
-          . S @ALTVMAP@("ALERTCODEVALUE")="ALERT CODE VALUE"
-"RTN","GPLALERT",49,0)
-          . S @ALTVMAP@("ALERTCODESYSTEM")="ALERT CODE SYSTEM"
-"RTN","GPLALERT",50,0)
-          . S @ALTVMAP@("ALERTSTATUSTEXT")="ALERT STATUS TEXT"
-"RTN","GPLALERT",51,0)
-          . S @ALTVMAP@("ALERTSOURCEID")="ALERT SOURCE ID"
-"RTN","GPLALERT",52,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="ALERT AGENT PRODUCT OBJECT ID"
-"RTN","GPLALERT",53,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="A"
-"RTN","GPLALERT",54,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")="B"
-"RTN","GPLALERT",55,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="C"
-"RTN","GPLALERT",56,0)
-          . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="D"
-"RTN","GPLALERT",57,0)
-          . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
-"RTN","GPLALERT",58,0)
-          . K @ALTARYTMP
-"RTN","GPLALERT",59,0)
-          . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
-"RTN","GPLALERT",60,0)
-          . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)
-"RTN","GPLALERT",61,0)
-          . I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP)
-"RTN","GPLALERT",62,0)
-          . S ALTCNT=ALTCNT+1
-"RTN","GPLALERT",63,0)
- 
-"RTN","GPLALERT",64,0)
-          Q
-"RTN","GPLALERT",65,0)
- 
-"RTN","GPLCCD")
-0^8^B114413975
-"RTN","GPLCCD",1,0)
-GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
-"RTN","GPLCCD",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 13
-"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^15^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 13
-"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^13^B82192762
-"RTN","GPLCCR",1,0)
-GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-"RTN","GPLCCR",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 13
-"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)
-       I '$D(DIR) S DIR=""
-"RTN","GPLCCR",35,0)
-       I '$D(FN) S FN=""
-"RTN","GPLCCR",36,0)
-       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-"RTN","GPLCCR",37,0)
-       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
-"RTN","GPLCCR",38,0)
-       S ONAM=FN
-"RTN","GPLCCR",39,0)
-       I FN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_5.xml"
-"RTN","GPLCCR",40,0)
-       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
-"RTN","GPLCCR",41,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","GPLCCR",42,0)
-       . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","GPLCCR",43,0)
-       . ;S @ODIRGLB="/home/cedwards/"
-"RTN","GPLCCR",44,0)
-       . S @ODIRGLB="/opt/wv/p/"
-"RTN","GPLCCR",45,0)
-       S ODIR=DIR
-"RTN","GPLCCR",46,0)
-       I DIR="" S ODIR=@ODIRGLB
-"RTN","GPLCCR",47,0)
-       N ZY
-"RTN","GPLCCR",48,0)
-       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-"RTN","GPLCCR",49,0)
-       W !,$P(ZY,U,2),!
-"RTN","GPLCCR",50,0)
-       Q
-"RTN","GPLCCR",51,0)
-       ;
-"RTN","GPLCCR",52,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","GPLCCR",53,0)
-    ;
-"RTN","GPLCCR",54,0)
-    N G1
-"RTN","GPLCCR",55,0)
-    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
-"RTN","GPLCCR",56,0)
-    I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","GPLCCR",57,0)
-    . D PARY^GPLXPATH(G1)
-"RTN","GPLCCR",58,0)
-    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
-"RTN","GPLCCR",59,0)
-    Q
-"RTN","GPLCCR",60,0)
-    ;
-"RTN","GPLCCR",61,0)
-CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","GPLCCR",62,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-"RTN","GPLCCR",63,0)
-    ; DFN IS PATIENT IEN
-"RTN","GPLCCR",64,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","GPLCCR",65,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","GPLCCR",66,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-"RTN","GPLCCR",67,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-"RTN","GPLCCR",68,0)
-    ; - NULL MEANS NOW
-"RTN","GPLCCR",69,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-"RTN","GPLCCR",70,0)
-    ;    "TO" VARIABLES
-"RTN","GPLCCR",71,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-"RTN","GPLCCR",72,0)
-    I '$D(DEBUG) S DEBUG=0
-"RTN","GPLCCR",73,0)
-    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","GPLCCR",74,0)
-    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","GPLCCR",75,0)
-    I '$D(TESTALERT) S TESTALERT=0 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","GPLCCR",76,0)
-    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
-"RTN","GPLCCR",77,0)
-    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","GPLCCR",78,0)
-    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","GPLCCR",79,0)
-    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","GPLCCR",80,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","GPLCCR",81,0)
-    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-"RTN","GPLCCR",82,0)
-    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","GPLCCR",83,0)
-    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","GPLCCR",84,0)
-    ;
-"RTN","GPLCCR",85,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","GPLCCR",86,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","GPLCCR",87,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",88,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",89,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","GPLCCR",90,0)
-    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","GPLCCR",91,0)
-    ;
-"RTN","GPLCCR",92,0)
-    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-"RTN","GPLCCR",93,0)
-    ;
-"RTN","GPLCCR",94,0)
-    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","GPLCCR",95,0)
-    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","GPLCCR",96,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","GPLCCR",97,0)
-    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","GPLCCR",98,0)
-    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","GPLCCR",99,0)
-    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","GPLCCR",100,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","GPLCCR",101,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","GPLCCR",102,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","GPLCCR",103,0)
-    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","GPLCCR",104,0)
-    . S IXML="INXML"
-"RTN","GPLCCR",105,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","GPLCCR",106,0)
-    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","GPLCCR",107,0)
-    . ; W OXML,!
-"RTN","GPLCCR",108,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","GPLCCR",109,0)
-    . I DEBUG W "RUNNING ",CALL,!
-"RTN","GPLCCR",110,0)
-    . X CALL
-"RTN","GPLCCR",111,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","GPLCCR",112,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-"RTN","GPLCCR",113,0)
-    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",114,0)
-    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-"RTN","GPLCCR",115,0)
-    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","GPLCCR",116,0)
-    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","GPLCCR",117,0)
-    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","GPLCCR",118,0)
-    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",119,0)
-    N TRIMI,J,DONE S DONE=0
-"RTN","GPLCCR",120,0)
-    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","GPLCCR",121,0)
-    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","GPLCCR",122,0)
-    . I DEBUG W "TRIMMED",J,!
-"RTN","GPLCCR",123,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","GPLCCR",124,0)
-    Q
-"RTN","GPLCCR",125,0)
-    ;
-"RTN","GPLCCR",126,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","GPLCCR",127,0)
-    ; TAB IS PASSED BY NAME
-"RTN","GPLCCR",128,0)
-    I DEBUG W "TAB= ",TAB,!
-"RTN","GPLCCR",129,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","GPLCCR",130,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","GPLCCR",131,0)
-    I TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS1;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",132,0)
-    I 'TESTMEDS D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",133,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
-"RTN","GPLCCR",134,0)
-    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
-"RTN","GPLCCR",135,0)
-    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
-"RTN","GPLCCR",136,0)
-    Q
-"RTN","GPLCCR",137,0)
-    ;
-"RTN","GPLCCR",138,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","GPLCCR",139,0)
-    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
-"RTN","GPLCCR",140,0)
-    ; K @VMAP
-"RTN","GPLCCR",141,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
-"RTN","GPLCCR",142,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","GPLCCR",143,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","GPLCCR",144,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","GPLCCR",145,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","GPLCCR",146,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-"RTN","GPLCCR",147,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",148,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",149,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","GPLCCR",150,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","GPLCCR",151,0)
-    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","GPLCCR",152,0)
-    N CTMP
-"RTN","GPLCCR",153,0)
-    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-"RTN","GPLCCR",154,0)
-    D CP^GPLXPATH("CTMP",CXML)
-"RTN","GPLCCR",155,0)
-    Q
-"RTN","GPLCCR",156,0)
-    ;
-"RTN","GPLCCR",157,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","GPLCCR",158,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","GPLCCR",159,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","GPLCCR",160,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","GPLCCR",161,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","GPLCCR",162,0)
-    ;OR INSTITUTION
-"RTN","GPLCCR",163,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","GPLCCR",164,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","GPLCCR",165,0)
-    N I,J,K,L
-"RTN","GPLCCR",166,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","GPLCCR",167,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","GPLCCR",168,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","GPLCCR",169,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","GPLCCR",170,0)
-    . . I DEBUG W "<ActorID>=>",J,!
-"RTN","GPLCCR",171,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","GPLCCR",172,0)
-    . . ;  TO GET RID OF DUPLICATES
-"RTN","GPLCCR",173,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","GPLCCR",174,0)
-    F J=0:0 D  Q:$O(K(I))=""
-"RTN","GPLCCR",175,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","GPLCCR",176,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","GPLCCR",177,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","GPLCCR",178,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","GPLCCR",179,0)
-    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","GPLCCR",180,0)
-    Q
-"RTN","GPLCCR",181,0)
-    ;
-"RTN","GPLCCR",182,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","GPLCCR",183,0)
-  D TESTALL^GPLUNIT("GPLCCR")
-"RTN","GPLCCR",184,0)
-  Q
-"RTN","GPLCCR",185,0)
-  ;
-"RTN","GPLCCR",186,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","GPLCCR",187,0)
-  N ZTMP
-"RTN","GPLCCR",188,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",189,0)
-  D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLCCR",190,0)
-  Q
-"RTN","GPLCCR",191,0)
-  ;
-"RTN","GPLCCR",192,0)
-TLIST  ; LIST THE TESTS
-"RTN","GPLCCR",193,0)
-  N ZTMP
-"RTN","GPLCCR",194,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",195,0)
-  D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLCCR",196,0)
-  Q
-"RTN","GPLCCR",197,0)
-  ;
-"RTN","GPLCCR",198,0)
- ;;><TEST>
-"RTN","GPLCCR",199,0)
- ;;><PROBLEMS>
-"RTN","GPLCCR",200,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",201,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
-"RTN","GPLCCR",202,0)
- ;;>>?@GPL@(@GPL@(0))["</Problems>"
-"RTN","GPLCCR",203,0)
- ;;><VITALS>
-"RTN","GPLCCR",204,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",205,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
-"RTN","GPLCCR",206,0)
- ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
-"RTN","GPLCCR",207,0)
- ;;><CCR>
-"RTN","GPLCCR",208,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",209,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",210,0)
- ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
-"RTN","GPLCCR",211,0)
- ;;><ACTLST>
-"RTN","GPLCCR",212,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",213,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",214,0)
- ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
-"RTN","GPLCCR",215,0)
- ;;><ACTORS>
-"RTN","GPLCCR",216,0)
- ;;>>>D ZTEST^GPLCCR("ACTLST")
-"RTN","GPLCCR",217,0)
- ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","GPLCCR",218,0)
- ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
-"RTN","GPLCCR",219,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","GPLCCR",220,0)
- ;;><TRIM>
-"RTN","GPLCCR",221,0)
- ;;>>>D ZTEST^GPLCCR("CCR")
-"RTN","GPLCCR",222,0)
- ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
-"RTN","GPLCCR",223,0)
- ;;><ALERTS>
-"RTN","GPLCCR",224,0)
- ;;>>>S TESTALERT=1
-"RTN","GPLCCR",225,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",226,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
-"RTN","GPLCCR",227,0)
- ;;>>?@GPL@(@GPL@(0))["</Alerts>"
-"RTN","GPLCCR",228,0)
- 
-"RTN","GPLCCR0")
-0^14^B654252455
-"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 13
-"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)
- ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
-"RTN","GPLCCR0",368,0)
- ;;</Frequency>
-"RTN","GPLCCR0",369,0)
- ;;<Interval>
-"RTN","GPLCCR0",370,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","GPLCCR0",371,0)
- ;;<Units>
-"RTN","GPLCCR0",372,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","GPLCCR0",373,0)
- ;;</Units>
-"RTN","GPLCCR0",374,0)
- ;;</Interval>
-"RTN","GPLCCR0",375,0)
- ;;<Duration>
-"RTN","GPLCCR0",376,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","GPLCCR0",377,0)
- ;;<Units>
-"RTN","GPLCCR0",378,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","GPLCCR0",379,0)
- ;;</Units>
-"RTN","GPLCCR0",380,0)
- ;;</Duration>
-"RTN","GPLCCR0",381,0)
- ;;<Indication>
-"RTN","GPLCCR0",382,0)
- ;;<PRNFlag>
-"RTN","GPLCCR0",383,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","GPLCCR0",384,0)
- ;;</PRNFlag>
-"RTN","GPLCCR0",385,0)
- ;;<Problem>
-"RTN","GPLCCR0",386,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",387,0)
- ;;<Type>
-"RTN","GPLCCR0",388,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","GPLCCR0",389,0)
- ;;</Type>
-"RTN","GPLCCR0",390,0)
- ;;<Description>
-"RTN","GPLCCR0",391,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","GPLCCR0",392,0)
- ;;<Code>
-"RTN","GPLCCR0",393,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","GPLCCR0",394,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",395,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","GPLCCR0",396,0)
- ;;</Code>
-"RTN","GPLCCR0",397,0)
- ;;</Description>
-"RTN","GPLCCR0",398,0)
- ;;<Source>
-"RTN","GPLCCR0",399,0)
- ;;<Actor>
-"RTN","GPLCCR0",400,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",401,0)
- ;;</Actor>
-"RTN","GPLCCR0",402,0)
- ;;</Source>
-"RTN","GPLCCR0",403,0)
- ;;</Problem>
-"RTN","GPLCCR0",404,0)
- ;;</Indication>
-"RTN","GPLCCR0",405,0)
- ;;<StopIndicator>
-"RTN","GPLCCR0",406,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","GPLCCR0",407,0)
- ;;</StopIndicator>
-"RTN","GPLCCR0",408,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","GPLCCR0",409,0)
- ;;<MultipleDirectionModifier>
-"RTN","GPLCCR0",410,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","GPLCCR0",411,0)
- ;;</MultipleDirectionModifier>
-"RTN","GPLCCR0",412,0)
- ;;</Direction>
-"RTN","GPLCCR0",413,0)
- ;;</Directions>
-"RTN","GPLCCR0",414,0)
- ;;<PatientInstructions>
-"RTN","GPLCCR0",415,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",416,0)
- ;;</PatientInstructions>
-"RTN","GPLCCR0",417,0)
- ;;<FullfillmentInstructions>
-"RTN","GPLCCR0",418,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",419,0)
- ;;</FullfillmentInstructions>
-"RTN","GPLCCR0",420,0)
- ;;<Refills>
-"RTN","GPLCCR0",421,0)
- ;;<Refill>
-"RTN","GPLCCR0",422,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","GPLCCR0",423,0)
- ;;</Refill>
-"RTN","GPLCCR0",424,0)
- ;;</Refills>
-"RTN","GPLCCR0",425,0)
- ;;</Medication>
-"RTN","GPLCCR0",426,0)
- ;;</Medications>
-"RTN","GPLCCR0",427,0)
- ;;<VitalSigns>
-"RTN","GPLCCR0",428,0)
- ;;<Result>
-"RTN","GPLCCR0",429,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",430,0)
- ;;<DateTime>
-"RTN","GPLCCR0",431,0)
- ;;<Type>
-"RTN","GPLCCR0",432,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","GPLCCR0",433,0)
- ;;</Type>
-"RTN","GPLCCR0",434,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",435,0)
- ;;</DateTime>
-"RTN","GPLCCR0",436,0)
- ;;<Description>
-"RTN","GPLCCR0",437,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",438,0)
- ;;</Description>
-"RTN","GPLCCR0",439,0)
- ;;<Source>
-"RTN","GPLCCR0",440,0)
- ;;<Actor>
-"RTN","GPLCCR0",441,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",442,0)
- ;;</Actor>
-"RTN","GPLCCR0",443,0)
- ;;</Source>
-"RTN","GPLCCR0",444,0)
- ;;<Test>
-"RTN","GPLCCR0",445,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",446,0)
- ;;<Type>
-"RTN","GPLCCR0",447,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","GPLCCR0",448,0)
- ;;</Type>
-"RTN","GPLCCR0",449,0)
- ;;<Description>
-"RTN","GPLCCR0",450,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",451,0)
- ;;<Code>
-"RTN","GPLCCR0",452,0)
- ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
-"RTN","GPLCCR0",453,0)
- ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",454,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","GPLCCR0",455,0)
- ;;</Code>
-"RTN","GPLCCR0",456,0)
- ;;</Description>
-"RTN","GPLCCR0",457,0)
- ;;<Source>
-"RTN","GPLCCR0",458,0)
- ;;<Actor>
-"RTN","GPLCCR0",459,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",460,0)
- ;;</Actor>
-"RTN","GPLCCR0",461,0)
- ;;</Source>
-"RTN","GPLCCR0",462,0)
- ;;<TestResult>
-"RTN","GPLCCR0",463,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","GPLCCR0",464,0)
- ;;<Units>
-"RTN","GPLCCR0",465,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","GPLCCR0",466,0)
- ;;</Units>
-"RTN","GPLCCR0",467,0)
- ;;</TestResult>
-"RTN","GPLCCR0",468,0)
- ;;</Test>
-"RTN","GPLCCR0",469,0)
- ;;</Result>
-"RTN","GPLCCR0",470,0)
- ;;</VitalSigns>
-"RTN","GPLCCR0",471,0)
- ;;<Results>
-"RTN","GPLCCR0",472,0)
- ;;<Result>
-"RTN","GPLCCR0",473,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",474,0)
- ;;<DateTime>
-"RTN","GPLCCR0",475,0)
- ;;<Type>
-"RTN","GPLCCR0",476,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",477,0)
- ;;</Type>
-"RTN","GPLCCR0",478,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",479,0)
- ;;</DateTime>
-"RTN","GPLCCR0",480,0)
- ;;<Description>
-"RTN","GPLCCR0",481,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",482,0)
- ;;<Code>
-"RTN","GPLCCR0",483,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","GPLCCR0",484,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",485,0)
- ;;</Code>
-"RTN","GPLCCR0",486,0)
- ;;</Description>
-"RTN","GPLCCR0",487,0)
- ;;<Status>
-"RTN","GPLCCR0",488,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","GPLCCR0",489,0)
- ;;</Status>
-"RTN","GPLCCR0",490,0)
- ;;<Source>
-"RTN","GPLCCR0",491,0)
- ;;<Actor>
-"RTN","GPLCCR0",492,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",493,0)
- ;;</Actor>
-"RTN","GPLCCR0",494,0)
- ;;</Source>
-"RTN","GPLCCR0",495,0)
- ;;<TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",496,0)
- ;;<Test>
-"RTN","GPLCCR0",497,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",498,0)
- ;;<DateTime>
-"RTN","GPLCCR0",499,0)
- ;;<Type>
-"RTN","GPLCCR0",500,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",501,0)
- ;;</Type>
-"RTN","GPLCCR0",502,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",503,0)
- ;;</DateTime>
-"RTN","GPLCCR0",504,0)
- ;;<Description>
-"RTN","GPLCCR0",505,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",506,0)
- ;;<Code>
-"RTN","GPLCCR0",507,0)
- ;;<Value>@@RESULTTESTCODE@@</Value>
-"RTN","GPLCCR0",508,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",509,0)
- ;;</Code>
-"RTN","GPLCCR0",510,0)
- ;;</Description>
-"RTN","GPLCCR0",511,0)
- ;;<Status>
-"RTN","GPLCCR0",512,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",513,0)
- ;;</Status>
-"RTN","GPLCCR0",514,0)
- ;;<Source>
-"RTN","GPLCCR0",515,0)
- ;;<Actor>
-"RTN","GPLCCR0",516,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",517,0)
- ;;</Actor>
-"RTN","GPLCCR0",518,0)
- ;;</Source>
-"RTN","GPLCCR0",519,0)
- ;;<TestResult>
-"RTN","GPLCCR0",520,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",521,0)
- ;;<Units>
-"RTN","GPLCCR0",522,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",523,0)
- ;;</Units>
-"RTN","GPLCCR0",524,0)
- ;;</TestResult>
-"RTN","GPLCCR0",525,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",526,0)
- ;;<Normal>
-"RTN","GPLCCR0",527,0)
- ;;<Description>
-"RTN","GPLCCR0",528,0)
- ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",529,0)
- ;;</Description>
-"RTN","GPLCCR0",530,0)
- ;;<Source>
-"RTN","GPLCCR0",531,0)
- ;;<Actor>
-"RTN","GPLCCR0",532,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",533,0)
- ;;</Actor>
-"RTN","GPLCCR0",534,0)
- ;;</Source>
-"RTN","GPLCCR0",535,0)
- ;;</Normal>
-"RTN","GPLCCR0",536,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",537,0)
- ;;<Flag>
-"RTN","GPLCCR0",538,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",539,0)
- ;;</Flag>
-"RTN","GPLCCR0",540,0)
- ;;</Test>
-"RTN","GPLCCR0",541,0)
- ;;</TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",542,0)
- ;;<TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",543,0)
- ;;<Test>
-"RTN","GPLCCR0",544,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",545,0)
- ;;<DateTime>
-"RTN","GPLCCR0",546,0)
- ;;<Type>
-"RTN","GPLCCR0",547,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",548,0)
- ;;</Type>
-"RTN","GPLCCR0",549,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",550,0)
- ;;</DateTime>
-"RTN","GPLCCR0",551,0)
- ;;<Description>
-"RTN","GPLCCR0",552,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",553,0)
- ;;<Code>
-"RTN","GPLCCR0",554,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",555,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",556,0)
- ;;</Code>
-"RTN","GPLCCR0",557,0)
- ;;</Description>
-"RTN","GPLCCR0",558,0)
- ;;<Status>
-"RTN","GPLCCR0",559,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",560,0)
- ;;</Status>
-"RTN","GPLCCR0",561,0)
- ;;<Source>
-"RTN","GPLCCR0",562,0)
- ;;<Actor>
-"RTN","GPLCCR0",563,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",564,0)
- ;;</Actor>
-"RTN","GPLCCR0",565,0)
- ;;</Source>
-"RTN","GPLCCR0",566,0)
- ;;<TestResult>
-"RTN","GPLCCR0",567,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",568,0)
- ;;<Units>
-"RTN","GPLCCR0",569,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",570,0)
- ;;</Units>
-"RTN","GPLCCR0",571,0)
- ;;</TestResult>
-"RTN","GPLCCR0",572,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",573,0)
- ;;<Normal>
-"RTN","GPLCCR0",574,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
-"RTN","GPLCCR0",575,0)
- ;;<Units>
-"RTN","GPLCCR0",576,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
-"RTN","GPLCCR0",577,0)
- ;;</Units>
-"RTN","GPLCCR0",578,0)
- ;;<ValueSequencePosition>1</ValueSequencePosition>
-"RTN","GPLCCR0",579,0)
- ;;<Source>
-"RTN","GPLCCR0",580,0)
- ;;<Actor>
-"RTN","GPLCCR0",581,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",582,0)
- ;;</Actor>
-"RTN","GPLCCR0",583,0)
- ;;</Source>
-"RTN","GPLCCR0",584,0)
- ;;</Normal>
-"RTN","GPLCCR0",585,0)
- ;;<Normal>
-"RTN","GPLCCR0",586,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
-"RTN","GPLCCR0",587,0)
- ;;<Units>
-"RTN","GPLCCR0",588,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
-"RTN","GPLCCR0",589,0)
- ;;</Units>
-"RTN","GPLCCR0",590,0)
- ;;<ValueSequencePosition>2</ValueSequencePosition>
-"RTN","GPLCCR0",591,0)
- ;;<VariableNomalModifier>
-"RTN","GPLCCR0",592,0)
- ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
-"RTN","GPLCCR0",593,0)
- ;;</VariableNomalModifier>
-"RTN","GPLCCR0",594,0)
- ;;<Source>
-"RTN","GPLCCR0",595,0)
- ;;<Actor>
-"RTN","GPLCCR0",596,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",597,0)
- ;;</Actor>
-"RTN","GPLCCR0",598,0)
- ;;</Source>
-"RTN","GPLCCR0",599,0)
- ;;</Normal>
-"RTN","GPLCCR0",600,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",601,0)
- ;;<Flag>
-"RTN","GPLCCR0",602,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",603,0)
- ;;</Flag>
-"RTN","GPLCCR0",604,0)
- ;;</Test>
-"RTN","GPLCCR0",605,0)
- ;;</TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",606,0)
- ;;</Result>
-"RTN","GPLCCR0",607,0)
- ;;</Results>
-"RTN","GPLCCR0",608,0)
- ;;<HealthCareProviders>
-"RTN","GPLCCR0",609,0)
- ;;<Provider>
-"RTN","GPLCCR0",610,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","GPLCCR0",611,0)
- ;;<ActorRole>
-"RTN","GPLCCR0",612,0)
- ;;<Text>Primary Provider</Text>
-"RTN","GPLCCR0",613,0)
- ;;</ActorRole>
-"RTN","GPLCCR0",614,0)
- ;;</Provider>
-"RTN","GPLCCR0",615,0)
- ;;</HealthCareProviders>
-"RTN","GPLCCR0",616,0)
- ;;</Body>
-"RTN","GPLCCR0",617,0)
- ;;<Actors>
-"RTN","GPLCCR0",618,0)
- ;;<ACTOR-PATIENT>
-"RTN","GPLCCR0",619,0)
- ;;<Actor>
-"RTN","GPLCCR0",620,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",621,0)
- ;;<Person>
-"RTN","GPLCCR0",622,0)
- ;;<Name>
-"RTN","GPLCCR0",623,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",624,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",625,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",626,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",627,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",628,0)
- ;;</Name>
-"RTN","GPLCCR0",629,0)
- ;;<DateOfBirth>
-"RTN","GPLCCR0",630,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","GPLCCR0",631,0)
- ;;</DateOfBirth>
-"RTN","GPLCCR0",632,0)
- ;;<Gender>
-"RTN","GPLCCR0",633,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","GPLCCR0",634,0)
- ;;<Code>
-"RTN","GPLCCR0",635,0)
- ;;<Value>@@ACTORGENDER@@</Value>
-"RTN","GPLCCR0",636,0)
- ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
-"RTN","GPLCCR0",637,0)
- ;;</Code>
-"RTN","GPLCCR0",638,0)
- ;;</Gender>
-"RTN","GPLCCR0",639,0)
- ;;</Person>
-"RTN","GPLCCR0",640,0)
- ;;<IDs>
-"RTN","GPLCCR0",641,0)
- ;;<Type>
-"RTN","GPLCCR0",642,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","GPLCCR0",643,0)
- ;;</Type>
-"RTN","GPLCCR0",644,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","GPLCCR0",645,0)
- ;;<Source>
-"RTN","GPLCCR0",646,0)
- ;;<Actor>
-"RTN","GPLCCR0",647,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","GPLCCR0",648,0)
- ;;</Actor>
-"RTN","GPLCCR0",649,0)
- ;;</Source>
-"RTN","GPLCCR0",650,0)
- ;;</IDs>
-"RTN","GPLCCR0",651,0)
- ;;<Address>
-"RTN","GPLCCR0",652,0)
- ;;<Type>
-"RTN","GPLCCR0",653,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",654,0)
- ;;</Type>
-"RTN","GPLCCR0",655,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",656,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","GPLCCR0",657,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",658,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",659,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","GPLCCR0",660,0)
- ;;</Address>
-"RTN","GPLCCR0",661,0)
- ;;<Telephone>
-"RTN","GPLCCR0",662,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","GPLCCR0",663,0)
- ;;<Type>
-"RTN","GPLCCR0",664,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","GPLCCR0",665,0)
- ;;</Type>
-"RTN","GPLCCR0",666,0)
- ;;</Telephone>
-"RTN","GPLCCR0",667,0)
- ;;<Telephone>
-"RTN","GPLCCR0",668,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","GPLCCR0",669,0)
- ;;<Type>
-"RTN","GPLCCR0",670,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","GPLCCR0",671,0)
- ;;</Type>
-"RTN","GPLCCR0",672,0)
- ;;</Telephone>
-"RTN","GPLCCR0",673,0)
- ;;<Telephone>
-"RTN","GPLCCR0",674,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","GPLCCR0",675,0)
- ;;<Type>
-"RTN","GPLCCR0",676,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","GPLCCR0",677,0)
- ;;</Type>
-"RTN","GPLCCR0",678,0)
- ;;</Telephone>
-"RTN","GPLCCR0",679,0)
- ;;<EMail>
-"RTN","GPLCCR0",680,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",681,0)
- ;;</EMail>
-"RTN","GPLCCR0",682,0)
- ;;<Source>
-"RTN","GPLCCR0",683,0)
- ;;<Actor>
-"RTN","GPLCCR0",684,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",685,0)
- ;;</Actor>
-"RTN","GPLCCR0",686,0)
- ;;</Source>
-"RTN","GPLCCR0",687,0)
- ;;</Actor>
-"RTN","GPLCCR0",688,0)
- ;;</ACTOR-PATIENT>
-"RTN","GPLCCR0",689,0)
- ;;<ACTOR-SYSTEM>
-"RTN","GPLCCR0",690,0)
- ;;<Actor>
-"RTN","GPLCCR0",691,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",692,0)
- ;;<InformationSystem>
-"RTN","GPLCCR0",693,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","GPLCCR0",694,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","GPLCCR0",695,0)
- ;;</InformationSystem>
-"RTN","GPLCCR0",696,0)
- ;;<Source>
-"RTN","GPLCCR0",697,0)
- ;;<Actor>
-"RTN","GPLCCR0",698,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",699,0)
- ;;</Actor>
-"RTN","GPLCCR0",700,0)
- ;;</Source>
-"RTN","GPLCCR0",701,0)
- ;;</Actor>
-"RTN","GPLCCR0",702,0)
- ;;</ACTOR-SYSTEM>
-"RTN","GPLCCR0",703,0)
- ;;<ACTOR-NOK>
-"RTN","GPLCCR0",704,0)
- ;;<Actor>
-"RTN","GPLCCR0",705,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","GPLCCR0",706,0)
- ;;<Person>
-"RTN","GPLCCR0",707,0)
- ;;<Name>
-"RTN","GPLCCR0",708,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","GPLCCR0",709,0)
- ;;</Name>
-"RTN","GPLCCR0",710,0)
- ;;</Person>
-"RTN","GPLCCR0",711,0)
- ;;<Relation>
-"RTN","GPLCCR0",712,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","GPLCCR0",713,0)
- ;;</Relation>
-"RTN","GPLCCR0",714,0)
- ;;<Source>
-"RTN","GPLCCR0",715,0)
- ;;<Actor>
-"RTN","GPLCCR0",716,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","GPLCCR0",717,0)
- ;;</Actor>
-"RTN","GPLCCR0",718,0)
- ;;</Source>
-"RTN","GPLCCR0",719,0)
- ;;</Actor>
-"RTN","GPLCCR0",720,0)
- ;;</ACTOR-NOK>
-"RTN","GPLCCR0",721,0)
- ;;<ACTOR-PROVIDER>
-"RTN","GPLCCR0",722,0)
- ;;<Actor>
-"RTN","GPLCCR0",723,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",724,0)
- ;;<Person>
-"RTN","GPLCCR0",725,0)
- ;;<Name>
-"RTN","GPLCCR0",726,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",727,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",728,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",729,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",730,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","GPLCCR0",731,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",732,0)
- ;;</Name>
-"RTN","GPLCCR0",733,0)
- ;;</Person>
-"RTN","GPLCCR0",734,0)
- ;;<IDs>
-"RTN","GPLCCR0",735,0)
- ;;<Type>
-"RTN","GPLCCR0",736,0)
- ;;<Text>@@IDTYPE@@</Text>
-"RTN","GPLCCR0",737,0)
- ;;</Type>
-"RTN","GPLCCR0",738,0)
- ;;<ID>@@ID@@</ID>
-"RTN","GPLCCR0",739,0)
- ;;<IssuedBy>
-"RTN","GPLCCR0",740,0)
- ;;<Description>
-"RTN","GPLCCR0",741,0)
- ;;<Text>@@IDDESC@@</Text>
-"RTN","GPLCCR0",742,0)
- ;;</Description>
-"RTN","GPLCCR0",743,0)
- ;;</IssuedBy>
-"RTN","GPLCCR0",744,0)
- ;;</IDs>
-"RTN","GPLCCR0",745,0)
- ;;<Specialty>
-"RTN","GPLCCR0",746,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","GPLCCR0",747,0)
- ;;</Specialty>
-"RTN","GPLCCR0",748,0)
- ;;<Address>
-"RTN","GPLCCR0",749,0)
- ;;<Type>
-"RTN","GPLCCR0",750,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",751,0)
- ;;</Type>
-"RTN","GPLCCR0",752,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",753,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",754,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",755,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","GPLCCR0",756,0)
- ;;</Address>
-"RTN","GPLCCR0",757,0)
- ;;<Telephone>
-"RTN","GPLCCR0",758,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","GPLCCR0",759,0)
- ;;<Type>
-"RTN","GPLCCR0",760,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","GPLCCR0",761,0)
- ;;</Type>
-"RTN","GPLCCR0",762,0)
- ;;</Telephone>
-"RTN","GPLCCR0",763,0)
- ;;<Email>
-"RTN","GPLCCR0",764,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",765,0)
- ;;</Email>
-"RTN","GPLCCR0",766,0)
- ;;<Source>
-"RTN","GPLCCR0",767,0)
- ;;<Actor>
-"RTN","GPLCCR0",768,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",769,0)
- ;;</Actor>
-"RTN","GPLCCR0",770,0)
- ;;</Source>
-"RTN","GPLCCR0",771,0)
- ;;</Actor>
-"RTN","GPLCCR0",772,0)
- ;;</ACTOR-PROVIDER>
-"RTN","GPLCCR0",773,0)
- ;;<ACTOR-ORG>
-"RTN","GPLCCR0",774,0)
- ;;<Actor>
-"RTN","GPLCCR0",775,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",776,0)
- ;;<Organization>
-"RTN","GPLCCR0",777,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","GPLCCR0",778,0)
- ;;</Organization>
-"RTN","GPLCCR0",779,0)
- ;;<Source>
-"RTN","GPLCCR0",780,0)
- ;;<Actor>
-"RTN","GPLCCR0",781,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",782,0)
- ;;</Actor>
-"RTN","GPLCCR0",783,0)
- ;;</Source>
-"RTN","GPLCCR0",784,0)
- ;;</Actor>
-"RTN","GPLCCR0",785,0)
- ;;</ACTOR-ORG>
-"RTN","GPLCCR0",786,0)
- ;;</Actors>
-"RTN","GPLCCR0",787,0)
- ;;<Signatures>
-"RTN","GPLCCR0",788,0)
- ;;<CCRSignature>
-"RTN","GPLCCR0",789,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","GPLCCR0",790,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","GPLCCR0",791,0)
- ;;<Source>
-"RTN","GPLCCR0",792,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","GPLCCR0",793,0)
- ;;</Source>
-"RTN","GPLCCR0",794,0)
- ;;<Signature>
-"RTN","GPLCCR0",795,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","GPLCCR0",796,0)
- ;;<SignedInfo>
-"RTN","GPLCCR0",797,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","GPLCCR0",798,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","GPLCCR0",799,0)
- ;;<Reference URI="">
-"RTN","GPLCCR0",800,0)
- ;;<Transforms>
-"RTN","GPLCCR0",801,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","GPLCCR0",802,0)
- ;;</Transforms>
-"RTN","GPLCCR0",803,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","GPLCCR0",804,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","GPLCCR0",805,0)
- ;;</Reference>
-"RTN","GPLCCR0",806,0)
- ;;</SignedInfo>
-"RTN","GPLCCR0",807,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","GPLCCR0",808,0)
- ;;<KeyInfo>
-"RTN","GPLCCR0",809,0)
- ;;<KeyValue>
-"RTN","GPLCCR0",810,0)
- ;;<RSAKeyValue>
-"RTN","GPLCCR0",811,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","GPLCCR0",812,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","GPLCCR0",813,0)
- ;;</RSAKeyValue>
-"RTN","GPLCCR0",814,0)
- ;;</KeyValue>
-"RTN","GPLCCR0",815,0)
- ;;</KeyInfo>
-"RTN","GPLCCR0",816,0)
- ;;</Signature>
-"RTN","GPLCCR0",817,0)
- ;;</Signature>
-"RTN","GPLCCR0",818,0)
- ;;</CCRSignature>
-"RTN","GPLCCR0",819,0)
- ;;</Signatures>
-"RTN","GPLCCR0",820,0)
- ;;</ContinuityOfCareRecord>
-"RTN","GPLCCR0",821,0)
- ;</TEMPLATE>
-"RTN","GPLPROBS")
-0^20^B25875394
-"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 13
-"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)
-          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","GPLPROBS",42,0)
-          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","GPLPROBS",43,0)
-          . S VMAP=$NA(@TVMAP@(J))
-"RTN","GPLPROBS",44,0)
-          . K @VMAP
-"RTN","GPLPROBS",45,0)
-          . I DEBUG W "VMAP= ",VMAP,!
-"RTN","GPLPROBS",46,0)
-          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","GPLPROBS",47,0)
-          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","GPLPROBS",48,0)
-          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","GPLPROBS",49,0)
-          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
-"RTN","GPLPROBS",50,0)
-          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","GPLPROBS",51,0)
-          . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","GPLPROBS",52,0)
-          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","GPLPROBS",53,0)
-          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
-"RTN","GPLPROBS",54,0)
-          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
-"RTN","GPLPROBS",55,0)
-          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","GPLPROBS",56,0)
-          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","GPLPROBS",57,0)
-          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","GPLPROBS",58,0)
-          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","GPLPROBS",59,0)
-          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","GPLPROBS",60,0)
-          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","GPLPROBS",61,0)
-          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","GPLPROBS",62,0)
-          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","GPLPROBS",63,0)
-          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","GPLPROBS",64,0)
-          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","GPLPROBS",65,0)
-          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
-"RTN","GPLPROBS",66,0)
-          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
-"RTN","GPLPROBS",67,0)
-          . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","GPLPROBS",68,0)
-          . ; W "ARYTMP= ",ARYTMP,!
-"RTN","GPLPROBS",69,0)
-          . K @ARYTMP
-"RTN","GPLPROBS",70,0)
-          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","GPLPROBS",71,0)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",72,0)
-          . . ; W "FIRST ONE",!
-"RTN","GPLPROBS",73,0)
-          . . D CP^GPLXPATH(ARYTMP,OUTXML)
-"RTN","GPLPROBS",74,0)
-          . . ; W "OUTXML ",OUTXML,!
-"RTN","GPLPROBS",75,0)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLPROBS",76,0)
-          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
-"RTN","GPLPROBS",77,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
-"RTN","GPLPROBS",78,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLPROBS",79,0)
-          ; ZWR @OUTXML
-"RTN","GPLPROBS",80,0)
-          ; $$HTML^DILF(
-"RTN","GPLPROBS",81,0)
-          ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","GPLPROBS",82,0)
-          I CCD D  ; IF THIS IS FOR A CCD
-"RTN","GPLPROBS",83,0)
-          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
-"RTN","GPLPROBS",84,0)
-          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","GPLPROBS",85,0)
-          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
-"RTN","GPLPROBS",86,0)
-          . . I DEBUG W "VMAP =",VMAP,!
-"RTN","GPLPROBS",87,0)
-          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","GPLPROBS",88,0)
-          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","GPLPROBS",89,0)
-          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
-"RTN","GPLPROBS",90,0)
-          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","GPLPROBS",91,0)
-          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","GPLPROBS",92,0)
-          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",93,0)
-          . . . D CP^GPLXPATH("HOUT","HTMLO")
-"RTN","GPLPROBS",94,0)
-          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","GPLPROBS",95,0)
-          . . . I DEBUG W "DOING INNER",!
-"RTN","GPLPROBS",96,0)
-          . . . N HTMLBLD,HTMLTMP
-"RTN","GPLPROBS",97,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","GPLPROBS",98,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","GPLPROBS",99,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","GPLPROBS",100,0)
-          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
-"RTN","GPLPROBS",101,0)
-          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
-"RTN","GPLPROBS",102,0)
-          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
-"RTN","GPLPROBS",103,0)
-          . I DEBUG D PARY^GPLXPATH("HTMLO")
-"RTN","GPLPROBS",104,0)
-          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","GPLPROBS",105,0)
-          N PROBSTMP,I
-"RTN","GPLPROBS",106,0)
-          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLPROBS",107,0)
-          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLPROBS",108,0)
-          . ; STRINGS MARKED AS @@X@@
-"RTN","GPLPROBS",109,0)
-          . W !,"PROBLEMS Missing list: ",!
-"RTN","GPLPROBS",110,0)
-          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","GPLPROBS",111,0)
-          Q
-"RTN","GPLPROBS",112,0)
-          ;
-"RTN","GPLRIMA")
-0^18^B214212612
-"RTN","GPLRIMA",1,0)
-GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-"RTN","GPLRIMA",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 13
-"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)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
-"RTN","GPLRIMA",63,0)
-    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","GPLRIMA",64,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
-"RTN","GPLRIMA",65,0)
-    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","GPLRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
-"RTN","GPLRIMA",67,0)
-    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","GPLRIMA",68,0)
-    . ;
-"RTN","GPLRIMA",69,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-"RTN","GPLRIMA",70,0)
-    . ;
-"RTN","GPLRIMA",71,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-"RTN","GPLRIMA",72,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","GPLRIMA",73,0)
-    . ;
-"RTN","GPLRIMA",74,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","GPLRIMA",75,0)
-    . ;
-"RTN","GPLRIMA",76,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","GPLRIMA",77,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","GPLRIMA",78,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","GPLRIMA",79,0)
-    . ;
-"RTN","GPLRIMA",80,0)
-    . N CATNAME,CATTBL
-"RTN","GPLRIMA",81,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","GPLRIMA",82,0)
-    . S CATNAME=""
-"RTN","GPLRIMA",83,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","GPLRIMA",84,0)
-    . W "CATEGORY NAME: ",CATNAME,!
-"RTN","GPLRIMA",85,0)
-    . ;
-"RTN","GPLRIMA",86,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
-"RTN","GPLRIMA",87,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","GPLRIMA",88,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","GPLRIMA",89,0)
-    . ; AND WE SKIP IT
-"RTN","GPLRIMA",90,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","GPLRIMA",91,0)
-    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","GPLRIMA",92,0)
-    Q
-"RTN","GPLRIMA",93,0)
-    ;
-"RTN","GPLRIMA",94,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","GPLRIMA",95,0)
-    N SBASE,SATTR
-"RTN","GPLRIMA",96,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","GPLRIMA",97,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","GPLRIMA",98,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","GPLRIMA",99,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","GPLRIMA",100,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","GPLRIMA",101,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","GPLRIMA",102,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","GPLRIMA",103,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","GPLRIMA",104,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",105,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","GPLRIMA",106,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",107,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",108,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","GPLRIMA",109,0)
-    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","GPLRIMA",110,0)
-    D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","GPLRIMA",111,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","GPLRIMA",112,0)
-    Q SATTR
-"RTN","GPLRIMA",113,0)
-    ;
-"RTN","GPLRIMA",114,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","GPLRIMA",115,0)
-    K ^TMP("GPLRIM","RESUME")
-"RTN","GPLRIMA",116,0)
-    K ^TMP("GPLRIM")
-"RTN","GPLRIMA",117,0)
-    Q
-"RTN","GPLRIMA",118,0)
-    ;
-"RTN","GPLRIMA",119,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","GPLRIMA",120,0)
-    ;
-"RTN","GPLRIMA",121,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",122,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","GPLRIMA",123,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","GPLRIMA",124,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","GPLRIMA",125,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","GPLRIMA",126,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","GPLRIMA",127,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","GPLRIMA",128,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","GPLRIMA",129,0)
-    . W CLIDX,!
-"RTN","GPLRIMA",130,0)
-    ; D PARY^GPLXPATH(CLBASE)
-"RTN","GPLRIMA",131,0)
-    Q
-"RTN","GPLRIMA",132,0)
-    ;
-"RTN","GPLRIMA",133,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","GPLRIMA",134,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","GPLRIMA",135,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","GPLRIMA",136,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","GPLRIMA",137,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","GPLRIMA",138,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","GPLRIMA",139,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","GPLRIMA",140,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","GPLRIMA",141,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","GPLRIMA",142,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","GPLRIMA",143,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","GPLRIMA",144,0)
-    ;
-"RTN","GPLRIMA",145,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","GPLRIMA",146,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","GPLRIMA",147,0)
-    W "CBASE: ",CCTBL,!
-"RTN","GPLRIMA",148,0)
-    ;
-"RTN","GPLRIMA",149,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","GPLRIMA",150,0)
-    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","GPLRIMA",151,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","GPLRIMA",152,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","GPLRIMA",153,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","GPLRIMA",154,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","GPLRIMA",155,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","GPLRIMA",156,0)
-    ;
-"RTN","GPLRIMA",157,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","GPLRIMA",158,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",159,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","GPLRIMA",160,0)
-    ;
-"RTN","GPLRIMA",161,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","GPLRIMA",162,0)
-    ;
-"RTN","GPLRIMA",163,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","GPLRIMA",164,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","GPLRIMA",165,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","GPLRIMA",166,0)
-    ;
-"RTN","GPLRIMA",167,0)
-    Q
-"RTN","GPLRIMA",168,0)
-    ;
-"RTN","GPLRIMA",169,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","GPLRIMA",170,0)
-    ;
-"RTN","GPLRIMA",171,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",172,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","GPLRIMA",173,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",174,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",175,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","GPLRIMA",176,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","GPLRIMA",177,0)
-    . S ZCNT=0
-"RTN","GPLRIMA",178,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","GPLRIMA",179,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","GPLRIMA",180,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","GPLRIMA",181,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","GPLRIMA",182,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",183,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","GPLRIMA",184,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","GPLRIMA",185,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","GPLRIMA",186,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","GPLRIMA",187,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","GPLRIMA",188,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","GPLRIMA",189,0)
-    Q
-"RTN","GPLRIMA",190,0)
-    ;
-"RTN","GPLRIMA",191,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","GPLRIMA",192,0)
-    ; INLST IS PASSED BY NAME
-"RTN","GPLRIMA",193,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","GPLRIMA",194,0)
-    W INLST,!
-"RTN","GPLRIMA",195,0)
-    S ZCOUNT=0
-"RTN","GPLRIMA",196,0)
-    S ZDX=""
-"RTN","GPLRIMA",197,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","GPLRIMA",198,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","GPLRIMA",199,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","GPLRIMA",200,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","GPLRIMA",201,0)
-    Q ZCOUNT
-"RTN","GPLRIMA",202,0)
-    ;
-"RTN","GPLRIMA",203,0)
-XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN 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 ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",208,0)
-    S ZI=""
-"RTN","GPLRIMA",209,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",210,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",211,0)
-    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
-"RTN","GPLRIMA",212,0)
-    Q
-"RTN","GPLRIMA",213,0)
-    ;
-"RTN","GPLRIMA",214,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","GPLRIMA",215,0)
-    ;
-"RTN","GPLRIMA",216,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",217,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",218,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","GPLRIMA",219,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",220,0)
-    S ZI=""
-"RTN","GPLRIMA",221,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",222,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",223,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","GPLRIMA",224,0)
-    . W ZI," "
-"RTN","GPLRIMA",225,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","GPLRIMA",226,0)
-    . . S ZC=0
-"RTN","GPLRIMA",227,0)
-    . . W !
-"RTN","GPLRIMA",228,0)
-    Q
-"RTN","GPLRIMA",229,0)
-    ;
-"RTN","GPLRIMA",230,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","GPLRIMA",231,0)
-    ;
-"RTN","GPLRIMA",232,0)
-    N ATTR S ATTR=""
-"RTN","GPLRIMA",233,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",234,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","GPLRIMA",235,0)
-    S ATTR=^TMP("GPLRIM","ATTR",DFN)
-"RTN","GPLRIMA",236,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","GPLRIMA",237,0)
-    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","GPLRIMA",238,0)
-    . N CAT
-"RTN","GPLRIMA",239,0)
-    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","GPLRIMA",240,0)
-    . W CAT,": ",ATTR,!
-"RTN","GPLRIMA",241,0)
-    Q
-"RTN","GPLRIMA",242,0)
-    ;
-"RTN","GPLRIMA",243,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","GPLRIMA",244,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","GPLRIMA",245,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","GPLRIMA",246,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","GPLRIMA",247,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","GPLRIMA",248,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","GPLRIMA",249,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","GPLRIMA",250,0)
-    ;
-"RTN","GPLRIMA",251,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","GPLRIMA",252,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","GPLRIMA",253,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","GPLRIMA",254,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","GPLRIMA",255,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","GPLRIMA",256,0)
-    Q
-"RTN","GPLRIMA",257,0)
-    ;
-"RTN","GPLRIMA",258,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","GPLRIMA",259,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
-"RTN","GPLRIMA",260,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","GPLRIMA",261,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","GPLRIMA",262,0)
-      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","GPLRIMA",263,0)
-      Q
-"RTN","GPLRIMA",264,0)
-      ;
-"RTN","GPLRIMA",265,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","GPLRIMA",266,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",267,0)
-      K @RIMTBL
-"RTN","GPLRIMA",268,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","GPLRIMA",269,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","GPLRIMA",270,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","GPLRIMA",271,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","GPLRIMA",272,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","GPLRIMA",273,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","GPLRIMA",274,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","GPLRIMA",275,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","GPLRIMA",276,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","GPLRIMA",277,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","GPLRIMA",278,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","GPLRIMA",279,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","GPLRIMA",280,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","GPLRIMA",281,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","GPLRIMA",282,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","GPLRIMA",283,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","GPLRIMA",284,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","GPLRIMA",285,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","GPLRIMA",286,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","GPLRIMA",287,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","GPLRIMA",288,0)
-      Q
-"RTN","GPLRIMA",289,0)
-      ;
-"RTN","GPLRIMA",290,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","GPLRIMA",291,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","GPLRIMA",292,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","GPLRIMA",293,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","GPLRIMA",294,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","GPLRIMA",295,0)
-    N USETBL
-"RTN","GPLRIMA",296,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","GPLRIMA",297,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","GPLRIMA",298,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","GPLRIMA",299,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","GPLRIMA",300,0)
-    Q
-"RTN","GPLRIMA",301,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","GPLRIMA",302,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","GPLRIMA",303,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","GPLRIMA",304,0)
-    ; IN SECTION "MEDS"
-"RTN","GPLRIMA",305,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","GPLRIMA",306,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","GPLRIMA",307,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","GPLRIMA",308,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","GPLRIMA",309,0)
-    ;
-"RTN","GPLRIMA",310,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","GPLRIMA",311,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",312,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",313,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","GPLRIMA",314,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","GPLRIMA",315,0)
-    N ZZI,ZZS
-"RTN","GPLRIMA",316,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","GPLRIMA",317,0)
-    ; ZWR @ZZS@(1)
-"RTN","GPLRIMA",318,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","GPLRIMA",319,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","GPLRIMA",320,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","GPLRIMA",321,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","GPLRIMA",322,0)
-    Q
-"RTN","GPLRIMA",323,0)
-    ;
-"RTN","GPLRIMA",324,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","GPLRIMA",325,0)
-    ;
-"RTN","GPLRIMA",326,0)
-    N ZR
-"RTN","GPLRIMA",327,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","GPLRIMA",328,0)
-    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
-"RTN","GPLRIMA",329,0)
-    E  W "NOTHING RETURNED",!
-"RTN","GPLRIMA",330,0)
-    Q
-"RTN","GPLRIMA",331,0)
-    ;
-"RTN","GPLRIMA",332,0)
-CAGET(RTN,IATTR) ;
-"RTN","GPLRIMA",333,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",334,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","GPLRIMA",335,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","GPLRIMA",336,0)
-    Q
-"RTN","GPLRIMA",337,0)
-    ;
-"RTN","GPLRIMA",338,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",339,0)
-    ;
-"RTN","GPLRIMA",340,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",341,0)
-    N ZLST
-"RTN","GPLRIMA",342,0)
-    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
-"RTN","GPLRIMA",343,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",344,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",345,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","GPLRIMA",346,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","GPLRIMA",347,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","GPLRIMA",348,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","GPLRIMA",349,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","GPLRIMA",350,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","GPLRIMA",351,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","GPLRIMA",352,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","GPLRIMA",353,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","GPLRIMA",354,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","GPLRIMA",355,0)
-    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","GPLRIMA",356,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","GPLRIMA",357,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","GPLRIMA",358,0)
-    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","GPLRIMA",359,0)
-    . S ZCNT=ZCNT+1
-"RTN","GPLRIMA",360,0)
-    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","GPLRIMA",361,0)
-    Q
-"RTN","GPLRIMA",362,0)
-    ;
-"RTN","GPLRIMA",363,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","GPLRIMA",364,0)
-    ;
-"RTN","GPLRIMA",365,0)
-    N ZR
-"RTN","GPLRIMA",366,0)
-    D PCLST(.ZR,CATTR)
-"RTN","GPLRIMA",367,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","GPLRIMA",368,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","GPLRIMA",369,0)
-    E  D  ;
-"RTN","GPLRIMA",370,0)
-    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
-"RTN","GPLRIMA",371,0)
-    . W "COUNT=",ZR(0),!
-"RTN","GPLRIMA",372,0)
-    Q
-"RTN","GPLRIMA",373,0)
-    ;
-"RTN","GPLRIMA",374,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","GPLRIMA",375,0)
-    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","GPLRIMA",376,0)
-    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","GPLRIMA",377,0)
-    ; DFN IS THE PATIENT NUMBER.
-"RTN","GPLRIMA",378,0)
-    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",379,0)
-    ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","GPLRIMA",380,0)
-    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","GPLRIMA",381,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",382,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",383,0)
-    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","GPLRIMA",384,0)
-    N ZZGI
-"RTN","GPLRIMA",385,0)
-    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","GPLRIMA",386,0)
-    . F ZZGI="PROBLEMS","VITALS","MEDS" D  ; FOR EACH SECTION
-"RTN","GPLRIMA",387,0)
-    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","GPLRIMA",388,0)
-    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","GPLRIMA",389,0)
-    Q
-"RTN","GPLRIMA",390,0)
-    ;
-"RTN","GPLRIMA",391,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","GPLRIMA",392,0)
-    ;
-"RTN","GPLRIMA",393,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","GPLRIMA",394,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","GPLRIMA",395,0)
-    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","GPLRIMA",396,0)
-    E  D  ; VARS EXIST
-"RTN","GPLRIMA",397,0)
-    . N ZGVI
-"RTN","GPLRIMA",398,0)
-    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","GPLRIMA",399,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","GPLRIMA",400,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","GPLRIMA",401,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","GPLRIMA",402,0)
-    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","GPLRIMA",403,0)
-    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2) ; CONVERT HASH TO ARRAY
-"RTN","GPLRIMA",404,0)
-    . . ; D PARY^GPLXPATH("ZZGA")
-"RTN","GPLRIMA",405,0)
-    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","GPLRIMA",406,0)
-    Q
-"RTN","GPLRIMA",407,0)
-    ;
-"RTN","GPLRIMA",408,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
-"RTN","GPLRIMA",409,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","GPLRIMA",410,0)
-    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",411,0)
-    N GTMP
-"RTN","GPLRIMA",412,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",413,0)
-    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","GPLRIMA",414,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","GPLRIMA",415,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","GPLRIMA",416,0)
-    D PARY^GPLXPATH("GTMP")
-"RTN","GPLRIMA",417,0)
-    Q
-"RTN","GPLRIMA",418,0)
-    ;
-"RTN","GPLUNIT")
-0^12^B31438520
-"RTN","GPLUNIT",1,0)
-GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-"RTN","GPLUNIT",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 13
-"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  Q ; TEST SECTION DOESN'T EXIST
-"RTN","GPLUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","GPLUNIT",83,0)
-          N FIRST,LAST
-"RTN","GPLUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","GPLUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","GPLUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
-"RTN","GPLUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","GPLUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",89,0)
-          . . ;  W ZP,!
-"RTN","GPLUNIT",90,0)
-          . . S ZX=ZP
-"RTN","GPLUNIT",91,0)
-          . . W "RUNNING: "_ZP
-"RTN","GPLUNIT",92,0)
-          . . X ZX
-"RTN","GPLUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
-"RTN","GPLUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-"RTN","GPLUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",96,0)
-          . . S ZX="S ZR="_ZP
-"RTN","GPLUNIT",97,0)
-          . . W "TRYING: "_ZP
-"RTN","GPLUNIT",98,0)
-          . . X ZX
-"RTN","GPLUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","GPLUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-"RTN","GPLUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
-"RTN","GPLUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
-"RTN","GPLUNIT",104,0)
-          Q
-"RTN","GPLUNIT",105,0)
-          ;
-"RTN","GPLUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
-"RTN","GPLUNIT",107,0)
-          N ZTMP
-"RTN","GPLUNIT",108,0)
-          D ZLOAD(.ZTMP)
-"RTN","GPLUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
-"RTN","GPLUNIT",110,0)
-          W "PASSED: ",TPASSED,!
-"RTN","GPLUNIT",111,0)
-          W "FAILED: ",TFAILED,!
-"RTN","GPLUNIT",112,0)
-          W !
-"RTN","GPLUNIT",113,0)
-          W "THE TESTS!",!
-"RTN","GPLUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
-"RTN","GPLUNIT",115,0)
-          Q
-"RTN","GPLUNIT",116,0)
-          ;
-"RTN","GPLUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","GPLUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",119,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",120,0)
-          . D PUSH^GPLXPATH(RTN,I)
-"RTN","GPLUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",122,0)
-          Q
-"RTN","GPLUNIT",123,0)
-          ;
-"RTN","GPLUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","GPLUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","GPLUNIT",126,0)
-          S TOTP=0 S TOTF=0
-"RTN","GPLUNIT",127,0)
-          D ZLOAD^GPLUNIT("TZTMP",RNM)
-"RTN","GPLUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
-"RTN","GPLUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",131,0)
-          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
-"RTN","GPLUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
-"RTN","GPLUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
-"RTN","GPLUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","GPLUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","GPLUNIT",136,0)
-          F I=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","GPLUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","GPLUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","GPLUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","GPLUNIT",141,0)
-          Q
-"RTN","GPLUNIT",142,0)
-          ;
-"RTN","GPLUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","GPLUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-"RTN","GPLUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
-"RTN","GPLUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",147,0)
-          S K=1
-"RTN","GPLUNIT",148,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",149,0)
-          . ; W "I IS NOW=",I,!
-"RTN","GPLUNIT",150,0)
-          . W I," "
-"RTN","GPLUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",152,0)
-          . S K=K+1 I K=6  D
-"RTN","GPLUNIT",153,0)
-          . . W !
-"RTN","GPLUNIT",154,0)
-          . . S K=1
-"RTN","GPLUNIT",155,0)
-          Q
-"RTN","GPLUNIT",156,0)
-          ;
-"RTN","GPLVITAL")
-0^17^B82628966
-"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 13
-"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)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","GPLVITAL",45,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","GPLVITAL",46,0)
- . I $D(VITRSLT(VSORT(J))) D
-"RTN","GPLVITAL",47,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","GPLVITAL",48,0)
- . . K @VITVMAP
-"RTN","GPLVITAL",49,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","GPLVITAL",50,0)
- . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","GPLVITAL",51,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","GPLVITAL",52,0)
- . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","GPLVITAL",53,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","GPLVITAL",54,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","GPLVITAL",55,0)
- . . I $P(VITPTMP,U,2)="HT" D
-"RTN","GPLVITAL",56,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",57,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",58,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",59,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",60,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",61,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",62,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",63,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-"RTN","GPLVITAL",64,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",65,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",66,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",67,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",68,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","GPLVITAL",69,0)
- . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","GPLVITAL",70,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",71,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",72,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",73,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",74,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",75,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",76,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",77,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-"RTN","GPLVITAL",78,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",79,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",80,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",81,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",82,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","GPLVITAL",83,0)
- . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","GPLVITAL",84,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",85,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",86,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",87,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",88,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",89,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",90,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",91,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-"RTN","GPLVITAL",92,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",93,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",94,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",95,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",96,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",97,0)
- . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","GPLVITAL",98,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",99,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",100,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",101,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",102,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",103,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",104,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",105,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-"RTN","GPLVITAL",106,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",107,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",108,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",109,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",110,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","GPLVITAL",111,0)
- . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","GPLVITAL",112,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",113,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",114,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",115,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",116,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",117,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",118,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",119,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-"RTN","GPLVITAL",120,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",121,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",122,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",123,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",124,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",125,0)
- . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","GPLVITAL",126,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",127,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",128,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",129,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",130,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",131,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",132,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",133,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-"RTN","GPLVITAL",134,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",135,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",136,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",137,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",138,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",139,0)
- . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","GPLVITAL",140,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",141,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",142,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",143,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",144,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",145,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",146,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",147,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-"RTN","GPLVITAL",148,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",149,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",150,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",151,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",152,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",153,0)
- . . E  D
-"RTN","GPLVITAL",154,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","GPLVITAL",155,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",156,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",157,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","GPLVITAL",158,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",159,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",160,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","GPLVITAL",161,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","GPLVITAL",162,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-"RTN","GPLVITAL",163,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-"RTN","GPLVITAL",164,0)
- . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",165,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",166,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",167,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","GPLVITAL",168,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","GPLVITAL",169,0)
- . . K @VITARYTMP
-"RTN","GPLVITAL",170,0)
- . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","GPLVITAL",171,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLVITAL",172,0)
- . . . ; W "FIRST ONE",!
-"RTN","GPLVITAL",173,0)
- . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-"RTN","GPLVITAL",174,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","GPLVITAL",175,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLVITAL",176,0)
- . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-"RTN","GPLVITAL",177,0)
- ; ZWR ^TMP($J,"VITALS",*)
-"RTN","GPLVITAL",178,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLVITAL",179,0)
- I DEBUG D PARY^GPLXPATH(VITOUTXML)
-"RTN","GPLVITAL",180,0)
- N VITTMP,I
-"RTN","GPLVITAL",181,0)
- D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLVITAL",182,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLVITAL",183,0)
- . W "VITALS MISSING ",!
-"RTN","GPLVITAL",184,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","GPLVITAL",185,0)
- Q
-"RTN","GPLVITAL",186,0)
- ;
-"RTN","GPLVITAL",187,0)
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","GPLVITAL",188,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","GPLVITAL",189,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","GPLVITAL",190,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","GPLVITAL",191,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","GPLVITAL",192,0)
- F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","GPLVITAL",193,0)
- . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","GPLVITAL",194,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","GPLVITAL",195,0)
- . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","GPLVITAL",196,0)
- S VDT(0)=VTDCNT
-"RTN","GPLVITAL",197,0)
- Q
-"RTN","GPLVITAL",198,0)
- ;
-"RTN","GPLXPAT0")
-0^21^B50983429
-"RTN","GPLXPAT0",1,0)
-GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-"RTN","GPLXPAT0",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 13
-"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)
- ;;><PUSHA>
-"RTN","GPLXPAT0",193,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","GPLXPAT0",195,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","A")
-"RTN","GPLXPAT0",196,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","B")
-"RTN","GPLXPAT0",197,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","C")
-"RTN","GPLXPAT0",198,0)
- ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
-"RTN","GPLXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","GPLXPAT0",200,0)
- ;;>>?GTMP(0)=3
-"RTN","GPLXPAT0",201,0)
- ;;><H2ARY>
-"RTN","GPLXPAT0",202,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","GPLXPAT0",204,0)
- ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","GPLXPAT0",206,0)
- ;;>>?GTMP2(1)="TEST1^1"
-"RTN","GPLXPAT0",207,0)
- ;;><XVARS>
-"RTN","GPLXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",209,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
-"RTN","GPLXPAT0",210,0)
- ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",211,0)
- ;;>>?GTMP2(1)="VAR1^"
-"RTN","GPLXPAT0",212,0)
- ;;></TEST>
-"RTN","GPLXPATH")
-0^9^B241520746
-"RTN","GPLXPATH",1,0)
-GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-"RTN","GPLXPATH",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 13
-"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)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","GPLXPATH",53,0)
- ;
-"RTN","GPLXPATH",54,0)
- N ZGI
-"RTN","GPLXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
-"RTN","GPLXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
-"RTN","GPLXPATH",57,0)
- Q
-"RTN","GPLXPATH",58,0)
- ;
-"RTN","GPLXPATH",59,0)
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","GPLXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","GPLXPATH",61,0)
- S RTN=""
-"RTN","GPLXPATH",62,0)
- N I
-"RTN","GPLXPATH",63,0)
- ; W "STK= ",STK,!
-"RTN","GPLXPATH",64,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",65,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","GPLXPATH",66,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","GPLXPATH",67,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","GPLXPATH",68,0)
- Q
-"RTN","GPLXPATH",69,0)
- ;
-"RTN","GPLXPATH",70,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","GPLXPATH",71,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","GPLXPATH",72,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","GPLXPATH",73,0)
- N CUR,TMP
-"RTN","GPLXPATH",74,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","GPLXPATH",75,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","GPLXPATH",76,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","GPLXPATH",77,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","GPLXPATH",78,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","GPLXPATH",79,0)
- ; W "CUR= ",CUR,!
-"RTN","GPLXPATH",80,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","GPLXPATH",81,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","GPLXPATH",82,0)
- ; W "CUR2= ",CUR,!
-"RTN","GPLXPATH",83,0)
- Q CUR
-"RTN","GPLXPATH",84,0)
- ;
-"RTN","GPLXPATH",85,0)
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
-"RTN","GPLXPATH",86,0)
- ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
-"RTN","GPLXPATH",87,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","GPLXPATH",88,0)
- ; XML SECTION
-"RTN","GPLXPATH",89,0)
- ; ZXML IS PASSED BY NAME
-"RTN","GPLXPATH",90,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
-"RTN","GPLXPATH",91,0)
- N GPLSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","GPLXPATH",92,0)
- I '$D(@ZXML@(0))  D  ; NO XML PASSED
-"RTN","GPLXPATH",93,0)
- . W "ERROR IN XML FILE",!
-"RTN","GPLXPATH",94,0)
- S GPLSTK(0)=0 ; INITIALIZE STACK
-"RTN","GPLXPATH",95,0)
- F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","GPLXPATH",96,0)
- . S LINE=@ZXML@(I)
-"RTN","GPLXPATH",97,0)
- . ;W LINE,!
-"RTN","GPLXPATH",98,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","GPLXPATH",99,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","GPLXPATH",100,0)
- . I FOUND'=1  D
-"RTN","GPLXPATH",101,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","GPLXPATH",102,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","GPLXPATH",103,0)
- . . . ; ON THE SAME LINE
-"RTN","GPLXPATH",104,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",105,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",106,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",107,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",108,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",109,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",110,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",111,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",112,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",113,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","GPLXPATH",114,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",115,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","GPLXPATH",116,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","GPLXPATH",117,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",118,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",119,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",120,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",121,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",122,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",123,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","GPLXPATH",124,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","GPLXPATH",125,0)
- . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","GPLXPATH",126,0)
- . . . . Q
-"RTN","GPLXPATH",127,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","GPLXPATH",128,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","GPLXPATH",129,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",130,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",131,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",132,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",133,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",134,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",135,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",136,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",137,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",138,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","GPLXPATH",139,0)
- S @ZXML@("INDEXED")=""
-"RTN","GPLXPATH",140,0)
- S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
-"RTN","GPLXPATH",141,0)
- Q
-"RTN","GPLXPATH",142,0)
- ;
-"RTN","GPLXPATH",143,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","GPLXPATH",144,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","GPLXPATH",145,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","GPLXPATH",146,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","GPLXPATH",147,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","GPLXPATH",148,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","GPLXPATH",149,0)
- N TMP,I,J,QXPATH
-"RTN","GPLXPATH",150,0)
- S FIRST=1
-"RTN","GPLXPATH",151,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","GPLXPATH",152,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","GPLXPATH",153,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","GPLXPATH",154,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","GPLXPATH",155,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","GPLXPATH",156,0)
- K @OARY
-"RTN","GPLXPATH",157,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","GPLXPATH",158,0)
- S J=1
-"RTN","GPLXPATH",159,0)
- FOR I=FIRST:1:LAST  D
-"RTN","GPLXPATH",160,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","GPLXPATH",161,0)
- . S J=J+1
-"RTN","GPLXPATH",162,0)
- ; ZWR OARY
-"RTN","GPLXPATH",163,0)
- Q
-"RTN","GPLXPATH",164,0)
- ;
-"RTN","GPLXPATH",165,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","GPLXPATH",166,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",167,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",168,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","GPLXPATH",169,0)
- ;
-"RTN","GPLXPATH",170,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","GPLXPATH",171,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",172,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",173,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","GPLXPATH",174,0)
- ;
-"RTN","GPLXPATH",175,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","GPLXPATH",176,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",177,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",178,0)
- Q $P(ISTR,";",2)
-"RTN","GPLXPATH",179,0)
- ;
-"RTN","GPLXPATH",180,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","GPLXPATH",181,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",182,0)
- Q $P(ISTR,";",3)
-"RTN","GPLXPATH",183,0)
- ;
-"RTN","GPLXPATH",184,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","GPLXPATH",185,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",186,0)
- Q $P(ISTR,";",1)
-"RTN","GPLXPATH",187,0)
- ;
-"RTN","GPLXPATH",188,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","GPLXPATH",189,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","GPLXPATH",190,0)
- ; DEST IS CLEARED TO START
-"RTN","GPLXPATH",191,0)
- ; USES PUSH TO DO THE COPY
-"RTN","GPLXPATH",192,0)
- N I
-"RTN","GPLXPATH",193,0)
- K @BDEST
-"RTN","GPLXPATH",194,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","GPLXPATH",195,0)
- . N J,ATMP
-"RTN","GPLXPATH",196,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","GPLXPATH",197,0)
- . I DEBUG W "ATMP=",ATMP,!
-"RTN","GPLXPATH",198,0)
- . I DEBUG W @BLIST@(I),!
-"RTN","GPLXPATH",199,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","GPLXPATH",200,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","GPLXPATH",201,0)
- . . I DEBUG W "BDEST= ",BDEST,!
-"RTN","GPLXPATH",202,0)
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
-"RTN","GPLXPATH",203,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","GPLXPATH",204,0)
- Q
-"RTN","GPLXPATH",205,0)
- ;
-"RTN","GPLXPATH",206,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","GPLXPATH",207,0)
- ;
-"RTN","GPLXPATH",208,0)
- I DEBUG W "QUEUEING ",BLST,!
-"RTN","GPLXPATH",209,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","GPLXPATH",210,0)
- Q
-"RTN","GPLXPATH",211,0)
- ;
-"RTN","GPLXPATH",212,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","GPLXPATH",213,0)
- ; KILLS CPDEST FIRST
-"RTN","GPLXPATH",214,0)
- N CPINSTR
-"RTN","GPLXPATH",215,0)
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","GPLXPATH",216,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","GPLXPATH",217,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","GPLXPATH",218,0)
- . Q
-"RTN","GPLXPATH",219,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","GPLXPATH",220,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","GPLXPATH",221,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","GPLXPATH",222,0)
- Q
-"RTN","GPLXPATH",223,0)
- ;
-"RTN","GPLXPATH",224,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","GPLXPATH",225,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","GPLXPATH",226,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","GPLXPATH",227,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","GPLXPATH",228,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",229,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","GPLXPATH",230,0)
- . Q
-"RTN","GPLXPATH",231,0)
- I DEBUG W "DOING QOPEN",!
-"RTN","GPLXPATH",232,0)
- N S1,E1,QOT,QOTMP
-"RTN","GPLXPATH",233,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","GPLXPATH",234,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",235,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","GPLXPATH",236,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","GPLXPATH",237,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",238,0)
- . S E1=@QOXML@(0)-1
-"RTN","GPLXPATH",239,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","GPLXPATH",240,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","GPLXPATH",241,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","GPLXPATH",242,0)
- Q
-"RTN","GPLXPATH",243,0)
- ;
-"RTN","GPLXPATH",244,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","GPLXPATH",245,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","GPLXPATH",246,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","GPLXPATH",247,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","GPLXPATH",248,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","GPLXPATH",249,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",250,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","GPLXPATH",251,0)
- I DEBUG W "GOING TO CLOSE",!
-"RTN","GPLXPATH",252,0)
- N S1,E1,QCT,QCTMP
-"RTN","GPLXPATH",253,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","GPLXPATH",254,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",255,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","GPLXPATH",256,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","GPLXPATH",257,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",258,0)
- . S S1=@QCXML@(0)
-"RTN","GPLXPATH",259,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","GPLXPATH",260,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","GPLXPATH",261,0)
- Q
-"RTN","GPLXPATH",262,0)
- ;
-"RTN","GPLXPATH",263,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","GPLXPATH",264,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","GPLXPATH",265,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","GPLXPATH",266,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","GPLXPATH",267,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","GPLXPATH",268,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","GPLXPATH",269,0)
- N INSBLD,INSTMP
-"RTN","GPLXPATH",270,0)
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","GPLXPATH",271,0)
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","GPLXPATH",272,0)
- I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","GPLXPATH",273,0)
- . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","GPLXPATH",274,0)
- I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",275,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",276,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","GPLXPATH",277,0)
- . . I DEBUG D PARY^GPLXPATH("INSBLD")
-"RTN","GPLXPATH",278,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",279,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","GPLXPATH",280,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","GPLXPATH",281,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",282,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","GPLXPATH",283,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",284,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","GPLXPATH",285,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","GPLXPATH",286,0)
- . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","GPLXPATH",287,0)
- Q
-"RTN","GPLXPATH",288,0)
- ;
-"RTN","GPLXPATH",289,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","GPLXPATH",290,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","GPLXPATH",291,0)
- ;
-"RTN","GPLXPATH",292,0)
- N INNBLD,UXPATH
-"RTN","GPLXPATH",293,0)
- N INNTBUF
-"RTN","GPLXPATH",294,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","GPLXPATH",295,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","GPLXPATH",296,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","GPLXPATH",297,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","GPLXPATH",298,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","GPLXPATH",299,0)
- . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","GPLXPATH",300,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","GPLXPATH",301,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","GPLXPATH",302,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","GPLXPATH",303,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","GPLXPATH",304,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","GPLXPATH",305,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","GPLXPATH",306,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","GPLXPATH",307,0)
- Q
-"RTN","GPLXPATH",308,0)
- ;
-"RTN","GPLXPATH",309,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","GPLXPATH",310,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","GPLXPATH",311,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",312,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","GPLXPATH",313,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","GPLXPATH",314,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","GPLXPATH",315,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",316,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","GPLXPATH",317,0)
- I DEBUG D PARY("XDEST")
-"RTN","GPLXPATH",318,0)
- Q
-"RTN","GPLXPATH",319,0)
- ;
-"RTN","GPLXPATH",320,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","GPLXPATH",321,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","GPLXPATH",322,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","GPLXPATH",323,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","GPLXPATH",324,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","GPLXPATH",325,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","GPLXPATH",326,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","GPLXPATH",327,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","GPLXPATH",328,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","GPLXPATH",329,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","GPLXPATH",330,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","GPLXPATH",331,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","GPLXPATH",332,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",333,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","GPLXPATH",334,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","GPLXPATH",335,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","GPLXPATH",336,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",337,0)
- I DEBUG W "REPLACE PREBUILD",!
-"RTN","GPLXPATH",338,0)
- I DEBUG D PARY("REBLD")
-"RTN","GPLXPATH",339,0)
- D BUILD("REBLD","RTMP")
-"RTN","GPLXPATH",340,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","GPLXPATH",341,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","GPLXPATH",342,0)
- Q
-"RTN","GPLXPATH",343,0)
- ;
-"RTN","GPLXPATH",344,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","GPLXPATH",345,0)
- ; W "Reporting on the missing",!
-"RTN","GPLXPATH",346,0)
- ; W OARY
-"RTN","GPLXPATH",347,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","GPLXPATH",348,0)
- N I
-"RTN","GPLXPATH",349,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","GPLXPATH",350,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",351,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","GPLXPATH",352,0)
- . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","GPLXPATH",353,0)
- . . Q
-"RTN","GPLXPATH",354,0)
- Q
-"RTN","GPLXPATH",355,0)
- ;
-"RTN","GPLXPATH",356,0)
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","GPLXPATH",357,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","GPLXPATH",358,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","GPLXPATH",359,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","GPLXPATH",360,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","GPLXPATH",361,0)
- S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
-"RTN","GPLXPATH",362,0)
- F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",363,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","GPLXPATH",364,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","GPLXPATH",365,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","GPLXPATH",366,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","GPLXPATH",367,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","GPLXPATH",368,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","GPLXPATH",369,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","GPLXPATH",370,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","GPLXPATH",371,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","GPLXPATH",372,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","GPLXPATH",373,0)
- . . . . E  D DOFLD ; PROCESS A FIELD
-"RTN","GPLXPATH",374,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","GPLXPATH",375,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","GPLXPATH",376,0)
- . . I DEBUG W TSTR
-"RTN","GPLXPATH",377,0)
- I DEBUG W "MAPPED",!
-"RTN","GPLXPATH",378,0)
- Q
-"RTN","GPLXPATH",379,0)
- ;
-"RTN","GPLXPATH",380,0)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
-"RTN","GPLXPATH",381,0)
- ;
-"RTN","GPLXPATH",382,0)
- Q
-"RTN","GPLXPATH",383,0)
- ;
-"RTN","GPLXPATH",384,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","GPLXPATH",385,0)
- ; THEXML IS PASSED BY NAME
-"RTN","GPLXPATH",386,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","GPLXPATH",387,0)
- S FOUND=0
-"RTN","GPLXPATH",388,0)
- S INTXT=0
-"RTN","GPLXPATH",389,0)
- I DEBUG W "DELETING EMPTY ELEMENTS",!
-"RTN","GPLXPATH",390,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","GPLXPATH",391,0)
- . S J=@THEXML@(I)
-"RTN","GPLXPATH",392,0)
- . I J["<text>" D
-"RTN","GPLXPATH",393,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","GPLXPATH",394,0)
- . . I DEBUG W "IN HTML SECTION",!
-"RTN","GPLXPATH",395,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","GPLXPATH",396,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","GPLXPATH",397,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","GPLXPATH",398,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","GPLXPATH",399,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","GPLXPATH",400,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","GPLXPATH",401,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","GPLXPATH",402,0)
- . . . I DEBUG W I,J,JP,!
-"RTN","GPLXPATH",403,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",404,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","GPLXPATH",405,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","GPLXPATH",406,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","GPLXPATH",407,0)
- . . . I DEBUG W I,J,!
-"RTN","GPLXPATH",408,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",409,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","GPLXPATH",410,0)
- . . . I JM=JPX D  ;
-"RTN","GPLXPATH",411,0)
- . . . . I DEBUG W I,JM_J_JPX,!
-"RTN","GPLXPATH",412,0)
- . . . . S DEL(I-1)=""
-"RTN","GPLXPATH",413,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","GPLXPATH",414,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","GPLXPATH",415,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","GPLXPATH",416,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","GPLXPATH",417,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","GPLXPATH",418,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","GPLXPATH",419,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","GPLXPATH",420,0)
- Q FOUND
-"RTN","GPLXPATH",421,0)
- ;
-"RTN","GPLXPATH",422,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","GPLXPATH",423,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","GPLXPATH",424,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",425,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","GPLXPATH",426,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",427,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","GPLXPATH",428,0)
- Q
-"RTN","GPLXPATH",429,0)
- ;
-"RTN","GPLXPATH",430,0)
-PARY(GLO)       ;PRINT AN ARRAY
-"RTN","GPLXPATH",431,0)
- N I
-"RTN","GPLXPATH",432,0)
- F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
-"RTN","GPLXPATH",433,0)
- Q
-"RTN","GPLXPATH",434,0)
- ;
-"RTN","GPLXPATH",435,0)
-H2ARY(IARYRTN,IHASH) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","GPLXPATH",436,0)
- ;
-"RTN","GPLXPATH",437,0)
- N H2I S H2I=""
-"RTN","GPLXPATH",438,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","GPLXPATH",439,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","GPLXPATH",440,0)
- . ; W H2I_"^"_@IHASH@(H2I),!
-"RTN","GPLXPATH",441,0)
- . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
-"RTN","GPLXPATH",442,0)
- . . W "GPLZZ",!
-"RTN","GPLXPATH",443,0)
- . . W $NA(@IHASH@(H2I)),!
-"RTN","GPLXPATH",444,0)
- . . Q  ;
-"RTN","GPLXPATH",445,0)
- . D PUSH(IARYRTN,H2I_"^"_@IHASH@(H2I))
-"RTN","GPLXPATH",446,0)
- . ; W @IARYRTN@(0),!
-"RTN","GPLXPATH",447,0)
- Q
-"RTN","GPLXPATH",448,0)
- ;
-"RTN","GPLXPATH",449,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","GPLXPATH",450,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","GPLXPATH",451,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","GPLXPATH",452,0)
- ;
-"RTN","GPLXPATH",453,0)
- N XVI,XVTMP,XVT
-"RTN","GPLXPATH",454,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","GPLXPATH",455,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","GPLXPATH",456,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
-"RTN","GPLXPATH",457,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","GPLXPATH",458,0)
- Q
-"RTN","GPLXPATH",459,0)
- ;
-"RTN","GPLXPATH",460,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","GPLXPATH",461,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","GPLXPATH",462,0)
- ;
-"RTN","GPLXPATH",463,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","GPLXPATH",464,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","GPLXPATH",465,0)
- . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",466,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",467,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","GPLXPATH",468,0)
- . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",469,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",470,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","GPLXPATH",471,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","GPLXPATH",472,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","GPLXPATH",473,0)
- D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","GPLXPATH",474,0)
- Q
-"RTN","GPLXPATH",475,0)
- ;
-"RTN","GPLXPATH",476,0)
-TEST     ; Run all the test cases
-"RTN","GPLXPATH",477,0)
- D TESTALL^GPLUNIT("GPLXPAT0")
-"RTN","GPLXPATH",478,0)
- Q
-"RTN","GPLXPATH",479,0)
- ;
-"RTN","GPLXPATH",480,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","GPLXPATH",481,0)
- N ZTMP
-"RTN","GPLXPATH",482,0)
- S DEBUG=1
-"RTN","GPLXPATH",483,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",484,0)
- D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLXPATH",485,0)
- Q
-"RTN","GPLXPATH",486,0)
- ;
-"RTN","GPLXPATH",487,0)
-TLIST   ; LIST THE TESTS
-"RTN","GPLXPATH",488,0)
- N ZTMP
-"RTN","GPLXPATH",489,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",490,0)
- D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLXPATH",491,0)
- Q
-"RTN","GPLXPATH",492,0)
- ;
-"VER")
-8.0^22.0
-**END**
-**END**
Index: ccr/tags/CCR_1_0_7/p/CCR_1_0_6_T1_CACHE.KID
===================================================================
--- ccr/trunk/p/CCR_1_0_6_T1_CACHE.KID	(revision 289)
+++ 	(revision )
@@ -1,10942 +1,0 @@
-KIDS Distribution saved on Nov 03, 2008@16:18:23
-Alerts and Non-VA Meds. Lab display
-**KIDS**:CCR*1.0*6^
-
-**INSTALL NAME**
-CCR*1.0*6
-"BLD",6955,0)
-CCR*1.0*6^^0^3081103^n
-"BLD",6955,1,0)
-^^23^23^3080923^
-"BLD",6955,1,1,0)
- 
-"BLD",6955,1,2,0)
-CCR AND CCD EXPORT TOOLS 
-"BLD",6955,1,3,0)
- 
-"BLD",6955,1,4,0)
-SINGLE XML EXPORT TO A HOST DIRECTORY AT 
-"BLD",6955,1,5,0)
- 
-"BLD",6955,1,6,0)
-BE SURE TO SET ^TMP("GPLCCR","ODIR")="DIRECTORYNAME" TO AN EXISTING 
-"BLD",6955,1,7,0)
-DIRECTORY
-"BLD",6955,1,8,0)
- 
-"BLD",6955,1,9,0)
-EXPORT^GPLCRR FOR THE CCR
-"BLD",6955,1,10,0)
-EXPORT^GPLCCD FOR THE CCD
-"BLD",6955,1,11,0)
-XPAT^GPLCCR(DFN,"","") 
-"BLD",6955,1,12,0)
- 
-"BLD",6955,1,13,0)
-BATCH ANALYSIS AND BATCH EXPORT BY RIM CATEGORIES
-"BLD",6955,1,14,0)
- 
-"BLD",6955,1,15,0)
-ANALYZE^GPLRIMA("",5000) TO ANALYZE 5000 PATIENTS. REPEAT TO RESUME
-"BLD",6955,1,16,0)
-RESET^GPLRIMA TO RESET ANALYZE - DELETES ^TMP("GPLRIM","RESUME")
-"BLD",6955,1,17,0)
-ANALYZE^GPLRIMA(5098,1) TO ANALYZE PATIENT 5098 FOR ONE PATIENT
-"BLD",6955,1,18,0)
- 
-"BLD",6955,1,19,0)
-CLIST^GPLRIMA TO LIST CATEGORY TOTALS
-"BLD",6955,1,20,0)
-CPAT^GPLRIMA("RIMTBL_X") TO LIST PATIENTS IN A CATEGORY
-"BLD",6955,1,21,0)
-XCPAT^GPLRIMA("RIMTBL_X") TO EXPORT CCR FOR ALL PATIENTS IN CATEGORY
-"BLD",6955,1,22,0)
- 
-"BLD",6955,1,23,0)
-TEST^GPLCCR AND TEST^GPLXPATH RUN UNIT TESTS ON THE CODE
-"BLD",6955,4,0)
-^9.64PA^^
-"BLD",6955,6.3)
-14
-"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^24^24
-"BLD",6955,"KRN",9.8,"NM",1,0)
-CCRDPT^^0^B45805995
-"BLD",6955,"KRN",9.8,"NM",2,0)
-CCRDPTT^^0^B4791589
-"BLD",6955,"KRN",9.8,"NM",3,0)
-CCRMEDS^^0^B68553972
-"BLD",6955,"KRN",9.8,"NM",4,0)
-CCRSYS^^0^B5866233
-"BLD",6955,"KRN",9.8,"NM",5,0)
-CCRUNIT^^0^B8574
-"BLD",6955,"KRN",9.8,"NM",6,0)
-CCRUTIL^^0^B11670240
-"BLD",6955,"KRN",9.8,"NM",7,0)
-CCRVA200^^0^B35847405
-"BLD",6955,"KRN",9.8,"NM",8,0)
-GPLCCD^^0^B114413975
-"BLD",6955,"KRN",9.8,"NM",9,0)
-GPLXPATH^^0^B242640815
-"BLD",6955,"KRN",9.8,"NM",10,0)
-CCRMEDS1^^0^B80043311
-"BLD",6955,"KRN",9.8,"NM",11,0)
-CCRMEDS2^^0^B101302627
-"BLD",6955,"KRN",9.8,"NM",12,0)
-GPLUNIT^^0^B31438520
-"BLD",6955,"KRN",9.8,"NM",13,0)
-GPLCCR^^0^B81968343
-"BLD",6955,"KRN",9.8,"NM",14,0)
-GPLCCR0^^0^B654420916
-"BLD",6955,"KRN",9.8,"NM",15,0)
-GPLCCD1^^0^B100039732
-"BLD",6955,"KRN",9.8,"NM",16,0)
-GPLACTOR^^0^B53216743
-"BLD",6955,"KRN",9.8,"NM",17,0)
-GPLVITAL^^0^B82628966
-"BLD",6955,"KRN",9.8,"NM",18,0)
-GPLRIMA^^0^B228265839
-"BLD",6955,"KRN",9.8,"NM",19,0)
-GPLALERT^^0^B22007040
-"BLD",6955,"KRN",9.8,"NM",20,0)
-GPLPROBS^^0^B25875394
-"BLD",6955,"KRN",9.8,"NM",21,0)
-GPLXPAT0^^0^B51026779
-"BLD",6955,"KRN",9.8,"NM",22,0)
-GPLLABS^^0^B74153607
-"BLD",6955,"KRN",9.8,"NM",23,0)
-LA7QRY1^^0^B12511401
-"BLD",6955,"KRN",9.8,"NM",24,0)
-CCRMEDS3^^0^B68176928
-"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","CCRMEDS1",10)
-
-"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS2",11)
-
-"BLD",6955,"KRN",9.8,"NM","B","CCRMEDS3",24)
-
-"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",16)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLALERT",19)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCD",8)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCD1",15)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCR",13)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLCCR0",14)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLLABS",22)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLPROBS",20)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLRIMA",18)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLUNIT",12)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLVITAL",17)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLXPAT0",21)
-
-"BLD",6955,"KRN",9.8,"NM","B","GPLXPATH",9)
-
-"BLD",6955,"KRN",9.8,"NM","B","LA7QRY1",23)
-
-"BLD",6955,"KRN",19,0)
-19
-"BLD",6955,"KRN",19,"NM",0)
-^9.68A^^
-"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")
-24
-"RTN","CCRDPT")
-0^1^B45805995
-"RTN","CCRDPT",1,0)
-CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
-"RTN","CCRDPT",2,0)
- ;;0.2;CCRCCD;;Jun 15, 2008;Build 14
-"RTN","CCRDPT",3,0)
- ;
-"RTN","CCRDPT",4,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRDPT",5,0)
- ; General Public License. 
-"RTN","CCRDPT",6,0)
- ; 
-"RTN","CCRDPT",7,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRDPT",8,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRDPT",9,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRDPT",10,0)
- ; GNU General Public License for more details.
-"RTN","CCRDPT",11,0)
- ; 
-"RTN","CCRDPT",12,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRDPT",13,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRDPT",14,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRDPT",15,0)
- ;
-"RTN","CCRDPT",16,0)
- ; CCRDPT       CCRCCD/SMH - Routines to Extract Patient Data for
-"RTN","CCRDPT",17,0)
- ; FAMILY       Family Name
-"RTN","CCRDPT",18,0)
- ; GIVEN        Given Name
-"RTN","CCRDPT",19,0)
- ; MIDDLE       Middle Name
-"RTN","CCRDPT",20,0)
- ; SUFFIX       Suffix Name
-"RTN","CCRDPT",21,0)
- ; DISPNAME     Display Name
-"RTN","CCRDPT",22,0)
- ; DOB          Date of Birth
-"RTN","CCRDPT",23,0)
- ; GENDER       Get Gender
-"RTN","CCRDPT",24,0)
- ; SSN          Get SSN for ID
-"RTN","CCRDPT",25,0)
- ; ADDRTYPE     Get Home Address
-"RTN","CCRDPT",26,0)
- ; ADDR1        Get Home Address line 1
-"RTN","CCRDPT",27,0)
- ; ADDR2        Get Home Address line 2
-"RTN","CCRDPT",28,0)
- ; CITY         Get City for Home Address
-"RTN","CCRDPT",29,0)
- ; STATE        Get State for Home Address
-"RTN","CCRDPT",30,0)
- ; ZIP          Get Zip code for Home Address
-"RTN","CCRDPT",31,0)
- ; COUNTY       Get County for our Address
-"RTN","CCRDPT",32,0)
- ; COUNTRY      Get Country for our Address
-"RTN","CCRDPT",33,0)
- ; RESTEL       Residential Telephone
-"RTN","CCRDPT",34,0)
- ; WORKTEL      Work Telephone
-"RTN","CCRDPT",35,0)
- ; EMAIL        Email Adddress
-"RTN","CCRDPT",36,0)
- ; CELLTEL      Cell Phone
-"RTN","CCRDPT",37,0)
- ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",38,0)
- ; NOK1GIV      NOK1 Given Name
-"RTN","CCRDPT",39,0)
- ; NOK1MID      NOK1 Middle Name
-"RTN","CCRDPT",40,0)
- ; NOK1SUF      NOK1 Suffi Name
-"RTN","CCRDPT",41,0)
- ; NOK1DISP     NOK1 Display Name
-"RTN","CCRDPT",42,0)
- ; NOK1REL      NOK1 Relationship to the patient
-"RTN","CCRDPT",43,0)
- ; NOK1ADD1     NOK1 Address 1
-"RTN","CCRDPT",44,0)
- ; NOK1ADD2     NOK1 Address 2
-"RTN","CCRDPT",45,0)
- ; NOK1CITY     NOK1 City
-"RTN","CCRDPT",46,0)
- ; NOK1STAT     NOK1 State
-"RTN","CCRDPT",47,0)
- ; NOK1ZIP      NOK1 Zip Code
-"RTN","CCRDPT",48,0)
- ; NOK1HTEL     NOK1 Home Telephone
-"RTN","CCRDPT",49,0)
- ; NOK1WTEL     NOK1 Work Telephone
-"RTN","CCRDPT",50,0)
- ; NOK1SAME     Is NOK1's Address the same the patient?
-"RTN","CCRDPT",51,0)
- ; NOK2FAM      NOK2 Family Name
-"RTN","CCRDPT",52,0)
- ; NOK2GIV      NOK2 Given Name
-"RTN","CCRDPT",53,0)
- ; NOK2MID      NOK2 Middle Name
-"RTN","CCRDPT",54,0)
- ; NOK2SUF      NOK2 Suffi Name
-"RTN","CCRDPT",55,0)
- ; NOK2DISP     NOK2 Display Name
-"RTN","CCRDPT",56,0)
- ; NOK2REL      NOK2 Relationship to the patient
-"RTN","CCRDPT",57,0)
- ; NOK2ADD1     NOK2 Address 1
-"RTN","CCRDPT",58,0)
- ; NOK2ADD2     NOK2 Address 2
-"RTN","CCRDPT",59,0)
- ; NOK2CITY     NOK2 City
-"RTN","CCRDPT",60,0)
- ; NOK2STAT     NOK2 State
-"RTN","CCRDPT",61,0)
- ; NOK2ZIP      NOK2 Zip Code
-"RTN","CCRDPT",62,0)
- ; NOK2HTEL     NOK2 Home Telephone
-"RTN","CCRDPT",63,0)
- ; NOK2WTEL     NOK2 Work Telephone
-"RTN","CCRDPT",64,0)
- ; NOK2SAME     Is NOK2's Address the same the patient?
-"RTN","CCRDPT",65,0)
- ; EMERFAM      Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",66,0)
- ; EMERGIV      EMER Given Name
-"RTN","CCRDPT",67,0)
- ; EMERMID      EMER Middle Name
-"RTN","CCRDPT",68,0)
- ; EMERSUF      EMER Suffi Name
-"RTN","CCRDPT",69,0)
- ; EMERDISP     EMER Display Name
-"RTN","CCRDPT",70,0)
- ; EMERREL      EMER Relationship to the patient
-"RTN","CCRDPT",71,0)
- ; EMERADD1     EMER Address 1
-"RTN","CCRDPT",72,0)
- ; EMERADD2     EMER Address 2
-"RTN","CCRDPT",73,0)
- ; EMERCITY     EMER City
-"RTN","CCRDPT",74,0)
- ; EMERSTAT     EMER State
-"RTN","CCRDPT",75,0)
- ; EMERZIP      EMER Zip Code
-"RTN","CCRDPT",76,0)
- ; EMERHTEL     EMER Home Telephone
-"RTN","CCRDPT",77,0)
- ; EMERWTEL     EMER Work Telephone
-"RTN","CCRDPT",78,0)
- ; EMERSAME     Is EMER's Address the same the NOK?
-"RTN","CCRDPT",79,0)
- ;
-"RTN","CCRDPT",80,0)
- W "No Entry at top!" Q
-"RTN","CCRDPT",81,0)
- ;
-"RTN","CCRDPT",82,0)
- ;**Revision History**
-"RTN","CCRDPT",83,0)
- ; - June 15, 08: v0.1 using merged global
-"RTN","CCRDPT",84,0)
- ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
-"RTN","CCRDPT",85,0)
- ;
-"RTN","CCRDPT",86,0)
- ; All methods are Public and Extrinsic
-"RTN","CCRDPT",87,0)
- ; All calls use Fileman file 2 (Patient).
-"RTN","CCRDPT",88,0)
- ; You can obtain field numbers using the data dictionary
-"RTN","CCRDPT",89,0)
- ;
-"RTN","CCRDPT",90,0)
-FAMILY(DFN) ; Family Name
-"RTN","CCRDPT",91,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",92,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",93,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",94,0)
-GIVEN(DFN) ; Given Name
-"RTN","CCRDPT",95,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",96,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",97,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",98,0)
-MIDDLE(DFN) ; Middle Name
-"RTN","CCRDPT",99,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",100,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",101,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",102,0)
-SUFFIX(DFN) ; Suffi Name
-"RTN","CCRDPT",103,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",104,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",105,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",106,0)
-DISPNAME(DFN) ; Display Name
-"RTN","CCRDPT",107,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
-"RTN","CCRDPT",108,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",109,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",110,0)
-DOB(DFN) ; Date of Birth
-"RTN","CCRDPT",111,0)
- N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
-"RTN","CCRDPT",112,0)
- ; Date in FM Date Format. Convert to UTC/ISO 8601.
-"RTN","CCRDPT",113,0)
- Q $$FMDTOUTC^CCRUTIL(DOB,"D")
-"RTN","CCRDPT",114,0)
-GENDER(DFN) ; Gender/Sex
-"RTN","CCRDPT",115,0)
- Q $$GET1^DIQ(2,DFN,.02) ;
-"RTN","CCRDPT",116,0)
-SSN(DFN) ; SSN
-"RTN","CCRDPT",117,0)
- Q $$GET1^DIQ(2,DFN,.09)
-"RTN","CCRDPT",118,0)
-ADDRTYPE(DFN) ; Address Type
-"RTN","CCRDPT",119,0)
- ; Vista only stores a home address for the patient.
-"RTN","CCRDPT",120,0)
- Q "Home"
-"RTN","CCRDPT",121,0)
-ADDR1(DFN) ; Get Home Address line 1
-"RTN","CCRDPT",122,0)
- Q $$GET1^DIQ(2,DFN,.111)
-"RTN","CCRDPT",123,0)
-ADDR2(DFN) ; Get Home Address line 2
-"RTN","CCRDPT",124,0)
- ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
-"RTN","CCRDPT",125,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",126,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
-"RTN","CCRDPT",127,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",128,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",129,0)
-CITY(DFN) ; Get City for Home Address
-"RTN","CCRDPT",130,0)
- Q $$GET1^DIQ(2,DFN,.114)
-"RTN","CCRDPT",131,0)
-STATE(DFN) ; Get State for Home Address
-"RTN","CCRDPT",132,0)
- Q $$GET1^DIQ(2,DFN,.115)
-"RTN","CCRDPT",133,0)
-ZIP(DFN) ; Get Zip code for Home Address
-"RTN","CCRDPT",134,0)
- Q $$GET1^DIQ(2,DFN,.116)
-"RTN","CCRDPT",135,0)
-COUNTY(DFN) ; Get County for our Address
-"RTN","CCRDPT",136,0)
- Q $$GET1^DIQ(2,DFN,.117)
-"RTN","CCRDPT",137,0)
-COUNTRY(DFN) ; Get Country for our Address
-"RTN","CCRDPT",138,0)
- ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
-"RTN","CCRDPT",139,0)
- Q "USA"
-"RTN","CCRDPT",140,0)
-RESTEL(DFN) ; Residential Telephone
-"RTN","CCRDPT",141,0)
- Q $$GET1^DIQ(2,DFN,.131)
-"RTN","CCRDPT",142,0)
-WORKTEL(DFN) ; Work Telephone
-"RTN","CCRDPT",143,0)
- Q $$GET1^DIQ(2,DFN,.132)
-"RTN","CCRDPT",144,0)
-EMAIL(DFN) ; Email Adddress
-"RTN","CCRDPT",145,0)
- Q $$GET1^DIQ(2,DFN,.133)
-"RTN","CCRDPT",146,0)
-CELLTEL(DFN) ; Cell Phone
-"RTN","CCRDPT",147,0)
- Q $$GET1^DIQ(2,DFN,.134)
-"RTN","CCRDPT",148,0)
-NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
-"RTN","CCRDPT",149,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",150,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",151,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",152,0)
-NOK1GIV(DFN) ; NOK1 Given Name
-"RTN","CCRDPT",153,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",154,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",155,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",156,0)
-NOK1MID(DFN) ; NOK1 Middle Name
-"RTN","CCRDPT",157,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",158,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",159,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",160,0)
-NOK1SUF(DFN) ; NOK1 Suffi Name
-"RTN","CCRDPT",161,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",162,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",163,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",164,0)
-NOK1DISP(DFN) ; NOK1 Display Name
-"RTN","CCRDPT",165,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
-"RTN","CCRDPT",166,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",167,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",168,0)
-NOK1REL(DFN) ; NOK1 Relationship to the patient
-"RTN","CCRDPT",169,0)
- Q $$GET1^DIQ(2,DFN,.212)
-"RTN","CCRDPT",170,0)
-NOK1ADD1(DFN) ; NOK1 Address 1
-"RTN","CCRDPT",171,0)
- Q $$GET1^DIQ(2,DFN,.213)
-"RTN","CCRDPT",172,0)
-NOK1ADD2(DFN) ; NOK1 Address 2 
-"RTN","CCRDPT",173,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",174,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
-"RTN","CCRDPT",175,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",176,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",177,0)
-NOK1CITY(DFN) ; NOK1 City
-"RTN","CCRDPT",178,0)
- Q $$GET1^DIQ(2,DFN,.216)
-"RTN","CCRDPT",179,0)
-NOK1STAT(DFN) ; NOK1 State
-"RTN","CCRDPT",180,0)
- Q $$GET1^DIQ(2,DFN,.217)
-"RTN","CCRDPT",181,0)
-NOK1ZIP(DFN) ; NOK1 Zip Code
-"RTN","CCRDPT",182,0)
- Q $$GET1^DIQ(2,DFN,.218)
-"RTN","CCRDPT",183,0)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
-"RTN","CCRDPT",184,0)
- Q $$GET1^DIQ(2,DFN,.219)
-"RTN","CCRDPT",185,0)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
-"RTN","CCRDPT",186,0)
- Q $$GET1^DIQ(2,DFN,.21011)
-"RTN","CCRDPT",187,0)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
-"RTN","CCRDPT",188,0)
- Q $$GET1^DIQ(2,DFN,.2125)
-"RTN","CCRDPT",189,0)
-NOK2FAM(DFN) ; NOK2 Family Name
-"RTN","CCRDPT",190,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",191,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",192,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",193,0)
-NOK2GIV(DFN) ; NOK2 Given Name
-"RTN","CCRDPT",194,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",195,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",196,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",197,0)
-NOK2MID(DFN) ; NOK2 Middle Name
-"RTN","CCRDPT",198,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",199,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",200,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",201,0)
-NOK2SUF(DFN) ; NOK2 Suffi Name
-"RTN","CCRDPT",202,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",203,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",204,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",205,0)
-NOK2DISP(DFN) ; NOK2 Display Name
-"RTN","CCRDPT",206,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
-"RTN","CCRDPT",207,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",208,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",209,0)
-NOK2REL(DFN) ; NOK2 Relationship to the patient
-"RTN","CCRDPT",210,0)
- Q $$GET1^DIQ(2,DFN,.2192)
-"RTN","CCRDPT",211,0)
-NOK2ADD1(DFN) ; NOK2 Address 1
-"RTN","CCRDPT",212,0)
- Q $$GET1^DIQ(2,DFN,.2193)
-"RTN","CCRDPT",213,0)
-NOK2ADD2(DFN) ; NOK2 Address 2
-"RTN","CCRDPT",214,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",215,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
-"RTN","CCRDPT",216,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",217,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",218,0)
-NOK2CITY(DFN) ; NOK2 City
-"RTN","CCRDPT",219,0)
- Q $$GET1^DIQ(2,DFN,.2196)
-"RTN","CCRDPT",220,0)
-NOK2STAT(DFN) ; NOK2 State
-"RTN","CCRDPT",221,0)
- Q $$GET1^DIQ(2,DFN,.2197)
-"RTN","CCRDPT",222,0)
-NOK2ZIP(DFN) ; NOK2 Zip Code
-"RTN","CCRDPT",223,0)
- Q $$GET1^DIQ(2,DFN,.2198)
-"RTN","CCRDPT",224,0)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
-"RTN","CCRDPT",225,0)
- Q $$GET1^DIQ(2,DFN,.2199)
-"RTN","CCRDPT",226,0)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
-"RTN","CCRDPT",227,0)
- Q $$GET1^DIQ(2,DFN,.211011)
-"RTN","CCRDPT",228,0)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
-"RTN","CCRDPT",229,0)
- Q $$GET1^DIQ(2,DFN,.21925)
-"RTN","CCRDPT",230,0)
-EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
-"RTN","CCRDPT",231,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",232,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",233,0)
- Q NAME("FAMILY")
-"RTN","CCRDPT",234,0)
-EMERGIV(DFN) ; EMER Given Name
-"RTN","CCRDPT",235,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",236,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",237,0)
- Q NAME("GIVEN")
-"RTN","CCRDPT",238,0)
-EMERMID(DFN) ; EMER Middle Name
-"RTN","CCRDPT",239,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",240,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",241,0)
- Q NAME("MIDDLE")
-"RTN","CCRDPT",242,0)
-EMERSUF(DFN) ; EMER Suffi Name
-"RTN","CCRDPT",243,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",244,0)
- D NAMECOMP^XLFNAME(.NAME)
-"RTN","CCRDPT",245,0)
- Q NAME("SUFFIX")
-"RTN","CCRDPT",246,0)
-EMERDISP(DFN) ; EMER Display Name
-"RTN","CCRDPT",247,0)
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",248,0)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
-"RTN","CCRDPT",249,0)
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-"RTN","CCRDPT",250,0)
-EMERREL(DFN) ; EMER Relationship to the patient
-"RTN","CCRDPT",251,0)
- Q $$GET1^DIQ(2,DFN,.331)
-"RTN","CCRDPT",252,0)
-EMERADD1(DFN) ; EMER Address 1
-"RTN","CCRDPT",253,0)
- Q $$GET1^DIQ(2,DFN,.333)
-"RTN","CCRDPT",254,0)
-EMERADD2(DFN) ; EMER Address 2
-"RTN","CCRDPT",255,0)
- N ADDLN2,ADDLN3
-"RTN","CCRDPT",256,0)
- S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
-"RTN","CCRDPT",257,0)
- Q:ADDLN3="" ADDLN2
-"RTN","CCRDPT",258,0)
- Q ADDLN2_", "_ADDLN3
-"RTN","CCRDPT",259,0)
-EMERCITY(DFN) ; EMER City
-"RTN","CCRDPT",260,0)
- Q $$GET1^DIQ(2,DFN,.336)
-"RTN","CCRDPT",261,0)
-EMERSTAT(DFN) ; EMER State
-"RTN","CCRDPT",262,0)
- Q $$GET1^DIQ(2,DFN,.337)
-"RTN","CCRDPT",263,0)
-EMERZIP(DFN) ; EMER Zip Code
-"RTN","CCRDPT",264,0)
- Q $$GET1^DIQ(2,DFN,.338)
-"RTN","CCRDPT",265,0)
-EMERHTEL(DFN) ; EMER Home Telephone
-"RTN","CCRDPT",266,0)
- Q $$GET1^DIQ(2,DFN,.339)
-"RTN","CCRDPT",267,0)
-EMERWTEL(DFN) ; EMER Work Telephone
-"RTN","CCRDPT",268,0)
- Q $$GET1^DIQ(2,DFN,.33011)
-"RTN","CCRDPT",269,0)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
-"RTN","CCRDPT",270,0)
- Q $$GET1^DIQ(2,DFN,.3305)
-"RTN","CCRDPTT")
-0^2^B4791589
-"RTN","CCRDPTT",1,0)
-CCRDPTT ; Unit Tester...
-"RTN","CCRDPTT",2,0)
-  ;;0.1;CCRCCD;;Jun 15, 2008;Build 14
-"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)
-          N I S I=89 F  S I=$O(OUT(I)) Q:I="ALINE"  D
-"RTN","CCRDPTT",39,0)
-          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
-"RTN","CCRDPTT",40,0)
-          . W "valued at "
-"RTN","CCRDPTT",41,0)
-    . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")")
-"RTN","CCRDPTT",42,0)
-          . W !
-"RTN","CCRDPTT",43,0)
-          Q
-"RTN","CCRMEDS")
-0^3^B68553972
-"RTN","CCRMEDS",1,0)
-CCRMEDS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
-"RTN","CCRMEDS",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 14
-"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(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS",24,0)
- ;
-"RTN","CCRMEDS",25,0)
- ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS",26,0)
- ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS",27,0)
- ;
-"RTN","CCRMEDS",28,0)
- N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
-"RTN","CCRMEDS",29,0)
- N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
-"RTN","CCRMEDS",30,0)
- ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^CCRMEDS1
-"RTN","CCRMEDS",31,0)
- ; OUTPATIENT PENDING MEDS IN EXTRACT^CCRMEDS2
-"RTN","CCRMEDS",32,0)
- ; NON-VA MEDS IN EXTRACT^CCRMEDS3
-"RTN","CCRMEDS",33,0)
- ; INPATIENT MEDS IN EXTRACT^CCRMEDS4
-"RTN","CCRMEDS",34,0)
- ; ALL OTHERS HERE
-"RTN","CCRMEDS",35,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",36,0)
- K @MEDTVMAP ; CLEAR VARIABLE ARRAY
-"RTN","CCRMEDS",37,0)
- S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
-"RTN","CCRMEDS",38,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",39,0)
- K @MEDTARYTMP ; KILL XML ARRAY
-"RTN","CCRMEDS",40,0)
- D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",41,0)
- I @MEDOUTXML@(0)>0 D  ; CCRMEDS FOUND ACTIVE OP MEDS
-"RTN","CCRMEDS",42,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",43,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",44,0)
- . W MEDCNT,!
-"RTN","CCRMEDS",45,0)
- . W "HAS ACTIVE OP MEDS",!
-"RTN","CCRMEDS",46,0)
- N PENDINGXML,MEDPENDING
-"RTN","CCRMEDS",47,0)
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
-"RTN","CCRMEDS",48,0)
- D EXTRACT^CCRMEDS2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",49,0)
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
-"RTN","CCRMEDS",50,0)
- . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",51,0)
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
-"RTN","CCRMEDS",52,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
-"RTN","CCRMEDS",53,0)
- . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
-"RTN","CCRMEDS",54,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",55,0)
- . ; W MEDCNT,!
-"RTN","CCRMEDS",56,0)
- . W "HAS OP PENDING MEDS",!
-"RTN","CCRMEDS",57,0)
- N PENDINGXML,MEDPENDING
-"RTN","CCRMEDS",58,0)
- S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
-"RTN","CCRMEDS",59,0)
- D EXTRACT^CCRMEDS3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
-"RTN","CCRMEDS",60,0)
- I @PENDINGXML@(0)>0 D  ; CCRMEDS FOUND PENDING OP MEDS
-"RTN","CCRMEDS",61,0)
- . ; S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
-"RTN","CCRMEDS",62,0)
- . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
-"RTN","CCRMEDS",63,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS
-"RTN","CCRMEDS",64,0)
- . E  D CP^GPLXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY
-"RTN","CCRMEDS",65,0)
- . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
-"RTN","CCRMEDS",66,0)
- . ; W MEDCNT,!
-"RTN","CCRMEDS",67,0)
- . W "HAS NON-VA MEDS",!
-"RTN","CCRMEDS",68,0)
-THEND ;
-"RTN","CCRMEDS",69,0)
- Q ; SKIPPING ALL THE REST OF THIS LOGIC.. IT IS NOT GOING TO BE NEEDED
-"RTN","CCRMEDS",70,0)
- ; ONCE NON-VA AND IP MEDS WORK (CCRMEDS3 AND CCRMEDS4)
-"RTN","CCRMEDS",71,0)
- N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
-"RTN","CCRMEDS",72,0)
- D ACTIVE^ORWPS(.MEDRSLT,DFN)
-"RTN","CCRMEDS",73,0)
- I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
-"RTN","CCRMEDS",74,0)
- . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
-"RTN","CCRMEDS",75,0)
- . S @MEDOUTXML@(0)=0
-"RTN","CCRMEDS",76,0)
- . Q
-"RTN","CCRMEDS",77,0)
- ; I DEBUG ZWR MEDRSLT
-"RTN","CCRMEDS",78,0)
- M GPLMEDS=MEDRSLT
-"RTN","CCRMEDS",79,0)
- S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS",80,0)
- S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
-"RTN","CCRMEDS",81,0)
- ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
-"RTN","CCRMEDS",82,0)
- ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
-"RTN","CCRMEDS",83,0)
- ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
-"RTN","CCRMEDS",84,0)
- N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
-"RTN","CCRMEDS",85,0)
- ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
-"RTN","CCRMEDS",86,0)
- S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
-"RTN","CCRMEDS",87,0)
- F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
-"RTN","CCRMEDS",88,0)
- . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
-"RTN","CCRMEDS",89,0)
- . . S ZI=ZI+1 ; INCREMENT MED COUNT
-"RTN","CCRMEDS",90,0)
- . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
-"RTN","CCRMEDS",91,0)
- . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
-"RTN","CCRMEDS",92,0)
- . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
-"RTN","CCRMEDS",93,0)
- . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
-"RTN","CCRMEDS",94,0)
- . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
-"RTN","CCRMEDS",95,0)
- ;ZWR ZA
-"RTN","CCRMEDS",96,0)
- ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
-"RTN","CCRMEDS",97,0)
- F ZI=1:1:ZA(0) D  ; FOR EACH MED
-"RTN","CCRMEDS",98,0)
- . I DEBUG W "ZI IS ",ZI,!
-"RTN","CCRMEDS",99,0)
- . ; W ZI," ",MEDCNT,!
-"RTN","CCRMEDS",100,0)
- . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
-"RTN","CCRMEDS",101,0)
- . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
-"RTN","CCRMEDS",102,0)
- . I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
-"RTN","CCRMEDS",103,0)
- . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
-"RTN","CCRMEDS",104,0)
- . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
-"RTN","CCRMEDS",105,0)
- . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
-"RTN","CCRMEDS",106,0)
- . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
-"RTN","CCRMEDS",107,0)
- . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
-"RTN","CCRMEDS",108,0)
- . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
-"RTN","CCRMEDS",109,0)
- . S @MEDVMAP@("MEDISSUEDATE")=""
-"RTN","CCRMEDS",110,0)
- . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS",111,0)
- . S @MEDVMAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS",112,0)
- . S @MEDVMAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS",113,0)
- . S @MEDVMAP@("MEDRXNO")=""
-"RTN","CCRMEDS",114,0)
- . S @MEDVMAP@("MEDDETAILUNADORNED")=""
-"RTN","CCRMEDS",115,0)
- . S @MEDVMAP@("MEDCONCVALUE")=""
-"RTN","CCRMEDS",116,0)
- . S @MEDVMAP@("MEDCONCUNIT")=""
-"RTN","CCRMEDS",117,0)
- . S @MEDVMAP@("MEDSIZETEXT")=""
-"RTN","CCRMEDS",118,0)
- . S @MEDVMAP@("MEDDOSEINDICATOR")=""
-"RTN","CCRMEDS",119,0)
- . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
-"RTN","CCRMEDS",120,0)
- . S @MEDVMAP@("MEDRATEVALUE")=""
-"RTN","CCRMEDS",121,0)
- . S @MEDVMAP@("MEDRATEUNIT")=""
-"RTN","CCRMEDS",122,0)
- . S @MEDVMAP@("MEDVEHICLETEXT")=""
-"RTN","CCRMEDS",123,0)
- . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
-"RTN","CCRMEDS",124,0)
- . S @MEDVMAP@("MEDINTERVALVALUE")=""
-"RTN","CCRMEDS",125,0)
- . S @MEDVMAP@("MEDINTERVALUNIT")=""
-"RTN","CCRMEDS",126,0)
- . S @MEDVMAP@("MEDPRNFLAG")=""
-"RTN","CCRMEDS",127,0)
- . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS",128,0)
- . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS",129,0)
- . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS",130,0)
- . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS",131,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS",132,0)
- . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS",133,0)
- . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS",134,0)
- . S @MEDVMAP@("MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS",135,0)
- . S @MEDVMAP@("MEDDIRSEQ")=""
-"RTN","CCRMEDS",136,0)
- . S @MEDVMAP@("MEDMULDIRMOD")=""
-"RTN","CCRMEDS",137,0)
- . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
-"RTN","CCRMEDS",138,0)
- . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","CCRMEDS",139,0)
- . S @MEDVMAP@("MEDDATETIMEAGE")=""
-"RTN","CCRMEDS",140,0)
- . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
-"RTN","CCRMEDS",141,0)
- . S @MEDVMAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS",142,0)
- . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
-"RTN","CCRMEDS",143,0)
- . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","CCRMEDS",144,0)
- . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
-"RTN","CCRMEDS",145,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
-"RTN","CCRMEDS",146,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-"RTN","CCRMEDS",147,0)
- . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
-"RTN","CCRMEDS",148,0)
- . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
-"RTN","CCRMEDS",149,0)
- . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
-"RTN","CCRMEDS",150,0)
- . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
-"RTN","CCRMEDS",151,0)
- . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
-"RTN","CCRMEDS",152,0)
- . . . I DEBUG W "RXIEN=",RXIEN,! ;
-"RTN","CCRMEDS",153,0)
- . . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
-"RTN","CCRMEDS",154,0)
- . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
-"RTN","CCRMEDS",155,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
-"RTN","CCRMEDS",156,0)
- . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS",157,0)
- . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS",158,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
-"RTN","CCRMEDS",159,0)
- . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
-"RTN","CCRMEDS",160,0)
- . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
-"RTN","CCRMEDS",161,0)
- . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
-"RTN","CCRMEDS",162,0)
- . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
-"RTN","CCRMEDS",163,0)
- . S @MEDVMAP@("MEDFORMTEXT")=""
-"RTN","CCRMEDS",164,0)
- . S @MEDVMAP@("MEDQUANTITYVALUE")=""
-"RTN","CCRMEDS",165,0)
- . S @MEDVMAP@("MEDQUANTITYUNIT")=""
-"RTN","CCRMEDS",166,0)
- . S @MEDVMAP@("MEDRFNO")=""
-"RTN","CCRMEDS",167,0)
- . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
-"RTN","CCRMEDS",168,0)
- . I ZK>1 D  ; MORE THAN ONE LINE IN MED
-"RTN","CCRMEDS",169,0)
- . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
-"RTN","CCRMEDS",170,0)
- . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
-"RTN","CCRMEDS",171,0)
- . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
-"RTN","CCRMEDS",172,0)
- . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
-"RTN","CCRMEDS",173,0)
- . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
-"RTN","CCRMEDS",174,0)
- . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
-"RTN","CCRMEDS",175,0)
- . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
-"RTN","CCRMEDS",176,0)
- . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
-"RTN","CCRMEDS",177,0)
- . S @MEDVMAP@("MEDDOSEVALUE")=""
-"RTN","CCRMEDS",178,0)
- . S @MEDVMAP@("MEDDOSEUNIT")=""
-"RTN","CCRMEDS",179,0)
- . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
-"RTN","CCRMEDS",180,0)
- . S @MEDVMAP@("MEDDURATIONVALUE")=""
-"RTN","CCRMEDS",181,0)
- . S @MEDVMAP@("MEDDURATIONUNIT")=""
-"RTN","CCRMEDS",182,0)
- . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
-"RTN","CCRMEDS",183,0)
- . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
-"RTN","CCRMEDS",184,0)
- . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
-"RTN","CCRMEDS",185,0)
- . K @MEDARYTMP
-"RTN","CCRMEDS",186,0)
- . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP)
-"RTN","CCRMEDS",187,0)
- . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
-"RTN","CCRMEDS",188,0)
- . . ; W "FIRST ONE",!
-"RTN","CCRMEDS",189,0)
- . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML)
-"RTN","CCRMEDS",190,0)
- . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
-"RTN","CCRMEDS",191,0)
- . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP)
-"RTN","CCRMEDS",192,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS",193,0)
- D MISSING^GPLXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS",194,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS",195,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS",196,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS",197,0)
- Q
-"RTN","CCRMEDS",198,0)
- ;
-"RTN","CCRMEDS",199,0)
-DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
-"RTN","CCRMEDS",200,0)
- ; EXAMPLE: $$DIGITS("13R") RETURNS 13
-"RTN","CCRMEDS",201,0)
- N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
-"RTN","CCRMEDS",202,0)
- S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
-"RTN","CCRMEDS",203,0)
- Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
-"RTN","CCRMEDS",204,0)
- ;
-"RTN","CCRMEDS1")
-0^10^B80043311
-"RTN","CCRMEDS1",1,0)
-CCRMEDS ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;08/24/08
-"RTN","CCRMEDS1",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 14
-"RTN","CCRMEDS1",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRMEDS1",4,0)
- ; General Public License See attached copy of the License.
-"RTN","CCRMEDS1",5,0)
- ;
-"RTN","CCRMEDS1",6,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","CCRMEDS1",7,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","CCRMEDS1",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","CCRMEDS1",9,0)
- ; (at your option) any later version.
-"RTN","CCRMEDS1",10,0)
- ;
-"RTN","CCRMEDS1",11,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRMEDS1",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRMEDS1",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRMEDS1",14,0)
- ; GNU General Public License for more details.
-"RTN","CCRMEDS1",15,0)
- ;
-"RTN","CCRMEDS1",16,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRMEDS1",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRMEDS1",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRMEDS1",19,0)
- ;
-"RTN","CCRMEDS1",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","CCRMEDS1",21,0)
- Q
-"RTN","CCRMEDS1",22,0)
- ;
-"RTN","CCRMEDS1",23,0)
-EXTRACT(MINXML,DFN,OUTXML)  ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS1",24,0)
- ;
-"RTN","CCRMEDS1",25,0)
- ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","CCRMEDS1",26,0)
- ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-"RTN","CCRMEDS1",27,0)
- ;
-"RTN","CCRMEDS1",28,0)
- ; MEDS is return array from RPC.
-"RTN","CCRMEDS1",29,0)
- ; MAP is a mapping variable map (store result) for each med
-"RTN","CCRMEDS1",30,0)
- ; MED is holds each array element from MEDS(J), one medicine
-"RTN","CCRMEDS1",31,0)
- ; J is a counter.
-"RTN","CCRMEDS1",32,0)
- ;
-"RTN","CCRMEDS1",33,0)
- ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
-"RTN","CCRMEDS1",34,0)
- ; med data available.
-"RTN","CCRMEDS1",35,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","CCRMEDS1",36,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","CCRMEDS1",37,0)
- ; D PARY^GPLXPATH(MINXML)
-"RTN","CCRMEDS1",38,0)
- N MEDS,MAP
-"RTN","CCRMEDS1",39,0)
- K ^TMP($J)
-"RTN","CCRMEDS1",40,0)
- D RX^PSO52API(DFN,"CCDCCR")
-"RTN","CCRMEDS1",41,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","CCRMEDS1",42,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","CCRMEDS1",43,0)
- ; If it is -1, we quit.
-"RTN","CCRMEDS1",44,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-"RTN","CCRMEDS1",45,0)
- I DEBUG ZWR MEDS
-"RTN","CCRMEDS1",46,0)
- N RXIEN S RXIEN=0
-"RTN","CCRMEDS1",47,0)
- N MEDCOUNT S MEDCOUNT=0
-"RTN","CCRMEDS1",48,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
-"RTN","CCRMEDS1",49,0)
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
-"RTN","CCRMEDS1",50,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS1",51,0)
- . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS1",52,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS1",53,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS1",54,0)
- . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN CCRMEDS
-"RTN","CCRMEDS1",55,0)
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
-"RTN","CCRMEDS1",56,0)
- . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS1",57,0)
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","CCRMEDS1",58,0)
- . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","CCRMEDS1",59,0)
- . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
-"RTN","CCRMEDS1",60,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","CCRMEDS1",61,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($P(MED(1),U))
-"RTN","CCRMEDS1",62,0)
- . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-"RTN","CCRMEDS1",63,0)
- . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^CCRUTIL($P(MED(101),U))
-"RTN","CCRMEDS1",64,0)
- . S @MAP@("MEDRXNOTXT")="Prescription Number"
-"RTN","CCRMEDS1",65,0)
- . S @MAP@("MEDRXNO")=MED(.01)
-"RTN","CCRMEDS1",66,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS1",67,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS1",68,0)
- . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
-"RTN","CCRMEDS1",69,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
-"RTN","CCRMEDS1",70,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
-"RTN","CCRMEDS1",71,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=MED(27)
-"RTN","CCRMEDS1",72,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS1",73,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
-"RTN","CCRMEDS1",74,0)
- . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
-"RTN","CCRMEDS1",75,0)
- . N MEDIEN S MEDIEN=$P(MED(6),U)
-"RTN","CCRMEDS1",76,0)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS1",77,0)
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS1",78,0)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","CCRMEDS1",79,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","CCRMEDS1",80,0)
- . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS1",81,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS1",82,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS1",83,0)
- . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS1",84,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS1",85,0)
- . ; Documented in the same manual.
-"RTN","CCRMEDS1",86,0)
- . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS1",87,0)
- . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS1",88,0)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS1",89,0)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS1",90,0)
- . N CONCDATA
-"RTN","CCRMEDS1",91,0)
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS1",92,0)
- . ; and this will crash the call. So...
-"RTN","CCRMEDS1",93,0)
- . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS1",94,0)
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS1",95,0)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","CCRMEDS1",96,0)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","CCRMEDS1",97,0)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","CCRMEDS1",98,0)
- . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
-"RTN","CCRMEDS1",99,0)
- . S @MAP@("MEDQUANTITYVALUE")=MED(7)
-"RTN","CCRMEDS1",100,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS1",101,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS1",102,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS1",103,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS1",104,0)
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS1",105,0)
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS1",106,0)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS1",107,0)
- . ;
-"RTN","CCRMEDS1",108,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS1",109,0)
- . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-"RTN","CCRMEDS1",110,0)
- . ; we want the compoenents.
-"RTN","CCRMEDS1",111,0)
- . ; It's in node 6 of ^PSRX(IEN)
-"RTN","CCRMEDS1",112,0)
- . ; So, here we go again
-"RTN","CCRMEDS1",113,0)
- . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
-"RTN","CCRMEDS1",114,0)
- . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
-"RTN","CCRMEDS1",115,0)
- . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
-"RTN","CCRMEDS1",116,0)
- . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
-"RTN","CCRMEDS1",117,0)
- . ;
-"RTN","CCRMEDS1",118,0)
- . N DIRNUM S DIRNUM=0 ; Sigline number
-"RTN","CCRMEDS1",119,0)
- . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
-"RTN","CCRMEDS1",120,0)
- . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
-"RTN","CCRMEDS1",121,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","CCRMEDS1",122,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","CCRMEDS1",123,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","CCRMEDS1",124,0)
- . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
-"RTN","CCRMEDS1",125,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
-"RTN","CCRMEDS1",126,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
-"RTN","CCRMEDS1",127,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","CCRMEDS1",128,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","CCRMEDS1",129,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","CCRMEDS1",130,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","CCRMEDS1",131,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
-"RTN","CCRMEDS1",132,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
-"RTN","CCRMEDS1",133,0)
- . . ; Invervals... again another call.
-"RTN","CCRMEDS1",134,0)
- . . ; In the wisdom of the original programmers, the schedule is a free text field
-"RTN","CCRMEDS1",135,0)
- . . ; However, it gets translated by a call to the administration schedule file
-"RTN","CCRMEDS1",136,0)
- . . ; to see if that schedule exists.
-"RTN","CCRMEDS1",137,0)
- . . ; That's the same thing I am going to do.
-"RTN","CCRMEDS1",138,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","CCRMEDS1",139,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","CCRMEDS1",140,0)
- . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
-"RTN","CCRMEDS1",141,0)
- . . ; So...
-"RTN","CCRMEDS1",142,0)
- . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
-"RTN","CCRMEDS1",143,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","CCRMEDS1",144,0)
- . . N INTERVAL
-"RTN","CCRMEDS1",145,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","CCRMEDS1",146,0)
- . . E  D
-"RTN","CCRMEDS1",147,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","CCRMEDS1",148,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","CCRMEDS1",149,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","CCRMEDS1",150,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","CCRMEDS1",151,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
-"RTN","CCRMEDS1",152,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-"RTN","CCRMEDS1",153,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
-"RTN","CCRMEDS1",154,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS1",155,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS1",156,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS1",157,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS1",158,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS1",159,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS1",160,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS1",161,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS1",162,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","CCRMEDS1",163,0)
- . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
-"RTN","CCRMEDS1",164,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
-"RTN","CCRMEDS1",165,0)
- . ;
-"RTN","CCRMEDS1",166,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS1",167,0)
- . ;
-"RTN","CCRMEDS1",168,0)
- . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
-"RTN","CCRMEDS1",169,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
-"RTN","CCRMEDS1",170,0)
- . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
-"RTN","CCRMEDS1",171,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
-"RTN","CCRMEDS1",172,0)
- . S @MAP@("MEDRFNO")=MED(9)
-"RTN","CCRMEDS1",173,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","CCRMEDS1",174,0)
- . K @RESULT
-"RTN","CCRMEDS1",175,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS1",176,0)
- . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS1",177,0)
- . ; MAPPING DIRECTIONS
-"RTN","CCRMEDS1",178,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","CCRMEDS1",179,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","CCRMEDS1",180,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","CCRMEDS1",181,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","CCRMEDS1",182,0)
- . ; N MDZ1,MDZNA
-"RTN","CCRMEDS1",183,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","CCRMEDS1",184,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","CCRMEDS1",185,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","CCRMEDS1",186,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","CCRMEDS1",187,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","CCRMEDS1",188,0)
- . D:MEDCOUNT=1 CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS1",189,0)
- . D:MEDCOUNT>1 INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-"RTN","CCRMEDS1",190,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS1",191,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS1",192,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS1",193,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS1",194,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS1",195,0)
- Q
-"RTN","CCRMEDS1",196,0)
- ;
-"RTN","CCRMEDS2")
-0^11^B101302627
-"RTN","CCRMEDS2",1,0)
-CCRMEDS2         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Pending Meds;08/24/08
-"RTN","CCRMEDS2",2,0)
- ;;0.1;CCDCCR;;JUL 16,2008;Build 14
-"RTN","CCRMEDS2",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRMEDS2",4,0)
- ; General Public License See attached copy of the License.
-"RTN","CCRMEDS2",5,0)
- ;
-"RTN","CCRMEDS2",6,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","CCRMEDS2",7,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","CCRMEDS2",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","CCRMEDS2",9,0)
- ; (at your option) any later version.
-"RTN","CCRMEDS2",10,0)
- ;
-"RTN","CCRMEDS2",11,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRMEDS2",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRMEDS2",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRMEDS2",14,0)
- ; GNU General Public License for more details.
-"RTN","CCRMEDS2",15,0)
- ;
-"RTN","CCRMEDS2",16,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRMEDS2",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRMEDS2",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRMEDS2",19,0)
- ;
-"RTN","CCRMEDS2",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","CCRMEDS2",21,0)
- Q
-"RTN","CCRMEDS2",22,0)
- ;
-"RTN","CCRMEDS2",23,0)
-EXTRACT(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS2",24,0)
- ;
-"RTN","CCRMEDS2",25,0)
- ; MINXML is the Input XML Template, passed by name
-"RTN","CCRMEDS2",26,0)
- ; DFN is Patient IEN
-"RTN","CCRMEDS2",27,0)
- ; OUTXML is the resultant XML.
-"RTN","CCRMEDS2",28,0)
- ;
-"RTN","CCRMEDS2",29,0)
- ; MEDS is return array from RPC.
-"RTN","CCRMEDS2",30,0)
- ; MAP is a mapping variable map (store result) for each med
-"RTN","CCRMEDS2",31,0)
- ; MED is holds each array element from MEDS, one medicine
-"RTN","CCRMEDS2",32,0)
- ;
-"RTN","CCRMEDS2",33,0)
- ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
-"RTN","CCRMEDS2",34,0)
- ; meds data available.
-"RTN","CCRMEDS2",35,0)
- ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-"RTN","CCRMEDS2",36,0)
- ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-"RTN","CCRMEDS2",37,0)
- ; File for pending meds is 52.41
-"RTN","CCRMEDS2",38,0)
- ; Unfortuantely, API does not supply us with any useful info beyond
-"RTN","CCRMEDS2",39,0)
- ; the IEN in 52.41, and the Med Name, and route.
-"RTN","CCRMEDS2",40,0)
- ; So, most of the info is going to get pulled from 52.41.
-"RTN","CCRMEDS2",41,0)
- N MEDS,MAP
-"RTN","CCRMEDS2",42,0)
- K ^TMP($J)
-"RTN","CCRMEDS2",43,0)
- D PEN^PSO5241(DFN,"CCDCCR")
-"RTN","CCRMEDS2",44,0)
- M MEDS=^TMP($J,"CCDCCR",DFN)
-"RTN","CCRMEDS2",45,0)
- ; @(0) contains the number of meds or -1^NO DATA FOUND
-"RTN","CCRMEDS2",46,0)
- ; If it is -1, we quit.
-"RTN","CCRMEDS2",47,0)
- I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-"RTN","CCRMEDS2",48,0)
- I DEBUG ZWR MEDS
-"RTN","CCRMEDS2",49,0)
- N RXIEN S RXIEN=0
-"RTN","CCRMEDS2",50,0)
- N MEDCOUNT S MEDCOUNT=0
-"RTN","CCRMEDS2",51,0)
- N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
-"RTN","CCRMEDS2",52,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
-"RTN","CCRMEDS2",53,0)
- S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
-"RTN","CCRMEDS2",54,0)
- F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS2",55,0)
- . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
-"RTN","CCRMEDS2",56,0)
- . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS2",57,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS2",58,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS2",59,0)
- . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN CCRMEDS
-"RTN","CCRMEDS2",60,0)
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
-"RTN","CCRMEDS2",61,0)
- . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS2",62,0)
- . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-"RTN","CCRMEDS2",63,0)
- . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","CCRMEDS2",64,0)
- . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
-"RTN","CCRMEDS2",65,0)
- . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-"RTN","CCRMEDS2",66,0)
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
-"RTN","CCRMEDS2",67,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
-"RTN","CCRMEDS2",68,0)
- . ; Med never filled; next 4 fields are not applicable.
-"RTN","CCRMEDS2",69,0)
- . S @MAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS2",70,0)
- . S @MAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS2",71,0)
- . S @MAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS2",72,0)
- . S @MAP@("MEDRXNO")=""
-"RTN","CCRMEDS2",73,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS2",74,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS2",75,0)
- . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
-"RTN","CCRMEDS2",76,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
-"RTN","CCRMEDS2",77,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
-"RTN","CCRMEDS2",78,0)
- . ; NDC not supplied in API, but is rather trivial to obtain
-"RTN","CCRMEDS2",79,0)
- . ; MED(11) piece 1 has the IEN of the drug (file 50)
-"RTN","CCRMEDS2",80,0)
- . ; IEN is field 31 in the drug file.
-"RTN","CCRMEDS2",81,0)
- . N MEDIEN S MEDIEN=$P(MED(11),U)
-"RTN","CCRMEDS2",82,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$$GET1^DIQ(50,MEDIEN,31,"E")
-"RTN","CCRMEDS2",83,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
-"RTN","CCRMEDS2",84,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")="none"
-"RTN","CCRMEDS2",85,0)
- . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS2",86,0)
- . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS2",87,0)
- . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS2",88,0)
- . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-"RTN","CCRMEDS2",89,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-"RTN","CCRMEDS2",90,0)
- . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS2",91,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS2",92,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS2",93,0)
- . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS2",94,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS2",95,0)
- . ; Documented in the same manual.
-"RTN","CCRMEDS2",96,0)
- . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS2",97,0)
- . N NDFDATA M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS2",98,0)
- . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS2",99,0)
- . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS2",100,0)
- . N CONCDATA
-"RTN","CCRMEDS2",101,0)
- . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS2",102,0)
- . ; and this will crash the call. So...
-"RTN","CCRMEDS2",103,0)
- . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS2",104,0)
- . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS2",105,0)
- . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-"RTN","CCRMEDS2",106,0)
- . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-"RTN","CCRMEDS2",107,0)
- . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-"RTN","CCRMEDS2",108,0)
- . S @MAP@("MEDSIZETEXT")=$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2)
-"RTN","CCRMEDS2",109,0)
- . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
-"RTN","CCRMEDS2",110,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS2",111,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS2",112,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS2",113,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS2",114,0)
- . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS2",115,0)
- . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS2",116,0)
- . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS2",117,0)
- . ;
-"RTN","CCRMEDS2",118,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS2",119,0)
- . ; Sig data is not in any API. We obtain it using the IEN from
-"RTN","CCRMEDS2",120,0)
- . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
-"RTN","CCRMEDS2",121,0)
- . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
-"RTN","CCRMEDS2",122,0)
- . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
-"RTN","CCRMEDS2",123,0)
- . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
-"RTN","CCRMEDS2",124,0)
- . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
-"RTN","CCRMEDS2",125,0)
- . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-"RTN","CCRMEDS2",126,0)
- . ; DIRNUM will be first piece for IEN.
-"RTN","CCRMEDS2",127,0)
- . ; DIRNUM is the proper Sigline numer.
-"RTN","CCRMEDS2",128,0)
- . ; SIGDATA is the simplfied array. Subscripts are really field numbers
-"RTN","CCRMEDS2",129,0)
- . ; in subfile 52.413.
-"RTN","CCRMEDS2",130,0)
- . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
-"RTN","CCRMEDS2",131,0)
- . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
-"RTN","CCRMEDS2",132,0)
- . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
-"RTN","CCRMEDS2",133,0)
- . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-"RTN","CCRMEDS2",134,0)
- . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
-"RTN","CCRMEDS2",135,0)
- . . ; If this is an order for a refill; it's not really a new order; move on to next
-"RTN","CCRMEDS2",136,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-"RTN","CCRMEDS2",137,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-"RTN","CCRMEDS2",138,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
-"RTN","CCRMEDS2",139,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
-"RTN","CCRMEDS2",140,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-"RTN","CCRMEDS2",141,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-"RTN","CCRMEDS2",142,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-"RTN","CCRMEDS2",143,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-"RTN","CCRMEDS2",144,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
-"RTN","CCRMEDS2",145,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
-"RTN","CCRMEDS2",146,0)
- . . ; Invervals... again another call.
-"RTN","CCRMEDS2",147,0)
- . . ; The schedule is a free text field
-"RTN","CCRMEDS2",148,0)
- . . ; However, it gets translated by a call to the administration
-"RTN","CCRMEDS2",149,0)
- . . ; schedule file to see if that schedule exists.
-"RTN","CCRMEDS2",150,0)
- . . ; That's the same thing I am going to do.
-"RTN","CCRMEDS2",151,0)
- . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-"RTN","CCRMEDS2",152,0)
- . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-"RTN","CCRMEDS2",153,0)
- . . ; I looked), PSSFT is the name,
-"RTN","CCRMEDS2",154,0)
- . . ; and list is the ^TMP name to store the data in.
-"RTN","CCRMEDS2",155,0)
- . . ; Also, freqency may have "PRN" in it, so strip that out
-"RTN","CCRMEDS2",156,0)
- . . N FREQ S FREQ=SIGDATA(1)
-"RTN","CCRMEDS2",157,0)
- . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
-"RTN","CCRMEDS2",158,0)
- . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
-"RTN","CCRMEDS2",159,0)
- . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-"RTN","CCRMEDS2",160,0)
- . . N INTERVAL
-"RTN","CCRMEDS2",161,0)
- . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-"RTN","CCRMEDS2",162,0)
- . . E  D
-"RTN","CCRMEDS2",163,0)
- . . . N SUB S SUB=$O(SCHEDATA(0))
-"RTN","CCRMEDS2",164,0)
- . . . S INTERVAL=SCHEDATA(SUB,2)
-"RTN","CCRMEDS2",165,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-"RTN","CCRMEDS2",166,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-"RTN","CCRMEDS2",167,0)
- . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
-"RTN","CCRMEDS2",168,0)
- . . N DUR S DUR=SIGDATA(2)
-"RTN","CCRMEDS2",169,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
-"RTN","CCRMEDS2",170,0)
- . . N DURUNIT S DURUNIT=$E(DUR)
-"RTN","CCRMEDS2",171,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
-"RTN","CCRMEDS2",172,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
-"RTN","CCRMEDS2",173,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS2",174,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS2",175,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS2",176,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS2",177,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS2",178,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS2",179,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS2",180,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
-"RTN","CCRMEDS2",181,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-"RTN","CCRMEDS2",182,0)
- . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
-"RTN","CCRMEDS2",183,0)
- . ;
-"RTN","CCRMEDS2",184,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS2",185,0)
- . ;
-"RTN","CCRMEDS2",186,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","CCRMEDS2",187,0)
- . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
-"RTN","CCRMEDS2",188,0)
- . ; W @MAP@("MEDPTINSTRUCTIONS"),!
-"RTN","CCRMEDS2",189,0)
- . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
-"RTN","CCRMEDS2",190,0)
- . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
-"RTN","CCRMEDS2",191,0)
- . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
-"RTN","CCRMEDS2",192,0)
- . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
-"RTN","CCRMEDS2",193,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","CCRMEDS2",194,0)
- . K @RESULT
-"RTN","CCRMEDS2",195,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS2",196,0)
- . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS2",197,0)
- . ; MAPPING DIRECTIONS
-"RTN","CCRMEDS2",198,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","CCRMEDS2",199,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","CCRMEDS2",200,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","CCRMEDS2",201,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","CCRMEDS2",202,0)
- . ; N MDZ1,MDZNA
-"RTN","CCRMEDS2",203,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","CCRMEDS2",204,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","CCRMEDS2",205,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","CCRMEDS2",206,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","CCRMEDS2",207,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","CCRMEDS2",208,0)
- . I MEDFIRST D  ;
-"RTN","CCRMEDS2",209,0)
- . . S MEDFIRST=0 ; RESET FIRST FLAG
-"RTN","CCRMEDS2",210,0)
- . . D CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS2",211,0)
- . D:'MEDFIRST INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
-"RTN","CCRMEDS2",212,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS2",213,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS2",214,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS2",215,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS2",216,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS2",217,0)
- Q
-"RTN","CCRMEDS2",218,0)
- ;
-"RTN","CCRMEDS3")
-0^24^B68176928
-"RTN","CCRMEDS3",1,0)
-CCRMEDS3         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Outside_non-VA Meds;10/13/08
-"RTN","CCRMEDS3",2,0)
- ;;0.1;CCDCCR;;;Build 14
-"RTN","CCRMEDS3",3,0)
- ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","CCRMEDS3",4,0)
- ; General Public License See attached copy of the License.
-"RTN","CCRMEDS3",5,0)
- ;
-"RTN","CCRMEDS3",6,0)
- ; This program is free software; you can redistribute it and/or modify
-"RTN","CCRMEDS3",7,0)
- ; it under the terms of the GNU General Public License as published by
-"RTN","CCRMEDS3",8,0)
- ; the Free Software Foundation; either version 2 of the License, or
-"RTN","CCRMEDS3",9,0)
- ; (at your option) any later version.
-"RTN","CCRMEDS3",10,0)
- ;
-"RTN","CCRMEDS3",11,0)
- ; This program is distributed in the hope that it will be useful,
-"RTN","CCRMEDS3",12,0)
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","CCRMEDS3",13,0)
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","CCRMEDS3",14,0)
- ; GNU General Public License for more details.
-"RTN","CCRMEDS3",15,0)
- ;
-"RTN","CCRMEDS3",16,0)
- ; You should have received a copy of the GNU General Public License along
-"RTN","CCRMEDS3",17,0)
- ; with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","CCRMEDS3",18,0)
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","CCRMEDS3",19,0)
- ;
-"RTN","CCRMEDS3",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","CCRMEDS3",21,0)
- Q
-"RTN","CCRMEDS3",22,0)
- ;
-"RTN","CCRMEDS3",23,0)
-EXTRACT(MINXML,DFN,OUTXML)           ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-"RTN","CCRMEDS3",24,0)
- ;
-"RTN","CCRMEDS3",25,0)
- ; MINXML is the Input XML Template, passed by name
-"RTN","CCRMEDS3",26,0)
- ; DFN is Patient IEN
-"RTN","CCRMEDS3",27,0)
- ; OUTXML is the resultant XML.
-"RTN","CCRMEDS3",28,0)
- ;
-"RTN","CCRMEDS3",29,0)
- ; MEDS is return array from RPC.
-"RTN","CCRMEDS3",30,0)
- ; MAP is a mapping variable map (store result) for each med
-"RTN","CCRMEDS3",31,0)
- ; MED is holds each array element from MEDS, one medicine
-"RTN","CCRMEDS3",32,0)
- ;
-"RTN","CCRMEDS3",33,0)
- ; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
-"RTN","CCRMEDS3",34,0)
- ; Discontinued meds are indicated by the presence of a value in fields
-"RTN","CCRMEDS3",35,0)
- ; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
-"RTN","CCRMEDS3",36,0)
- ; Will use Fileman API GETS^DIQ
-"RTN","CCRMEDS3",37,0)
- ;
-"RTN","CCRMEDS3",38,0)
- N MEDS,MAP
-"RTN","CCRMEDS3",39,0)
- K ^TMP($J),NVA
-"RTN","CCRMEDS3",40,0)
- D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
-"RTN","CCRMEDS3",41,0)
- ; If NVA does not exist, then patient has no non-VA meds
-"RTN","CCRMEDS3",42,0)
- I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
-"RTN","CCRMEDS3",43,0)
- ; Otherwise, we go on...
-"RTN","CCRMEDS3",44,0)
- M MEDS=NVA(55.05)
-"RTN","CCRMEDS3",45,0)
- ; We are done with NVA
-"RTN","CCRMEDS3",46,0)
- K NVA
-"RTN","CCRMEDS3",47,0)
- ;
-"RTN","CCRMEDS3",48,0)
- I DEBUG ZWR MEDS
-"RTN","CCRMEDS3",49,0)
- N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
-"RTN","CCRMEDS3",50,0)
- S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
-"RTN","CCRMEDS3",51,0)
- N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
-"RTN","CCRMEDS3",52,0)
- N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
-"RTN","CCRMEDS3",53,0)
- F  S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
-"RTN","CCRMEDS3",54,0)
- . N MED M MED=MEDS(FDAIEN)
-"RTN","CCRMEDS3",55,0)
- . I MED(5,"I")!MED(6,"I") QUIT  ; If disconinued, we don't want to pull it.
-"RTN","CCRMEDS3",56,0)
- . S MEDCOUNT=MEDCOUNT+1
-"RTN","CCRMEDS3",57,0)
- . S MAP=$NA(^TMP("GPLCCR",$J,"MEDMAP",MEDCOUNT))
-"RTN","CCRMEDS3",58,0)
- . S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
-"RTN","CCRMEDS3",59,0)
- . N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
-"RTN","CCRMEDS3",60,0)
- . I DEBUG W "RXIEN IS ",RXIEN,!
-"RTN","CCRMEDS3",61,0)
- . I DEBUG W "MAP= ",MAP,!
-"RTN","CCRMEDS3",62,0)
- . S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
-"RTN","CCRMEDS3",63,0)
- . S @MAP@("MEDISSUEDATETXT")="Documented Date"
-"RTN","CCRMEDS3",64,0)
- . ; Field 6 is "Effective date", and we pull it in timson format w/ I
-"RTN","CCRMEDS3",65,0)
- . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^CCRUTIL(MED(11,"I"),"DT")
-"RTN","CCRMEDS3",66,0)
- . ; Med never filled; next 4 fields are not applicable.
-"RTN","CCRMEDS3",67,0)
- . S @MAP@("MEDLASTFILLDATETXT")=""
-"RTN","CCRMEDS3",68,0)
- . S @MAP@("MEDLASTFILLDATE")=""
-"RTN","CCRMEDS3",69,0)
- . S @MAP@("MEDRXNOTXT")=""
-"RTN","CCRMEDS3",70,0)
- . S @MAP@("MEDRXNO")=""
-"RTN","CCRMEDS3",71,0)
- . S @MAP@("MEDTYPETEXT")="Medication"
-"RTN","CCRMEDS3",72,0)
- . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-"RTN","CCRMEDS3",73,0)
- . S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
-"RTN","CCRMEDS3",74,0)
- . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
-"RTN","CCRMEDS3",75,0)
- . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
-"RTN","CCRMEDS3",76,0)
- . ; NDC is field 31 in the drug file.
-"RTN","CCRMEDS3",77,0)
- . ; The actual drug entry in the drug file is not necessarily supplied.
-"RTN","CCRMEDS3",78,0)
- . ; It' node 1, internal form.
-"RTN","CCRMEDS3",79,0)
- . N MEDIEN S MEDIEN=MED(1,"I")
-"RTN","CCRMEDS3",80,0)
- . S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
-"RTN","CCRMEDS3",81,0)
- . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
-"RTN","CCRMEDS3",82,0)
- . S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
-"RTN","CCRMEDS3",83,0)
- . S @MAP@("MEDBRANDNAMETEXT")=""
-"RTN","CCRMEDS3",84,0)
- . I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-"RTN","CCRMEDS3",85,0)
- . I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-"RTN","CCRMEDS3",86,0)
- . S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
-"RTN","CCRMEDS3",87,0)
- . S @MAP@("MEDSTRENGTHUNIT")=$S($L(DOSEDATA(902))>0:$P(DOSEDATA(902),U,2),1:"") ; SAM PLEASE CHECK
-"RTN","CCRMEDS3",88,0)
- . ; Units, concentration, etc, come from another call
-"RTN","CCRMEDS3",89,0)
- . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-"RTN","CCRMEDS3",90,0)
- . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-"RTN","CCRMEDS3",91,0)
- . ; NDF Entry IEN, and VA Product Name
-"RTN","CCRMEDS3",92,0)
- . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS3",93,0)
- . ; Documented in the same manual.
-"RTN","CCRMEDS3",94,0)
- . N NDFDATA,CONCDATA
-"RTN","CCRMEDS3",95,0)
- . I $L(MEDIEN) D
-"RTN","CCRMEDS3",96,0)
- . . D NDF^PSS50(MEDIEN,,,,,"CONC")
-"RTN","CCRMEDS3",97,0)
- . . M NDFDATA=^TMP($J,"CONC",MEDIEN)
-"RTN","CCRMEDS3",98,0)
- . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-"RTN","CCRMEDS3",99,0)
- . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-"RTN","CCRMEDS3",100,0)
- . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-"RTN","CCRMEDS3",101,0)
- . . ; and this will crash the call. So...
-"RTN","CCRMEDS3",102,0)
- . . I NDFIEN="" S CONCDATA=""
-"RTN","CCRMEDS3",103,0)
- . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-"RTN","CCRMEDS3",104,0)
- . E  S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
-"RTN","CCRMEDS3",105,0)
- . S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
-"RTN","CCRMEDS3",106,0)
- . S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
-"RTN","CCRMEDS3",107,0)
- . S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
-"RTN","CCRMEDS3",108,0)
- . S @MAP@("MEDSIZETEXT")=$S($L(MEDIEN):$P(NDFDATA(23),U,2)_" "_$P(NDFDATA(24),U,2),1:"")
-"RTN","CCRMEDS3",109,0)
- . S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
-"RTN","CCRMEDS3",110,0)
- . ; Oddly, there is no easy place to find the dispense unit.
-"RTN","CCRMEDS3",111,0)
- . ; It's not included in the original call, so we have to go to the drug file.
-"RTN","CCRMEDS3",112,0)
- . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-"RTN","CCRMEDS3",113,0)
- . ; Node 14.5 is the Dispense Unit
-"RTN","CCRMEDS3",114,0)
- . I $L(MEDIEN) D
-"RTN","CCRMEDS3",115,0)
- . . D DATA^PSS50(MEDIEN,,,,,"QTY")
-"RTN","CCRMEDS3",116,0)
- . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-"RTN","CCRMEDS3",117,0)
- . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-"RTN","CCRMEDS3",118,0)
- . E  S @MAP@("MEDQUANTITYUNIT")=""
-"RTN","CCRMEDS3",119,0)
- . ;
-"RTN","CCRMEDS3",120,0)
- . ; --- START OF DIRECTIONS ---
-"RTN","CCRMEDS3",121,0)
- . ; Dosage is field 2, route is 3, schedule is 4
-"RTN","CCRMEDS3",122,0)
- . ; These are all free text fields, and don't point to any files
-"RTN","CCRMEDS3",123,0)
- . ; For that reason, I will use the field I never used before:
-"RTN","CCRMEDS3",124,0)
- . ; MEDDIRECTIONDESCRIPTIONTEXT
-"RTN","CCRMEDS3",125,0)
- . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
-"RTN","CCRMEDS3",126,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
-"RTN","CCRMEDS3",127,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
-"RTN","CCRMEDS3",128,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
-"RTN","CCRMEDS3",129,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
-"RTN","CCRMEDS3",130,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
-"RTN","CCRMEDS3",131,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
-"RTN","CCRMEDS3",132,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
-"RTN","CCRMEDS3",133,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
-"RTN","CCRMEDS3",134,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
-"RTN","CCRMEDS3",135,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
-"RTN","CCRMEDS3",136,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
-"RTN","CCRMEDS3",137,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
-"RTN","CCRMEDS3",138,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
-"RTN","CCRMEDS3",139,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
-"RTN","CCRMEDS3",140,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
-"RTN","CCRMEDS3",141,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
-"RTN","CCRMEDS3",142,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
-"RTN","CCRMEDS3",143,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
-"RTN","CCRMEDS3",144,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
-"RTN","CCRMEDS3",145,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
-"RTN","CCRMEDS3",146,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
-"RTN","CCRMEDS3",147,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
-"RTN","CCRMEDS3",148,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
-"RTN","CCRMEDS3",149,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
-"RTN","CCRMEDS3",150,0)
- . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
-"RTN","CCRMEDS3",151,0)
- . ;
-"RTN","CCRMEDS3",152,0)
- . ; --- END OF DIRECTIONS ---
-"RTN","CCRMEDS3",153,0)
- . ;
-"RTN","CCRMEDS3",154,0)
- . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-"RTN","CCRMEDS3",155,0)
- . I $D(MED(10,1)) D  ;
-"RTN","CCRMEDS3",156,0)
- . . S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
-"RTN","CCRMEDS3",157,0)
- . E  S @MAP@("MEDPTINSTRUCTIONS")=""
-"RTN","CCRMEDS3",158,0)
- . I $D(MED(14,1)) D  ;
-"RTN","CCRMEDS3",159,0)
- . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
-"RTN","CCRMEDS3",160,0)
- . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
-"RTN","CCRMEDS3",161,0)
- . S @MAP@("MEDRFNO")=""
-"RTN","CCRMEDS3",162,0)
- . N RESULT S RESULT=$NA(^TMP("GPLCCR",$J,"MAPPED"))
-"RTN","CCRMEDS3",163,0)
- . K @RESULT
-"RTN","CCRMEDS3",164,0)
- . D MAP^GPLXPATH(MINXML,MAP,RESULT)
-"RTN","CCRMEDS3",165,0)
- . ; D PARY^GPLXPATH(RESULT)
-"RTN","CCRMEDS3",166,0)
- . ; MAPPING DIRECTIONS
-"RTN","CCRMEDS3",167,0)
- . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-"RTN","CCRMEDS3",168,0)
- . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-"RTN","CCRMEDS3",169,0)
- . D QUERY^GPLXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-"RTN","CCRMEDS3",170,0)
- . D REPLACE^GPLXPATH(RESULT,"","//Medications/Medication/Directions")
-"RTN","CCRMEDS3",171,0)
- . ; N MDZ1,MDZNA
-"RTN","CCRMEDS3",172,0)
- . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-"RTN","CCRMEDS3",173,0)
- . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-"RTN","CCRMEDS3",174,0)
- . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-"RTN","CCRMEDS3",175,0)
- . . . D MAP^GPLXPATH(DIRXML1,MDZNA,DIRXML2)
-"RTN","CCRMEDS3",176,0)
- . . . D INSERT^GPLXPATH(RESULT,DIRXML2,"//Medications/Medication")
-"RTN","CCRMEDS3",177,0)
- . I MEDFIRST D  ;
-"RTN","CCRMEDS3",178,0)
- . . S MEDFIRST=0 ; RESET FIRST FLAG
-"RTN","CCRMEDS3",179,0)
- . . D CP^GPLXPATH(RESULT,OUTXML) ; First one is a copy
-"RTN","CCRMEDS3",180,0)
- . D:'MEDFIRST INSINNER^GPLXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
-"RTN","CCRMEDS3",181,0)
- N MEDTMP,MEDI
-"RTN","CCRMEDS3",182,0)
- D MISSING^GPLXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","CCRMEDS3",183,0)
- I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","CCRMEDS3",184,0)
- . W "MEDICATION MISSING ",!
-"RTN","CCRMEDS3",185,0)
- . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-"RTN","CCRMEDS3",186,0)
- Q
-"RTN","CCRMEDS3",187,0)
- ;
-"RTN","CCRSYS")
-0^4^B5866233
-"RTN","CCRSYS",1,0)
-CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
-"RTN","CCRSYS",2,0)
-        ;;0.1;CCDCCR;;;Build 14
-"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 DFN="" Q 0  ; BAD DFN PASSED
-"RTN","CCRSYS",41,0)
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-"RTN","CCRSYS",42,0)
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-"RTN","CCRSYS",43,0)
-         ;
-"RTN","CCRSYS",44,0)
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-"RTN","CCRSYS",45,0)
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-"RTN","CCRSYS",46,0)
-         N DIERR,DATA
-"RTN","CCRSYS",47,0)
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-"RTN","CCRSYS",48,0)
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-"RTN","CCRSYS",49,0)
-         ; 1 = Test Patient
-"RTN","CCRSYS",50,0)
-         ; 0 = Non-test Patient
-"RTN","CCRSYS",51,0)
-         I DATA Q DATA
-"RTN","CCRSYS",52,0)
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-"RTN","CCRSYS",53,0)
-         D CLEAN^DILF
-"RTN","CCRSYS",54,0)
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-"RTN","CCRSYS",55,0)
-         I $E(DATA,1,3)="000" Q 1
-"RTN","CCRSYS",56,0)
-         I $E(DATA,1,3)="666" Q 1
-"RTN","CCRSYS",57,0)
-         Q 0
-"RTN","CCRSYS",58,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 14
-"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)
-        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
-"RTN","CCRUNIT",12,0)
-        W "XPATH is: "_XPATH,!
-"RTN","CCRUNIT",13,0)
-        W "Getting Med Template into MINXML using",!
-"RTN","CCRUNIT",14,0)
-        W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!!
-"RTN","CCRUNIT",15,0)
-        D QUERY^GPLXPATH(T,XPATH,"MINXML")
-"RTN","CCRUNIT",16,0)
-  W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",!
-"RTN","CCRUNIT",17,0)
-        W "OUTXML will be ^TMP($J,""OUT"")",!
-"RTN","CCRUNIT",18,0)
-        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
-"RTN","CCRUNIT",19,0)
-        D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML)
-"RTN","CCRUNIT",20,0)
-        Q
-"RTN","CCRUTIL")
-0^6^B11670240
-"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 14
-"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=V2(0) ; COUNTING NUMBER OF DATES
-"RTN","CCRUTIL",61,0)
- F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-"RTN","CCRUTIL",62,0)
- . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-"RTN","CCRUTIL",63,0)
- . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-"RTN","CCRUTIL",64,0)
- . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-"RTN","CCRUTIL",65,0)
- . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-"RTN","CCRUTIL",66,0)
- . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-"RTN","CCRUTIL",67,0)
- N ZG
-"RTN","CCRUTIL",68,0)
- S ZG=$Q(VSRT(""))
-"RTN","CCRUTIL",69,0)
- F  D  Q:ZG=""  ;
-"RTN","CCRUTIL",70,0)
- . ; W ZG,!
-"RTN","CCRUTIL",71,0)
- . D PUSH^GPLXPATH("V1",@ZG)
-"RTN","CCRUTIL",72,0)
- . S ZG=$Q(@ZG)
-"RTN","CCRUTIL",73,0)
- I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-"RTN","CCRUTIL",74,0)
- . N ZG2
-"RTN","CCRUTIL",75,0)
- . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-"RTN","CCRUTIL",76,0)
- . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-"RTN","CCRUTIL",77,0)
- . S ZG2(0)=V1(0)
-"RTN","CCRUTIL",78,0)
- . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-"RTN","CCRUTIL",79,0)
- Q ZCNT
-"RTN","CCRUTIL",80,0)
- ;
-"RTN","CCRUTIL",81,0)
-DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
-"RTN","CCRUTIL",82,0)
- ; RETURNS AN ARRAY RTN PASSED BY REFERENCE
-"RTN","CCRUTIL",83,0)
- ; THIS ROUTINE CAN BE USED AS AN RPC
-"RTN","CCRUTIL",84,0)
- ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
-"RTN","CCRUTIL",85,0)
- ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
-"RTN","CCRUTIL",86,0)
- ;
-"RTN","CCRUTIL",87,0)
- N LEXIEN
-"RTN","CCRUTIL",88,0)
- I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D  ; IEN FOUND FOR THIS DRUG
-"RTN","CCRUTIL",89,0)
- . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
-"RTN","CCRUTIL",90,0)
- . W LEXIEN,!
-"RTN","CCRUTIL",91,0)
- . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
-"RTN","CCRUTIL",92,0)
- . S RTN(0)=1 ; ONE THING RETURNED
-"RTN","CCRUTIL",93,0)
- E  S RTN(0)=0 ; NOT FOUND
-"RTN","CCRUTIL",94,0)
- Q
-"RTN","CCRUTIL",95,0)
- ;
-"RTN","CCRUTIL",96,0)
-DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
-"RTN","CCRUTIL",97,0)
- ;
-"RTN","CCRUTIL",98,0)
- N DARTN
-"RTN","CCRUTIL",99,0)
- D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
-"RTN","CCRUTIL",100,0)
- I DARTN(0)>0 D  ; GOT RESULTS
-"RTN","CCRUTIL",101,0)
- . W !,DARTN(1) ;PRINT THE SNOMED CODE
-"RTN","CCRUTIL",102,0)
- E  W !,"NOT FOUND",!
-"RTN","CCRUTIL",103,0)
- Q
-"RTN","CCRUTIL",104,0)
- ;
-"RTN","CCRUTIL",105,0)
-DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
-"RTN","CCRUTIL",106,0)
- ; ASSOCIATED SNOMED CODES
-"RTN","CCRUTIL",107,0)
- N DASTMP,DASIEN,DASNO
-"RTN","CCRUTIL",108,0)
- S DASTMP=""
-"RTN","CCRUTIL",109,0)
- F  S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
-"RTN","CCRUTIL",110,0)
- . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
-"RTN","CCRUTIL",111,0)
- . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
-"RTN","CCRUTIL",112,0)
- . W DASTMP,"=",DASNO,! ; PRINT IT OUT
-"RTN","CCRUTIL",113,0)
- Q
-"RTN","CCRUTIL",114,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 14
-"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^16^B53216743
-"RTN","GPLACTOR",1,0)
-GPLACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
-"RTN","GPLACTOR",2,0)
- ;;0.4;CCDCCR;nopatch;noreleasedate;Build 14
-"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)
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
-"RTN","GPLACTOR",27,0)
- ;
-"RTN","GPLACTOR",28,0)
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-"RTN","GPLACTOR",29,0)
- ; IPXML is the Input Actor Template into which we  substitute values
-"RTN","GPLACTOR",30,0)
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
-"RTN","GPLACTOR",31,0)
- ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
-"RTN","GPLACTOR",32,0)
- ; ^TMP(7542,1,"ACTORS",0)=Count
-"RTN","GPLACTOR",33,0)
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-"RTN","GPLACTOR",34,0)
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-"RTN","GPLACTOR",35,0)
- ; AXML is the output arrary, to contain XML.
-"RTN","GPLACTOR",36,0)
- ;
-"RTN","GPLACTOR",37,0)
- N I,J,AMAP,AOID,ATYP,AIEN
-"RTN","GPLACTOR",38,0)
- D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-"RTN","GPLACTOR",39,0)
- D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-"RTN","GPLACTOR",40,0)
- I DEBUG W "PROCESSING ACTORS ",!
-"RTN","GPLACTOR",41,0)
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
-"RTN","GPLACTOR",42,0)
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",43,0)
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-"RTN","GPLACTOR",44,0)
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-"RTN","GPLACTOR",45,0)
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-"RTN","GPLACTOR",46,0)
- . I ATYP="" Q  ; NOT A VALID ACTOR
-"RTN","GPLACTOR",47,0)
- . ;
-"RTN","GPLACTOR",48,0)
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
-"RTN","GPLACTOR",49,0)
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
-"RTN","GPLACTOR",50,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-"RTN","GPLACTOR",51,0)
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",52,0)
- . ;
-"RTN","GPLACTOR",53,0)
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
-"RTN","GPLACTOR",54,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-"RTN","GPLACTOR",55,0)
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",56,0)
- . ;
-"RTN","GPLACTOR",57,0)
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
-"RTN","GPLACTOR",58,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-"RTN","GPLACTOR",59,0)
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",60,0)
- . ;
-"RTN","GPLACTOR",61,0)
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",62,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-"RTN","GPLACTOR",63,0)
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",64,0)
- . ;
-"RTN","GPLACTOR",65,0)
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
-"RTN","GPLACTOR",66,0)
- . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-"RTN","GPLACTOR",67,0)
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
-"RTN","GPLACTOR",68,0)
- . ;
-"RTN","GPLACTOR",69,0)
- . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-"RTN","GPLACTOR",70,0)
- . K ATYP,AIEN,AOID ; BE SURE TO GET THE NEXT ONE
-"RTN","GPLACTOR",71,0)
- ;
-"RTN","GPLACTOR",72,0)
- N ACTTMP
-"RTN","GPLACTOR",73,0)
- D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLACTOR",74,0)
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLACTOR",75,0)
- . ; STRINGS MARKED AS @@X@@
-"RTN","GPLACTOR",76,0)
- . W "ACTORS Missing list: ",!
-"RTN","GPLACTOR",77,0)
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
-"RTN","GPLACTOR",78,0)
- Q
-"RTN","GPLACTOR",79,0)
- ;
-"RTN","GPLACTOR",80,0)
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-"RTN","GPLACTOR",81,0)
- I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
-"RTN","GPLACTOR",82,0)
- N AMAP,ZX
-"RTN","GPLACTOR",83,0)
- S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",84,0)
- K @AMAP
-"RTN","GPLACTOR",85,0)
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",86,0)
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
-"RTN","GPLACTOR",87,0)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
-"RTN","GPLACTOR",88,0)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
-"RTN","GPLACTOR",89,0)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
-"RTN","GPLACTOR",90,0)
- S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
-"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(AIEN)
-"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(AIEN)
-"RTN","GPLACTOR",100,0)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
-"RTN","GPLACTOR",101,0)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
-"RTN","GPLACTOR",102,0)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
-"RTN","GPLACTOR",103,0)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
-"RTN","GPLACTOR",104,0)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
-"RTN","GPLACTOR",105,0)
- S @AMAP@("ACTORRESTEL")=""
-"RTN","GPLACTOR",106,0)
- S @AMAP@("ACTORRESTELTEXT")=""
-"RTN","GPLACTOR",107,0)
- S ZX=$$RESTEL^CCRDPT(AIEN)
-"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(AIEN)
-"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(AIEN)
-"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(AIEN)
-"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 MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",129,0)
- Q
-"RTN","GPLACTOR",130,0)
- ;
-"RTN","GPLACTOR",131,0)
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-"RTN","GPLACTOR",132,0)
-     ;
-"RTN","GPLACTOR",133,0)
-     ; N AMAP
-"RTN","GPLACTOR",134,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",135,0)
-     K @AMAP
-"RTN","GPLACTOR",136,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",137,0)
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
-"RTN","GPLACTOR",138,0)
-         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
-"RTN","GPLACTOR",139,0)
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-"RTN","GPLACTOR",140,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",141,0)
-     Q
-"RTN","GPLACTOR",142,0)
-     ;
-"RTN","GPLACTOR",143,0)
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-"RTN","GPLACTOR",144,0)
-     ;
-"RTN","GPLACTOR",145,0)
-     ; N AMAP
-"RTN","GPLACTOR",146,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",147,0)
-     K @AMAP
-"RTN","GPLACTOR",148,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",149,0)
-     S @AMAP@("ACTORDISPLAYNAME")=""
-"RTN","GPLACTOR",150,0)
-     S @AMAP@("ACTORRELATION")=""
-"RTN","GPLACTOR",151,0)
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-"RTN","GPLACTOR",152,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",153,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",154,0)
-     Q
-"RTN","GPLACTOR",155,0)
-     ;
-"RTN","GPLACTOR",156,0)
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-"RTN","GPLACTOR",157,0)
-     ;
-"RTN","GPLACTOR",158,0)
-     ; N AMAP
-"RTN","GPLACTOR",159,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",160,0)
-     K @AMAP
-"RTN","GPLACTOR",161,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",162,0)
-     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
-"RTN","GPLACTOR",163,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",164,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",165,0)
-     Q
-"RTN","GPLACTOR",166,0)
-     ;
-"RTN","GPLACTOR",167,0)
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-"RTN","GPLACTOR",168,0)
-     ;
-"RTN","GPLACTOR",169,0)
-     ; N AMAP
-"RTN","GPLACTOR",170,0)
-     S AMAP=$NA(^TMP($J,"AMAP"))
-"RTN","GPLACTOR",171,0)
-     K @AMAP
-"RTN","GPLACTOR",172,0)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-"RTN","GPLACTOR",173,0)
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
-"RTN","GPLACTOR",174,0)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",175,0)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
-"RTN","GPLACTOR",176,0)
-         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
-"RTN","GPLACTOR",177,0)
-         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
-"RTN","GPLACTOR",178,0)
-         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
-"RTN","GPLACTOR",179,0)
-         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
-"RTN","GPLACTOR",180,0)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
-"RTN","GPLACTOR",181,0)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",182,0)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
-"RTN","GPLACTOR",183,0)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
-"RTN","GPLACTOR",184,0)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
-"RTN","GPLACTOR",185,0)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
-"RTN","GPLACTOR",186,0)
-     S @AMAP@("ACTORTELEPHONE")=""
-"RTN","GPLACTOR",187,0)
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-"RTN","GPLACTOR",188,0)
-     S ZX=$$TEL^CCRVA200(AIEN)
-"RTN","GPLACTOR",189,0)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-"RTN","GPLACTOR",190,0)
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-"RTN","GPLACTOR",191,0)
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
-"RTN","GPLACTOR",192,0)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
-"RTN","GPLACTOR",193,0)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-"RTN","GPLACTOR",194,0)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-"RTN","GPLACTOR",195,0)
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-"RTN","GPLACTOR",196,0)
-     Q
-"RTN","GPLACTOR",197,0)
-     ;
-"RTN","GPLALERT")
-0^19^B22007040
-"RTN","GPLALERT",1,0)
-GPLALERT  ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
-"RTN","GPLALERT",2,0)
- ;;0.1;CCDCCR;;SEP 11,2008;Build 14
-"RTN","GPLALERT",3,0)
- ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","GPLALERT",4,0)
- ;General Public License See attached copy of the License.
-"RTN","GPLALERT",5,0)
- ;
-"RTN","GPLALERT",6,0)
- ;This program is free software; you can redistribute it and/or modify
-"RTN","GPLALERT",7,0)
- ;it under the terms of the GNU General Public License as published by
-"RTN","GPLALERT",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
-"RTN","GPLALERT",9,0)
- ;(at your option) any later version.
-"RTN","GPLALERT",10,0)
- ;
-"RTN","GPLALERT",11,0)
- ;This program is distributed in the hope that it will be useful,
-"RTN","GPLALERT",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","GPLALERT",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","GPLALERT",14,0)
- ;GNU General Public License for more details.
-"RTN","GPLALERT",15,0)
- ;
-"RTN","GPLALERT",16,0)
- ;You should have received a copy of the GNU General Public License along
-"RTN","GPLALERT",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","GPLALERT",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","GPLALERT",19,0)
- ;
-"RTN","GPLALERT",20,0)
- W "NO ENTRY FROM TOP",!
-"RTN","GPLALERT",21,0)
- Q
-"RTN","GPLALERT",22,0)
- ;
-"RTN","GPLALERT",23,0)
-EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
-"RTN","GPLALERT",24,0)
- ;
-"RTN","GPLALERT",25,0)
- ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","GPLALERT",26,0)
- ;
-"RTN","GPLALERT",27,0)
- ; GET ADVERSE REACTIONS AND ALLERGIES
-"RTN","GPLALERT",28,0)
- ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
-"RTN","GPLALERT",29,0)
- S GMRA="0^0^111"
-"RTN","GPLALERT",30,0)
- D EN1^GMRADPT
-"RTN","GPLALERT",31,0)
- I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
-"RTN","GPLALERT",32,0)
- . S @ALTOUTXML@(0)=0
-"RTN","GPLALERT",33,0)
- ; DEFINE MAPPING
-"RTN","GPLALERT",34,0)
- N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
-"RTN","GPLALERT",35,0)
- S ALTTVMAP=$NA(^TMP("GPLALERT",$J,"ALERTS"))
-"RTN","GPLALERT",36,0)
- S ALTTARYTMP=$NA(^TMP("GPLALERT",$J,"ALERTSARYTMP"))
-"RTN","GPLALERT",37,0)
- K @ALTTVMAP,@ALTTARYTMP
-"RTN","GPLALERT",38,0)
- N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
-"RTN","GPLALERT",39,0)
- S ALTTMP="" ;
-"RTN","GPLALERT",40,0)
- F  S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP=""  D  ; CHANGED TO $O BY GPL
-"RTN","GPLALERT",41,0)
- . W "ALTTMP="_ALTTMP,!
-"RTN","GPLALERT",42,0)
- . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
-"RTN","GPLALERT",43,0)
- . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
-"RTN","GPLALERT",44,0)
- . K @ALTVMAP
-"RTN","GPLALERT",45,0)
- . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
-"RTN","GPLALERT",46,0)
- . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
-"RTN","GPLALERT",47,0)
- . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
-"RTN","GPLALERT",48,0)
- . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
-"RTN","GPLALERT",49,0)
- . N ADT S ADT="Patient has an " ; X $ZINT H 5
-"RTN","GPLALERT",50,0)
- . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
-"RTN","GPLALERT",51,0)
- . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
-"RTN","GPLALERT",52,0)
- . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
-"RTN","GPLALERT",53,0)
- . N ALTCDE ; SNOMED CODE THE THE ALERT
-"RTN","GPLALERT",54,0)
- . S ALTCDE=$S(A2="P":"282100009",A2="A":"418634005",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
-"RTN","GPLALERT",55,0)
- . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
-"RTN","GPLALERT",56,0)
- . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
-"RTN","GPLALERT",57,0)
- . ; AND  282100009 FOR ADVERSE REACTION TO A SUBSTANCE
-"RTN","GPLALERT",58,0)
- . I ALTCDE'="" D  ; IF THERE IS A CODE
-"RTN","GPLALERT",59,0)
- . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
-"RTN","GPLALERT",60,0)
- . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
-"RTN","GPLALERT",61,0)
- . E  D  ; SET TO NULL
-"RTN","GPLALERT",62,0)
- . . S @ALTVMAP@("ALERTCODESYSTEM")=""
-"RTN","GPLALERT",63,0)
- . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
-"RTN","GPLALERT",64,0)
- . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
-"RTN","GPLALERT",65,0)
- . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
-"RTN","GPLALERT",66,0)
- . I ALTPROV'="" D  ; PROVIDER PROVIDEED
-"RTN","GPLALERT",67,0)
- . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
-"RTN","GPLALERT",68,0)
- . E  S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
-"RTN","GPLALERT",69,0)
- . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
-"RTN","GPLALERT",70,0)
- . N ACGL1,ACGFI,ACIEN,ACVUID
-"RTN","GPLALERT",71,0)
- . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
-"RTN","GPLALERT",72,0)
- . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
-"RTN","GPLALERT",73,0)
- . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
-"RTN","GPLALERT",74,0)
- . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
-"RTN","GPLALERT",75,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
-"RTN","GPLALERT",76,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
-"RTN","GPLALERT",77,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
-"RTN","GPLALERT",78,0)
- . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID
-"RTN","GPLALERT",79,0)
- . I ACVUID'="" D  ; IF VUID IS NOT NULL
-"RTN","GPLALERT",80,0)
- . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID"
-"RTN","GPLALERT",81,0)
- . E  D  ; IF REACTANT CODE VALUE IS NULL
-"RTN","GPLALERT",82,0)
- . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
-"RTN","GPLALERT",83,0)
- . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
-"RTN","GPLALERT",84,0)
- . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
-"RTN","GPLALERT",85,0)
- . N ARTMP,ARIEN,ARDES,ARVUID
-"RTN","GPLALERT",86,0)
- . S (ARTMP,ARDES,ARVUID)=""
-"RTN","GPLALERT",87,0)
- . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
-"RTN","GPLALERT",88,0)
- . . S ARTMP=@ALTG@(ALTTMP,"S",1)
-"RTN","GPLALERT",89,0)
- . . W "REACTION:",ARTMP,!
-"RTN","GPLALERT",90,0)
- . . S ARIEN=$P(ARTMP,";",2)
-"RTN","GPLALERT",91,0)
- . . S ARDES=$P(ARTMP,";",1)
-"RTN","GPLALERT",92,0)
- . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
-"RTN","GPLALERT",93,0)
- . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
-"RTN","GPLALERT",94,0)
- . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
-"RTN","GPLALERT",95,0)
- . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
-"RTN","GPLALERT",96,0)
- . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
-"RTN","GPLALERT",97,0)
- . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
-"RTN","GPLALERT",98,0)
- . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
-"RTN","GPLALERT",99,0)
- . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
-"RTN","GPLALERT",100,0)
- . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
-"RTN","GPLALERT",101,0)
- . K @ALTARYTMP
-"RTN","GPLALERT",102,0)
- . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
-"RTN","GPLALERT",103,0)
- . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)
-"RTN","GPLALERT",104,0)
- . I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP)
-"RTN","GPLALERT",105,0)
- . S ALTCNT=ALTCNT+1
-"RTN","GPLALERT",106,0)
- S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
-"RTN","GPLALERT",107,0)
- Q
-"RTN","GPLALERT",108,0)
-PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
-"RTN","GPLALERT",109,0)
- ; INGLB IS OF THE FORM: PSNDF(50.6,
-"RTN","GPLALERT",110,0)
- ; RETURN 50.6
-"RTN","GPLALERT",111,0)
- Q $P($P(INGLB,"(",2),",",1)  ;
-"RTN","GPLCCD")
-0^8^B114413975
-"RTN","GPLCCD",1,0)
-GPLCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
-"RTN","GPLCCD",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 14
-"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^15^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 14
-"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^13^B81968343
-"RTN","GPLCCR",1,0)
-GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-"RTN","GPLCCR",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 14
-"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,UDIR,UFN
-"RTN","GPLCCR",34,0)
-       I '$D(DIR) S UDIR=""
-"RTN","GPLCCR",35,0)
-       E  S UDIR=DIR
-"RTN","GPLCCR",36,0)
-       I '$D(FN) S UFN=""
-"RTN","GPLCCR",37,0)
-       E  S UFN=FN
-"RTN","GPLCCR",38,0)
-       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-"RTN","GPLCCR",39,0)
-       S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
-"RTN","GPLCCR",40,0)
-       S ONAM=UFN
-"RTN","GPLCCR",41,0)
-       I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_5.xml"
-"RTN","GPLCCR",42,0)
-       S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
-"RTN","GPLCCR",43,0)
-       I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
-"RTN","GPLCCR",44,0)
-       . ;S @ODIRGLB="/home/glilly/CCROUT"
-"RTN","GPLCCR",45,0)
-       . ;S @ODIRGLB="/home/cedwards/"
-"RTN","GPLCCR",46,0)
-       . S @ODIRGLB="/opt/wv/p/"
-"RTN","GPLCCR",47,0)
-       S ODIR=UDIR
-"RTN","GPLCCR",48,0)
-       I UDIR="" S ODIR=@ODIRGLB
-"RTN","GPLCCR",49,0)
-       N ZY
-"RTN","GPLCCR",50,0)
-       S ZY=$$OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-"RTN","GPLCCR",51,0)
-       W !,$P(ZY,U,2),!
-"RTN","GPLCCR",52,0)
-       Q
-"RTN","GPLCCR",53,0)
-       ;
-"RTN","GPLCCR",54,0)
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
-"RTN","GPLCCR",55,0)
-    ;
-"RTN","GPLCCR",56,0)
-    N G1
-"RTN","GPLCCR",57,0)
-    S G1=$NA(^TMP("GPLCCR",$J,DFN,"CCR"))
-"RTN","GPLCCR",58,0)
-    I $D(@G1@(0)) D  ; CCR EXISTS
-"RTN","GPLCCR",59,0)
-    . D PARY^GPLXPATH(G1)
-"RTN","GPLCCR",60,0)
-    E  W "CCR NOT CREATED, RUN D XPAT^GPLCCR(DFN,"""","""") FIRST",!
-"RTN","GPLCCR",61,0)
-    Q
-"RTN","GPLCCR",62,0)
-    ;
-"RTN","GPLCCR",63,0)
-CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-"RTN","GPLCCR",64,0)
-    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-"RTN","GPLCCR",65,0)
-    ; DFN IS PATIENT IEN
-"RTN","GPLCCR",66,0)
-    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-"RTN","GPLCCR",67,0)
-    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-"RTN","GPLCCR",68,0)
-    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-"RTN","GPLCCR",69,0)
-    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-"RTN","GPLCCR",70,0)
-    ; - NULL MEANS NOW
-"RTN","GPLCCR",71,0)
-    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-"RTN","GPLCCR",72,0)
-    ;    "TO" VARIABLES
-"RTN","GPLCCR",73,0)
-    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-"RTN","GPLCCR",74,0)
-    I '$D(DEBUG) S DEBUG=0
-"RTN","GPLCCR",75,0)
-    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
-"RTN","GPLCCR",76,0)
-    I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
-"RTN","GPLCCR",77,0)
-    I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
-"RTN","GPLCCR",78,0)
-    I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
-"RTN","GPLCCR",79,0)
-    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-"RTN","GPLCCR",80,0)
-    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-"RTN","GPLCCR",81,0)
-    S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
-"RTN","GPLCCR",82,0)
-    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-"RTN","GPLCCR",83,0)
-    S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-"RTN","GPLCCR",84,0)
-    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-"RTN","GPLCCR",85,0)
-    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-"RTN","GPLCCR",86,0)
-    ;
-"RTN","GPLCCR",87,0)
-    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-"RTN","GPLCCR",88,0)
-    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-"RTN","GPLCCR",89,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",90,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",91,0)
-    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-"RTN","GPLCCR",92,0)
-    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-"RTN","GPLCCR",93,0)
-    ;
-"RTN","GPLCCR",94,0)
-    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-"RTN","GPLCCR",95,0)
-    ;
-"RTN","GPLCCR",96,0)
-    K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-"RTN","GPLCCR",97,0)
-    S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
-"RTN","GPLCCR",98,0)
-    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-"RTN","GPLCCR",99,0)
-    N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-"RTN","GPLCCR",100,0)
-    F PROCI=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-"RTN","GPLCCR",101,0)
-    . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
-"RTN","GPLCCR",102,0)
-    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-"RTN","GPLCCR",103,0)
-    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-"RTN","GPLCCR",104,0)
-    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-"RTN","GPLCCR",105,0)
-    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-"RTN","GPLCCR",106,0)
-    . S IXML="INXML"
-"RTN","GPLCCR",107,0)
-    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-"RTN","GPLCCR",108,0)
-    . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
-"RTN","GPLCCR",109,0)
-    . ; W OXML,!
-"RTN","GPLCCR",110,0)
-    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-"RTN","GPLCCR",111,0)
-    . I DEBUG W "RUNNING ",CALL,!
-"RTN","GPLCCR",112,0)
-    . X CALL
-"RTN","GPLCCR",113,0)
-    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-"RTN","GPLCCR",114,0)
-    . I @OXML@(0)'=0 D  ; THERE IS A RESULT
-"RTN","GPLCCR",115,0)
-    . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-"RTN","GPLCCR",116,0)
-    . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-"RTN","GPLCCR",117,0)
-    N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
-"RTN","GPLCCR",118,0)
-    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-"RTN","GPLCCR",119,0)
-    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-"RTN","GPLCCR",120,0)
-    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
-"RTN","GPLCCR",121,0)
-    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
-"RTN","GPLCCR",122,0)
-    N TRIMI,J,DONE S DONE=0
-"RTN","GPLCCR",123,0)
-    F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
-"RTN","GPLCCR",124,0)
-    . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
-"RTN","GPLCCR",125,0)
-    . I DEBUG W "TRIMMED",J,!
-"RTN","GPLCCR",126,0)
-    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
-"RTN","GPLCCR",127,0)
-    Q
-"RTN","GPLCCR",128,0)
-    ;
-"RTN","GPLCCR",129,0)
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
-"RTN","GPLCCR",130,0)
-    ; TAB IS PASSED BY NAME
-"RTN","GPLCCR",131,0)
-    I DEBUG W "TAB= ",TAB,!
-"RTN","GPLCCR",132,0)
-    ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
-"RTN","GPLCCR",133,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
-"RTN","GPLCCR",134,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-"RTN","GPLCCR",135,0)
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
-"RTN","GPLCCR",136,0)
-    I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
-"RTN","GPLCCR",137,0)
-    I TESTALERT D PUSH^GPLXPATH(TAB,"EXTRACT;GPLALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""GPLCCR"",$J,DFN,""ALERTS"")")
-"RTN","GPLCCR",138,0)
-    Q
-"RTN","GPLCCR",139,0)
-    ;
-"RTN","GPLCCR",140,0)
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-"RTN","GPLCCR",141,0)
-    N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
-"RTN","GPLCCR",142,0)
-    ; K @VMAP
-"RTN","GPLCCR",143,0)
-    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
-"RTN","GPLCCR",144,0)
-    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-"RTN","GPLCCR",145,0)
-    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-"RTN","GPLCCR",146,0)
-    . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
-"RTN","GPLCCR",147,0)
-    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
-"RTN","GPLCCR",148,0)
-    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
-"RTN","GPLCCR",149,0)
-    . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",150,0)
-    . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
-"RTN","GPLCCR",151,0)
-    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-"RTN","GPLCCR",152,0)
-    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-"RTN","GPLCCR",153,0)
-    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-"RTN","GPLCCR",154,0)
-    N CTMP
-"RTN","GPLCCR",155,0)
-    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-"RTN","GPLCCR",156,0)
-    D CP^GPLXPATH("CTMP",CXML)
-"RTN","GPLCCR",157,0)
-    Q
-"RTN","GPLCCR",158,0)
-    ;
-"RTN","GPLCCR",159,0)
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-"RTN","GPLCCR",160,0)
-    ; AXML AND ACTRTN ARE PASSED BY NAME
-"RTN","GPLCCR",161,0)
-    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-"RTN","GPLCCR",162,0)
-    ; P1= OBJECTID - ACTORPATIENT_2
-"RTN","GPLCCR",163,0)
-    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-"RTN","GPLCCR",164,0)
-    ;OR INSTITUTION
-"RTN","GPLCCR",165,0)
-    ;  OR PERSON(IN PATIENT FILE IE NOK)
-"RTN","GPLCCR",166,0)
-    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-"RTN","GPLCCR",167,0)
-    N I,J,K,L
-"RTN","GPLCCR",168,0)
-    K @ACTRTN ; CLEAR RETURN ARRAY
-"RTN","GPLCCR",169,0)
-    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-"RTN","GPLCCR",170,0)
-    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-"RTN","GPLCCR",171,0)
-    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-"RTN","GPLCCR",172,0)
-    . . I DEBUG W "<ActorID>=>",J,!
-"RTN","GPLCCR",173,0)
-    . . I J'="" S K(J)="" ; HASHING ACTOR
-"RTN","GPLCCR",174,0)
-    . . ;  TO GET RID OF DUPLICATES
-"RTN","GPLCCR",175,0)
-    S I="" ; GOING TO $O THROUGH THE HASH
-"RTN","GPLCCR",176,0)
-    F J=0:0 D  Q:$O(K(I))=""
-"RTN","GPLCCR",177,0)
-    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-"RTN","GPLCCR",178,0)
-    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-"RTN","GPLCCR",179,0)
-    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-"RTN","GPLCCR",180,0)
-    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-"RTN","GPLCCR",181,0)
-    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-"RTN","GPLCCR",182,0)
-    Q
-"RTN","GPLCCR",183,0)
-    ;
-"RTN","GPLCCR",184,0)
-TEST ; RUN ALL THE TEST CASES
-"RTN","GPLCCR",185,0)
-  D TESTALL^GPLUNIT("GPLCCR")
-"RTN","GPLCCR",186,0)
-  Q
-"RTN","GPLCCR",187,0)
-  ;
-"RTN","GPLCCR",188,0)
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
-"RTN","GPLCCR",189,0)
-  N ZTMP
-"RTN","GPLCCR",190,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",191,0)
-  D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLCCR",192,0)
-  Q
-"RTN","GPLCCR",193,0)
-  ;
-"RTN","GPLCCR",194,0)
-TLIST  ; LIST THE TESTS
-"RTN","GPLCCR",195,0)
-  N ZTMP
-"RTN","GPLCCR",196,0)
-  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-"RTN","GPLCCR",197,0)
-  D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLCCR",198,0)
-  Q
-"RTN","GPLCCR",199,0)
-  ;
-"RTN","GPLCCR",200,0)
- ;;><TEST>
-"RTN","GPLCCR",201,0)
- ;;><PROBLEMS>
-"RTN","GPLCCR",202,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",203,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
-"RTN","GPLCCR",204,0)
- ;;>>?@GPL@(@GPL@(0))["</Problems>"
-"RTN","GPLCCR",205,0)
- ;;><VITALS>
-"RTN","GPLCCR",206,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",207,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
-"RTN","GPLCCR",208,0)
- ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
-"RTN","GPLCCR",209,0)
- ;;><CCR>
-"RTN","GPLCCR",210,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",211,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",212,0)
- ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
-"RTN","GPLCCR",213,0)
- ;;><ACTLST>
-"RTN","GPLCCR",214,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",215,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
-"RTN","GPLCCR",216,0)
- ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
-"RTN","GPLCCR",217,0)
- ;;><ACTORS>
-"RTN","GPLCCR",218,0)
- ;;>>>D ZTEST^GPLCCR("ACTLST")
-"RTN","GPLCCR",219,0)
- ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
-"RTN","GPLCCR",220,0)
- ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
-"RTN","GPLCCR",221,0)
- ;;>>?G3(G3(0))["</Actors>"
-"RTN","GPLCCR",222,0)
- ;;><TRIM>
-"RTN","GPLCCR",223,0)
- ;;>>>D ZTEST^GPLCCR("CCR")
-"RTN","GPLCCR",224,0)
- ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
-"RTN","GPLCCR",225,0)
- ;;><ALERTS>
-"RTN","GPLCCR",226,0)
- ;;>>>S TESTALERT=1
-"RTN","GPLCCR",227,0)
- ;;>>>K GPL S GPL=""
-"RTN","GPLCCR",228,0)
- ;;>>>D CCRRPC^GPLCCR(.GPL,"2","ALERTS","","","")
-"RTN","GPLCCR",229,0)
- ;;>>?@GPL@(@GPL@(0))["</Alerts>"
-"RTN","GPLCCR",230,0)
- 
-"RTN","GPLCCR0")
-0^14^B654420916
-"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 14
-"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)
- ;;<Text>@@MEDFREQUENCYVALUE@@</Text>
-"RTN","GPLCCR0",368,0)
- ;;</Frequency>
-"RTN","GPLCCR0",369,0)
- ;;<Interval>
-"RTN","GPLCCR0",370,0)
- ;;<Value>@@MEDINTERVALVALUE@@</Value>
-"RTN","GPLCCR0",371,0)
- ;;<Units>
-"RTN","GPLCCR0",372,0)
- ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
-"RTN","GPLCCR0",373,0)
- ;;</Units>
-"RTN","GPLCCR0",374,0)
- ;;</Interval>
-"RTN","GPLCCR0",375,0)
- ;;<Duration>
-"RTN","GPLCCR0",376,0)
- ;;<Value>@@MEDDURATIONVALUE@@</Value>
-"RTN","GPLCCR0",377,0)
- ;;<Units>
-"RTN","GPLCCR0",378,0)
- ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
-"RTN","GPLCCR0",379,0)
- ;;</Units>
-"RTN","GPLCCR0",380,0)
- ;;</Duration>
-"RTN","GPLCCR0",381,0)
- ;;<Indication>
-"RTN","GPLCCR0",382,0)
- ;;<PRNFlag>
-"RTN","GPLCCR0",383,0)
- ;;<Text>@@MEDPRNFLAG@@</Text>
-"RTN","GPLCCR0",384,0)
- ;;</PRNFlag>
-"RTN","GPLCCR0",385,0)
- ;;<Problem>
-"RTN","GPLCCR0",386,0)
- ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",387,0)
- ;;<Type>
-"RTN","GPLCCR0",388,0)
- ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
-"RTN","GPLCCR0",389,0)
- ;;</Type>
-"RTN","GPLCCR0",390,0)
- ;;<Description>
-"RTN","GPLCCR0",391,0)
- ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
-"RTN","GPLCCR0",392,0)
- ;;<Code>
-"RTN","GPLCCR0",393,0)
- ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
-"RTN","GPLCCR0",394,0)
- ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",395,0)
- ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
-"RTN","GPLCCR0",396,0)
- ;;</Code>
-"RTN","GPLCCR0",397,0)
- ;;</Description>
-"RTN","GPLCCR0",398,0)
- ;;<Source>
-"RTN","GPLCCR0",399,0)
- ;;<Actor>
-"RTN","GPLCCR0",400,0)
- ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",401,0)
- ;;</Actor>
-"RTN","GPLCCR0",402,0)
- ;;</Source>
-"RTN","GPLCCR0",403,0)
- ;;</Problem>
-"RTN","GPLCCR0",404,0)
- ;;</Indication>
-"RTN","GPLCCR0",405,0)
- ;;<StopIndicator>
-"RTN","GPLCCR0",406,0)
- ;;<Text>@@MEDSTOPINDICATOR@@</Text>
-"RTN","GPLCCR0",407,0)
- ;;</StopIndicator>
-"RTN","GPLCCR0",408,0)
- ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
-"RTN","GPLCCR0",409,0)
- ;;<MultipleDirectionModifier>
-"RTN","GPLCCR0",410,0)
- ;;<Text>@@MEDMULDIRMOD@@</Text>
-"RTN","GPLCCR0",411,0)
- ;;</MultipleDirectionModifier>
-"RTN","GPLCCR0",412,0)
- ;;</Direction>
-"RTN","GPLCCR0",413,0)
- ;;</Directions>
-"RTN","GPLCCR0",414,0)
- ;;<PatientInstructions>
-"RTN","GPLCCR0",415,0)
- ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",416,0)
- ;;</PatientInstructions>
-"RTN","GPLCCR0",417,0)
- ;;<FullfillmentInstructions>
-"RTN","GPLCCR0",418,0)
- ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
-"RTN","GPLCCR0",419,0)
- ;;</FullfillmentInstructions>
-"RTN","GPLCCR0",420,0)
- ;;<Refills>
-"RTN","GPLCCR0",421,0)
- ;;<Refill>
-"RTN","GPLCCR0",422,0)
- ;;<Number>@@MEDRFNO@@</Number>
-"RTN","GPLCCR0",423,0)
- ;;</Refill>
-"RTN","GPLCCR0",424,0)
- ;;</Refills>
-"RTN","GPLCCR0",425,0)
- ;;</Medication>
-"RTN","GPLCCR0",426,0)
- ;;</Medications>
-"RTN","GPLCCR0",427,0)
- ;;<VitalSigns>
-"RTN","GPLCCR0",428,0)
- ;;<Result>
-"RTN","GPLCCR0",429,0)
- ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",430,0)
- ;;<DateTime>
-"RTN","GPLCCR0",431,0)
- ;;<Type>
-"RTN","GPLCCR0",432,0)
- ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
-"RTN","GPLCCR0",433,0)
- ;;</Type>
-"RTN","GPLCCR0",434,0)
- ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",435,0)
- ;;</DateTime>
-"RTN","GPLCCR0",436,0)
- ;;<Description>
-"RTN","GPLCCR0",437,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",438,0)
- ;;</Description>
-"RTN","GPLCCR0",439,0)
- ;;<Source>
-"RTN","GPLCCR0",440,0)
- ;;<Actor>
-"RTN","GPLCCR0",441,0)
- ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",442,0)
- ;;</Actor>
-"RTN","GPLCCR0",443,0)
- ;;</Source>
-"RTN","GPLCCR0",444,0)
- ;;<Test>
-"RTN","GPLCCR0",445,0)
- ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",446,0)
- ;;<Type>
-"RTN","GPLCCR0",447,0)
- ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
-"RTN","GPLCCR0",448,0)
- ;;</Type>
-"RTN","GPLCCR0",449,0)
- ;;<Description>
-"RTN","GPLCCR0",450,0)
- ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",451,0)
- ;;<Code>
-"RTN","GPLCCR0",452,0)
- ;;<Value>@@VITALSIGNSDESCRIPTIONCODEVALUE@@</Value>
-"RTN","GPLCCR0",453,0)
- ;;<CodingSystem>@@VITALSIGNSDESCRIPTIONCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",454,0)
- ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
-"RTN","GPLCCR0",455,0)
- ;;</Code>
-"RTN","GPLCCR0",456,0)
- ;;</Description>
-"RTN","GPLCCR0",457,0)
- ;;<Source>
-"RTN","GPLCCR0",458,0)
- ;;<Actor>
-"RTN","GPLCCR0",459,0)
- ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",460,0)
- ;;</Actor>
-"RTN","GPLCCR0",461,0)
- ;;</Source>
-"RTN","GPLCCR0",462,0)
- ;;<TestResult>
-"RTN","GPLCCR0",463,0)
- ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
-"RTN","GPLCCR0",464,0)
- ;;<Units>
-"RTN","GPLCCR0",465,0)
- ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
-"RTN","GPLCCR0",466,0)
- ;;</Units>
-"RTN","GPLCCR0",467,0)
- ;;</TestResult>
-"RTN","GPLCCR0",468,0)
- ;;</Test>
-"RTN","GPLCCR0",469,0)
- ;;</Result>
-"RTN","GPLCCR0",470,0)
- ;;</VitalSigns>
-"RTN","GPLCCR0",471,0)
- ;;<Results>
-"RTN","GPLCCR0",472,0)
- ;;<Result>
-"RTN","GPLCCR0",473,0)
- ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",474,0)
- ;;<DateTime>
-"RTN","GPLCCR0",475,0)
- ;;<Type>
-"RTN","GPLCCR0",476,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",477,0)
- ;;</Type>
-"RTN","GPLCCR0",478,0)
- ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",479,0)
- ;;</DateTime>
-"RTN","GPLCCR0",480,0)
- ;;<Description>
-"RTN","GPLCCR0",481,0)
- ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",482,0)
- ;;<Code>
-"RTN","GPLCCR0",483,0)
- ;;<Value>@@RESULTCODE@@</Value>
-"RTN","GPLCCR0",484,0)
- ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",485,0)
- ;;</Code>
-"RTN","GPLCCR0",486,0)
- ;;</Description>
-"RTN","GPLCCR0",487,0)
- ;;<Status>
-"RTN","GPLCCR0",488,0)
- ;;<Text>@@RESULTSTATUS@@</Text>
-"RTN","GPLCCR0",489,0)
- ;;</Status>
-"RTN","GPLCCR0",490,0)
- ;;<Source>
-"RTN","GPLCCR0",491,0)
- ;;<Actor>
-"RTN","GPLCCR0",492,0)
- ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",493,0)
- ;;</Actor>
-"RTN","GPLCCR0",494,0)
- ;;</Source>
-"RTN","GPLCCR0",495,0)
- ;;<TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",496,0)
- ;;<Test>
-"RTN","GPLCCR0",497,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",498,0)
- ;;<DateTime>
-"RTN","GPLCCR0",499,0)
- ;;<Type>
-"RTN","GPLCCR0",500,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",501,0)
- ;;</Type>
-"RTN","GPLCCR0",502,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",503,0)
- ;;</DateTime>
-"RTN","GPLCCR0",504,0)
- ;;<Description>
-"RTN","GPLCCR0",505,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",506,0)
- ;;<Code>
-"RTN","GPLCCR0",507,0)
- ;;<Value>@@RESULTTESTCODE@@</Value>
-"RTN","GPLCCR0",508,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",509,0)
- ;;</Code>
-"RTN","GPLCCR0",510,0)
- ;;</Description>
-"RTN","GPLCCR0",511,0)
- ;;<Status>
-"RTN","GPLCCR0",512,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",513,0)
- ;;</Status>
-"RTN","GPLCCR0",514,0)
- ;;<Source>
-"RTN","GPLCCR0",515,0)
- ;;<Actor>
-"RTN","GPLCCR0",516,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",517,0)
- ;;</Actor>
-"RTN","GPLCCR0",518,0)
- ;;</Source>
-"RTN","GPLCCR0",519,0)
- ;;<TestResult>
-"RTN","GPLCCR0",520,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",521,0)
- ;;<Units>
-"RTN","GPLCCR0",522,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",523,0)
- ;;</Units>
-"RTN","GPLCCR0",524,0)
- ;;</TestResult>
-"RTN","GPLCCR0",525,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",526,0)
- ;;<Normal>
-"RTN","GPLCCR0",527,0)
- ;;<Description>
-"RTN","GPLCCR0",528,0)
- ;;<Text>@@RESULTTESTNORMALDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",529,0)
- ;;</Description>
-"RTN","GPLCCR0",530,0)
- ;;<Source>
-"RTN","GPLCCR0",531,0)
- ;;<Actor>
-"RTN","GPLCCR0",532,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",533,0)
- ;;</Actor>
-"RTN","GPLCCR0",534,0)
- ;;</Source>
-"RTN","GPLCCR0",535,0)
- ;;</Normal>
-"RTN","GPLCCR0",536,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",537,0)
- ;;<Flag>
-"RTN","GPLCCR0",538,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",539,0)
- ;;</Flag>
-"RTN","GPLCCR0",540,0)
- ;;</Test>
-"RTN","GPLCCR0",541,0)
- ;;</TEST_NORMALDESCRIPTION>
-"RTN","GPLCCR0",542,0)
- ;;<TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",543,0)
- ;;<Test>
-"RTN","GPLCCR0",544,0)
- ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
-"RTN","GPLCCR0",545,0)
- ;;<DateTime>
-"RTN","GPLCCR0",546,0)
- ;;<Type>
-"RTN","GPLCCR0",547,0)
- ;;<Text>Assessment Time</Text>
-"RTN","GPLCCR0",548,0)
- ;;</Type>
-"RTN","GPLCCR0",549,0)
- ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
-"RTN","GPLCCR0",550,0)
- ;;</DateTime>
-"RTN","GPLCCR0",551,0)
- ;;<Description>
-"RTN","GPLCCR0",552,0)
- ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
-"RTN","GPLCCR0",553,0)
- ;;<Code>
-"RTN","GPLCCR0",554,0)
- ;;<Value>@@RESULTTESTCODEVALUE@@</Value>
-"RTN","GPLCCR0",555,0)
- ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
-"RTN","GPLCCR0",556,0)
- ;;</Code>
-"RTN","GPLCCR0",557,0)
- ;;</Description>
-"RTN","GPLCCR0",558,0)
- ;;<Status>
-"RTN","GPLCCR0",559,0)
- ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
-"RTN","GPLCCR0",560,0)
- ;;</Status>
-"RTN","GPLCCR0",561,0)
- ;;<Source>
-"RTN","GPLCCR0",562,0)
- ;;<Actor>
-"RTN","GPLCCR0",563,0)
- ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",564,0)
- ;;</Actor>
-"RTN","GPLCCR0",565,0)
- ;;</Source>
-"RTN","GPLCCR0",566,0)
- ;;<TestResult>
-"RTN","GPLCCR0",567,0)
- ;;<Value>@@RESULTTESTVALUE@@</Value>
-"RTN","GPLCCR0",568,0)
- ;;<Units>
-"RTN","GPLCCR0",569,0)
- ;;<Unit>@@RESULTTESTUNITS@@</Unit>
-"RTN","GPLCCR0",570,0)
- ;;</Units>
-"RTN","GPLCCR0",571,0)
- ;;</TestResult>
-"RTN","GPLCCR0",572,0)
- ;;<NormalResult>
-"RTN","GPLCCR0",573,0)
- ;;<Normal>
-"RTN","GPLCCR0",574,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ1@@</Value>
-"RTN","GPLCCR0",575,0)
- ;;<Units>
-"RTN","GPLCCR0",576,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ1@@</Unit>
-"RTN","GPLCCR0",577,0)
- ;;</Units>
-"RTN","GPLCCR0",578,0)
- ;;<ValueSequencePosition>1</ValueSequencePosition>
-"RTN","GPLCCR0",579,0)
- ;;<Source>
-"RTN","GPLCCR0",580,0)
- ;;<Actor>
-"RTN","GPLCCR0",581,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",582,0)
- ;;</Actor>
-"RTN","GPLCCR0",583,0)
- ;;</Source>
-"RTN","GPLCCR0",584,0)
- ;;</Normal>
-"RTN","GPLCCR0",585,0)
- ;;<Normal>
-"RTN","GPLCCR0",586,0)
- ;;<Value>@@RESULTTESTNORMALVALUESEQ2@@</Value>
-"RTN","GPLCCR0",587,0)
- ;;<Units>
-"RTN","GPLCCR0",588,0)
- ;;<Unit>@@RESULTTESTNORMALUNITSEQ2@@</Unit>
-"RTN","GPLCCR0",589,0)
- ;;</Units>
-"RTN","GPLCCR0",590,0)
- ;;<ValueSequencePosition>2</ValueSequencePosition>
-"RTN","GPLCCR0",591,0)
- ;;<VariableNomalModifier>
-"RTN","GPLCCR0",592,0)
- ;;<Text>@@RESULTTESTNORMALMODIFIER@@</Text>
-"RTN","GPLCCR0",593,0)
- ;;</VariableNomalModifier>
-"RTN","GPLCCR0",594,0)
- ;;<Source>
-"RTN","GPLCCR0",595,0)
- ;;<Actor>
-"RTN","GPLCCR0",596,0)
- ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
-"RTN","GPLCCR0",597,0)
- ;;</Actor>
-"RTN","GPLCCR0",598,0)
- ;;</Source>
-"RTN","GPLCCR0",599,0)
- ;;</Normal>
-"RTN","GPLCCR0",600,0)
- ;;</NormalResult>
-"RTN","GPLCCR0",601,0)
- ;;<Flag>
-"RTN","GPLCCR0",602,0)
- ;;<Text>@@RESULTTESTFLAG@@</Text>
-"RTN","GPLCCR0",603,0)
- ;;</Flag>
-"RTN","GPLCCR0",604,0)
- ;;</Test>
-"RTN","GPLCCR0",605,0)
- ;;</TEST_NORMALSEQUENCE>
-"RTN","GPLCCR0",606,0)
- ;;</Result>
-"RTN","GPLCCR0",607,0)
- ;;</Results>
-"RTN","GPLCCR0",608,0)
- ;;<HealthCareProviders>
-"RTN","GPLCCR0",609,0)
- ;;<Provider>
-"RTN","GPLCCR0",610,0)
- ;;<ActorID>AA0005</ActorID>
-"RTN","GPLCCR0",611,0)
- ;;<ActorRole>
-"RTN","GPLCCR0",612,0)
- ;;<Text>Primary Provider</Text>
-"RTN","GPLCCR0",613,0)
- ;;</ActorRole>
-"RTN","GPLCCR0",614,0)
- ;;</Provider>
-"RTN","GPLCCR0",615,0)
- ;;</HealthCareProviders>
-"RTN","GPLCCR0",616,0)
- ;;</Body>
-"RTN","GPLCCR0",617,0)
- ;;<Actors>
-"RTN","GPLCCR0",618,0)
- ;;<ACTOR-PATIENT>
-"RTN","GPLCCR0",619,0)
- ;;<Actor>
-"RTN","GPLCCR0",620,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",621,0)
- ;;<Person>
-"RTN","GPLCCR0",622,0)
- ;;<Name>
-"RTN","GPLCCR0",623,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",624,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",625,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",626,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",627,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",628,0)
- ;;</Name>
-"RTN","GPLCCR0",629,0)
- ;;<DateOfBirth>
-"RTN","GPLCCR0",630,0)
- ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
-"RTN","GPLCCR0",631,0)
- ;;</DateOfBirth>
-"RTN","GPLCCR0",632,0)
- ;;<Gender>
-"RTN","GPLCCR0",633,0)
- ;;<Text>@@ACTORGENDER@@</Text>
-"RTN","GPLCCR0",634,0)
- ;;<Code>
-"RTN","GPLCCR0",635,0)
- ;;<Value>@@ACTORGENDER@@</Value>
-"RTN","GPLCCR0",636,0)
- ;;<CodingSystem>2.16.840.1.113883.5.1</CodingSystem>
-"RTN","GPLCCR0",637,0)
- ;;</Code>
-"RTN","GPLCCR0",638,0)
- ;;</Gender>
-"RTN","GPLCCR0",639,0)
- ;;</Person>
-"RTN","GPLCCR0",640,0)
- ;;<IDs>
-"RTN","GPLCCR0",641,0)
- ;;<Type>
-"RTN","GPLCCR0",642,0)
- ;;<Text>@@ACTORSSNTEXT@@</Text>
-"RTN","GPLCCR0",643,0)
- ;;</Type>
-"RTN","GPLCCR0",644,0)
- ;;<ID>@@ACTORSSN@@</ID>
-"RTN","GPLCCR0",645,0)
- ;;<Source>
-"RTN","GPLCCR0",646,0)
- ;;<Actor>
-"RTN","GPLCCR0",647,0)
- ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
-"RTN","GPLCCR0",648,0)
- ;;</Actor>
-"RTN","GPLCCR0",649,0)
- ;;</Source>
-"RTN","GPLCCR0",650,0)
- ;;</IDs>
-"RTN","GPLCCR0",651,0)
- ;;<Address>
-"RTN","GPLCCR0",652,0)
- ;;<Type>
-"RTN","GPLCCR0",653,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",654,0)
- ;;</Type>
-"RTN","GPLCCR0",655,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",656,0)
- ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
-"RTN","GPLCCR0",657,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",658,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",659,0)
- ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
-"RTN","GPLCCR0",660,0)
- ;;</Address>
-"RTN","GPLCCR0",661,0)
- ;;<Telephone>
-"RTN","GPLCCR0",662,0)
- ;;<Value>@@ACTORRESTEL@@</Value>
-"RTN","GPLCCR0",663,0)
- ;;<Type>
-"RTN","GPLCCR0",664,0)
- ;;<Text>@@ACTORRESTELTEXT@@</Text>
-"RTN","GPLCCR0",665,0)
- ;;</Type>
-"RTN","GPLCCR0",666,0)
- ;;</Telephone>
-"RTN","GPLCCR0",667,0)
- ;;<Telephone>
-"RTN","GPLCCR0",668,0)
- ;;<Value>@@ACTORWORKTEL@@</Value>
-"RTN","GPLCCR0",669,0)
- ;;<Type>
-"RTN","GPLCCR0",670,0)
- ;;<Text>@@ACTORWORKTELTEXT@@</Text>
-"RTN","GPLCCR0",671,0)
- ;;</Type>
-"RTN","GPLCCR0",672,0)
- ;;</Telephone>
-"RTN","GPLCCR0",673,0)
- ;;<Telephone>
-"RTN","GPLCCR0",674,0)
- ;;<Value>@@ACTORCELLTEL@@</Value>
-"RTN","GPLCCR0",675,0)
- ;;<Type>
-"RTN","GPLCCR0",676,0)
- ;;<Text>@@ACTORCELLTELTEXT@@</Text>
-"RTN","GPLCCR0",677,0)
- ;;</Type>
-"RTN","GPLCCR0",678,0)
- ;;</Telephone>
-"RTN","GPLCCR0",679,0)
- ;;<EMail>
-"RTN","GPLCCR0",680,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",681,0)
- ;;</EMail>
-"RTN","GPLCCR0",682,0)
- ;;<Source>
-"RTN","GPLCCR0",683,0)
- ;;<Actor>
-"RTN","GPLCCR0",684,0)
- ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",685,0)
- ;;</Actor>
-"RTN","GPLCCR0",686,0)
- ;;</Source>
-"RTN","GPLCCR0",687,0)
- ;;</Actor>
-"RTN","GPLCCR0",688,0)
- ;;</ACTOR-PATIENT>
-"RTN","GPLCCR0",689,0)
- ;;<ACTOR-SYSTEM>
-"RTN","GPLCCR0",690,0)
- ;;<Actor>
-"RTN","GPLCCR0",691,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",692,0)
- ;;<InformationSystem>
-"RTN","GPLCCR0",693,0)
- ;;<Name>@@ACTORINFOSYSNAME@@</Name>
-"RTN","GPLCCR0",694,0)
- ;;<Version>@@ACTORINFOSYSVER@@</Version>
-"RTN","GPLCCR0",695,0)
- ;;</InformationSystem>
-"RTN","GPLCCR0",696,0)
- ;;<Source>
-"RTN","GPLCCR0",697,0)
- ;;<Actor>
-"RTN","GPLCCR0",698,0)
- ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
-"RTN","GPLCCR0",699,0)
- ;;</Actor>
-"RTN","GPLCCR0",700,0)
- ;;</Source>
-"RTN","GPLCCR0",701,0)
- ;;</Actor>
-"RTN","GPLCCR0",702,0)
- ;;</ACTOR-SYSTEM>
-"RTN","GPLCCR0",703,0)
- ;;<ACTOR-NOK>
-"RTN","GPLCCR0",704,0)
- ;;<Actor>
-"RTN","GPLCCR0",705,0)
- ;;<ActorObjectID>AA0003</ActorObjectID>
-"RTN","GPLCCR0",706,0)
- ;;<Person>
-"RTN","GPLCCR0",707,0)
- ;;<Name>
-"RTN","GPLCCR0",708,0)
- ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
-"RTN","GPLCCR0",709,0)
- ;;</Name>
-"RTN","GPLCCR0",710,0)
- ;;</Person>
-"RTN","GPLCCR0",711,0)
- ;;<Relation>
-"RTN","GPLCCR0",712,0)
- ;;<Text>@@ACTORRELATION@@</Text>
-"RTN","GPLCCR0",713,0)
- ;;</Relation>
-"RTN","GPLCCR0",714,0)
- ;;<Source>
-"RTN","GPLCCR0",715,0)
- ;;<Actor>
-"RTN","GPLCCR0",716,0)
- ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
-"RTN","GPLCCR0",717,0)
- ;;</Actor>
-"RTN","GPLCCR0",718,0)
- ;;</Source>
-"RTN","GPLCCR0",719,0)
- ;;</Actor>
-"RTN","GPLCCR0",720,0)
- ;;</ACTOR-NOK>
-"RTN","GPLCCR0",721,0)
- ;;<ACTOR-PROVIDER>
-"RTN","GPLCCR0",722,0)
- ;;<Actor>
-"RTN","GPLCCR0",723,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",724,0)
- ;;<Person>
-"RTN","GPLCCR0",725,0)
- ;;<Name>
-"RTN","GPLCCR0",726,0)
- ;;<CurrentName>
-"RTN","GPLCCR0",727,0)
- ;;<Given>@@ACTORGIVENNAME@@</Given>
-"RTN","GPLCCR0",728,0)
- ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
-"RTN","GPLCCR0",729,0)
- ;;<Family>@@ACTORFAMILYNAME@@</Family>
-"RTN","GPLCCR0",730,0)
- ;;<Title>@@ACTORTITLE@@</Title>
-"RTN","GPLCCR0",731,0)
- ;;</CurrentName>
-"RTN","GPLCCR0",732,0)
- ;;</Name>
-"RTN","GPLCCR0",733,0)
- ;;</Person>
-"RTN","GPLCCR0",734,0)
- ;;<IDs>
-"RTN","GPLCCR0",735,0)
- ;;<Type>
-"RTN","GPLCCR0",736,0)
- ;;<Text>@@IDTYPE@@</Text>
-"RTN","GPLCCR0",737,0)
- ;;</Type>
-"RTN","GPLCCR0",738,0)
- ;;<ID>@@ID@@</ID>
-"RTN","GPLCCR0",739,0)
- ;;<IssuedBy>
-"RTN","GPLCCR0",740,0)
- ;;<Description>
-"RTN","GPLCCR0",741,0)
- ;;<Text>@@IDDESC@@</Text>
-"RTN","GPLCCR0",742,0)
- ;;</Description>
-"RTN","GPLCCR0",743,0)
- ;;</IssuedBy>
-"RTN","GPLCCR0",744,0)
- ;;</IDs>
-"RTN","GPLCCR0",745,0)
- ;;<Specialty>
-"RTN","GPLCCR0",746,0)
- ;;<Text>@@ACTORSPECIALITY@@</Text>
-"RTN","GPLCCR0",747,0)
- ;;</Specialty>
-"RTN","GPLCCR0",748,0)
- ;;<Address>
-"RTN","GPLCCR0",749,0)
- ;;<Type>
-"RTN","GPLCCR0",750,0)
- ;;<Text>@@ACTORADDRESSTYPE@@</Text>
-"RTN","GPLCCR0",751,0)
- ;;</Type>
-"RTN","GPLCCR0",752,0)
- ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
-"RTN","GPLCCR0",753,0)
- ;;<City>@@ACTORADDRESSCITY@@</City>
-"RTN","GPLCCR0",754,0)
- ;;<State>@@ACTORADDRESSSTATE@@</State>
-"RTN","GPLCCR0",755,0)
- ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
-"RTN","GPLCCR0",756,0)
- ;;</Address>
-"RTN","GPLCCR0",757,0)
- ;;<Telephone>
-"RTN","GPLCCR0",758,0)
- ;;<Value>@@ACTORTELEPHONE@@</Value>
-"RTN","GPLCCR0",759,0)
- ;;<Type>
-"RTN","GPLCCR0",760,0)
- ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
-"RTN","GPLCCR0",761,0)
- ;;</Type>
-"RTN","GPLCCR0",762,0)
- ;;</Telephone>
-"RTN","GPLCCR0",763,0)
- ;;<Email>
-"RTN","GPLCCR0",764,0)
- ;;<Value>@@ACTOREMAIL@@</Value>
-"RTN","GPLCCR0",765,0)
- ;;</Email>
-"RTN","GPLCCR0",766,0)
- ;;<Source>
-"RTN","GPLCCR0",767,0)
- ;;<Actor>
-"RTN","GPLCCR0",768,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",769,0)
- ;;</Actor>
-"RTN","GPLCCR0",770,0)
- ;;</Source>
-"RTN","GPLCCR0",771,0)
- ;;</Actor>
-"RTN","GPLCCR0",772,0)
- ;;</ACTOR-PROVIDER>
-"RTN","GPLCCR0",773,0)
- ;;<ACTOR-ORG>
-"RTN","GPLCCR0",774,0)
- ;;<Actor>
-"RTN","GPLCCR0",775,0)
- ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
-"RTN","GPLCCR0",776,0)
- ;;<Organization>
-"RTN","GPLCCR0",777,0)
- ;;<Name>@@ORGANIZATIONNAME@@</Name>
-"RTN","GPLCCR0",778,0)
- ;;</Organization>
-"RTN","GPLCCR0",779,0)
- ;;<Source>
-"RTN","GPLCCR0",780,0)
- ;;<Actor>
-"RTN","GPLCCR0",781,0)
- ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
-"RTN","GPLCCR0",782,0)
- ;;</Actor>
-"RTN","GPLCCR0",783,0)
- ;;</Source>
-"RTN","GPLCCR0",784,0)
- ;;</Actor>
-"RTN","GPLCCR0",785,0)
- ;;</ACTOR-ORG>
-"RTN","GPLCCR0",786,0)
- ;;</Actors>
-"RTN","GPLCCR0",787,0)
- ;;<Signatures>
-"RTN","GPLCCR0",788,0)
- ;;<CCRSignature>
-"RTN","GPLCCR0",789,0)
- ;;<SignatureObjectID>S0001</SignatureObjectID>
-"RTN","GPLCCR0",790,0)
- ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
-"RTN","GPLCCR0",791,0)
- ;;<Source>
-"RTN","GPLCCR0",792,0)
- ;;<ActorID>AA0001</ActorID>
-"RTN","GPLCCR0",793,0)
- ;;</Source>
-"RTN","GPLCCR0",794,0)
- ;;<Signature>
-"RTN","GPLCCR0",795,0)
- ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
-"RTN","GPLCCR0",796,0)
- ;;<SignedInfo>
-"RTN","GPLCCR0",797,0)
- ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
-"RTN","GPLCCR0",798,0)
- ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
-"RTN","GPLCCR0",799,0)
- ;;<Reference URI="">
-"RTN","GPLCCR0",800,0)
- ;;<Transforms>
-"RTN","GPLCCR0",801,0)
- ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
-"RTN","GPLCCR0",802,0)
- ;;</Transforms>
-"RTN","GPLCCR0",803,0)
- ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
-"RTN","GPLCCR0",804,0)
- ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
-"RTN","GPLCCR0",805,0)
- ;;</Reference>
-"RTN","GPLCCR0",806,0)
- ;;</SignedInfo>
-"RTN","GPLCCR0",807,0)
- ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
-"RTN","GPLCCR0",808,0)
- ;;<KeyInfo>
-"RTN","GPLCCR0",809,0)
- ;;<KeyValue>
-"RTN","GPLCCR0",810,0)
- ;;<RSAKeyValue>
-"RTN","GPLCCR0",811,0)
- ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
-"RTN","GPLCCR0",812,0)
- ;;<Exponent>AQAB</Exponent>
-"RTN","GPLCCR0",813,0)
- ;;</RSAKeyValue>
-"RTN","GPLCCR0",814,0)
- ;;</KeyValue>
-"RTN","GPLCCR0",815,0)
- ;;</KeyInfo>
-"RTN","GPLCCR0",816,0)
- ;;</Signature>
-"RTN","GPLCCR0",817,0)
- ;;</Signature>
-"RTN","GPLCCR0",818,0)
- ;;</CCRSignature>
-"RTN","GPLCCR0",819,0)
- ;;</Signatures>
-"RTN","GPLCCR0",820,0)
- ;;</ContinuityOfCareRecord>
-"RTN","GPLCCR0",821,0)
- ;</TEMPLATE>
-"RTN","GPLLABS")
-0^22^B74153607
-"RTN","GPLLABS",1,0)
-GPLALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
-"RTN","GPLLABS",2,0)
- ;;0.3;CCDCCR;nopatch;noreleasedate;Build 14
-"RTN","GPLLABS",3,0)
- ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-"RTN","GPLLABS",4,0)
- ;General Public License See attached copy of the License.
-"RTN","GPLLABS",5,0)
- ;
-"RTN","GPLLABS",6,0)
- ;This program is free software; you can redistribute it and/or modify
-"RTN","GPLLABS",7,0)
- ;it under the terms of the GNU General Public License as published by
-"RTN","GPLLABS",8,0)
- ;the Free Software Foundation; either version 2 of the License, or
-"RTN","GPLLABS",9,0)
- ;(at your option) any later version.
-"RTN","GPLLABS",10,0)
- ;
-"RTN","GPLLABS",11,0)
- ;This program is distributed in the hope that it will be useful,
-"RTN","GPLLABS",12,0)
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-"RTN","GPLLABS",13,0)
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-"RTN","GPLLABS",14,0)
- ;GNU General Public License for more details.
-"RTN","GPLLABS",15,0)
- ;
-"RTN","GPLLABS",16,0)
- ;You should have received a copy of the GNU General Public License along
-"RTN","GPLLABS",17,0)
- ;with this program; if not, write to the Free Software Foundation, Inc.,
-"RTN","GPLLABS",18,0)
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-"RTN","GPLLABS",19,0)
-           ;
-"RTN","GPLLABS",20,0)
-EXTRACT(LABXML,DFN,LABOUTXML) ; EXTRACT LABS INTO PROVIDED XML TEMPLATE
-"RTN","GPLLABS",21,0)
- ;
-"RTN","GPLLABS",22,0)
- ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-"RTN","GPLLABS",23,0)
- ;
-"RTN","GPLLABS",24,0)
- ;
-"RTN","GPLLABS",25,0)
- ;
-"RTN","GPLLABS",26,0)
- ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
-"RTN","GPLLABS",27,0)
- ; SET UP FOR LAB API CALL
-"RTN","GPLLABS",28,0)
- S C0CPTID=$$SSN^CCRDPT(DFN) ; GET THE SSN FOR THIS PATIENT
-"RTN","GPLLABS",29,0)
- I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
-"RTN","GPLLABS",30,0)
- . W "LAB LOOKUP FAILED, NO SSN",!
-"RTN","GPLLABS",31,0)
- S C0CSPC="*" ; LOOKING FOR ALL LABS
-"RTN","GPLLABS",32,0)
- D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
-"RTN","GPLLABS",33,0)
- D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY TO GET EVERYTHING
-"RTN","GPLLABS",34,0)
- S C0CR=$$GCPR^LA7QRY(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
-"RTN","GPLLABS",35,0)
- W "i'm back",!
-"RTN","GPLLABS",36,0)
- Q
-"RTN","GPLLABS",37,0)
-     ;
-"RTN","GPLLABS",38,0)
-LIST ; LIST THE HL7 MESSAGE
-"RTN","GPLLABS",39,0)
- ;
-"RTN","GPLLABS",40,0)
- ; N C0CI,C0CJ,C0COBT,C0CHB
-"RTN","GPLLABS",41,0)
- ; D EXTRACT^GPLLABS(,1,)
-"RTN","GPLLABS",42,0)
- S C0CTAB=$NA(^KBAI) ; BASE OF OBX TABLE
-"RTN","GPLLABS",43,0)
- S C0CHB=$NA(^TMP("HLS",$J))
-"RTN","GPLLABS",44,0)
- S C0CI=""
-"RTN","GPLLABS",45,0)
- F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
-"RTN","GPLLABS",46,0)
- . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
-"RTN","GPLLABS",47,0)
- . D LTYP(@C0CHB@(C0CI),C0CTYP)
-"RTN","GPLLABS",48,0)
- . W C0CI," ",C0CTYP,!
-"RTN","GPLLABS",49,0)
- . ; S C0CI=$O(@C0CHB@(C0CI))
-"RTN","GPLLABS",50,0)
- Q
-"RTN","GPLLABS",51,0)
-LTYP(OSEG,OTYP) ;
-"RTN","GPLLABS",52,0)
- S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
-"RTN","GPLLABS",53,0)
- I 1 D  ; FOR HL7 SEGMENT TYPE
-"RTN","GPLLABS",54,0)
- . S OI="" ; INDEX INTO FIELDS IN SEG
-"RTN","GPLLABS",55,0)
- . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
-"RTN","GPLLABS",56,0)
- . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
-"RTN","GPLLABS",57,0)
- . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
-"RTN","GPLLABS",58,0)
- . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
-"RTN","GPLLABS",59,0)
- . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
-"RTN","GPLLABS",60,0)
- . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
-"RTN","GPLLABS",61,0)
- . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
-"RTN","GPLLABS",62,0)
- . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
-"RTN","GPLLABS",63,0)
- Q
-"RTN","GPLLABS",64,0)
-LOBX ;
-"RTN","GPLLABS",65,0)
- Q
-"RTN","GPLLABS",66,0)
- ;
-"RTN","GPLLABS",67,0)
-SETTBL ;
-"RTN","GPLLABS",68,0)
- K X ; CLEAR X
-"RTN","GPLLABS",69,0)
- S X("PID","PID1")="1^00104^Set ID - Patient ID"
-"RTN","GPLLABS",70,0)
- S X("PID","PID2")="2^00105^Patient ID (External ID)"
-"RTN","GPLLABS",71,0)
- S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
-"RTN","GPLLABS",72,0)
- S X("PID","PID4")="4^00107^Alternate Patient ID"
-"RTN","GPLLABS",73,0)
- S X("PID","PID5")="5^00108^Patient's Name"
-"RTN","GPLLABS",74,0)
- S X("PID","PID6")="6^00109^Mother's Maiden Name"
-"RTN","GPLLABS",75,0)
- S X("PID","PID7")="7^00110^Date of Birth"
-"RTN","GPLLABS",76,0)
- S X("PID","PID8")="8^00111^Sex"
-"RTN","GPLLABS",77,0)
- S X("PID","PID9")="9^00112^Patient Alias"
-"RTN","GPLLABS",78,0)
- S X("PID","PID10")="10^00113^Race"
-"RTN","GPLLABS",79,0)
- S X("PID","PID11")="11^00114^Patient Address"
-"RTN","GPLLABS",80,0)
- S X("PID","PID12")="12^00115^County Code"
-"RTN","GPLLABS",81,0)
- S X("PID","PID13")="13^00116^Phone Number - Home"
-"RTN","GPLLABS",82,0)
- S X("PID","PID14")="14^00117^Phone Number - Business"
-"RTN","GPLLABS",83,0)
- S X("PID","PID15")="15^00118^Language - Patient"
-"RTN","GPLLABS",84,0)
- S X("PID","PID16")="16^00119^Marital Status"
-"RTN","GPLLABS",85,0)
- S X("PID","PID17")="17^00120^Religion"
-"RTN","GPLLABS",86,0)
- S X("PID","PID18")="18^00121^Patient Account Number"
-"RTN","GPLLABS",87,0)
- S X("PID","PID19")="19^00122^SSN Number - Patient"
-"RTN","GPLLABS",88,0)
- S X("PID","PID20")="20^00123^Drivers License - Patient"
-"RTN","GPLLABS",89,0)
- S X("PID","PID21")="21^00124^Mother's Identifier"
-"RTN","GPLLABS",90,0)
- S X("PID","PID22")="22^00125^Ethnic Group"
-"RTN","GPLLABS",91,0)
- S X("PID","PID23")="23^00126^Birth Place"
-"RTN","GPLLABS",92,0)
- S X("PID","PID24")="24^00127^Multiple Birth Indicator"
-"RTN","GPLLABS",93,0)
- S X("PID","PID25")="25^00128^Birth Order"
-"RTN","GPLLABS",94,0)
- S X("PID","PID26")="26^00129^Citizenship"
-"RTN","GPLLABS",95,0)
- S X("PID","PID27")="27^00130^Veteran.s Military Status"
-"RTN","GPLLABS",96,0)
- S X("PID","PID28")="28^00739^Nationality"
-"RTN","GPLLABS",97,0)
- S X("PID","PID29")="29^00740^Patient Death Date/Time"
-"RTN","GPLLABS",98,0)
- S X("PID","PID30")="30^00741^Patient Death Indicator"
-"RTN","GPLLABS",99,0)
- S X("NTE","NTE1")="1^00573^Set ID - NTE"
-"RTN","GPLLABS",100,0)
- S X("NTE","NTE2")="2^00574^Source of Comment"
-"RTN","GPLLABS",101,0)
- S X("NTE","NTE3")="3^00575^Comment"
-"RTN","GPLLABS",102,0)
- S X("ORC","ORC1")="1^00215^Order Control"
-"RTN","GPLLABS",103,0)
- S X("ORC","ORC2")="2^00216^Placer Order Number"
-"RTN","GPLLABS",104,0)
- S X("ORC","ORC3")="3^00217^Filler Order Number"
-"RTN","GPLLABS",105,0)
- S X("ORC","ORC4")="4^00218^Placer Order Number"
-"RTN","GPLLABS",106,0)
- S X("ORC","ORC5")="5^00219^Order Status"
-"RTN","GPLLABS",107,0)
- S X("ORC","ORC6")="6^00220^Response Flag"
-"RTN","GPLLABS",108,0)
- S X("ORC","ORC7")="7^00221^Quantity/Timing"
-"RTN","GPLLABS",109,0)
- S X("ORC","ORC8")="8^00222^Parent"
-"RTN","GPLLABS",110,0)
- S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
-"RTN","GPLLABS",111,0)
- S X("ORC","ORC10")="10^00224^Entered By"
-"RTN","GPLLABS",112,0)
- S X("ORC","ORC11")="11^00225^Verified By"
-"RTN","GPLLABS",113,0)
- S X("ORC","ORC12")="12^00226^Ordering Provider"
-"RTN","GPLLABS",114,0)
- S X("ORC","ORC13")="13^00227^Enterer's Location"
-"RTN","GPLLABS",115,0)
- S X("ORC","ORC14")="14^00228^Call Back Phone Number"
-"RTN","GPLLABS",116,0)
- S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
-"RTN","GPLLABS",117,0)
- S X("ORC","ORC16")="16^00230^Order Control Code Reason"
-"RTN","GPLLABS",118,0)
- S X("ORC","ORC17")="17^00231^Entering Organization"
-"RTN","GPLLABS",119,0)
- S X("ORC","ORC18")="18^00232^Entering Device"
-"RTN","GPLLABS",120,0)
- S X("ORC","ORC19")="19^00233^Action By"
-"RTN","GPLLABS",121,0)
- S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
-"RTN","GPLLABS",122,0)
- S X("OBR","OBR2")="2^00216^Placer Order Number"
-"RTN","GPLLABS",123,0)
- S X("OBR","OBR3")="3^00217^Filler Order Number"
-"RTN","GPLLABS",124,0)
- S X("OBR","OBR4")="4^00238^Universal Service ID"
-"RTN","GPLLABS",125,0)
- S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
-"RTN","GPLLABS",126,0)
- S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
-"RTN","GPLLABS",127,0)
- S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE"
-"RTN","GPLLABS",128,0)
- S X("OBR","OBR5")="5^00239^Priority"
-"RTN","GPLLABS",129,0)
- S X("OBR","OBR6")="6^00240^Requested Date/Time"
-"RTN","GPLLABS",130,0)
- S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
-"RTN","GPLLABS",131,0)
- S X("OBR","OBR8")="8^00242^Observation End Date/Time"
-"RTN","GPLLABS",132,0)
- S X("OBR","OBR9")="9^00243^Collection Volume"
-"RTN","GPLLABS",133,0)
- S X("OBR","OBR10")="10^00244^Collector Identifier"
-"RTN","GPLLABS",134,0)
- S X("OBR","OBR11")="11^00245^Specimen Action Code"
-"RTN","GPLLABS",135,0)
- S X("OBR","OBR12")="12^00246^Danger Code"
-"RTN","GPLLABS",136,0)
- S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
-"RTN","GPLLABS",137,0)
- S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
-"RTN","GPLLABS",138,0)
- S X("OBR","OBR15")="15^00249^Specimen Source"
-"RTN","GPLLABS",139,0)
- S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
-"RTN","GPLLABS",140,0)
- S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
-"RTN","GPLLABS",141,0)
- S X("OBR","OBR18")="18^00251^Placers Field 1"
-"RTN","GPLLABS",142,0)
- S X("OBR","OBR19")="19^00252^Placers Field 2"
-"RTN","GPLLABS",143,0)
- S X("OBR","OBR20")="20^00253^Filler Field 1"
-"RTN","GPLLABS",144,0)
- S X("OBR","OBR21")="21^00254^Filler Field 2"
-"RTN","GPLLABS",145,0)
- S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
-"RTN","GPLLABS",146,0)
- S X("OBR","OBR23")="23^00256^Charge to Practice"
-"RTN","GPLLABS",147,0)
- S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
-"RTN","GPLLABS",148,0)
- S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
-"RTN","GPLLABS",149,0)
- S X("OBR","OBR26")="26^00259^Parent Result"
-"RTN","GPLLABS",150,0)
- S X("OBR","OBR27")="27^00221^Quantity/Timing"
-"RTN","GPLLABS",151,0)
- S X("OBR","OBR28")="28^00260^Result Copies to"
-"RTN","GPLLABS",152,0)
- S X("OBR","OBR29")="29^00261^Parent Number"
-"RTN","GPLLABS",153,0)
- S X("OBR","OBR30")="30^00262^Transportation Mode"
-"RTN","GPLLABS",154,0)
- S X("OBR","OBR31")="31^00263^Reason for Study"
-"RTN","GPLLABS",155,0)
- S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
-"RTN","GPLLABS",156,0)
- S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
-"RTN","GPLLABS",157,0)
- S X("OBR","OBR34")="34^00266^Technician"
-"RTN","GPLLABS",158,0)
- S X("OBR","OBR35")="35^00267^Transcriptionist"
-"RTN","GPLLABS",159,0)
- S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
-"RTN","GPLLABS",160,0)
- S X("OBR","OBR37")="37^01028^Number of Sample Containers"
-"RTN","GPLLABS",161,0)
- S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
-"RTN","GPLLABS",162,0)
- S X("OBR","OBR39")="39^01030^Collector.s Comment"
-"RTN","GPLLABS",163,0)
- S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
-"RTN","GPLLABS",164,0)
- S X("OBR","OBR41")="41^01032^Transport Arranged"
-"RTN","GPLLABS",165,0)
- S X("OBR","OBR42")="42^01033^Escort Required"
-"RTN","GPLLABS",166,0)
- S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
-"RTN","GPLLABS",167,0)
- S X("OBX","OBX1")="1^00559^Set ID - OBX"
-"RTN","GPLLABS",168,0)
- S X("OBX","OBX2")="2^00676^Value Type"
-"RTN","GPLLABS",169,0)
- S X("OBX","OBX3")="3^00560^Observation Identifier"
-"RTN","GPLLABS",170,0)
- S X("OBX","OBX3;LOINC")="3;4^00560^Observation Identifier^RESULTTESTCODEVALUE"
-"RTN","GPLLABS",171,0)
- S X("OBX","OBX3;DESC")="3;5^00560^Observation Identifier^RESULTTESTDESCRIPTIONTEXT"
-"RTN","GPLLABS",172,0)
- S X("OBX","OBX3;VACODE")="3;6^00560^Observation Identifier"
-"RTN","GPLLABS",173,0)
- S X("OBX","OBX4")="4^00769^Observation Sub-Id"
-"RTN","GPLLABS",174,0)
- S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
-"RTN","GPLLABS",175,0)
- S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
-"RTN","GPLLABS",176,0)
- S X("OBX","OBX7")="7^00563^Reference Range^"
-"RTN","GPLLABS",177,0)
- S X("OBX","OBX8")="8^00564^Abnormal Flags"
-"RTN","GPLLABS",178,0)
- S X("OBX","OBX9")="9^00639^Probability"
-"RTN","GPLLABS",179,0)
- S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
-"RTN","GPLLABS",180,0)
- S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
-"RTN","GPLLABS",181,0)
- S X("OBX","OBX12")="12^00567^Date Last Normal Value"
-"RTN","GPLLABS",182,0)
- S X("OBX","OBX13")="13^00581^User Defined Access Checks"
-"RTN","GPLLABS",183,0)
- S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
-"RTN","GPLLABS",184,0)
- S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
-"RTN","GPLLABS",185,0)
- S X("OBX","OBX16")="16^00584^Responsible Observer"
-"RTN","GPLLABS",186,0)
- S X("OBX","OBX17")="17^00936^Observation Method"
-"RTN","GPLLABS",187,0)
- M ^KBAI=X ; SET VALUES IN ^KBAI
-"RTN","GPLLABS",188,0)
- Q
-"RTN","GPLLABS",189,0)
- ;
-"RTN","GPLPROBS")
-0^20^B25875394
-"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 14
-"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)
-          S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
-"RTN","GPLPROBS",42,0)
-          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
-"RTN","GPLPROBS",43,0)
-          . S VMAP=$NA(@TVMAP@(J))
-"RTN","GPLPROBS",44,0)
-          . K @VMAP
-"RTN","GPLPROBS",45,0)
-          . I DEBUG W "VMAP= ",VMAP,!
-"RTN","GPLPROBS",46,0)
-          . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
-"RTN","GPLPROBS",47,0)
-          . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
-"RTN","GPLPROBS",48,0)
-          . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
-"RTN","GPLPROBS",49,0)
-          . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2)
-"RTN","GPLPROBS",50,0)
-          . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
-"RTN","GPLPROBS",51,0)
-          . S @VMAP@("PROBLEMCODINGVERSION")=""
-"RTN","GPLPROBS",52,0)
-          . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
-"RTN","GPLPROBS",53,0)
-          . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5)
-"RTN","GPLPROBS",54,0)
-          . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6)
-"RTN","GPLPROBS",55,0)
-          . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
-"RTN","GPLPROBS",56,0)
-          . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
-"RTN","GPLPROBS",57,0)
-          . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
-"RTN","GPLPROBS",58,0)
-          . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
-"RTN","GPLPROBS",59,0)
-          . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
-"RTN","GPLPROBS",60,0)
-          . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
-"RTN","GPLPROBS",61,0)
-          . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
-"RTN","GPLPROBS",62,0)
-          . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
-"RTN","GPLPROBS",63,0)
-          . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
-"RTN","GPLPROBS",64,0)
-          . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
-"RTN","GPLPROBS",65,0)
-          . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15)
-"RTN","GPLPROBS",66,0)
-          . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16)
-"RTN","GPLPROBS",67,0)
-          . S ARYTMP=$NA(@TARYTMP@(J))
-"RTN","GPLPROBS",68,0)
-          . ; W "ARYTMP= ",ARYTMP,!
-"RTN","GPLPROBS",69,0)
-          . K @ARYTMP
-"RTN","GPLPROBS",70,0)
-          . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ;
-"RTN","GPLPROBS",71,0)
-          . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",72,0)
-          . . ; W "FIRST ONE",!
-"RTN","GPLPROBS",73,0)
-          . . D CP^GPLXPATH(ARYTMP,OUTXML)
-"RTN","GPLPROBS",74,0)
-          . . ; W "OUTXML ",OUTXML,!
-"RTN","GPLPROBS",75,0)
-          . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLPROBS",76,0)
-          . . D INSINNER^GPLXPATH(OUTXML,ARYTMP)
-"RTN","GPLPROBS",77,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBVALS",*)
-"RTN","GPLPROBS",78,0)
-          ; ZWR ^TMP("GPLCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLPROBS",79,0)
-          ; ZWR @OUTXML
-"RTN","GPLPROBS",80,0)
-          ; $$HTML^DILF(
-"RTN","GPLPROBS",81,0)
-          ; GENERATE THE NARITIVE HTML FOR THE CCD
-"RTN","GPLPROBS",82,0)
-          I CCD D  ; IF THIS IS FOR A CCD
-"RTN","GPLPROBS",83,0)
-          . N HTMP,HOUT,HTMLO,GPLPROBI,ZX
-"RTN","GPLPROBS",84,0)
-          . F GPLPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
-"RTN","GPLPROBS",85,0)
-          . . S VMAP=$NA(@TVMAP@(GPLPROBI))
-"RTN","GPLPROBS",86,0)
-          . . I DEBUG W "VMAP =",VMAP,!
-"RTN","GPLPROBS",87,0)
-          . . D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
-"RTN","GPLPROBS",88,0)
-          . . D UNMARK^GPLXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
-"RTN","GPLPROBS",89,0)
-          . . ; D PARY^GPLXPATH("HTMP") ; PRINT IT
-"RTN","GPLPROBS",90,0)
-          . . D MAP^GPLXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
-"RTN","GPLPROBS",91,0)
-          . . ; D PARY^GPLXPATH("HOUT") ; PRINT IT AGAIN
-"RTN","GPLPROBS",92,0)
-          . . I GPLPROBI=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLPROBS",93,0)
-          . . . D CP^GPLXPATH("HOUT","HTMLO")
-"RTN","GPLPROBS",94,0)
-          . . I GPLPROBI>1 D  ; AFTER THE FIRST, INSERT INNER HTML
-"RTN","GPLPROBS",95,0)
-          . . . I DEBUG W "DOING INNER",!
-"RTN","GPLPROBS",96,0)
-          . . . N HTMLBLD,HTMLTMP
-"RTN","GPLPROBS",97,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
-"RTN","GPLPROBS",98,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
-"RTN","GPLPROBS",99,0)
-          . . . D QUEUE^GPLXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
-"RTN","GPLPROBS",100,0)
-          . . . D BUILD^GPLXPATH("HTMLBLD","HTMLTMP")
-"RTN","GPLPROBS",101,0)
-          . . . D CP^GPLXPATH("HTMLTMP","HTMLO")
-"RTN","GPLPROBS",102,0)
-          . . . ; D INSINNER^GPLXPATH("HOUT","HTMLO","//")
-"RTN","GPLPROBS",103,0)
-          . I DEBUG D PARY^GPLXPATH("HTMLO")
-"RTN","GPLPROBS",104,0)
-          . D INSB4^GPLXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
-"RTN","GPLPROBS",105,0)
-          N PROBSTMP,I
-"RTN","GPLPROBS",106,0)
-          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLPROBS",107,0)
-          I PROBSTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-"RTN","GPLPROBS",108,0)
-          . ; STRINGS MARKED AS @@X@@
-"RTN","GPLPROBS",109,0)
-          . W !,"PROBLEMS Missing list: ",!
-"RTN","GPLPROBS",110,0)
-          . F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
-"RTN","GPLPROBS",111,0)
-          Q
-"RTN","GPLPROBS",112,0)
-          ;
-"RTN","GPLRIMA")
-0^18^B228265839
-"RTN","GPLRIMA",1,0)
-GPLRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
-"RTN","GPLRIMA",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 14
-"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)
-    . . S @RIMBASE@("VARS",RIMDFN,"PROBLEMS",0)=^TMP("GPLCCR",$J,"PROBVALS",0)
-"RTN","GPLRIMA",63,0)
-    . I $D(^TMP("GPLCCR",$J,"VITALS",1)) D  ; VITALS VARS EXISTS
-"RTN","GPLRIMA",64,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"VITALS")=^TMP("GPLCCR",$J,"VITALS")
-"RTN","GPLRIMA",65,0)
-    . I $D(^TMP("GPLCCR",$J,"MEDMAP",1)) D  ; MEDS VARS EXISTS
-"RTN","GPLRIMA",66,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"MEDS")=^TMP("GPLCCR",$J,"MEDMAP")
-"RTN","GPLRIMA",67,0)
-    . I $D(^TMP("GPLALERT",$J,"ALERTS",1,"ALERTOBJECTID")) D  ; ALERTS EXIST
-"RTN","GPLRIMA",68,0)
-    . . W "FOUND ALERT VARS",!
-"RTN","GPLRIMA",69,0)
-    . . M @RIMBASE@("VARS",RIMDFN,"ALERTS")=^TMP("GPLALERT",$J,"ALERTS")
-"RTN","GPLRIMA",70,0)
-    . K ^TMP("GPLCCR",$J) ; KILL WORK AREA FOR CCR BUILDING
-"RTN","GPLRIMA",71,0)
-    . ;
-"RTN","GPLRIMA",72,0)
-    . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
-"RTN","GPLRIMA",73,0)
-    . ;
-"RTN","GPLRIMA",74,0)
-    . S RATTR=$$SETATTR(RIMDFN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
-"RTN","GPLRIMA",75,0)
-    . S @RIMBASE@("ATTR",RIMDFN)=RATTR ; SAVE THE ATRIBUTES FOR THIS PAT
-"RTN","GPLRIMA",76,0)
-    . ;
-"RTN","GPLRIMA",77,0)
-    . ; INCREMENT THE COUNT OF PATIENTS WITH THESE ATTRIBUTES IN ATTRTBL
-"RTN","GPLRIMA",78,0)
-    . ;
-"RTN","GPLRIMA",79,0)
-    . ; I '$D(@RIMBASE@("ATTRTBL",RATTR)) D  ; IF FIRST PAT WITH THESE ATTRS
-"RTN","GPLRIMA",80,0)
-    . ; . S @RIMBASE@("ATTRTBL",RATTR)=0 ; DEFAULT VALUE TO BE INCREMENTED
-"RTN","GPLRIMA",81,0)
-    . ; S @RIMBASE@("ATTRTBL",RATTR)=@RIMBASE@("ATTRTBL",RATTR)+1 ; INCREMENT
-"RTN","GPLRIMA",82,0)
-    . ;
-"RTN","GPLRIMA",83,0)
-    . N CATNAME,CATTBL
-"RTN","GPLRIMA",84,0)
-    . ; S CATBASE=$NA(@RIMBASE@("ANALYSIS"))
-"RTN","GPLRIMA",85,0)
-    . S CATNAME=""
-"RTN","GPLRIMA",86,0)
-    . D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
-"RTN","GPLRIMA",87,0)
-    . W "CATEGORY NAME: ",CATNAME,!
-"RTN","GPLRIMA",88,0)
-    . ;
-"RTN","GPLRIMA",89,0)
-    . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^CCRSYS(RIMDFN) ; NEXT PATIENT
-"RTN","GPLRIMA",90,0)
-    . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
-"RTN","GPLRIMA",91,0)
-    . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
-"RTN","GPLRIMA",92,0)
-    . ; AND WE SKIP IT
-"RTN","GPLRIMA",93,0)
-    . S @RIMBASE@("RESUME")=RIMDFN ; WHERE WE ARE LEAVING OFF THIS RUN
-"RTN","GPLRIMA",94,0)
-    ; D PARY^GPLXPATH(@RIMBASE@("ATTRTBL"))
-"RTN","GPLRIMA",95,0)
-    Q
-"RTN","GPLRIMA",96,0)
-    ;
-"RTN","GPLRIMA",97,0)
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
-"RTN","GPLRIMA",98,0)
-    N SBASE,SATTR
-"RTN","GPLRIMA",99,0)
-    S SBASE=$NA(@RIMBASE@("VARS",SDFN))
-"RTN","GPLRIMA",100,0)
-    D APOST("SATTR","RIMTBL","HEADER")
-"RTN","GPLRIMA",101,0)
-    I $D(@SBASE@("PROBLEMS",1)) D  ;
-"RTN","GPLRIMA",102,0)
-    . D APOST("SATTR","RIMTBL","PROBLEMS")
-"RTN","GPLRIMA",103,0)
-    . ; W "POSTING PROBLEMS",!
-"RTN","GPLRIMA",104,0)
-    I $D(@SBASE@("VITALS",1)) D APOST("SATTR","RIMTBL","VITALS")
-"RTN","GPLRIMA",105,0)
-    I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
-"RTN","GPLRIMA",106,0)
-    . D APOST("SATTR","RIMTBL","MEDS")
-"RTN","GPLRIMA",107,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",108,0)
-    . D GETPA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
-"RTN","GPLRIMA",109,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",110,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",111,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","MEDSCODE") ;CODES
-"RTN","GPLRIMA",112,0)
-    . ; D PATD^GPLRIMA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
-"RTN","GPLRIMA",113,0)
-    I $D(@SBASE@("ALERTS",1)) D  ; IF THE PATIENT HAS ALERTS
-"RTN","GPLRIMA",114,0)
-    . D APOST("SATTR","RIMTBL","ALERTS")
-"RTN","GPLRIMA",115,0)
-    . N ZR,ZI
-"RTN","GPLRIMA",116,0)
-    . D GETPA(.ZR,SDFN,"ALERTS","ALERTAGENTPRODUCTCODEVALUE") ;REACTANT CODES
-"RTN","GPLRIMA",117,0)
-    . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
-"RTN","GPLRIMA",118,0)
-    . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
-"RTN","GPLRIMA",119,0)
-    . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","RIMTBL","ALERTSCODE") ;CODES
-"RTN","GPLRIMA",120,0)
-    ; D APOST("SATTR","RIMTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
-"RTN","GPLRIMA",121,0)
-    W "ATTRIBUTES: ",SATTR,!
-"RTN","GPLRIMA",122,0)
-    Q SATTR
-"RTN","GPLRIMA",123,0)
-    ;
-"RTN","GPLRIMA",124,0)
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
-"RTN","GPLRIMA",125,0)
-    K ^TMP("GPLRIM","RESUME")
-"RTN","GPLRIMA",126,0)
-    K ^TMP("GPLRIM")
-"RTN","GPLRIMA",127,0)
-    Q
-"RTN","GPLRIMA",128,0)
-    ;
-"RTN","GPLRIMA",129,0)
-CLIST ; LIST THE CATEGORIES
-"RTN","GPLRIMA",130,0)
-    ;
-"RTN","GPLRIMA",131,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",132,0)
-    N CLBASE,CLNUM,ZI,CLIDX
-"RTN","GPLRIMA",133,0)
-    S CLBASE=$NA(@RIMBASE@("RIMTBL","CATS"))
-"RTN","GPLRIMA",134,0)
-    S CLNUM=@CLBASE@(0)
-"RTN","GPLRIMA",135,0)
-    F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
-"RTN","GPLRIMA",136,0)
-    . S CLIDX=@CLBASE@(ZI)
-"RTN","GPLRIMA",137,0)
-    . W "(",$P(@CLBASE@(CLIDX),"^",1)
-"RTN","GPLRIMA",138,0)
-    . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
-"RTN","GPLRIMA",139,0)
-    . W CLIDX,!
-"RTN","GPLRIMA",140,0)
-    ; D PARY^GPLXPATH(CLBASE)
-"RTN","GPLRIMA",141,0)
-    Q
-"RTN","GPLRIMA",142,0)
-    ;
-"RTN","GPLRIMA",143,0)
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
-"RTN","GPLRIMA",144,0)
-    ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
-"RTN","GPLRIMA",145,0)
-    ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
-"RTN","GPLRIMA",146,0)
-    ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
-"RTN","GPLRIMA",147,0)
-    ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
-"RTN","GPLRIMA",148,0)
-    ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
-"RTN","GPLRIMA",149,0)
-    ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
-"RTN","GPLRIMA",150,0)
-    ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
-"RTN","GPLRIMA",151,0)
-    ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
-"RTN","GPLRIMA",152,0)
-    ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
-"RTN","GPLRIMA",153,0)
-    ; NUMBER IE CTBL_X(CDFN)=""
-"RTN","GPLRIMA",154,0)
-    ;
-"RTN","GPLRIMA",155,0)
-    ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
-"RTN","GPLRIMA",156,0)
-    S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
-"RTN","GPLRIMA",157,0)
-    W "CBASE: ",CCTBL,!
-"RTN","GPLRIMA",158,0)
-    ;
-"RTN","GPLRIMA",159,0)
-    I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
-"RTN","GPLRIMA",160,0)
-    . D PUSH^GPLXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
-"RTN","GPLRIMA",161,0)
-    . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
-"RTN","GPLRIMA",162,0)
-    . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
-"RTN","GPLRIMA",163,0)
-    . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
-"RTN","GPLRIMA",164,0)
-    . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
-"RTN","GPLRIMA",165,0)
-    . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
-"RTN","GPLRIMA",166,0)
-    ;
-"RTN","GPLRIMA",167,0)
-    S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
-"RTN","GPLRIMA",168,0)
-    S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",169,0)
-    S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
-"RTN","GPLRIMA",170,0)
-    ;
-"RTN","GPLRIMA",171,0)
-    S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
-"RTN","GPLRIMA",172,0)
-    ;
-"RTN","GPLRIMA",173,0)
-    S CPATLIST=$NA(@CBASE@(CTBL,"PATS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
-"RTN","GPLRIMA",174,0)
-    W "PATS BASE: ",CPATLIST,!
-"RTN","GPLRIMA",175,0)
-    S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
-"RTN","GPLRIMA",176,0)
-    ;
-"RTN","GPLRIMA",177,0)
-    Q
-"RTN","GPLRIMA",178,0)
-    ;
-"RTN","GPLRIMA",179,0)
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
-"RTN","GPLRIMA",180,0)
-    ;
-"RTN","GPLRIMA",181,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",182,0)
-    N ZI,ZJ,ZCNT,ZIDX,ZCAT,ZATR,ZTOT
-"RTN","GPLRIMA",183,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",184,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",185,0)
-    S ZTOT=0 ; INITIALIZE OVERALL TOTAL
-"RTN","GPLRIMA",186,0)
-    F ZI=1:1:@ZCBASE@(0) D  ; FOR ALL CATS
-"RTN","GPLRIMA",187,0)
-    . S ZCNT=0
-"RTN","GPLRIMA",188,0)
-    . S ZATR=@ZCBASE@(ZI) ; THE ATTRIBUTE OF THE CATEGORY
-"RTN","GPLRIMA",189,0)
-    . S ZCAT=$P(@ZCBASE@(ZATR),"^",1) ; USE IT TO LOOK UP THE CATEGORY NAME
-"RTN","GPLRIMA",190,0)
-    . ; S ZIDX=$O(@ZPBASE@(ZCAT,"")) ; FIRST PATIENT IN LIST
-"RTN","GPLRIMA",191,0)
-    . ; F ZJ=0:0 D  Q:$O(@ZPBASE@(ZCAT,ZIDX))="" ; ALL PATIENTS IN THE LISTS
-"RTN","GPLRIMA",192,0)
-    . ; . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
-"RTN","GPLRIMA",193,0)
-    . ; . W ZCAT," DFN:",ZIDX," COUNT:",ZCNT,!
-"RTN","GPLRIMA",194,0)
-    . ; . S ZIDX=$O(@ZPBASE@(ZCAT,ZIDX))
-"RTN","GPLRIMA",195,0)
-    . S ZCNT=$$CNTLST($NA(@ZPBASE@(ZCAT)))
-"RTN","GPLRIMA",196,0)
-    . S $P(@ZCBASE@(ZATR),"^",2)=ZCNT ; UPDATE THE COUNT IN THE CAT RECORD
-"RTN","GPLRIMA",197,0)
-    . S ZTOT=ZTOT+ZCNT
-"RTN","GPLRIMA",198,0)
-    W "TOTAL: ",ZTOT,!
-"RTN","GPLRIMA",199,0)
-    Q
-"RTN","GPLRIMA",200,0)
-    ;
-"RTN","GPLRIMA",201,0)
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
-"RTN","GPLRIMA",202,0)
-    ; INLST IS PASSED BY NAME
-"RTN","GPLRIMA",203,0)
-    N ZI,ZDX,ZCOUNT
-"RTN","GPLRIMA",204,0)
-    W INLST,!
-"RTN","GPLRIMA",205,0)
-    S ZCOUNT=0
-"RTN","GPLRIMA",206,0)
-    S ZDX=""
-"RTN","GPLRIMA",207,0)
-    F ZI=$O(@INLST@(ZDX)):0 D  Q:$O(@INLST@(ZDX))=""  ; LOOP UNTIL THE END
-"RTN","GPLRIMA",208,0)
-    . S ZCOUNT=ZCOUNT+1
-"RTN","GPLRIMA",209,0)
-    . S ZDX=$O(@INLST@(ZDX))
-"RTN","GPLRIMA",210,0)
-    . W "ZDX:",ZDX," ZCNT:",ZCOUNT,!
-"RTN","GPLRIMA",211,0)
-    Q ZCOUNT
-"RTN","GPLRIMA",212,0)
-    ;
-"RTN","GPLRIMA",213,0)
-XCPAT(CPATCAT) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
-"RTN","GPLRIMA",214,0)
-    ;
-"RTN","GPLRIMA",215,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",216,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",217,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",218,0)
-    S ZI=""
-"RTN","GPLRIMA",219,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",220,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",221,0)
-    . D XPAT^GPLCCR(ZI,"","") ; EXPORT THE PATIENT TO A FILE
-"RTN","GPLRIMA",222,0)
-    Q
-"RTN","GPLRIMA",223,0)
-    ;
-"RTN","GPLRIMA",224,0)
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
-"RTN","GPLRIMA",225,0)
-    ;
-"RTN","GPLRIMA",226,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",227,0)
-    N ZI,ZJ,ZC,ZPATBASE
-"RTN","GPLRIMA",228,0)
-    S ZC=0 ; COUNT FOR SPACING THE PRINTOUT
-"RTN","GPLRIMA",229,0)
-    S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",CPATCAT))
-"RTN","GPLRIMA",230,0)
-    S ZI=""
-"RTN","GPLRIMA",231,0)
-    F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
-"RTN","GPLRIMA",232,0)
-    . S ZI=$O(@ZPATBASE@(ZI))
-"RTN","GPLRIMA",233,0)
-    . S ZC=ZC+1 ; INCREMENT OUTPUT PER LINE COUNT
-"RTN","GPLRIMA",234,0)
-    . W ZI," "
-"RTN","GPLRIMA",235,0)
-    . I ZC=10 D  ; NEW LINE
-"RTN","GPLRIMA",236,0)
-    . . S ZC=0
-"RTN","GPLRIMA",237,0)
-    . . W !
-"RTN","GPLRIMA",238,0)
-    Q
-"RTN","GPLRIMA",239,0)
-    ;
-"RTN","GPLRIMA",240,0)
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
-"RTN","GPLRIMA",241,0)
-    ;
-"RTN","GPLRIMA",242,0)
-    N ATTR S ATTR=""
-"RTN","GPLRIMA",243,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",244,0)
-    . D ANALYZE(DFN,1) ; EXTRACT THE RIM VARIABLE FOR THIS PATIENT
-"RTN","GPLRIMA",245,0)
-    S ATTR=^TMP("GPLRIM","ATTR",DFN)
-"RTN","GPLRIMA",246,0)
-    I ATTR="" W "THIS PATIENT NOT ANALYZED.",! Q  ;NO ATTRIBUTES FOUND
-"RTN","GPLRIMA",247,0)
-    I $D(^TMP("GPLRIM","RIMTBL","CATS",ATTR)) D  ; FOUND A CAT
-"RTN","GPLRIMA",248,0)
-    . N CAT
-"RTN","GPLRIMA",249,0)
-    . S CAT=$P(^TMP("GPLRIM","RIMTBL","CATS",ATTR),U,1) ; LOOK UP THE CAT
-"RTN","GPLRIMA",250,0)
-    . W CAT,": ",ATTR,!
-"RTN","GPLRIMA",251,0)
-    Q
-"RTN","GPLRIMA",252,0)
-    ;
-"RTN","GPLRIMA",253,0)
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
-"RTN","GPLRIMA",254,0)
-    ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
-"RTN","GPLRIMA",255,0)
-    ; AND AMAP(N)=AVAL IS THE NTH AVAL
-"RTN","GPLRIMA",256,0)
-    ; ALSO HASH ACCESS AMAP(AVAL)=N WHERE N IS THE ASSIGNED ORDER OF THE
-"RTN","GPLRIMA",257,0)
-    ; MAP VALUE. INSTANCES OF THE MAP WILL USE $P(X,U,N)=AVAL TO PLACE
-"RTN","GPLRIMA",258,0)
-    ; THE ATTRIBUTE IN ITS RIGHT PLACE. THE ATTRIBUTE VALUE IS STORED
-"RTN","GPLRIMA",259,0)
-    ; SO THAT DIFFERENT MAPS CAN BE AUTOMATICALLY CROSSWALKED
-"RTN","GPLRIMA",260,0)
-    ;
-"RTN","GPLRIMA",261,0)
-    I '$D(@AMAP) D  ; IF THE MAP DOES NOT EXIST
-"RTN","GPLRIMA",262,0)
-    . S @AMAP@(0)=0 ; HAS ZERO ELEMENTS
-"RTN","GPLRIMA",263,0)
-    S @AMAP@(0)=@AMAP@(0)+1 ;INCREMENT ELEMENT COUNT
-"RTN","GPLRIMA",264,0)
-    S @AMAP@(@AMAP@(0))=AVAL ; ADD THE VALUE TO THE ARRAY
-"RTN","GPLRIMA",265,0)
-    S @AMAP@(AVAL)=@AMAP@(0) ; ADD THE VALUE TO THE HASH WITH ARRAY REF
-"RTN","GPLRIMA",266,0)
-    Q
-"RTN","GPLRIMA",267,0)
-    ;
-"RTN","GPLRIMA",268,0)
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
-"RTN","GPLRIMA",269,0)
-      I '$D(RIMBASE) S RIMBASE=$NA(^TMP("GPLRIM"))
-"RTN","GPLRIMA",270,0)
-      I '$D(@RIMBASE) S @RIMBASE=""
-"RTN","GPLRIMA",271,0)
-      I '$D(RIMTBL) S RIMTBL=$NA(^TMP("GPLRIM","RIMTBL","TABLE")) ; ATTR TABLE
-"RTN","GPLRIMA",272,0)
-      S ^TMP("GPLRIM","TABLES","RIMTBL")=RIMTBL ; TABLE OF TABLES
-"RTN","GPLRIMA",273,0)
-      Q
-"RTN","GPLRIMA",274,0)
-      ;
-"RTN","GPLRIMA",275,0)
-AINIT ; INITIALIZE ATTRIBUTE TABLE
-"RTN","GPLRIMA",276,0)
-      I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",277,0)
-      K @RIMTBL
-"RTN","GPLRIMA",278,0)
-      D APUSH(RIMTBL,"EXTRACTED")
-"RTN","GPLRIMA",279,0)
-      D APUSH(RIMTBL,"NOTEXTRACTED")
-"RTN","GPLRIMA",280,0)
-      D APUSH(RIMTBL,"HEADER")
-"RTN","GPLRIMA",281,0)
-      D APUSH(RIMTBL,"NOPCP")
-"RTN","GPLRIMA",282,0)
-      D APUSH(RIMTBL,"PCP")
-"RTN","GPLRIMA",283,0)
-      D APUSH(RIMTBL,"PROBLEMS")
-"RTN","GPLRIMA",284,0)
-      D APUSH(RIMTBL,"PROBCODE")
-"RTN","GPLRIMA",285,0)
-      D APUSH(RIMTBL,"PROBNOCODE")
-"RTN","GPLRIMA",286,0)
-      D APUSH(RIMTBL,"PROBDATE")
-"RTN","GPLRIMA",287,0)
-      D APUSH(RIMTBL,"PROBNODATE")
-"RTN","GPLRIMA",288,0)
-      D APUSH(RIMTBL,"VITALS")
-"RTN","GPLRIMA",289,0)
-      D APUSH(RIMTBL,"VITALSCODE")
-"RTN","GPLRIMA",290,0)
-      D APUSH(RIMTBL,"VITALSNOCODE")
-"RTN","GPLRIMA",291,0)
-      D APUSH(RIMTBL,"VITALSDATE")
-"RTN","GPLRIMA",292,0)
-      D APUSH(RIMTBL,"VITALSNODATE")
-"RTN","GPLRIMA",293,0)
-      D APUSH(RIMTBL,"MEDS")
-"RTN","GPLRIMA",294,0)
-      D APUSH(RIMTBL,"MEDSCODE")
-"RTN","GPLRIMA",295,0)
-      D APUSH(RIMTBL,"MEDSNOCODE")
-"RTN","GPLRIMA",296,0)
-      D APUSH(RIMTBL,"MEDSDATE")
-"RTN","GPLRIMA",297,0)
-      D APUSH(RIMTBL,"MEDSNODATE")
-"RTN","GPLRIMA",298,0)
-      D APUSH(RIMTBL,"ALERTS")
-"RTN","GPLRIMA",299,0)
-      D APUSH(RIMTBL,"ALERTSCODE")
-"RTN","GPLRIMA",300,0)
-      Q
-"RTN","GPLRIMA",301,0)
-      ;
-"RTN","GPLRIMA",302,0)
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
-"RTN","GPLRIMA",303,0)
-    ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
-"RTN","GPLRIMA",304,0)
-    ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
-"RTN","GPLRIMA",305,0)
-    ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
-"RTN","GPLRIMA",306,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
-"RTN","GPLRIMA",307,0)
-    N USETBL
-"RTN","GPLRIMA",308,0)
-    I '$D(@RIMBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
-"RTN","GPLRIMA",309,0)
-    . W "ERROR NO SUCH TABLE",!
-"RTN","GPLRIMA",310,0)
-    S USETBL=@RIMBASE@("TABLES",PTBL)
-"RTN","GPLRIMA",311,0)
-    S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
-"RTN","GPLRIMA",312,0)
-    Q
-"RTN","GPLRIMA",313,0)
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
-"RTN","GPLRIMA",314,0)
-    ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
-"RTN","GPLRIMA",315,0)
-    ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
-"RTN","GPLRIMA",316,0)
-    ; IN SECTION "MEDS"
-"RTN","GPLRIMA",317,0)
-    ; P1 IS THE IEN OF THE MED WITH THE VALUE IE 2^PENDING WOULD BE STATUS
-"RTN","GPLRIMA",318,0)
-    ; PENDING FOR MED 2 FOR PATIENT 2
-"RTN","GPLRIMA",319,0)
-    ; RT(0) IS THE COUNT OF HOW MANY IN THE ARRAY. NULL VALUES ARE
-"RTN","GPLRIMA",320,0)
-    ; RETURNED. RTN IS PASSED BY REFERENCE
-"RTN","GPLRIMA",321,0)
-    ;
-"RTN","GPLRIMA",322,0)
-    S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
-"RTN","GPLRIMA",323,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",324,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",325,0)
-    I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
-"RTN","GPLRIMA",326,0)
-    . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
-"RTN","GPLRIMA",327,0)
-    N ZZI,ZZS
-"RTN","GPLRIMA",328,0)
-    S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
-"RTN","GPLRIMA",329,0)
-    ; ZWR @ZZS@(1)
-"RTN","GPLRIMA",330,0)
-    S RTN(0)=@ZZS@(0)
-"RTN","GPLRIMA",331,0)
-    F ZZI=1:1:RTN(0) D  ; FOR ALL PARTS OF THIS SECTION ( IE FOR ALL MEDS)
-"RTN","GPLRIMA",332,0)
-    . S $P(RTN(ZZI),"^",1)=ZZI ; INDEX FOR VARIABLE
-"RTN","GPLRIMA",333,0)
-    . S $P(RTN(ZZI),"^",2)=@ZZS@(ZZI,IVAR) ; THE VALUE OF THE VARIABLE
-"RTN","GPLRIMA",334,0)
-    Q
-"RTN","GPLRIMA",335,0)
-    ;
-"RTN","GPLRIMA",336,0)
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
-"RTN","GPLRIMA",337,0)
-    ;
-"RTN","GPLRIMA",338,0)
-    N ZR
-"RTN","GPLRIMA",339,0)
-    D GETPA(.ZR,DFN,ISEC,IVAR)
-"RTN","GPLRIMA",340,0)
-    I $D(ZR(0)) D PARY^GPLXPATH("ZR")
-"RTN","GPLRIMA",341,0)
-    E  W "NOTHING RETURNED",!
-"RTN","GPLRIMA",342,0)
-    Q
-"RTN","GPLRIMA",343,0)
-    ;
-"RTN","GPLRIMA",344,0)
-CAGET(RTN,IATTR) ;
-"RTN","GPLRIMA",345,0)
-    ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",346,0)
-    ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
-"RTN","GPLRIMA",347,0)
-    ; IT RETURNS AN ARRAY OF THE VALUES OF VARIABLE IVAR IN SECTION ISEC
-"RTN","GPLRIMA",348,0)
-    Q
-"RTN","GPLRIMA",349,0)
-    ;
-"RTN","GPLRIMA",350,0)
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
-"RTN","GPLRIMA",351,0)
-    ;
-"RTN","GPLRIMA",352,0)
-    I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
-"RTN","GPLRIMA",353,0)
-    N ZLST
-"RTN","GPLRIMA",354,0)
-    S LSTRTN(0)=0 ; DEFAULT RETURN NONE
-"RTN","GPLRIMA",355,0)
-    S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
-"RTN","GPLRIMA",356,0)
-    S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
-"RTN","GPLRIMA",357,0)
-    N ZNC  ; ZNC IS NUMBER OF CATEGORIES
-"RTN","GPLRIMA",358,0)
-    S ZNC=@ZCBASE@(0)
-"RTN","GPLRIMA",359,0)
-    I ZNC=0 Q ; NO CATEGORIES TO SEARCH
-"RTN","GPLRIMA",360,0)
-    N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
-"RTN","GPLRIMA",361,0)
-    S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
-"RTN","GPLRIMA",362,0)
-    N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
-"RTN","GPLRIMA",363,0)
-    F ZI=1:1:ZNC D  ; FOR ALL CATEGORIES
-"RTN","GPLRIMA",364,0)
-    . S ZATBL=@ZCBASE@(ZI) ; PULL OUT ATTR TBL FOR CAT
-"RTN","GPLRIMA",365,0)
-    . I $P(ZATBL,"^",ZAP)'="" D  ; CAT HAS ATTR
-"RTN","GPLRIMA",366,0)
-    . . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
-"RTN","GPLRIMA",367,0)
-    . . M LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
-"RTN","GPLRIMA",368,0)
-    S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
-"RTN","GPLRIMA",369,0)
-    S ZPAT=0 ; START AT FIRST PATIENT IN LIST
-"RTN","GPLRIMA",370,0)
-    F  S ZPAT=$O(LSTRTN(ZPAT)) Q:ZPAT=""  D  ;
-"RTN","GPLRIMA",371,0)
-    . S ZCNT=ZCNT+1
-"RTN","GPLRIMA",372,0)
-    S LSTRTN(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
-"RTN","GPLRIMA",373,0)
-    Q
-"RTN","GPLRIMA",374,0)
-    ;
-"RTN","GPLRIMA",375,0)
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
-"RTN","GPLRIMA",376,0)
-    ;
-"RTN","GPLRIMA",377,0)
-    N ZR
-"RTN","GPLRIMA",378,0)
-    D PCLST(.ZR,CATTR)
-"RTN","GPLRIMA",379,0)
-    I ZR(0)=0 D  Q  ;
-"RTN","GPLRIMA",380,0)
-    . W "NO PATIENTS RETURNED",!
-"RTN","GPLRIMA",381,0)
-    E  D  ;
-"RTN","GPLRIMA",382,0)
-    . D PARY^GPLXPATH("ZR") ; PRINT ARRAY
-"RTN","GPLRIMA",383,0)
-    . W "COUNT=",ZR(0),!
-"RTN","GPLRIMA",384,0)
-    Q
-"RTN","GPLRIMA",385,0)
-    ;
-"RTN","GPLRIMA",386,0)
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
-"RTN","GPLRIMA",387,0)
-    ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
-"RTN","GPLRIMA",388,0)
-    ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
-"RTN","GPLRIMA",389,0)
-    ; DFN IS THE PATIENT NUMBER.
-"RTN","GPLRIMA",390,0)
-    ; WHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",391,0)
-    ; OR OTHER SECTIONS AS THEY ARE ADDED
-"RTN","GPLRIMA",392,0)
-    ; THIS IS MEANT TO BE AVAILABLE AS AN RPC
-"RTN","GPLRIMA",393,0)
-    I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
-"RTN","GPLRIMA",394,0)
-    S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
-"RTN","GPLRIMA",395,0)
-    S RTN(0)=0 ; DEFAULT NOTHING IS RETURNED
-"RTN","GPLRIMA",396,0)
-    N ZZGI
-"RTN","GPLRIMA",397,0)
-    I WHICH="ALL" D  ; VARIABLES FROM ALL SECTIONS
-"RTN","GPLRIMA",398,0)
-    . F ZZGI="PROBLEMS","VITALS","MEDS","ALERTS" D  ; FOR EACH SECTION
-"RTN","GPLRIMA",399,0)
-    . . D ZGVWRK(ZZGI) ; DO EACH SECTION
-"RTN","GPLRIMA",400,0)
-    E  D ZGVWRK(WHICH) ; ONLY ONE SECTION ASKED FOR
-"RTN","GPLRIMA",401,0)
-    Q
-"RTN","GPLRIMA",402,0)
-    ;
-"RTN","GPLRIMA",403,0)
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
-"RTN","GPLRIMA",404,0)
-    ;
-"RTN","GPLRIMA",405,0)
-    N ZZGN ; NAME FOR SECTION VARIABLES
-"RTN","GPLRIMA",406,0)
-    S ZZGN=$NA(@ZVBASE@(DFN,ZWHICH)) ; BASE OF VARS FOR SECTION
-"RTN","GPLRIMA",407,0)
-    I '$D(@ZZGN@(0)) Q ; NO VARS FOR THIS SECTION
-"RTN","GPLRIMA",408,0)
-    E  D  ; VARS EXIST
-"RTN","GPLRIMA",409,0)
-    . N ZGVI
-"RTN","GPLRIMA",410,0)
-    . F ZGVI=1:1:@ZZGN@(0) D  ; FOR EACH MULTIPLE IN SECTION
-"RTN","GPLRIMA",411,0)
-    . . K ZZGA N ZZGA ; TEMP ARRAY FOR SECTION VARS
-"RTN","GPLRIMA",412,0)
-    . . K ZZGN2 N ZZGN2 ; NAME FOR MULTIPLE
-"RTN","GPLRIMA",413,0)
-    . . S ZZGN2=$NA(@ZZGN@(ZGVI))
-"RTN","GPLRIMA",414,0)
-    . . ; W ZZGN2,!,$O(@ZZGN2@("")),!
-"RTN","GPLRIMA",415,0)
-    . . D H2ARY^GPLXPATH("ZZGA",ZZGN2,ZGVI) ; CONVERT HASH TO ARRAY
-"RTN","GPLRIMA",416,0)
-    . . ; D PARY^GPLXPATH("ZZGA")
-"RTN","GPLRIMA",417,0)
-    . . D PUSHA^GPLXPATH("RTN","ZZGA") ; PUSH ARRAY INTO RETURN
-"RTN","GPLRIMA",418,0)
-    Q
-"RTN","GPLRIMA",419,0)
-    ;
-"RTN","GPLRIMA",420,0)
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN GPLRIM
-"RTN","GPLRIMA",421,0)
-    ; ALONG WITH SAMPLE VALUES.
-"RTN","GPLRIMA",422,0)
-    ; IWHICH IS "ALL" OR "MEDS" OR "VITALS" OR "PROBLEMS" OR "ALERTS" OR "LABS"
-"RTN","GPLRIMA",423,0)
-    N GTMP
-"RTN","GPLRIMA",424,0)
-    I '$D(^TMP("GPLRIM","ATTR",DFN)) D  ; RIM VARS NOT PRESENT
-"RTN","GPLRIMA",425,0)
-    . D ANALYZE(DFN,1) ; REFRESH THE RIM VARIABLES
-"RTN","GPLRIMA",426,0)
-    I '$D(IWHICH) S IWHICH="ALL"
-"RTN","GPLRIMA",427,0)
-    D RPCGV(.GTMP,DFN,IWHICH)
-"RTN","GPLRIMA",428,0)
-    D PARY^GPLXPATH("GTMP")
-"RTN","GPLRIMA",429,0)
-    Q
-"RTN","GPLRIMA",430,0)
-    ;
-"RTN","GPLUNIT")
-0^12^B31438520
-"RTN","GPLUNIT",1,0)
-GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
-"RTN","GPLUNIT",2,0)
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 14
-"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  Q ; TEST SECTION DOESN'T EXIST
-"RTN","GPLUNIT",82,0)
-          . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-"RTN","GPLUNIT",83,0)
-          N FIRST,LAST
-"RTN","GPLUNIT",84,0)
-          S FIRST=$P(ZARY(WHICH),"^",1)
-"RTN","GPLUNIT",85,0)
-          S LAST=$P(ZARY(WHICH),"^",2)
-"RTN","GPLUNIT",86,0)
-          F ZI=FIRST:1:LAST  D
-"RTN","GPLUNIT",87,0)
-          . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-"RTN","GPLUNIT",88,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",89,0)
-          . . ;  W ZP,!
-"RTN","GPLUNIT",90,0)
-          . . S ZX=ZP
-"RTN","GPLUNIT",91,0)
-          . . W "RUNNING: "_ZP
-"RTN","GPLUNIT",92,0)
-          . . X ZX
-"RTN","GPLUNIT",93,0)
-          . . W "..SUCCESS: ",WHICH,!
-"RTN","GPLUNIT",94,0)
-          . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
-"RTN","GPLUNIT",95,0)
-          . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
-"RTN","GPLUNIT",96,0)
-          . . S ZX="S ZR="_ZP
-"RTN","GPLUNIT",97,0)
-          . . W "TRYING: "_ZP
-"RTN","GPLUNIT",98,0)
-          . . X ZX
-"RTN","GPLUNIT",99,0)
-          . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-"RTN","GPLUNIT",100,0)
-          . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-"RTN","GPLUNIT",101,0)
-          . . . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",102,0)
-          . . I ZR S TPASSED=TPASSED+1
-"RTN","GPLUNIT",103,0)
-          . . I 'ZR S TFAILED=TFAILED+1
-"RTN","GPLUNIT",104,0)
-          Q
-"RTN","GPLUNIT",105,0)
-          ;
-"RTN","GPLUNIT",106,0)
-TEST   ; RUN ALL THE TEST CASES
-"RTN","GPLUNIT",107,0)
-          N ZTMP
-"RTN","GPLUNIT",108,0)
-          D ZLOAD(.ZTMP)
-"RTN","GPLUNIT",109,0)
-          D ZTEST(.ZTMP,"ALL")
-"RTN","GPLUNIT",110,0)
-          W "PASSED: ",TPASSED,!
-"RTN","GPLUNIT",111,0)
-          W "FAILED: ",TFAILED,!
-"RTN","GPLUNIT",112,0)
-          W !
-"RTN","GPLUNIT",113,0)
-          W "THE TESTS!",!
-"RTN","GPLUNIT",114,0)
-          ; I DEBUG ZWR ZTMP
-"RTN","GPLUNIT",115,0)
-          Q
-"RTN","GPLUNIT",116,0)
-          ;
-"RTN","GPLUNIT",117,0)
-GTSTS(GTZARY,RTN) ; return an array of test names
-"RTN","GPLUNIT",118,0)
-          N I,J S I="" S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",119,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",120,0)
-          . D PUSH^GPLXPATH(RTN,I)
-"RTN","GPLUNIT",121,0)
-          . S I=$O(GTZARY("TESTS",I))
-"RTN","GPLUNIT",122,0)
-          Q
-"RTN","GPLUNIT",123,0)
-          ;
-"RTN","GPLUNIT",124,0)
-TESTALL(RNM) ; RUN ALL THE TESTS
-"RTN","GPLUNIT",125,0)
-          N ZI,J,TZTMP,TSTS,TOTP,TOTF
-"RTN","GPLUNIT",126,0)
-          S TOTP=0 S TOTF=0
-"RTN","GPLUNIT",127,0)
-          D ZLOAD^GPLUNIT("TZTMP",RNM)
-"RTN","GPLUNIT",128,0)
-          D GTSTS(.TZTMP,"TSTS")
-"RTN","GPLUNIT",129,0)
-          F ZI=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",130,0)
-          . S TPASSED=0 S TFAILED=0
-"RTN","GPLUNIT",131,0)
-          . D ZTEST^GPLUNIT(.TZTMP,TSTS(ZI))
-"RTN","GPLUNIT",132,0)
-          . S TOTP=TOTP+TPASSED
-"RTN","GPLUNIT",133,0)
-          . S TOTF=TOTF+TFAILED
-"RTN","GPLUNIT",134,0)
-          . S $P(TSTS(ZI),"^",2)=TPASSED
-"RTN","GPLUNIT",135,0)
-          . S $P(TSTS(ZI),"^",3)=TFAILED
-"RTN","GPLUNIT",136,0)
-          F I=1:1:TSTS(0) D  ;
-"RTN","GPLUNIT",137,0)
-          . W "TEST=> ",$P(TSTS(ZI),"^",1)
-"RTN","GPLUNIT",138,0)
-          . W " PASSED=>",$P(TSTS(ZI),"^",2)
-"RTN","GPLUNIT",139,0)
-          . W " FAILED=>",$P(TSTS(ZI),"^",3),!
-"RTN","GPLUNIT",140,0)
-          W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
-"RTN","GPLUNIT",141,0)
-          Q
-"RTN","GPLUNIT",142,0)
-          ;
-"RTN","GPLUNIT",143,0)
-TLIST(ZARY) ; LIST ALL THE TESTS
-"RTN","GPLUNIT",144,0)
-          ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
-"RTN","GPLUNIT",145,0)
-          ; ZARY IS PASSED BY REFERENCE
-"RTN","GPLUNIT",146,0)
-          N I,J,K S I="" S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",147,0)
-          S K=1
-"RTN","GPLUNIT",148,0)
-          F J=0:0  Q:I=""  D
-"RTN","GPLUNIT",149,0)
-          . ; W "I IS NOW=",I,!
-"RTN","GPLUNIT",150,0)
-          . W I," "
-"RTN","GPLUNIT",151,0)
-          . S I=$O(ZARY("TESTS",I))
-"RTN","GPLUNIT",152,0)
-          . S K=K+1 I K=6  D
-"RTN","GPLUNIT",153,0)
-          . . W !
-"RTN","GPLUNIT",154,0)
-          . . S K=1
-"RTN","GPLUNIT",155,0)
-          Q
-"RTN","GPLUNIT",156,0)
-          ;
-"RTN","GPLVITAL")
-0^17^B82628966
-"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 14
-"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)
- S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
-"RTN","GPLVITAL",45,0)
- F J=1:1:VCNT  D  ; FOR EACH VITAL IN THE LIST
-"RTN","GPLVITAL",46,0)
- . I $D(VITRSLT(VSORT(J))) D
-"RTN","GPLVITAL",47,0)
- . . S VITVMAP=$NA(@VITTVMAP@(J))
-"RTN","GPLVITAL",48,0)
- . . K @VITVMAP
-"RTN","GPLVITAL",49,0)
- . . I DEBUG W "VMAP= ",VITVMAP,!
-"RTN","GPLVITAL",50,0)
- . . S VITPTMP=VITRSLT(VSORT(J)) ; DATE SORTED VITAL FROM RETURN ARRAY
-"RTN","GPLVITAL",51,0)
- . . I DEBUG W "VITAL ",VSORT(J),!
-"RTN","GPLVITAL",52,0)
- . . I DEBUG W VITRSLT(VSORT(J))," ",$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT"),!
-"RTN","GPLVITAL",53,0)
- . . I DEBUG W $P(VITPTMP,U,4),!
-"RTN","GPLVITAL",54,0)
- . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID
-"RTN","GPLVITAL",55,0)
- . . I $P(VITPTMP,U,2)="HT" D
-"RTN","GPLVITAL",56,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",57,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",58,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",59,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",60,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",61,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",62,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-"RTN","GPLVITAL",63,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-"RTN","GPLVITAL",64,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",65,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",66,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",67,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",68,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-"RTN","GPLVITAL",69,0)
- . . E  I $P(VITPTMP,U,2)="WT" D
-"RTN","GPLVITAL",70,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",71,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",72,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",73,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",74,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",75,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",76,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-"RTN","GPLVITAL",77,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-"RTN","GPLVITAL",78,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",79,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",80,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",81,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",82,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-"RTN","GPLVITAL",83,0)
- . . E  I $P(VITPTMP,U,2)="BP" D
-"RTN","GPLVITAL",84,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",85,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",86,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",87,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",88,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",89,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",90,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-"RTN","GPLVITAL",91,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-"RTN","GPLVITAL",92,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",93,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",94,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",95,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",96,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",97,0)
- . . E  I $P(VITPTMP,U,2)="T" D
-"RTN","GPLVITAL",98,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",99,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",100,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",101,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",102,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",103,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",104,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-"RTN","GPLVITAL",105,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-"RTN","GPLVITAL",106,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",107,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",108,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",109,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",110,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-"RTN","GPLVITAL",111,0)
- . . E  I $P(VITPTMP,U,2)="R" D
-"RTN","GPLVITAL",112,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",113,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",114,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",115,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",116,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",117,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",118,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-"RTN","GPLVITAL",119,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-"RTN","GPLVITAL",120,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",121,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",122,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",123,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",124,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",125,0)
- . . E  I $P(VITPTMP,U,2)="P" D
-"RTN","GPLVITAL",126,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",127,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",128,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",129,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",130,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",131,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",132,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-"RTN","GPLVITAL",133,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-"RTN","GPLVITAL",134,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",135,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",136,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",137,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",138,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",139,0)
- . . E  I $P(VITPTMP,U,2)="PN" D
-"RTN","GPLVITAL",140,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",141,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",142,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",143,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",144,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",145,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",146,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-"RTN","GPLVITAL",147,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-"RTN","GPLVITAL",148,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-"RTN","GPLVITAL",149,0)
- . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",150,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",151,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",152,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-"RTN","GPLVITAL",153,0)
- . . E  D
-"RTN","GPLVITAL",154,0)
- . . . ;W "IN VITAL:  OTHER",!
-"RTN","GPLVITAL",155,0)
- . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-"RTN","GPLVITAL",156,0)
- . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-"RTN","GPLVITAL",157,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-"RTN","GPLVITAL",158,0)
- . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-"RTN","GPLVITAL",159,0)
- . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-"RTN","GPLVITAL",160,0)
- . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-"RTN","GPLVITAL",161,0)
- . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-"RTN","GPLVITAL",162,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-"RTN","GPLVITAL",163,0)
- . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-"RTN","GPLVITAL",164,0)
- . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-"RTN","GPLVITAL",165,0)
- . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-"RTN","GPLVITAL",166,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-"RTN","GPLVITAL",167,0)
- . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-"RTN","GPLVITAL",168,0)
- . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-"RTN","GPLVITAL",169,0)
- . . K @VITARYTMP
-"RTN","GPLVITAL",170,0)
- . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-"RTN","GPLVITAL",171,0)
- . . I J=1 D  ; FIRST ONE IS JUST A COPY
-"RTN","GPLVITAL",172,0)
- . . . ; W "FIRST ONE",!
-"RTN","GPLVITAL",173,0)
- . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-"RTN","GPLVITAL",174,0)
- . . . I DEBUG W "VITOUTXML ",VITOUTXML,!
-"RTN","GPLVITAL",175,0)
- . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-"RTN","GPLVITAL",176,0)
- . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-"RTN","GPLVITAL",177,0)
- ; ZWR ^TMP($J,"VITALS",*)
-"RTN","GPLVITAL",178,0)
- ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-"RTN","GPLVITAL",179,0)
- I DEBUG D PARY^GPLXPATH(VITOUTXML)
-"RTN","GPLVITAL",180,0)
- N VITTMP,I
-"RTN","GPLVITAL",181,0)
- D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-"RTN","GPLVITAL",182,0)
- I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-"RTN","GPLVITAL",183,0)
- . W "VITALS MISSING ",!
-"RTN","GPLVITAL",184,0)
- . F I=1:1:VITTMP(0) W VITTMP(I),!
-"RTN","GPLVITAL",185,0)
- Q
-"RTN","GPLVITAL",186,0)
- ;
-"RTN","GPLVITAL",187,0)
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
-"RTN","GPLVITAL",188,0)
- ; OF DATES IN THE VITALS RESULTS
-"RTN","GPLVITAL",189,0)
- N VDTI,VDTJ,VTDCNT
-"RTN","GPLVITAL",190,0)
- S VTDCNT=0 ; COUNT TO BUILD ARRAY
-"RTN","GPLVITAL",191,0)
- S VDTJ="" ; USED TO VISIT THE RESULTS
-"RTN","GPLVITAL",192,0)
- F VDTI=0:0 D  Q:$O(VITRSLT(VDTJ))=""  ; VISIT ALL RESULTS
-"RTN","GPLVITAL",193,0)
- . S VDTJ=$O(VITRSLT(VDTJ)) ; NEXT RESULT
-"RTN","GPLVITAL",194,0)
- . S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
-"RTN","GPLVITAL",195,0)
- . S VDT(VTDCNT)=$P(VITRSLT(VDTJ),U,4) ; PULL OUT THE DATE
-"RTN","GPLVITAL",196,0)
- S VDT(0)=VTDCNT
-"RTN","GPLVITAL",197,0)
- Q
-"RTN","GPLVITAL",198,0)
- ;
-"RTN","GPLXPAT0")
-0^21^B51026779
-"RTN","GPLXPAT0",1,0)
-GPLXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
-"RTN","GPLXPAT0",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 14
-"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)
- ;;><PUSHA>
-"RTN","GPLXPAT0",193,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",194,0)
- ;;>>>N GTMP,GTMP2
-"RTN","GPLXPAT0",195,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","A")
-"RTN","GPLXPAT0",196,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","B")
-"RTN","GPLXPAT0",197,0)
- ;;>>>D PUSH^GPLXPATH("GTMP2","C")
-"RTN","GPLXPAT0",198,0)
- ;;>>>D PUSHA^GPLXPATH("GTMP","GTMP2")
-"RTN","GPLXPAT0",199,0)
- ;;>>?GTMP(3)="C"
-"RTN","GPLXPAT0",200,0)
- ;;>>?GTMP(0)=3
-"RTN","GPLXPAT0",201,0)
- ;;><H2ARY>
-"RTN","GPLXPAT0",202,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",203,0)
- ;;>>>S GTMP("TEST1")=1
-"RTN","GPLXPAT0",204,0)
- ;;>>>D H2ARY^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",205,0)
- ;;>>?GTMP2(0)=1
-"RTN","GPLXPAT0",206,0)
- ;;>>?GTMP2(1)="^TEST1^1"
-"RTN","GPLXPAT0",207,0)
- ;;><XVARS>
-"RTN","GPLXPAT0",208,0)
- ;;>>>K GTMP,GTMP2
-"RTN","GPLXPAT0",209,0)
- ;;>>>D PUSH^GPLXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
-"RTN","GPLXPAT0",210,0)
- ;;>>>D XVARS^GPLXPATH("GTMP2","GTMP")
-"RTN","GPLXPAT0",211,0)
- ;;>>?GTMP2(1)="^VAR1^"
-"RTN","GPLXPAT0",212,0)
- ;;></TEST>
-"RTN","GPLXPATH")
-0^9^B242640815
-"RTN","GPLXPATH",1,0)
-GPLXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
-"RTN","GPLXPATH",2,0)
- ;;0.2;CCDCCR;nopatch;noreleasedate;Build 14
-"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)
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
-"RTN","GPLXPATH",53,0)
- ;
-"RTN","GPLXPATH",54,0)
- N ZGI
-"RTN","GPLXPATH",55,0)
- F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
-"RTN","GPLXPATH",56,0)
- . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
-"RTN","GPLXPATH",57,0)
- Q
-"RTN","GPLXPATH",58,0)
- ;
-"RTN","GPLXPATH",59,0)
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
-"RTN","GPLXPATH",60,0)
- ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
-"RTN","GPLXPATH",61,0)
- S RTN=""
-"RTN","GPLXPATH",62,0)
- N I
-"RTN","GPLXPATH",63,0)
- ; W "STK= ",STK,!
-"RTN","GPLXPATH",64,0)
- I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",65,0)
- . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
-"RTN","GPLXPATH",66,0)
- . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
-"RTN","GPLXPATH",67,0)
- . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
-"RTN","GPLXPATH",68,0)
- Q
-"RTN","GPLXPATH",69,0)
- ;
-"RTN","GPLXPATH",70,0)
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
-"RTN","GPLXPATH",71,0)
- ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
-"RTN","GPLXPATH",72,0)
- ; ISTR IS PASSED BY VALUE
-"RTN","GPLXPATH",73,0)
- N CUR,TMP
-"RTN","GPLXPATH",74,0)
- I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
-"RTN","GPLXPATH",75,0)
- . S TMP=$P(ISTR,"<",2)
-"RTN","GPLXPATH",76,0)
- I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
-"RTN","GPLXPATH",77,0)
- . S TMP=$P(TMP,"/",2)
-"RTN","GPLXPATH",78,0)
- S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
-"RTN","GPLXPATH",79,0)
- ; W "CUR= ",CUR,!
-"RTN","GPLXPATH",80,0)
- I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
-"RTN","GPLXPATH",81,0)
- . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
-"RTN","GPLXPATH",82,0)
- ; W "CUR2= ",CUR,!
-"RTN","GPLXPATH",83,0)
- Q CUR
-"RTN","GPLXPATH",84,0)
- ;
-"RTN","GPLXPATH",85,0)
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
-"RTN","GPLXPATH",86,0)
- ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
-"RTN","GPLXPATH",87,0)
- ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
-"RTN","GPLXPATH",88,0)
- ; XML SECTION
-"RTN","GPLXPATH",89,0)
- ; ZXML IS PASSED BY NAME
-"RTN","GPLXPATH",90,0)
- N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
-"RTN","GPLXPATH",91,0)
- N GPLSTK ; LEAVE OUT FOR DEBUGGING
-"RTN","GPLXPATH",92,0)
- I '$D(@ZXML@(0))  D  ; NO XML PASSED
-"RTN","GPLXPATH",93,0)
- . W "ERROR IN XML FILE",!
-"RTN","GPLXPATH",94,0)
- S GPLSTK(0)=0 ; INITIALIZE STACK
-"RTN","GPLXPATH",95,0)
- F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
-"RTN","GPLXPATH",96,0)
- . S LINE=@ZXML@(I)
-"RTN","GPLXPATH",97,0)
- . ;W LINE,!
-"RTN","GPLXPATH",98,0)
- . S FOUND=0  ; INTIALIZED FOUND FLAG
-"RTN","GPLXPATH",99,0)
- . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
-"RTN","GPLXPATH",100,0)
- . I FOUND'=1  D
-"RTN","GPLXPATH",101,0)
- . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
-"RTN","GPLXPATH",102,0)
- . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
-"RTN","GPLXPATH",103,0)
- . . . ; ON THE SAME LINE
-"RTN","GPLXPATH",104,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",105,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",106,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",107,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",108,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",109,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",110,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",111,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",112,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",113,0)
- . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
-"RTN","GPLXPATH",114,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",115,0)
- . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
-"RTN","GPLXPATH",116,0)
- . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
-"RTN","GPLXPATH",117,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",118,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",119,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",120,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",121,0)
- . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",122,0)
- . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
-"RTN","GPLXPATH",123,0)
- . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
-"RTN","GPLXPATH",124,0)
- . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
-"RTN","GPLXPATH",125,0)
- . . . . D PARY("GPLSTK") ; PRINT OUT THE STACK FOR DEBUGING
-"RTN","GPLXPATH",126,0)
- . . . . Q
-"RTN","GPLXPATH",127,0)
- . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
-"RTN","GPLXPATH",128,0)
- . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
-"RTN","GPLXPATH",129,0)
- . . . ; W "FOUND ",LINE,!
-"RTN","GPLXPATH",130,0)
- . . . S FOUND=1  ; SET FOUND FLAG
-"RTN","GPLXPATH",131,0)
- . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
-"RTN","GPLXPATH",132,0)
- . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
-"RTN","GPLXPATH",133,0)
- . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
-"RTN","GPLXPATH",134,0)
- . . . ; W "MDX=",MDX,!
-"RTN","GPLXPATH",135,0)
- . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
-"RTN","GPLXPATH",136,0)
- . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
-"RTN","GPLXPATH",137,0)
- . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
-"RTN","GPLXPATH",138,0)
- . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
-"RTN","GPLXPATH",139,0)
- S @ZXML@("INDEXED")=""
-"RTN","GPLXPATH",140,0)
- S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
-"RTN","GPLXPATH",141,0)
- Q
-"RTN","GPLXPATH",142,0)
- ;
-"RTN","GPLXPATH",143,0)
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
-"RTN","GPLXPATH",144,0)
- ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
-"RTN","GPLXPATH",145,0)
- ; IARY AND OARY ARE PASSED BY NAME
-"RTN","GPLXPATH",146,0)
- I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
-"RTN","GPLXPATH",147,0)
- . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
-"RTN","GPLXPATH",148,0)
- N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
-"RTN","GPLXPATH",149,0)
- N TMP,I,J,QXPATH
-"RTN","GPLXPATH",150,0)
- S FIRST=1
-"RTN","GPLXPATH",151,0)
- S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
-"RTN","GPLXPATH",152,0)
- I XPATH'="//" D  ; NOT A ROOT QUERY
-"RTN","GPLXPATH",153,0)
- . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
-"RTN","GPLXPATH",154,0)
- . S FIRST=$P(TMP,"^",1)
-"RTN","GPLXPATH",155,0)
- . S LAST=$P(TMP,"^",2)
-"RTN","GPLXPATH",156,0)
- K @OARY
-"RTN","GPLXPATH",157,0)
- S @OARY@(0)=+LAST-FIRST+1
-"RTN","GPLXPATH",158,0)
- S J=1
-"RTN","GPLXPATH",159,0)
- FOR I=FIRST:1:LAST  D
-"RTN","GPLXPATH",160,0)
- . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
-"RTN","GPLXPATH",161,0)
- . S J=J+1
-"RTN","GPLXPATH",162,0)
- ; ZWR OARY
-"RTN","GPLXPATH",163,0)
- Q
-"RTN","GPLXPATH",164,0)
- ;
-"RTN","GPLXPATH",165,0)
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
-"RTN","GPLXPATH",166,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",167,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",168,0)
- Q $P(@IDX@(XPATH),"^",1)
-"RTN","GPLXPATH",169,0)
- ;
-"RTN","GPLXPATH",170,0)
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
-"RTN","GPLXPATH",171,0)
- ; INDEX WITH TWO PIECES START^FINISH
-"RTN","GPLXPATH",172,0)
- ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",173,0)
- Q $P(@IDX@(XPATH),"^",2)
-"RTN","GPLXPATH",174,0)
- ;
-"RTN","GPLXPATH",175,0)
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
-"RTN","GPLXPATH",176,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",177,0)
- ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
-"RTN","GPLXPATH",178,0)
- Q $P(ISTR,";",2)
-"RTN","GPLXPATH",179,0)
- ;
-"RTN","GPLXPATH",180,0)
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
-"RTN","GPLXPATH",181,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",182,0)
- Q $P(ISTR,";",3)
-"RTN","GPLXPATH",183,0)
- ;
-"RTN","GPLXPATH",184,0)
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
-"RTN","GPLXPATH",185,0)
- ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
-"RTN","GPLXPATH",186,0)
- Q $P(ISTR,";",1)
-"RTN","GPLXPATH",187,0)
- ;
-"RTN","GPLXPATH",188,0)
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
-"RTN","GPLXPATH",189,0)
- ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
-"RTN","GPLXPATH",190,0)
- ; DEST IS CLEARED TO START
-"RTN","GPLXPATH",191,0)
- ; USES PUSH TO DO THE COPY
-"RTN","GPLXPATH",192,0)
- N I
-"RTN","GPLXPATH",193,0)
- K @BDEST
-"RTN","GPLXPATH",194,0)
- F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
-"RTN","GPLXPATH",195,0)
- . N J,ATMP
-"RTN","GPLXPATH",196,0)
- . S ATMP=$$ARRAY(@BLIST@(I))
-"RTN","GPLXPATH",197,0)
- . I DEBUG W "ATMP=",ATMP,!
-"RTN","GPLXPATH",198,0)
- . I DEBUG W @BLIST@(I),!
-"RTN","GPLXPATH",199,0)
- . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
-"RTN","GPLXPATH",200,0)
- . . ; FOR EACH LINE IN THIS INSTR
-"RTN","GPLXPATH",201,0)
- . . I DEBUG W "BDEST= ",BDEST,!
-"RTN","GPLXPATH",202,0)
- . . I DEBUG W "ATMP= ",@ATMP@(J),!
-"RTN","GPLXPATH",203,0)
- . . D PUSH(BDEST,@ATMP@(J))
-"RTN","GPLXPATH",204,0)
- Q
-"RTN","GPLXPATH",205,0)
- ;
-"RTN","GPLXPATH",206,0)
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
-"RTN","GPLXPATH",207,0)
- ;
-"RTN","GPLXPATH",208,0)
- I DEBUG W "QUEUEING ",BLST,!
-"RTN","GPLXPATH",209,0)
- D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
-"RTN","GPLXPATH",210,0)
- Q
-"RTN","GPLXPATH",211,0)
- ;
-"RTN","GPLXPATH",212,0)
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
-"RTN","GPLXPATH",213,0)
- ; KILLS CPDEST FIRST
-"RTN","GPLXPATH",214,0)
- N CPINSTR
-"RTN","GPLXPATH",215,0)
- I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
-"RTN","GPLXPATH",216,0)
- I @CPSRC@(0)<1 D  ; BAD LENGTH
-"RTN","GPLXPATH",217,0)
- . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
-"RTN","GPLXPATH",218,0)
- . Q
-"RTN","GPLXPATH",219,0)
- ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
-"RTN","GPLXPATH",220,0)
- D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
-"RTN","GPLXPATH",221,0)
- D BUILD("CPINSTR",CPDEST)
-"RTN","GPLXPATH",222,0)
- Q
-"RTN","GPLXPATH",223,0)
- ;
-"RTN","GPLXPATH",224,0)
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
-"RTN","GPLXPATH",225,0)
- ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
-"RTN","GPLXPATH",226,0)
- ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
-"RTN","GPLXPATH",227,0)
- ; USED TO INSERT CHILDREN NODES
-"RTN","GPLXPATH",228,0)
- I @QOXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",229,0)
- . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
-"RTN","GPLXPATH",230,0)
- . Q
-"RTN","GPLXPATH",231,0)
- I DEBUG W "DOING QOPEN",!
-"RTN","GPLXPATH",232,0)
- N S1,E1,QOT,QOTMP
-"RTN","GPLXPATH",233,0)
- S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
-"RTN","GPLXPATH",234,0)
- I $D(QOXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",235,0)
- . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
-"RTN","GPLXPATH",236,0)
- . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
-"RTN","GPLXPATH",237,0)
- I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",238,0)
- . S E1=@QOXML@(0)-1
-"RTN","GPLXPATH",239,0)
- D QUEUE(QOBLIST,QOXML,S1,E1)
-"RTN","GPLXPATH",240,0)
- ; S QOTMP=QOXML_"^"_S1_"^"_E1
-"RTN","GPLXPATH",241,0)
- ; D PUSH(QOBLIST,QOTMP)
-"RTN","GPLXPATH",242,0)
- Q
-"RTN","GPLXPATH",243,0)
- ;
-"RTN","GPLXPATH",244,0)
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
-"RTN","GPLXPATH",245,0)
- ; ADDS THE LIST LINE OF QCXML TO QCBLIST
-"RTN","GPLXPATH",246,0)
- ; USED TO FINISH INSERTING CHILDERN NODES
-"RTN","GPLXPATH",247,0)
- ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
-"RTN","GPLXPATH",248,0)
- ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
-"RTN","GPLXPATH",249,0)
- I @QCXML@(0)<1 D  ; MALFORMED XML
-"RTN","GPLXPATH",250,0)
- . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
-"RTN","GPLXPATH",251,0)
- I DEBUG W "GOING TO CLOSE",!
-"RTN","GPLXPATH",252,0)
- N S1,E1,QCT,QCTMP
-"RTN","GPLXPATH",253,0)
- S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
-"RTN","GPLXPATH",254,0)
- I $D(QCXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",255,0)
- . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
-"RTN","GPLXPATH",256,0)
- . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
-"RTN","GPLXPATH",257,0)
- I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",258,0)
- . S S1=@QCXML@(0)
-"RTN","GPLXPATH",259,0)
- D QUEUE(QCBLIST,QCXML,S1,E1)
-"RTN","GPLXPATH",260,0)
- ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
-"RTN","GPLXPATH",261,0)
- Q
-"RTN","GPLXPATH",262,0)
- ;
-"RTN","GPLXPATH",263,0)
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
-"RTN","GPLXPATH",264,0)
- ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
-"RTN","GPLXPATH",265,0)
- ; OMITTED, INSERTION WILL BE AT THE ROOT
-"RTN","GPLXPATH",266,0)
- ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
-"RTN","GPLXPATH",267,0)
- ; XML AT THE END OF THE XPATH POINT
-"RTN","GPLXPATH",268,0)
- ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-"RTN","GPLXPATH",269,0)
- N INSBLD,INSTMP
-"RTN","GPLXPATH",270,0)
- I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
-"RTN","GPLXPATH",271,0)
- I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-"RTN","GPLXPATH",272,0)
- I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-"RTN","GPLXPATH",273,0)
- . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
-"RTN","GPLXPATH",274,0)
- I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-"RTN","GPLXPATH",275,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",276,0)
- . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
-"RTN","GPLXPATH",277,0)
- . . I DEBUG D PARY^GPLXPATH("INSBLD")
-"RTN","GPLXPATH",278,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
-"RTN","GPLXPATH",279,0)
- . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
-"RTN","GPLXPATH",280,0)
- . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
-"RTN","GPLXPATH",281,0)
- . I $D(INSXPATH) D  ; XPATH PROVIDED
-"RTN","GPLXPATH",282,0)
- . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
-"RTN","GPLXPATH",283,0)
- . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
-"RTN","GPLXPATH",284,0)
- . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-"RTN","GPLXPATH",285,0)
- . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
-"RTN","GPLXPATH",286,0)
- . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
-"RTN","GPLXPATH",287,0)
- Q
-"RTN","GPLXPATH",288,0)
- ;
-"RTN","GPLXPATH",289,0)
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
-"RTN","GPLXPATH",290,0)
- ; INTO INNXML AT THE INNXPATH XPATH POINT
-"RTN","GPLXPATH",291,0)
- ;
-"RTN","GPLXPATH",292,0)
- N INNBLD,UXPATH
-"RTN","GPLXPATH",293,0)
- N INNTBUF
-"RTN","GPLXPATH",294,0)
- S INNTBUF=$NA(^TMP($J,"INNTBUF"))
-"RTN","GPLXPATH",295,0)
- I '$D(INNXPATH) D  ; XPATH NOT PASSED
-"RTN","GPLXPATH",296,0)
- . S UXPATH="//" ; USE ROOT XPATH
-"RTN","GPLXPATH",297,0)
- I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
-"RTN","GPLXPATH",298,0)
- I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
-"RTN","GPLXPATH",299,0)
- . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
-"RTN","GPLXPATH",300,0)
- . D BUILD("INNBLD",INNXML)
-"RTN","GPLXPATH",301,0)
- I @INNXML@(0)>0  D  ; NOT EMPTY
-"RTN","GPLXPATH",302,0)
- . D QOPEN("INNBLD",INNXML,UXPATH) ;
-"RTN","GPLXPATH",303,0)
- . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
-"RTN","GPLXPATH",304,0)
- . D QCLOSE("INNBLD",INNXML,UXPATH)
-"RTN","GPLXPATH",305,0)
- . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
-"RTN","GPLXPATH",306,0)
- . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
-"RTN","GPLXPATH",307,0)
- Q
-"RTN","GPLXPATH",308,0)
- ;
-"RTN","GPLXPATH",309,0)
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
-"RTN","GPLXPATH",310,0)
- ; BUT XDEST AN XNEW ARE PASSED BY NAME
-"RTN","GPLXPATH",311,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",312,0)
- D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
-"RTN","GPLXPATH",313,0)
- D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
-"RTN","GPLXPATH",314,0)
- D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
-"RTN","GPLXPATH",315,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",316,0)
- D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
-"RTN","GPLXPATH",317,0)
- I DEBUG D PARY("XDEST")
-"RTN","GPLXPATH",318,0)
- Q
-"RTN","GPLXPATH",319,0)
- ;
-"RTN","GPLXPATH",320,0)
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
-"RTN","GPLXPATH",321,0)
- ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
-"RTN","GPLXPATH",322,0)
- ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
-"RTN","GPLXPATH",323,0)
- ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
-"RTN","GPLXPATH",324,0)
- N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
-"RTN","GPLXPATH",325,0)
- S OLD=$NA(^TMP($J,"REPLACE_OLD"))
-"RTN","GPLXPATH",326,0)
- D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
-"RTN","GPLXPATH",327,0)
- S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
-"RTN","GPLXPATH",328,0)
- S XFIRST=$P(XNODE,"^",1)
-"RTN","GPLXPATH",329,0)
- S XLAST=$P(XNODE,"^",2)
-"RTN","GPLXPATH",330,0)
- I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
-"RTN","GPLXPATH",331,0)
- . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
-"RTN","GPLXPATH",332,0)
- . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",333,0)
- I RENEW'="" D  ; NEW XML IS NOT NULL
-"RTN","GPLXPATH",334,0)
- . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
-"RTN","GPLXPATH",335,0)
- . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
-"RTN","GPLXPATH",336,0)
- . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
-"RTN","GPLXPATH",337,0)
- I DEBUG W "REPLACE PREBUILD",!
-"RTN","GPLXPATH",338,0)
- I DEBUG D PARY("REBLD")
-"RTN","GPLXPATH",339,0)
- D BUILD("REBLD","RTMP")
-"RTN","GPLXPATH",340,0)
- K @REXML ; KILL WHAT WAS THERE
-"RTN","GPLXPATH",341,0)
- D CP("RTMP",REXML) ; COPY IN THE RESULT
-"RTN","GPLXPATH",342,0)
- Q
-"RTN","GPLXPATH",343,0)
- ;
-"RTN","GPLXPATH",344,0)
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
-"RTN","GPLXPATH",345,0)
- ; W "Reporting on the missing",!
-"RTN","GPLXPATH",346,0)
- ; W OARY
-"RTN","GPLXPATH",347,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
-"RTN","GPLXPATH",348,0)
- N I
-"RTN","GPLXPATH",349,0)
- S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
-"RTN","GPLXPATH",350,0)
- F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",351,0)
- . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
-"RTN","GPLXPATH",352,0)
- . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
-"RTN","GPLXPATH",353,0)
- . . Q
-"RTN","GPLXPATH",354,0)
- Q
-"RTN","GPLXPATH",355,0)
- ;
-"RTN","GPLXPATH",356,0)
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
-"RTN","GPLXPATH",357,0)
- ; AND PUT THE RESULTS IN OXML
-"RTN","GPLXPATH",358,0)
- I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
-"RTN","GPLXPATH",359,0)
- I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
-"RTN","GPLXPATH",360,0)
- N I,J,TNAM,TVAL,TSTR
-"RTN","GPLXPATH",361,0)
- S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
-"RTN","GPLXPATH",362,0)
- F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
-"RTN","GPLXPATH",363,0)
- . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
-"RTN","GPLXPATH",364,0)
- . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
-"RTN","GPLXPATH",365,0)
- . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
-"RTN","GPLXPATH",366,0)
- . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
-"RTN","GPLXPATH",367,0)
- . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
-"RTN","GPLXPATH",368,0)
- . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
-"RTN","GPLXPATH",369,0)
- . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
-"RTN","GPLXPATH",370,0)
- . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
-"RTN","GPLXPATH",371,0)
- . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
-"RTN","GPLXPATH",372,0)
- . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
-"RTN","GPLXPATH",373,0)
- . . . . E  D DOFLD ; PROCESS A FIELD
-"RTN","GPLXPATH",374,0)
- . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
-"RTN","GPLXPATH",375,0)
- . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
-"RTN","GPLXPATH",376,0)
- . . I DEBUG W TSTR
-"RTN","GPLXPATH",377,0)
- I DEBUG W "MAPPED",!
-"RTN","GPLXPATH",378,0)
- Q
-"RTN","GPLXPATH",379,0)
- ;
-"RTN","GPLXPATH",380,0)
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
-"RTN","GPLXPATH",381,0)
- ;
-"RTN","GPLXPATH",382,0)
- Q
-"RTN","GPLXPATH",383,0)
- ;
-"RTN","GPLXPATH",384,0)
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
-"RTN","GPLXPATH",385,0)
- ; THEXML IS PASSED BY NAME
-"RTN","GPLXPATH",386,0)
- N I,J,TMPXML,DEL,FOUND,INTXT
-"RTN","GPLXPATH",387,0)
- S FOUND=0
-"RTN","GPLXPATH",388,0)
- S INTXT=0
-"RTN","GPLXPATH",389,0)
- I DEBUG W "DELETING EMPTY ELEMENTS",!
-"RTN","GPLXPATH",390,0)
- F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
-"RTN","GPLXPATH",391,0)
- . S J=@THEXML@(I)
-"RTN","GPLXPATH",392,0)
- . I J["<text>" D
-"RTN","GPLXPATH",393,0)
- . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
-"RTN","GPLXPATH",394,0)
- . . I DEBUG W "IN HTML SECTION",!
-"RTN","GPLXPATH",395,0)
- . N JM,JP,JPX ; JMINUS AND JPLUS
-"RTN","GPLXPATH",396,0)
- . S JM=@THEXML@(I-1) ; LINE BEFORE
-"RTN","GPLXPATH",397,0)
- . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
-"RTN","GPLXPATH",398,0)
- . S JP=@THEXML@(I+1) ; LINE AFTER
-"RTN","GPLXPATH",399,0)
- . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
-"RTN","GPLXPATH",400,0)
- . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
-"RTN","GPLXPATH",401,0)
- . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
-"RTN","GPLXPATH",402,0)
- . . . I DEBUG W I,J,JP,!
-"RTN","GPLXPATH",403,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",404,0)
- . . . S DEL(I)="" ; SET LINE TO DELETE
-"RTN","GPLXPATH",405,0)
- . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
-"RTN","GPLXPATH",406,0)
- . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
-"RTN","GPLXPATH",407,0)
- . . . I DEBUG W I,J,!
-"RTN","GPLXPATH",408,0)
- . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
-"RTN","GPLXPATH",409,0)
- . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
-"RTN","GPLXPATH",410,0)
- . . . I JM=JPX D  ;
-"RTN","GPLXPATH",411,0)
- . . . . I DEBUG W I,JM_J_JPX,!
-"RTN","GPLXPATH",412,0)
- . . . . S DEL(I-1)=""
-"RTN","GPLXPATH",413,0)
- . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
-"RTN","GPLXPATH",414,0)
- ; . I J'["><" D PUSH("TMPXML",J)
-"RTN","GPLXPATH",415,0)
- I FOUND D  ; NEED TO DELETE THINGS
-"RTN","GPLXPATH",416,0)
- . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
-"RTN","GPLXPATH",417,0)
- . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
-"RTN","GPLXPATH",418,0)
- . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
-"RTN","GPLXPATH",419,0)
- . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
-"RTN","GPLXPATH",420,0)
- Q FOUND
-"RTN","GPLXPATH",421,0)
- ;
-"RTN","GPLXPATH",422,0)
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
-"RTN","GPLXPATH",423,0)
- ; XSEC IS A SECTION PASSED BY NAME
-"RTN","GPLXPATH",424,0)
- N XBLD,XTMP
-"RTN","GPLXPATH",425,0)
- D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
-"RTN","GPLXPATH",426,0)
- D BUILD("XBLD","XTMP") ; BUILD THE RESULT
-"RTN","GPLXPATH",427,0)
- D CP("XTMP",XSEC) ; REPLACE PASSED XML
-"RTN","GPLXPATH",428,0)
- Q
-"RTN","GPLXPATH",429,0)
- ;
-"RTN","GPLXPATH",430,0)
-PARY(GLO)       ;PRINT AN ARRAY
-"RTN","GPLXPATH",431,0)
- N I
-"RTN","GPLXPATH",432,0)
- F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
-"RTN","GPLXPATH",433,0)
- Q
-"RTN","GPLXPATH",434,0)
- ;
-"RTN","GPLXPATH",435,0)
-H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
-"RTN","GPLXPATH",436,0)
- ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
-"RTN","GPLXPATH",437,0)
- I '$D(IPRE) S IPRE=""
-"RTN","GPLXPATH",438,0)
- N H2I S H2I=""
-"RTN","GPLXPATH",439,0)
- ; W $O(@IHASH@(H2I)),!
-"RTN","GPLXPATH",440,0)
- F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
-"RTN","GPLXPATH",441,0)
- . ; W H2I_"^"_@IHASH@(H2I),!
-"RTN","GPLXPATH",442,0)
- . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
-"RTN","GPLXPATH",443,0)
- . . W "GPLZZ",!
-"RTN","GPLXPATH",444,0)
- . . W $NA(@IHASH@(H2I)),!
-"RTN","GPLXPATH",445,0)
- . . Q  ;
-"RTN","GPLXPATH",446,0)
- . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
-"RTN","GPLXPATH",447,0)
- . ; W @IARYRTN@(0),!
-"RTN","GPLXPATH",448,0)
- Q
-"RTN","GPLXPATH",449,0)
- ;
-"RTN","GPLXPATH",450,0)
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
-"RTN","GPLXPATH",451,0)
- ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
-"RTN","GPLXPATH",452,0)
- ; XVRTN AND XVIXML ARE PASSED BY NAME
-"RTN","GPLXPATH",453,0)
- ;
-"RTN","GPLXPATH",454,0)
- N XVI,XVTMP,XVT
-"RTN","GPLXPATH",455,0)
- F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
-"RTN","GPLXPATH",456,0)
- . S XVT=@XVIXML@(XVI)
-"RTN","GPLXPATH",457,0)
- . I XVT["@@" S XVTMP($P(XVT,"@@",2))=""
-"RTN","GPLXPATH",458,0)
- D H2ARY(XVRTN,"XVTMP")
-"RTN","GPLXPATH",459,0)
- Q
-"RTN","GPLXPATH",460,0)
- ;
-"RTN","GPLXPATH",461,0)
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
-"RTN","GPLXPATH",462,0)
- ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
-"RTN","GPLXPATH",463,0)
- ;
-"RTN","GPLXPATH",464,0)
- N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
-"RTN","GPLXPATH",465,0)
- I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
-"RTN","GPLXPATH",466,0)
- . D LOAD^GPLCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",467,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",468,0)
- E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
-"RTN","GPLXPATH",469,0)
- . D LOAD^GPLCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
-"RTN","GPLXPATH",470,0)
- . S DXUSE="DTMP" ; DXUSE IS NAME
-"RTN","GPLXPATH",471,0)
- E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
-"RTN","GPLXPATH",472,0)
- N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
-"RTN","GPLXPATH",473,0)
- D XVARS("DVARS",DXUSE) ; PULL OUT VARS
-"RTN","GPLXPATH",474,0)
- D PARY^GPLXPATH("DVARS") ;AND DISPLAY THEM
-"RTN","GPLXPATH",475,0)
- Q
-"RTN","GPLXPATH",476,0)
- ;
-"RTN","GPLXPATH",477,0)
-TEST     ; Run all the test cases
-"RTN","GPLXPATH",478,0)
- D TESTALL^GPLUNIT("GPLXPAT0")
-"RTN","GPLXPATH",479,0)
- Q
-"RTN","GPLXPATH",480,0)
- ;
-"RTN","GPLXPATH",481,0)
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
-"RTN","GPLXPATH",482,0)
- N ZTMP
-"RTN","GPLXPATH",483,0)
- S DEBUG=1
-"RTN","GPLXPATH",484,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",485,0)
- D ZTEST^GPLUNIT(.ZTMP,WHICH)
-"RTN","GPLXPATH",486,0)
- Q
-"RTN","GPLXPATH",487,0)
- ;
-"RTN","GPLXPATH",488,0)
-TLIST   ; LIST THE TESTS
-"RTN","GPLXPATH",489,0)
- N ZTMP
-"RTN","GPLXPATH",490,0)
- D ZLOAD^GPLUNIT("ZTMP","GPLXPAT0")
-"RTN","GPLXPATH",491,0)
- D TLIST^GPLUNIT(.ZTMP)
-"RTN","GPLXPATH",492,0)
- Q
-"RTN","GPLXPATH",493,0)
- ;
-"RTN","LA7QRY1")
-0^23^B12511401
-"RTN","LA7QRY1",1,0)
-LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
-"RTN","LA7QRY1",2,0)
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 14
-"RTN","LA7QRY1",3,0)
- ;
-"RTN","LA7QRY1",4,0)
- Q
-"RTN","LA7QRY1",5,0)
- ;
-"RTN","LA7QRY1",6,0)
-CHKSC ; Check search NLT/LOINC codes
-"RTN","LA7QRY1",7,0)
- ;
-"RTN","LA7QRY1",8,0)
- N J
-"RTN","LA7QRY1",9,0)
- ;
-"RTN","LA7QRY1",10,0)
- S J=0
-"RTN","LA7QRY1",11,0)
- F  S J=$O(LA7SC(J)) Q:'J  D
-"RTN","LA7QRY1",12,0)
- . N X
-"RTN","LA7QRY1",13,0)
- . S X=LA7SC(J)
-"RTN","LA7QRY1",14,0)
- . I $P(X,"^",2)="NLT",$D(^LAM("E",$P(X,"^"))) D  Q
-"RTN","LA7QRY1",15,0)
- . . S ^TMP("LA7-NLT",$J,$P(X,"^"))=""
-"RTN","LA7QRY1",16,0)
- . I $P(X,"^",2)="LN",$D(^LAB(95.3,$P($P(X,"^"),"-"))) D  Q
-"RTN","LA7QRY1",17,0)
- . . S ^TMP("LA7-LN",$J,$P($P(X,"^"),"-"))=""
-"RTN","LA7QRY1",18,0)
- . S LA7ERR(6)="Unknown search code "_$P(X,"^")_" passed"
-"RTN","LA7QRY1",19,0)
- . K LA7SC(J)
-"RTN","LA7QRY1",20,0)
- Q
-"RTN","LA7QRY1",21,0)
- ;
-"RTN","LA7QRY1",22,0)
- ;
-"RTN","LA7QRY1",23,0)
-SPEC ; Convert HL7 Specimen Codes to File #61, Topography codes
-"RTN","LA7QRY1",24,0)
- ; Find all topographies that use this HL7 specimen code
-"RTN","LA7QRY1",25,0)
- N J,K,L
-"RTN","LA7QRY1",26,0)
- ;
-"RTN","LA7QRY1",27,0)
- S J=0
-"RTN","LA7QRY1",28,0)
- F  S J=$O(LA7SPEC(J)) Q:'J  D
-"RTN","LA7QRY1",29,0)
- . S K=LA7SPEC(J),L=0
-"RTN","LA7QRY1",30,0)
- . F  S L=$O(^LAB(61,"HL7",K,L)) Q:'L  S ^TMP("LA7-61",$J,L)=""
-"RTN","LA7QRY1",31,0)
- Q
-"RTN","LA7QRY1",32,0)
- ;
-"RTN","LA7QRY1",33,0)
- ;
-"RTN","LA7QRY1",34,0)
-BUILDMSG ; Build HL7 message with result of query
-"RTN","LA7QRY1",35,0)
- ;
-"RTN","LA7QRY1",36,0)
- N HL,HLECH,HLFS,HLQ,LA,LA763,LA7ECH,LA7FS,LA7MSH,LA7NOMSG,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7ROOT,LA7X,X
-"RTN","LA7QRY1",37,0)
- ;
-"RTN","LA7QRY1",38,0)
- I $L($G(LA7HL7))'=5 S LA7HL7="|^\~&"
-"RTN","LA7QRY1",39,0)
- S (HL("FS"),HLFS,LA7FS)=$E(LA7HL7),(HL("ECH"),HLECH,LA7ECH)=$E(LA7HL7,2,5)
-"RTN","LA7QRY1",40,0)
- S (HLQ,HL("Q"))=""""""
-"RTN","LA7QRY1",41,0)
- ; Set flag to not send HL7 message
-"RTN","LA7QRY1",42,0)
- S LA7NOMSG=1
-"RTN","LA7QRY1",43,0)
- ; Create dummy MSH to pass HL7 delimiters
-"RTN","LA7QRY1",44,0)
- S LA7MSH(0)="MSH"_LA7FS_LA7ECH_LA7FS
-"RTN","LA7QRY1",45,0)
- D FILESEG^LA7VHLU(GBL,.LA7MSH)
-"RTN","LA7QRY1",46,0)
- ;
-"RTN","LA7QRY1",47,0)
- F X="AUTO-INST","LRDFN","LRIDT","SUB","HUID","NLT","RUID","SITE" S LA(X)=""
-"RTN","LA7QRY1",48,0)
- ;
-"RTN","LA7QRY1",49,0)
- ; Take search results and put in HL7 message structure
-"RTN","LA7QRY1",50,0)
- S LA7ROOT="^TMP(""LA7-QRY"",$J)",(LA7QUIT,LA7PIDSN)=0
-"RTN","LA7QRY1",51,0)
- ; F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7QUIT  D ;change per John M
-"RTN","LA7QRY1",52,0)
- F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  D  Q:LA7QUIT
-"RTN","LA7QRY1",53,0)
- . I $QS(LA7ROOT,1)'="LA7-QRY"!($QS(LA7ROOT,2)'=$J) S LA7QUIT=1 Q
-"RTN","LA7QRY1",54,0)
- . I LA("LRDFN")'=$QS(LA7ROOT,3) D PID S LA7OBRSN=0
-"RTN","LA7QRY1",55,0)
- . I LA("LRIDT")'=$QS(LA7ROOT,4) D ORC,OBR
-"RTN","LA7QRY1",56,0)
- . I LA("SUB")'=$QS(LA7ROOT,5) D ORC,OBR
-"RTN","LA7QRY1",57,0)
- . I LA("NLT")'=$P($QS(LA7ROOT,6),"!") D ORC,OBR
-"RTN","LA7QRY1",58,0)
- . D OBX
-"RTN","LA7QRY1",59,0)
- ;
-"RTN","LA7QRY1",60,0)
- Q
-"RTN","LA7QRY1",61,0)
- ;
-"RTN","LA7QRY1",62,0)
- ;
-"RTN","LA7QRY1",63,0)
-PID ; Build PID segment
-"RTN","LA7QRY1",64,0)
- ;
-"RTN","LA7QRY1",65,0)
- N LA7PID
-"RTN","LA7QRY1",66,0)
- ;
-"RTN","LA7QRY1",67,0)
- S (LA("LRDFN"),LRDFN)=$QS(LA7ROOT,3)
-"RTN","LA7QRY1",68,0)
- S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
-"RTN","LA7QRY1",69,0)
- D DEM^LRX
-"RTN","LA7QRY1",70,0)
- D PID^LA7VPID(LA("LRDFN"),"",.LA7PID,.LA7PIDSN,.HL)
-"RTN","LA7QRY1",71,0)
- D FILESEG^LA7VHLU(GBL,.LA7PID)
-"RTN","LA7QRY1",72,0)
- S (LA("LRIDT"),LA("SUB"))=""
-"RTN","LA7QRY1",73,0)
- Q
-"RTN","LA7QRY1",74,0)
- ;
-"RTN","LA7QRY1",75,0)
- ;
-"RTN","LA7QRY1",76,0)
-ORC ; Build ORC segment
-"RTN","LA7QRY1",77,0)
- ;
-"RTN","LA7QRY1",78,0)
- N X
-"RTN","LA7QRY1",79,0)
- ;
-"RTN","LA7QRY1",80,0)
- S LA("LRIDT")=$QS(LA7ROOT,4),LA("SUB")=$QS(LA7ROOT,5)
-"RTN","LA7QRY1",81,0)
- S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
-"RTN","LA7QRY1",82,0)
- S X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"ORU"))
-"RTN","LA7QRY1",83,0)
- S LA("HUID")=$P(X,"^"),LA("SITE")=$P(X,"^",2),LA("RUID")=$P(X,"^",4)
-"RTN","LA7QRY1",84,0)
- I LA("HUID")="" S LA("HUID")=$P(LA763(0),"^",6)
-"RTN","LA7QRY1",85,0)
- S LA7NVAF=$$NVAF^LA7VHLU2(0),LA7NTESN=0
-"RTN","LA7QRY1",86,0)
- D ORC^LA7VORU
-"RTN","LA7QRY1",87,0)
- S LA("NLT")=""
-"RTN","LA7QRY1",88,0)
- ;
-"RTN","LA7QRY1",89,0)
- Q
-"RTN","LA7QRY1",90,0)
- ;
-"RTN","LA7QRY1",91,0)
- ;
-"RTN","LA7QRY1",92,0)
-OBR ; Build OBR segment
-"RTN","LA7QRY1",93,0)
- ;
-"RTN","LA7QRY1",94,0)
- N LA764,LA7NLT
-"RTN","LA7QRY1",95,0)
- ;
-"RTN","LA7QRY1",96,0)
- S (LA("NLT"),LA7NLT)=$P($QS(LA7ROOT,6),"!"),(LA764,LA("ORD"))=""
-"RTN","LA7QRY1",97,0)
- I $L(LA7NLT) D
-"RTN","LA7QRY1",98,0)
- . S LA764=+$O(^LAM("E",LA7NLT,0))
-"RTN","LA7QRY1",99,0)
- . I LA764 S LA("ORD")=$$GET1^DIQ(64,LA764_",",.01)
-"RTN","LA7QRY1",100,0)
- I LA("SUB")="CH" D
-"RTN","LA7QRY1",101,0)
- . D OBR^LA7VORU
-"RTN","LA7QRY1",102,0)
- . D NTE^LA7VORU
-"RTN","LA7QRY1",103,0)
- . S LA7OBXSN=0
-"RTN","LA7QRY1",104,0)
- ;
-"RTN","LA7QRY1",105,0)
- Q
-"RTN","LA7QRY1",106,0)
- ;
-"RTN","LA7QRY1",107,0)
- ;
-"RTN","LA7QRY1",108,0)
-OBX ; Build OBX segment
-"RTN","LA7QRY1",109,0)
- ;
-"RTN","LA7QRY1",110,0)
- N LA7DATA,LA7VT
-"RTN","LA7QRY1",111,0)
- ;
-"RTN","LA7QRY1",112,0)
- S LA7NTESN=0
-"RTN","LA7QRY1",113,0)
- I LA("SUB")="MI" D MI^LA7VORU1 Q
-"RTN","LA7QRY1",114,0)
- I "CYEMSP"[LA("SUB") D AP^LA7VORU2 Q
-"RTN","LA7QRY1",115,0)
- ;
-"RTN","LA7QRY1",116,0)
- S LA7VT=$QS(LA7ROOT,7)
-"RTN","LA7QRY1",117,0)
- D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LA7VT,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH)
-"RTN","LA7QRY1",118,0)
- I '$D(LA7DATA) Q
-"RTN","LA7QRY1",119,0)
- D FILESEG^LA7VHLU(GBL,.LA7DATA)
-"RTN","LA7QRY1",120,0)
- ; Send any test interpretation from file #60
-"RTN","LA7QRY1",121,0)
- D INTRP^LA7VORUA
-"RTN","LA7QRY1",122,0)
- ;
-"RTN","LA7QRY1",123,0)
- Q
-"VER")
-8.0^22.0
-**END**
-**END**
