Changeset 34 for ccr/trunk


Ignore:
Timestamp:
Jul 2, 2008, 12:34:15 PM (16 years ago)
Author:
Christopher Edwards
Message:

Enabled Vitals processing in GPLCCR.m
Fixed bug where if you ran EXPORTGPLCCR more than once body tags would still get added (added K TMP($J,"CCRSTEP") before setting it by INITSTPS)
Added code to start processing Vitals for selected patient
Cleaned up some of the template CCR so information in CCR would be correct

Location:
ccr/trunk/p
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/GPLCCR.m

    r33 r34  
    1 GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
    2  ;;0.1;CCDCCR;nopatch;noreleasedate
    3  ;
    4  ; EXPORT A CCR
    5  ;
    6 EXPORT ; EXPORT ENTRY POINT FOR CCR
    7         ; Select a patient.
    8         S DIC=2,DIC(0)="AEMQ" D ^DIC
    9         I Y<1 Q ; EXIT
    10         S DFN=$P(Y,U,1) ; SET THE PATIENT
    11         N CCRGLO
    12         D CCRRPC(.CCRGLO,DFN,"CCR","","","")
    13         S OARY=$NA(^TMP($J,DFN,"CCR",1))
    14         S ONAM="PAT_"_DFN_"_CCR_V1.xml"
    15         S ODIR="/home/glilly/CCROUT"
    16         D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
    17         Q
    18         ;
    19 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ; RPC ENTRY POINT FOR CCR OUTPUT
    20         ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
    21         ; DFN IS PATIENT IEN
    22         ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE
    23         ;        CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
    24         ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
    25         ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW
    26         ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES
    27         ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
    28         S DEBUG=1
    29         S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
    30         S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
    31         S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR
    32         ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
    33         S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR
    34         D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
    35         D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL
    36         ;
    37         ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL
    38         ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES
    39         D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
    40         D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
    41         D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
    42         I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
    43         ;
    44         D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
    45         ;
    46         S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS
    47         D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
    48         N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
    49         F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
    50         . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
    51         . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
    52         . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
    53         . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
    54         . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
    55         . S IXML="INXML"
    56         . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
    57         . ; W OXML,!
    58         . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
    59         . W "RUNNING ",CALL,!
    60         . X CALL
    61         . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
    62         . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
    63         . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
    64         D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
    65         Q
    66         ;
    67 INITSTPS(TAB)   ; INITIALIZE CCR PROCESSING STEPS
    68         ; TAB IS PASSED BY NAME
    69         ; W "TAB= ",TAB,!
    70         ; D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
    71         D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
    72         Q
    73          ;
    74 HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
    75         N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
    76         ; K @VMAP
    77         I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
    78         . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
    79         . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
    80         . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY
    81         . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES,
    82         . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
    83         I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
    84         . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
    85         N CTMP
    86         D MAP^GPLXPATH(CXML,VMAP,"CTMP")
    87         D CP^GPLXPATH("CTMP",CXML)
    88         Q
    89         ;
    90 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
    91         ; AXML AND ACTRTN ARE PASSED BY NAME
    92         ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
    93         ; P1= OBJECTID - ACTORPATIENT_2
    94         ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION
    95         ;     OR PERSON(IN PATIENT FILE IE NOK)
    96         ; P3= IEN RECORD NUMBER FOR ACTOR - 2
    97         N I,J,K,L
    98         K @ACTRTN ; CLEAR RETURN ARRAY
    99         F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
    100         . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR ON THIS LINE
    101         . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
    102         . . W "<ActorID>=>",J,!
    103         . . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES
    104         S I="" ; GOING TO $O THROUGH THE HASH
    105         F J=0:0 D  Q:$O(K(I))=""
    106         . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
    107         . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
    108         . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER
    109         . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
    110         . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
    111         Q
    112         ;
    113 TEST   ; RUN ALL THE TEST CASES
    114       ;D TESTALL^GPLUNIT("GPLCCR")
    115       D ZTEST^GPLCCR("PROBLEMS")
    116       W "TESTING RETURNED FROM PROBLMES",!
    117       D ZTEST^GPLCCR("CCR")
    118       Q
    119       ;
    120 ZTEST(WHICH) ; RUN ONE SET OF TESTS
    121       N ZTMP
    122       D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
    123       D ZTEST^GPLUNIT(.ZTMP,WHICH)
    124       Q
    125       ;
    126 TLIST ; LIST THE TESTS
    127       N ZTMP
    128       D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
    129       D TLIST^GPLUNIT(.ZTMP)
    130       Q
    131       ;
    132 ;;><TEST>
    133 ;;><PROBLEMS>
    134 ;;>>>K GPL S GPL=""
    135 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
    136 ;;>>?@GPL@(@GPL@(0))="</Problems>"
    137 ;;><CCR>
    138 ;;>>>D ^%ZTER
    139 ;;>>>K GPL S GPL=""
    140 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
    141 ;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>"
    142 ;;><ACTLST>
    143 ;;>>>N TCCR
    144 ;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR","","","")
    145 ;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST")
    146 ;;></TEST>
     1GPLCCR  ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
     2        ;;0.1;CCDCCR;nopatch;noreleasedate
     3        ;
     4        ; EXPORT A CCR
     5        ;
     6EXPORT  ; EXPORT ENTRY POINT FOR CCR
     7               ; Select a patient.
     8               S DIC=2,DIC(0)="AEMQ" D ^DIC
     9               I Y<1 Q ; EXIT
     10               S DFN=$P(Y,U,1) ; SET THE PATIENT
     11               N CCRGLO
     12               D CCRRPC(.CCRGLO,DFN,"CCR","","","")
     13               S OARY=$NA(^TMP($J,DFN,"CCR",1))
     14               S ONAM="PAT_"_DFN_"_CCR_V1.xml"
     15               S ODIR="/home/glilly/CCROUT"
     16               ;S ODIR="/home/cedwards/"
     17               D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
     18               Q
     19               ;
     20CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ; RPC ENTRY POINT FOR CCR OUTPUT
     21               ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
     22               ; DFN IS PATIENT IEN
     23               ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART OF THE
     24               ;        CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
     25               ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
     26               ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME - NULL MEANS NOW
     27               ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND "TO" VARIABLES
     28               ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
     29               S DEBUG=0
     30               S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
     31               S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
     32               S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR
     33               ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
     34               S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR
     35               D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
     36               D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL
     37               ;
     38               ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL
     39               ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES
     40               D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
     41               D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
     42               D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
     43               I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
     44               ;
     45               D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
     46               ;
     47               K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
     48               S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS
     49               D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
     50               N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
     51               F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
     52               . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
     53               . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
     54               . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
     55               . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
     56               . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
     57               . S IXML="INXML"
     58               . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
     59               . ; W OXML,!
     60               . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
     61               . W "RUNNING ",CALL,!
     62               . X CALL
     63               . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
     64               . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
     65               . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
     66               D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
     67               Q
     68               ;
     69INITSTPS(TAB)     ; INITIALIZE CCR PROCESSING STEPS
     70               ; TAB IS PASSED BY NAME
     71               ; W "TAB= ",TAB,!
     72               D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
     73               D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
     74               Q
     75                ;
     76HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
     77               N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
     78               ; K @VMAP
     79               I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
     80               . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
     81               . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
     82               . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY
     83               . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES,
     84               . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
     85               I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
     86               . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
     87               N CTMP
     88               D MAP^GPLXPATH(CXML,VMAP,"CTMP")
     89               D CP^GPLXPATH("CTMP",CXML)
     90               Q
     91               ;
     92ACTLST(AXML,ACTRTN)     ; RETURN THE ACTOR LIST FOR THE XML IN AXML
     93               ; AXML AND ACTRTN ARE PASSED BY NAME
     94               ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
     95               ; P1= OBJECTID - ACTORPATIENT_2
     96               ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE OR INSTITUTION
     97               ;     OR PERSON(IN PATIENT FILE IE NOK)
     98               ; P3= IEN RECORD NUMBER FOR ACTOR - 2
     99               N I,J,K,L
     100               K @ACTRTN ; CLEAR RETURN ARRAY
     101               F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
     102               . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR ON THIS LINE
     103               . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
     104               . . ;W "<ActorID>=>",J,!
     105               . . S K(J)="" ; HASHING ACTOR TO GET RID OF DUPLICATES
     106               S I="" ; GOING TO $O THROUGH THE HASH
     107               F J=0:0 D  Q:$O(K(I))=""
     108               . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
     109               . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
     110               . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE: PATIENT/PROVIDER
     111               . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
     112               . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
     113               Q
     114               ;
     115TEST      ; RUN ALL THE TEST CASES
     116             ;D TESTALL^GPLUNIT("GPLCCR")
     117             D ZTEST^GPLCCR("PROBLEMS")
     118             W "TESTING RETURNED FROM PROBLMES",!
     119             D ZTEST^GPLCCR("CCR")
     120             Q
     121             ;
     122ZTEST(WHICH)    ; RUN ONE SET OF TESTS
     123             N ZTMP
     124             D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
     125             D ZTEST^GPLUNIT(.ZTMP,WHICH)
     126             Q
     127             ;
     128TLIST   ; LIST THE TESTS
     129             N ZTMP
     130             D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
     131             D TLIST^GPLUNIT(.ZTMP)
     132             Q
     133             ;
     134;;><TEST>       
     135;;><PROBLEMS>   
     136;;>>>K  GPL S GPL=""
     137;;>>>D  CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
     138;;>>?@GPL@(@GPL@(0))="</Problems>"     
     139;;><CCR>       
     140;;>>>D  ^%ZTER
     141;;>>>K  GPL S GPL=""
     142;;>>>D  CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
     143;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>"       
     144;;><ACTLST>     
     145;;>>>N  TCCR
     146;;>>>D  CCRRPC^GPLCCR(.TCCR,"2","CCR","","","")
     147;;>>>D  ACTLST^GPLCCR("TCCR","ACTTEST")
     148;;></TEST>     
  • ccr/trunk/p/GPLCCR0.m

    r25 r34  
    1 GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
    2         ;;0.1;CCDCCR;nopatch;noreleasedate
    3         W "This is a CCR TEMPLATE with processing routines",!
    4         W !
    5         Q
    6         ;
    7 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
    8         ; ZARY IS PASSED BY NAME
    9         ; BAT is a string identifying the section
    10         ; LINE is a test which will evaluate to true or false
    11         ; I '$G(@ZARY) D
    12         . S @ZARY@(0)=0 ; initially there are no elements
    13         . W "GOT HERE LOADING "_LINE,!
    14         N CNT ; count of array elements
    15         S CNT=@ZARY@(0) ; contains array count
    16         S CNT=CNT+1 ; increment count
    17         S @ZARY@(CNT)=LINE ; put the line in the array
    18         ; S @ZARY@(BAT,CNT)="" ; index the test by battery
    19         S @ZARY@(0)=CNT ; update the array counter
    20         Q
    21         ;
    22 ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
    23        ; ZARY IS PASSED BY NAME
    24        ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
    25        ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
    26        K @ZARY S @ZARY=""
    27        S @ZARY@(0)=0 ; initialize array count
    28        N LINE,LABEL,BODY
    29        N INTEST S INTEST=0 ; switch for in the TEMPLATE section
    30        N SECTION S SECTION="[anonymous]" ; NO section LABEL
    31        ;
    32        N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
    33        . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
    34        . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
    35        . I INTEST  D  ; within the section
    36        . . I LINE?." "1";><".E  D  ; sub-section name found
    37        . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
    38        . . I LINE?." "1";;".E  D  ; line found
    39        . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
    40        Q
    41        ;
    42 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
    43         D ZLOAD(ARY,"GPLCCR0")
    44         ; ZWR @ARY
    45         Q
    46         ;
    47 ;<TEMPLATE>
    48 ;;<?xml version="1.0" encoding="UTF-8"?>
    49 ;;<?xml-stylesheet type="text/xsl" href="ccr_20060420.xsl"?>
    50 ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
    51 ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
    52 ;;<Language>
    53 ;;<Text>English</Text>
    54 ;;</Language>
    55 ;;<Version>V1.0</Version>
    56 ;;<DateTime>
    57 ;;<ExactDateTime>@@DATETIME@@2008-03-18T23:10:58Z</ExactDateTime>
    58 ;;</DateTime>
    59 ;;<Patient>
    60 ;;<ActorID>@@ACTORPATIENT@@</ActorID>
    61 ;;</Patient>
    62 ;;<From>
    63 ;;<ActorLink>
    64 ;;<ActorID>@@ACTORFROM@@</ActorID>
    65 ;;</ActorLink>
    66 ;;<ActorLink>
    67 ;;<ActorID>@@ACTORFROM2@@</ActorID>
    68 ;;</ActorLink>
    69 ;;</From>
    70 ;;<To>
    71 ;;<ActorLink>
    72 ;;<ActorID>@@ACTORTO@@</ActorID>
    73 ;;<ActorRole>
    74 ;;<Text>Primary Provider</Text>
    75 ;;</ActorRole>
    76 ;;</ActorLink>
    77 ;;</To>
    78 ;;<Purpose>
    79 ;;<Description>
    80 ;;<Text>@@PURPOSEDESCRIPTION@@CEND PHR</Text>
    81 ;;</Description>
    82 ;;</Purpose>
    83 ;;<Body>
    84 ;;<Problems>
    85 ;;<Problem>
    86 ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
    87 ;;<Type>
    88 ;;<Text>Problem</Text>
    89 ;;</Type>
    90 ;;<Description>
    91 ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
    92 ;;<Code>
    93 ;;<Value>@@PROBLEMCODEVALUE@@</Value>
    94 ;;<CodingSystem>ICD9CM</CodingSystem>
    95 ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
    96 ;;</Code>
    97 ;;</Description>
    98 ;;<Source>
    99 ;;<Actor>
    100 ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
    101 ;;</Actor>
    102 ;;</Source>
    103 ;;</Problem>
    104 ;;</Problems>
    105 ;;<FamilyHistory>
    106 ;;<FamilyProblemHistory>
    107 ;;<CCRDataObjectID></CCRDataObjectID>
    108 ;;<Source>
    109 ;;<Actor>
    110 ;;<ActorID>AA0001</ActorID>
    111 ;;</Actor>
    112 ;;</Source>
    113 ;;<FamilyMember>
    114 ;;<ActorID>AA0003</ActorID>
    115 ;;<ActorRole>
    116 ;;<Text>Father</Text>
    117 ;;</ActorRole>
    118 ;;<Source>
    119 ;;<Actor>
    120 ;;<ActorID>AA0001</ActorID>
    121 ;;</Actor>
    122 ;;</Source>
    123 ;;</FamilyMember>
    124 ;;<Problem>
    125 ;;<Type>
    126 ;;<Text>Problem</Text>
    127 ;;</Type>
    128 ;;<Description>
    129 ;;<Text>Heart Disease</Text>
    130 ;;<Code>
    131 ;;<Value>C0018799</Value>
    132 ;;<CodingSystem>UMLS Concept</CodingSystem>
    133 ;;<Version>2006</Version>
    134 ;;</Code>
    135 ;;<Code>
    136 ;;<Value>429.9</Value>
    137 ;;<CodingSystem>ICD9CM</CodingSystem>
    138 ;;<Version>2006</Version>
    139 ;;</Code>
    140 ;;<Code>
    141 ;;<Value>56265001</Value>
    142 ;;<CodingSystem>SNOMEDCT</CodingSystem>
    143 ;;<Version>2006</Version>
    144 ;;</Code>
    145 ;;</Description>
    146 ;;<Source>
    147 ;;<Actor>
    148 ;;<ActorID>AA0001</ActorID>
    149 ;;</Actor>
    150 ;;</Source>
    151 ;;</Problem>
    152 ;;</FamilyProblemHistory>
    153 ;;<FamilyProblemHistory>
    154 ;;<CCRDataObjectID>BB0003</CCRDataObjectID>
    155 ;;<Source>
    156 ;;<Actor>
    157 ;;<ActorID>AA0001</ActorID>
    158 ;;</Actor>
    159 ;;</Source>
    160 ;;<FamilyMember>
    161 ;;<ActorID>AA0004</ActorID>
    162 ;;<ActorRole>
    163 ;;<Text>Grandparents</Text>
    164 ;;</ActorRole>
    165 ;;<Source>
    166 ;;<Actor>
    167 ;;<ActorID>AA0001</ActorID>
    168 ;;</Actor>
    169 ;;</Source>
    170 ;;</FamilyMember>
    171 ;;<Problem>
    172 ;;<Type>
    173 ;;<Text>Problem</Text>
    174 ;;</Type>
    175 ;;<Description>
    176 ;;<Text>Arthritis</Text>
    177 ;;<Code>
    178 ;;<Value>C0003873</Value>
    179 ;;<CodingSystem>UMLS Concept</CodingSystem>
    180 ;;<Version>2006</Version>
    181 ;;</Code>
    182 ;;<Code>
    183 ;;<Value>714.0</Value>
    184 ;;<CodingSystem>ICD9CM</CodingSystem>
    185 ;;<Version>2006</Version>
    186 ;;</Code>
    187 ;;<Code>
    188 ;;<Value>69896004</Value>
    189 ;;<CodingSystem>SNOMEDCT</CodingSystem>
    190 ;;<Version>2006</Version>
    191 ;;</Code>
    192 ;;</Description>
    193 ;;<Source>
    194 ;;<Actor>
    195 ;;<ActorID>AA0001</ActorID>
    196 ;;</Actor>
    197 ;;</Source>
    198 ;;</Problem>
    199 ;;<Problem>
    200 ;;<Type>
    201 ;;<Text>Problem</Text>
    202 ;;</Type>
    203 ;;<Description>
    204 ;;<Text>Diabetes Mellitus</Text>
    205 ;;<Code>
    206 ;;<Value>C0375113</Value>
    207 ;;<CodingSystem>UMLS Concept</CodingSystem>
    208 ;;<Version>2006</Version>
    209 ;;</Code>
    210 ;;<Code>
    211 ;;<Value>250.00</Value>
    212 ;;<CodingSystem>ICD9CM</CodingSystem>
    213 ;;<Version>2006</Version>
    214 ;;</Code>
    215 ;;</Description>
    216 ;;<Source>
    217 ;;<Actor>
    218 ;;<ActorID>AA0001</ActorID>
    219 ;;</Actor>
    220 ;;</Source>
    221 ;;</Problem>
    222 ;;<Problem>
    223 ;;<Type>
    224 ;;<Text>Problem</Text>
    225 ;;</Type>
    226 ;;<Description>
    227 ;;<Text>Parkinson's disease NOS</Text>
    228 ;;<Code>
    229 ;;<Value>332.0</Value>
    230 ;;<CodingSystem>ICD9CM</CodingSystem>
    231 ;;<Version>2007</Version>
    232 ;;</Code>
    233 ;;</Description>
    234 ;;<Source>
    235 ;;<Actor>
    236 ;;<ActorID>AA0001</ActorID>
    237 ;;</Actor>
    238 ;;</Source>
    239 ;;</Problem>
    240 ;;</FamilyProblemHistory>
    241 ;;</FamilyHistory>
    242 ;;<SocialHistory>
    243 ;;<SocialHistoryElement>
    244 ;;<CCRDataObjectID>BB0004</CCRDataObjectID>
    245 ;;<Type>
    246 ;;<Text>Marital Status</Text>
    247 ;;</Type>
    248 ;;<Description>
    249 ;;<Text>Married</Text>
    250 ;;</Description>
    251 ;;<Source>
    252 ;;<Actor>
    253 ;;<ActorID>AA0001</ActorID>
    254 ;;</Actor>
    255 ;;</Source>
    256 ;;</SocialHistoryElement>
    257 ;;<SocialHistoryElement>
    258 ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
    259 ;;<Type>
    260 ;;<Text>Ethnic Origin</Text>
    261 ;;</Type>
    262 ;;<Description>
    263 ;;<Text>Not Hispanic or Latino</Text>
    264 ;;</Description>
    265 ;;<Source>
    266 ;;<Actor>
    267 ;;<ActorID>AA0001</ActorID>
    268 ;;</Actor>
    269 ;;</Source>
    270 ;;</SocialHistoryElement>
    271 ;;<SocialHistoryElement>
    272 ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
    273 ;;<Type>
    274 ;;<Text>Race</Text>
    275 ;;</Type>
    276 ;;<Description>
    277 ;;<Text>White</Text>
    278 ;;</Description>
    279 ;;<Source>
    280 ;;<Actor>
    281 ;;<ActorID>AA0001</ActorID>
    282 ;;</Actor>
    283 ;;</Source>
    284 ;;</SocialHistoryElement>
    285 ;;<SocialHistoryElement>
    286 ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
    287 ;;<Type>
    288 ;;<Text>Occupation</Text>
    289 ;;</Type>
    290 ;;<Description>
    291 ;;<Text>Physician</Text>
    292 ;;</Description>
    293 ;;<Source>
    294 ;;<Actor>
    295 ;;<ActorID>AA0001</ActorID>
    296 ;;</Actor>
    297 ;;</Source>
    298 ;;</SocialHistoryElement>
    299 ;;</SocialHistory>
    300 ;;<Medications>
    301 ;;<Medication>
    302 ;;<CCRDataObjectID>BB0008</CCRDataObjectID>
    303 ;;<DateTime>
    304 ;;<Type>
    305 ;;<Text>Begin Date</Text>
    306 ;;</Type>
    307 ;;<Age>
    308 ;;<Value>42</Value>
    309 ;;<Units>
    310 ;;<Unit>Years</Unit>
    311 ;;</Units>
    312 ;;</Age>
    313 ;;</DateTime>
    314 ;;<Type>
    315 ;;<Text>Medication</Text>
    316 ;;</Type>
    317 ;;<Status>
    318 ;;<Text>Active</Text>
    319 ;;</Status>
    320 ;;<Source>
    321 ;;<Actor>
    322 ;;<ActorID>AA0001</ActorID>
    323 ;;</Actor>
    324 ;;</Source>
    325 ;;<Product>
    326 ;;<ProductName>
    327 ;;<Text>simvastatin</Text>
    328 ;;<Code>
    329 ;;<Value>36567</Value>
    330 ;;<CodingSystem>RXNORM</CodingSystem>
    331 ;;<Version>2005</Version>
    332 ;;</Code>
    333 ;;</ProductName>
    334 ;;<BrandName>
    335 ;;<Text>Simvastatin</Text>
    336 ;;<Code>
    337 ;;<Value>00093715510</Value>
    338 ;;<CodingSystem>NDC</CodingSystem>
    339 ;;<Version>2005</Version>
    340 ;;</Code>
    341 ;;</BrandName>
    342 ;;<Strength>
    343 ;;<Value>40</Value>
    344 ;;<Units>
    345 ;;<Unit>mg</Unit>
    346 ;;</Units>
    347 ;;</Strength>
    348 ;;<Form>
    349 ;;<Text>tablet</Text>
    350 ;;</Form>
    351 ;;</Product>
    352 ;;<Directions>
    353 ;;<Direction>
    354 ;;<Description>
    355 ;;<Text>1  PO 1 time per day</Text>
    356 ;;</Description>
    357 ;;<Dose>
    358 ;;<Value>1</Value>
    359 ;;</Dose>
    360 ;;<Route>
    361 ;;<Text>PO</Text>
    362 ;;</Route>
    363 ;;<Frequency>
    364 ;;<Value>1 time per day</Value>
    365 ;;</Frequency>
    366 ;;</Direction>
    367 ;;</Directions>
    368 ;;</Medication>
    369 ;;</Medications>
    370 ;;<VitalSigns>
    371 ;;<Result>
    372 ;;<CCRDataObjectID>@@DATAOBJECTID@@BB0009</CCRDataObjectID>
    373 ;;<DateTime>
    374 ;;<Type>
    375 ;;<Text>Assessment Time</Text>
    376 ;;</Type>
    377 ;;<ExactDateTime>@@HEIGHTWEIGHTDATATIME@@2008-03-18</ExactDateTime>
    378 ;;</DateTime>
    379 ;;<Description>
    380 ;;<Text>Height &amp; Weight</Text>
    381 ;;</Description>
    382 ;;<Source>
    383 ;;<Actor>
    384 ;;<ActorID>@@HEIGHTWEIGHTSOURCE@@AA0001</ActorID>
    385 ;;</Actor>
    386 ;;</Source>
    387 ;;<Test>
    388 ;;<CCRDataObjectID>@@DATAOBJECTID@@BB0010</CCRDataObjectID>
    389 ;;<Type>
    390 ;;<Text>Observation</Text>
    391 ;;</Type>
    392 ;;<Description>
    393 ;;<Text>Height</Text>
    394 ;;<Code>
    395 ;;<Value>50373000</Value>
    396 ;;<CodingSystem>SNOMED</CodingSystem>
    397 ;;<Version>2006</Version>
    398 ;;</Code>
    399 ;;</Description>
    400 ;;<Source>
    401 ;;<Actor>
    402 ;;<ActorID>@@HEIGHTSOURCEID@@AA0002</ActorID>
    403 ;;</Actor>
    404 ;;</Source>
    405 ;;<TestResult>
    406 ;;<Value>@@HEIGHTINCHES@@68</Value>
    407 ;;<Units>
    408 ;;<Unit>in</Unit>
    409 ;;</Units>
    410 ;;</TestResult>
    411 ;;</Test>
    412 ;;<Test>
    413 ;;<CCRDataObjectID>@@DATAOBJECTID@@BB0011</CCRDataObjectID>
    414 ;;<Type>
    415 ;;<Text>Observation</Text>
    416 ;;</Type>
    417 ;;<Description>
    418 ;;<Text>Weight</Text>
    419 ;;<Code>
    420 ;;<Value>363808001</Value>
    421 ;;<CodingSystem>SNOMED</CodingSystem>
    422 ;;<Version>2006</Version>
    423 ;;</Code>
    424 ;;</Description>
    425 ;;<Source>
    426 ;;<Actor>
    427 ;;<ActorID>@@WEIGHTSOURCEID@@AA0002</ActorID>
    428 ;;</Actor>
    429 ;;</Source>
    430 ;;<TestResult>
    431 ;;<Value>@@WEIGHTLBS@@180</Value>
    432 ;;<Units>
    433 ;;<Unit>lb</Unit>
    434 ;;</Units>
    435 ;;</TestResult>
    436 ;;</Test>
    437 ;;</Result>
    438 ;;<Result>
    439 ;;<CCRDataObjectID>@@DATAOBJECTID@@BB0012</CCRDataObjectID>
    440 ;;<Description>
    441 ;;<Text>Blood Type</Text>
    442 ;;</Description>
    443 ;;<Source>
    444 ;;<Actor>
    445 ;;<ActorID>@@BLOODTYPESOURCEID@@AA0001</ActorID>
    446 ;;</Actor>
    447 ;;</Source>
    448 ;;<Test>
    449 ;;<CCRDataObjectID>@@DATAOBJECTID@@BB0013</CCRDataObjectID>
    450 ;;<Type>
    451 ;;<Text>Result</Text>
    452 ;;</Type>
    453 ;;<Description>
    454 ;;<Text>Blood Type</Text>
    455 ;;<Code>
    456 ;;<Value>278149003</Value>
    457 ;;<CodingSystem>SNOMED</CodingSystem>
    458 ;;<Version>2005</Version>
    459 ;;</Code>
    460 ;;</Description>
    461 ;;<Source>
    462 ;;<Actor>
    463 ;;<ActorID>@@BLOODTYPESOURCEID2@@AA0002</ActorID>
    464 ;;</Actor>
    465 ;;</Source>
    466 ;;<TestResult>
    467 ;;<Value>@@BLOODTYPERESULT@@A+</Value>
    468 ;;</TestResult>
    469 ;;</Test>
    470 ;;</Result>
    471 ;;</VitalSigns>
    472 ;;<HealthCareProviders>
    473 ;;<Provider>
    474 ;;<ActorID>AA0005</ActorID>
    475 ;;<ActorRole>
    476 ;;<Text>Primary Provider</Text>
    477 ;;</ActorRole>
    478 ;;</Provider>
    479 ;;</HealthCareProviders>
    480 ;;</Body>
    481 ;;<Actors>
    482 ;;<Actor>
    483 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    484 ;;<Person>
    485 ;;<Name>
    486 ;;<CurrentName>
    487 ;;<Given>@@ACTORGIVENNAME@@</Given>
    488 ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
    489 ;;<Family>@@ACTORFAMILYNAME@@</Family>
    490 ;;</CurrentName>
    491 ;;</Name>
    492 ;;<DateOfBirth>
    493 ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
    494 ;;</DateOfBirth>
    495 ;;<Gender>
    496 ;;<Text>@@ACTORGENDER@@</Text>
    497 ;;</Gender>
    498 ;;</Person>
    499 ;;<IDs>
    500 ;;<Type>
    501 ;;<Text>SSN</Text>
    502 ;;</Type>
    503 ;;<ID>@@ACTORSSN@@</ID>
    504 ;;<Source>
    505 ;;<Actor>
    506 ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
    507 ;;</Actor>
    508 ;;</Source>
    509 ;;</IDs>
    510 ;;<Address>
    511 ;;<Type>
    512 ;;<Text>@@ACTORADDRESSTYPE@@</Text>
    513 ;;</Type>
    514 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
    515 ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
    516 ;;<City>@@ACTORADDRESSCITY@@</City>
    517 ;;<State>@@ACTORADDRESSSTATE@@</State>
    518 ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
    519 ;;</Address>
    520 ;;<Telephone>
    521 ;;<Value>@@ACTORTELEPHONE@@</Value>
    522 ;;<Type>
    523 ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
    524 ;;</Type>
    525 ;;</Telephone>
    526 ;;<EMail>
    527 ;;<Value>@@ACTOREMAIL@@</Value>
    528 ;;</EMail>
    529 ;;<Source>
    530 ;;<Actor>
    531 ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
    532 ;;</Actor>
    533 ;;</Source>
    534 ;;</Actor>
    535 ;;<Actor>
    536 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    537 ;;<InformationSystem>
    538 ;;<Name>@@ACTORINFOSYSNAME@@</Name>
    539 ;;<Version>@@ACTORINFOSYSVER@@</Version>
    540 ;;</InformationSystem>
    541 ;;<Source>
    542 ;;<Actor>
    543 ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
    544 ;;</Actor>
    545 ;;</Source>
    546 ;;</Actor>
    547 ;;<Actor>
    548 ;;<ActorObjectID>AA0003</ActorObjectID>
    549 ;;<Person>
    550 ;;<Name>
    551 ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
    552 ;;</Name>
    553 ;;</Person>
    554 ;;<Relation>
    555 ;;<Text>@@ACTORRELATION@@</Text>
    556 ;;</Relation>
    557 ;;<Source>
    558 ;;<Actor>
    559 ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
    560 ;;</Actor>
    561 ;;</Source>
    562 ;;</Actor>
    563 ;;<Actor>
    564 ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    565 ;;<Person>
    566 ;;<Name>
    567 ;;<CurrentName>
    568 ;;<Given>@@ACTORGIVENNAME@@</Given>
    569 ;;<Family>@@ACTORFAMILYNAME@@</Family>
    570 ;;</CurrentName>
    571 ;;</Name>
    572 ;;</Person>
    573 ;;<Specialty>
    574 ;;<Text>@@ACTORSPECIALITY@@</Text>
    575 ;;</Specialty>
    576 ;;<Address>
    577 ;;<Type>
    578 ;;<Text>@@ACTORADDRESSTYPE@@</Text>
    579 ;;</Type>
    580 ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
    581 ;;<City>@@ACTORADDRESSLINE2@@</City>
    582 ;;<State>@@ACTORADDRESSSTATE@@</State>
    583 ;;</Address>
    584 ;;<Source>
    585 ;;<Actor>
    586 ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
    587 ;;</Actor>
    588 ;;</Source>
    589 ;;</Actor>
    590 ;;</Actors>
    591 ;;<Signatures>
    592 ;;<CCRSignature>
    593 ;;<SignatureObjectID>S0001</SignatureObjectID>
    594 ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
    595 ;;<Source>
    596 ;;<ActorID>AA0001</ActorID>
    597 ;;</Source>
    598 ;;<Signature>
    599 ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
    600 ;;<SignedInfo>
    601 ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315" />
    602 ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" />
    603 ;;<Reference URI="">
    604 ;;<Transforms>
    605 ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
    606 ;;</Transforms>
    607 ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" />
    608 ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
    609 ;;</Reference>
    610 ;;</SignedInfo>
    611 ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
    612 ;;<KeyInfo>
    613 ;;<KeyValue>
    614 ;;<RSAKeyValue>
    615 ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
    616 ;;<Exponent>AQAB</Exponent>
    617 ;;</RSAKeyValue>
    618 ;;</KeyValue>
    619 ;;</KeyInfo>
    620 ;;</Signature>
    621 ;;</Signature>
    622 ;;</CCRSignature>
    623 ;;</Signatures>
    624 ;;</ContinuityOfCareRecord>
    625 ;</TEMPLATE>
     1GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
     2               ;;0.1;CCDCCR;nopatch;noreleasedate
     3               W "This is a CCR TEMPLATE with processing routines",!
     4               W !
     5               Q
     6               ;
     7ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
     8               ; ZARY IS PASSED BY NAME
     9               ; BAT is a string identifying the section
     10               ; LINE is a test which will evaluate to true or false
     11               ; I '$G(@ZARY) D
     12               . S @ZARY@(0)=0 ; initially there are no elements
     13               . W "GOT HERE LOADING "_LINE,!
     14               N CNT ; count of array elements
     15               S CNT=@ZARY@(0) ; contains array count
     16               S CNT=CNT+1 ; increment count
     17               S @ZARY@(CNT)=LINE ; put the line in the array
     18               ; S @ZARY@(BAT,CNT)="" ; index the test by battery
     19               S @ZARY@(0)=CNT ; update the array counter
     20               Q
     21               ;
     22ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
     23              ; ZARY IS PASSED BY NAME
     24              ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
     25              ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
     26              K @ZARY S @ZARY=""
     27              S @ZARY@(0)=0 ; initialize array count
     28              N LINE,LABEL,BODY
     29              N INTEST S INTEST=0 ; switch for in the TEMPLATE section
     30              N SECTION S SECTION="[anonymous]" ; NO section LABEL
     31              ;
     32              N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
     33              . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
     34              . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
     35              . I INTEST  D  ; within the section
     36              . . I LINE?." "1";><".E  D  ; sub-section name found
     37              . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
     38              . . I LINE?." "1";;".E  D  ; line found
     39              . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
     40              Q
     41              ;
     42LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
     43               D ZLOAD(ARY,"GPLCCR0")
     44               ; ZWR @ARY
     45               Q
     46               ;
     47;<TEMPLATE>     
     48;;<?xml version="1.0" encoding="UTF-8"?>
     49;;<?xml-stylesheet      type="text/xsl" href="ccr_20060420.xsl"?>
     50;;<ContinuityOfCareRecord       xmlns="urn:astm-org:CCR">
     51;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>       
     52;;<Language>   
     53;;<Text>English</Text> 
     54;;</Language>   
     55;;<Version>V1.0</Version>       
     56;;<DateTime>   
     57;;<ExactDateTime>@@DATETIME@@2008-03-18T23:10:58Z</ExactDateTime>       
     58;;</DateTime>   
     59;;<Patient>     
     60;;<ActorID>@@ACTORPATIENT@@</ActorID>   
     61;;</Patient>   
     62;;<From>       
     63;;<ActorLink>   
     64;;<ActorID>@@ACTORFROM@@</ActorID>     
     65;;</ActorLink> 
     66;;<ActorLink>   
     67;;<ActorID>@@ACTORFROM2@@</ActorID>     
     68;;</ActorLink> 
     69;;</From>       
     70;;<To> 
     71;;<ActorLink>   
     72;;<ActorID>@@ACTORTO@@</ActorID>       
     73;;<ActorRole>   
     74;;<Text>Primary Provider</Text>
     75;;</ActorRole> 
     76;;</ActorLink> 
     77;;</To> 
     78;;<Purpose>     
     79;;<Description> 
     80;;<Text>@@PURPOSEDESCRIPTION@@CEND      PHR</Text>
     81;;</Description>       
     82;;</Purpose>   
     83;;<Body>       
     84;;<Problems>   
     85;;<Problem>     
     86;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>       
     87;;<Type>       
     88;;<Text>Problem</Text> 
     89;;</Type>       
     90;;<Description> 
     91;;<Text>@@PROBLEMDESCRIPTION@@</Text>   
     92;;<Code>       
     93;;<Value>@@PROBLEMCODEVALUE@@</Value>   
     94;;<CodingSystem>ICD9CM</CodingSystem>   
     95;;<Version>@@PROBLEMCODINGVERSION@@</Version>   
     96;;</Code>       
     97;;</Description>       
     98;;<Source>     
     99;;<Actor>       
     100;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>   
     101;;</Actor>     
     102;;</Source>     
     103;;</Problem>   
     104;;</Problems>   
     105;;<FamilyHistory>       
     106;;<FamilyProblemHistory>       
     107;;<CCRDataObjectID></CCRDataObjectID>   
     108;;<Source>     
     109;;<Actor>       
     110;;<ActorID>AA0001</ActorID>     
     111;;</Actor>     
     112;;</Source>     
     113;;<FamilyMember>       
     114;;<ActorID>AA0003</ActorID>     
     115;;<ActorRole>   
     116;;<Text>Father</Text>   
     117;;</ActorRole> 
     118;;<Source>     
     119;;<Actor>       
     120;;<ActorID>AA0001</ActorID>     
     121;;</Actor>     
     122;;</Source>     
     123;;</FamilyMember>       
     124;;<Problem>     
     125;;<Type>       
     126;;<Text>Problem</Text> 
     127;;</Type>       
     128;;<Description> 
     129;;<Text>Heart   Disease</Text>
     130;;<Code>       
     131;;<Value>C0018799</Value>       
     132;;<CodingSystem>UMLS    Concept</CodingSystem>
     133;;<Version>2006</Version>       
     134;;</Code>       
     135;;<Code>       
     136;;<Value>429.9</Value> 
     137;;<CodingSystem>ICD9CM</CodingSystem>   
     138;;<Version>2006</Version>       
     139;;</Code>       
     140;;<Code>       
     141;;<Value>56265001</Value>       
     142;;<CodingSystem>SNOMEDCT</CodingSystem> 
     143;;<Version>2006</Version>       
     144;;</Code>       
     145;;</Description>       
     146;;<Source>     
     147;;<Actor>       
     148;;<ActorID>AA0001</ActorID>     
     149;;</Actor>     
     150;;</Source>     
     151;;</Problem>   
     152;;</FamilyProblemHistory>       
     153;;<FamilyProblemHistory>       
     154;;<CCRDataObjectID>BB0003</CCRDataObjectID>     
     155;;<Source>     
     156;;<Actor>       
     157;;<ActorID>AA0001</ActorID>     
     158;;</Actor>     
     159;;</Source>     
     160;;<FamilyMember>       
     161;;<ActorID>AA0004</ActorID>     
     162;;<ActorRole>   
     163;;<Text>Grandparents</Text>     
     164;;</ActorRole> 
     165;;<Source>     
     166;;<Actor>       
     167;;<ActorID>AA0001</ActorID>     
     168;;</Actor>     
     169;;</Source>     
     170;;</FamilyMember>       
     171;;<Problem>     
     172;;<Type>       
     173;;<Text>Problem</Text> 
     174;;</Type>       
     175;;<Description> 
     176;;<Text>Arthritis</Text>       
     177;;<Code>       
     178;;<Value>C0003873</Value>       
     179;;<CodingSystem>UMLS    Concept</CodingSystem>
     180;;<Version>2006</Version>       
     181;;</Code>       
     182;;<Code>       
     183;;<Value>714.0</Value> 
     184;;<CodingSystem>ICD9CM</CodingSystem>   
     185;;<Version>2006</Version>       
     186;;</Code>       
     187;;<Code>       
     188;;<Value>69896004</Value>       
     189;;<CodingSystem>SNOMEDCT</CodingSystem> 
     190;;<Version>2006</Version>       
     191;;</Code>       
     192;;</Description>       
     193;;<Source>     
     194;;<Actor>       
     195;;<ActorID>AA0001</ActorID>     
     196;;</Actor>     
     197;;</Source>     
     198;;</Problem>   
     199;;<Problem>     
     200;;<Type>       
     201;;<Text>Problem</Text> 
     202;;</Type>       
     203;;<Description> 
     204;;<Text>Diabetes        Mellitus</Text>
     205;;<Code>       
     206;;<Value>C0375113</Value>       
     207;;<CodingSystem>UMLS    Concept</CodingSystem>
     208;;<Version>2006</Version>       
     209;;</Code>       
     210;;<Code>       
     211;;<Value>250.00</Value> 
     212;;<CodingSystem>ICD9CM</CodingSystem>   
     213;;<Version>2006</Version>       
     214;;</Code>       
     215;;</Description>       
     216;;<Source>     
     217;;<Actor>       
     218;;<ActorID>AA0001</ActorID>     
     219;;</Actor>     
     220;;</Source>     
     221;;</Problem>   
     222;;<Problem>     
     223;;<Type>       
     224;;<Text>Problem</Text> 
     225;;</Type>       
     226;;<Description> 
     227;;<Text>Parkinson's     disease NOS</Text>
     228;;<Code>       
     229;;<Value>332.0</Value> 
     230;;<CodingSystem>ICD9CM</CodingSystem>   
     231;;<Version>2007</Version>       
     232;;</Code>       
     233;;</Description>       
     234;;<Source>     
     235;;<Actor>       
     236;;<ActorID>AA0001</ActorID>     
     237;;</Actor>     
     238;;</Source>     
     239;;</Problem>   
     240;;</FamilyProblemHistory>       
     241;;</FamilyHistory>     
     242;;<SocialHistory>       
     243;;<SocialHistoryElement>       
     244;;<CCRDataObjectID>BB0004</CCRDataObjectID>     
     245;;<Type>       
     246;;<Text>Marital Status</Text>
     247;;</Type>       
     248;;<Description> 
     249;;<Text>Married</Text> 
     250;;</Description>       
     251;;<Source>     
     252;;<Actor>       
     253;;<ActorID>AA0001</ActorID>     
     254;;</Actor>     
     255;;</Source>     
     256;;</SocialHistoryElement>       
     257;;<SocialHistoryElement>       
     258;;<CCRDataObjectID>BB0005</CCRDataObjectID>     
     259;;<Type>       
     260;;<Text>Ethnic  Origin</Text>
     261;;</Type>       
     262;;<Description> 
     263;;<Text>Not     Hispanic or Latino</Text>
     264;;</Description>       
     265;;<Source>     
     266;;<Actor>       
     267;;<ActorID>AA0001</ActorID>     
     268;;</Actor>     
     269;;</Source>     
     270;;</SocialHistoryElement>       
     271;;<SocialHistoryElement>       
     272;;<CCRDataObjectID>BB0006</CCRDataObjectID>     
     273;;<Type>       
     274;;<Text>Race</Text>     
     275;;</Type>       
     276;;<Description> 
     277;;<Text>White</Text>   
     278;;</Description>       
     279;;<Source>     
     280;;<Actor>       
     281;;<ActorID>AA0001</ActorID>     
     282;;</Actor>     
     283;;</Source>     
     284;;</SocialHistoryElement>       
     285;;<SocialHistoryElement>       
     286;;<CCRDataObjectID>BB0007</CCRDataObjectID>     
     287;;<Type>       
     288;;<Text>Occupation</Text>       
     289;;</Type>       
     290;;<Description> 
     291;;<Text>Physician</Text>       
     292;;</Description>       
     293;;<Source>     
     294;;<Actor>       
     295;;<ActorID>AA0001</ActorID>     
     296;;</Actor>     
     297;;</Source>     
     298;;</SocialHistoryElement>       
     299;;</SocialHistory>     
     300;;<Medications> 
     301;;<Medication> 
     302;;<CCRDataObjectID>BB0008</CCRDataObjectID>     
     303;;<DateTime>   
     304;;<Type>       
     305;;<Text>Begin   Date</Text>
     306;;</Type>       
     307;;<Age> 
     308;;<Value>42</Value>     
     309;;<Units>       
     310;;<Unit>Years</Unit>   
     311;;</Units>     
     312;;</Age>       
     313;;</DateTime>   
     314;;<Type>       
     315;;<Text>Medication</Text>       
     316;;</Type>       
     317;;<Status>     
     318;;<Text>Active</Text>   
     319;;</Status>     
     320;;<Source>     
     321;;<Actor>       
     322;;<ActorID>AA0001</ActorID>     
     323;;</Actor>     
     324;;</Source>     
     325;;<Product>     
     326;;<ProductName> 
     327;;<Text>simvastatin</Text>     
     328;;<Code>       
     329;;<Value>36567</Value> 
     330;;<CodingSystem>RXNORM</CodingSystem>   
     331;;<Version>2005</Version>       
     332;;</Code>       
     333;;</ProductName>       
     334;;<BrandName>   
     335;;<Text>Simvastatin</Text>     
     336;;<Code>       
     337;;<Value>00093715510</Value>   
     338;;<CodingSystem>NDC</CodingSystem>     
     339;;<Version>2005</Version>       
     340;;</Code>       
     341;;</BrandName> 
     342;;<Strength>   
     343;;<Value>40</Value>     
     344;;<Units>       
     345;;<Unit>mg</Unit>       
     346;;</Units>     
     347;;</Strength>   
     348;;<Form>       
     349;;<Text>tablet</Text>   
     350;;</Form>       
     351;;</Product>   
     352;;<Directions> 
     353;;<Direction>   
     354;;<Description> 
     355;;<Text>1        PO 1 time per day</Text>
     356;;</Description>       
     357;;<Dose>       
     358;;<Value>1</Value>     
     359;;</Dose>       
     360;;<Route>       
     361;;<Text>PO</Text>       
     362;;</Route>     
     363;;<Frequency>   
     364;;<Value>1      time per day</Value>
     365;;</Frequency> 
     366;;</Direction> 
     367;;</Directions> 
     368;;</Medication> 
     369;;</Medications>       
     370;;<VitalSigns> 
     371;;<Result>     
     372;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>   
     373;;<DateTime>   
     374;;<Type>       
     375;;<Text>Assessment      Time</Text>
     376;;</Type>       
     377;;<ExactDateTime>@@HEIGHTWEIGHTDATATIME@@</ExactDateTime>       
     378;;</DateTime>   
     379;;<Description> 
     380;;<Text>Height  &amp; Weight</Text>
     381;;</Description>       
     382;;<Source>     
     383;;<Actor>       
     384;;<ActorID>@@HEIGHTWEIGHTSOURCE@@</ActorID>     
     385;;</Actor>     
     386;;</Source>     
     387;;<Test>       
     388;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>   
     389;;<Type>       
     390;;<Text>Observation</Text>     
     391;;</Type>       
     392;;<Description> 
     393;;<Text>Height</Text>   
     394;;<Code>       
     395;;<Value>50373000</Value>       
     396;;<CodingSystem>SNOMED</CodingSystem>   
     397;;<Version>2006</Version>       
     398;;</Code>       
     399;;</Description>       
     400;;<Source>     
     401;;<Actor>       
     402;;<ActorID>@@HEIGHTSOURCEID@@</ActorID>
     403;;</Actor>     
     404;;</Source>     
     405;;<TestResult> 
     406;;<Value>@@HEIGHTINCHES@@</Value>       
     407;;<Units>       
     408;;<Unit>in</Unit>       
     409;;</Units>     
     410;;</TestResult> 
     411;;</Test>       
     412;;<Test>       
     413;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>   
     414;;<Type>       
     415;;<Text>Observation</Text>     
     416;;</Type>       
     417;;<Description> 
     418;;<Text>Weight</Text>   
     419;;<Code>       
     420;;<Value>363808001</Value>     
     421;;<CodingSystem>SNOMED</CodingSystem>   
     422;;<Version>2006</Version>       
     423;;</Code>       
     424;;</Description>       
     425;;<Source>     
     426;;<Actor>       
     427;;<ActorID>@@WEIGHTSOURCEID@@</ActorID>
     428;;</Actor>     
     429;;</Source>     
     430;;<TestResult> 
     431;;<Value>@@WEIGHTLBS@@</Value> 
     432;;<Units>       
     433;;<Unit>lb</Unit>       
     434;;</Units>     
     435;;</TestResult> 
     436;;</Test>       
     437;;</Result>     
     438;;<Result>     
     439;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>   
     440;;<Description> 
     441;;<Text>Blood   Type</Text>
     442;;</Description>       
     443;;<Source>     
     444;;<Actor>       
     445;;<ActorID>@@BLOODTYPESOURCEID@@</ActorID>     
     446;;</Actor>     
     447;;</Source>     
     448;;<Test>       
     449;;<CCRDataObjectID>@@DATAOBJECTID@@</CCRDataObjectID>   
     450;;<Type>       
     451;;<Text>Result</Text>   
     452;;</Type>       
     453;;<Description> 
     454;;<Text>Blood   Type</Text>
     455;;<Code>       
     456;;<Value>278149003</Value>     
     457;;<CodingSystem>SNOMED</CodingSystem>   
     458;;<Version>2005</Version>       
     459;;</Code>       
     460;;</Description>       
     461;;<Source>     
     462;;<Actor>       
     463;;<ActorID>@@BLOODTYPESOURCEID2@@</ActorID>     
     464;;</Actor>     
     465;;</Source>     
     466;;<TestResult> 
     467;;<Value>@@BLOODTYPERESULT@@</Value>   
     468;;</TestResult> 
     469;;</Test>       
     470;;</Result>     
     471;;</VitalSigns> 
     472;;<HealthCareProviders> 
     473;;<Provider>   
     474;;<ActorID>AA0005</ActorID>     
     475;;<ActorRole>   
     476;;<Text>Primary Provider</Text>
     477;;</ActorRole> 
     478;;</Provider>   
     479;;</HealthCareProviders>       
     480;;</Body>       
     481;;<Actors>     
     482;;<Actor>       
     483;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>     
     484;;<Person>     
     485;;<Name>       
     486;;<CurrentName> 
     487;;<Given>@@ACTORGIVENNAME@@</Given>     
     488;;<Middle>@@ACTORMIDDLENAME@@</Middle> 
     489;;<Family>@@ACTORFAMILYNAME@@</Family> 
     490;;</CurrentName>       
     491;;</Name>       
     492;;<DateOfBirth> 
     493;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>   
     494;;</DateOfBirth>       
     495;;<Gender>     
     496;;<Text>@@ACTORGENDER@@</Text> 
     497;;</Gender>     
     498;;</Person>     
     499;;<IDs> 
     500;;<Type>       
     501;;<Text>SSN</Text>     
     502;;</Type>       
     503;;<ID>@@ACTORSSN@@</ID> 
     504;;<Source>     
     505;;<Actor>       
     506;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>       
     507;;</Actor>     
     508;;</Source>     
     509;;</IDs>       
     510;;<Address>     
     511;;<Type>       
     512;;<Text>@@ACTORADDRESSTYPE@@</Text>     
     513;;</Type>       
     514;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 
     515;;<Line2>@@ACTORADDRESSLINE2@@</Line2> 
     516;;<City>@@ACTORADDRESSCITY@@</City>     
     517;;<State>@@ACTORADDRESSSTATE@@</State> 
     518;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>     
     519;;</Address>   
     520;;<Telephone>   
     521;;<Value>@@ACTORTELEPHONE@@</Value>     
     522;;<Type>       
     523;;<Text>@@ACTORTELEPHONETYPE@@</Text>   
     524;;</Type>       
     525;;</Telephone> 
     526;;<EMail>       
     527;;<Value>@@ACTOREMAIL@@</Value> 
     528;;</EMail>     
     529;;<Source>     
     530;;<Actor>       
     531;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>   
     532;;</Actor>     
     533;;</Source>     
     534;;</Actor>     
     535;;<Actor>       
     536;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>     
     537;;<InformationSystem>   
     538;;<Name>@@ACTORINFOSYSNAME@@</Name>     
     539;;<Version>@@ACTORINFOSYSVER@@</Version>       
     540;;</InformationSystem> 
     541;;<Source>     
     542;;<Actor>       
     543;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>   
     544;;</Actor>     
     545;;</Source>     
     546;;</Actor>     
     547;;<Actor>       
     548;;<ActorObjectID>AA0003</ActorObjectID> 
     549;;<Person>     
     550;;<Name>       
     551;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>       
     552;;</Name>       
     553;;</Person>     
     554;;<Relation>   
     555;;<Text>@@ACTORRELATION@@</Text>       
     556;;</Relation>   
     557;;<Source>     
     558;;<Actor>       
     559;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID> 
     560;;</Actor>     
     561;;</Source>     
     562;;</Actor>     
     563;;<Actor>       
     564;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>     
     565;;<Person>     
     566;;<Name>       
     567;;<CurrentName> 
     568;;<Given>@@ACTORGIVENNAME@@</Given>     
     569;;<Family>@@ACTORFAMILYNAME@@</Family> 
     570;;</CurrentName>       
     571;;</Name>       
     572;;</Person>     
     573;;<Specialty>   
     574;;<Text>@@ACTORSPECIALITY@@</Text>     
     575;;</Specialty> 
     576;;<Address>     
     577;;<Type>       
     578;;<Text>@@ACTORADDRESSTYPE@@</Text>     
     579;;</Type>       
     580;;<Line1>@@ACTORADDRESSLINE1@@</Line1> 
     581;;<City>@@ACTORADDRESSLINE2@@</City>   
     582;;<State>@@ACTORADDRESSSTATE@@</State> 
     583;;</Address>   
     584;;<Source>     
     585;;<Actor>       
     586;;<ActorID>@@ACTORSOURCEID@@</ActorID> 
     587;;</Actor>     
     588;;</Source>     
     589;;</Actor>     
     590;;</Actors>     
     591;;<Signatures> 
     592;;<CCRSignature>       
     593;;<SignatureObjectID>S0001</SignatureObjectID> 
     594;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>   
     595;;<Source>     
     596;;<ActorID>AA0001</ActorID>     
     597;;</Source>     
     598;;<Signature>   
     599;;<Signature    xmlns="http://www.w3.org/2000/09/xmldsig#">
     600;;<SignedInfo> 
     601;;<CanonicalizationMethod       Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315" />
     602;;<SignatureMethod      Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" />
     603;;<Reference    URI="">
     604;;<Transforms> 
     605;;<Transform    Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
     606;;</Transforms> 
     607;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" />
     608;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>       
     609;;</Reference> 
     610;;</SignedInfo> 
     611;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue> 
     612;;<KeyInfo>     
     613;;<KeyValue>   
     614;;<RSAKeyValue> 
     615;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>       
     616;;<Exponent>AQAB</Exponent>     
     617;;</RSAKeyValue>       
     618;;</KeyValue>   
     619;;</KeyInfo>   
     620;;</Signature> 
     621;;</Signature> 
     622;;</CCRSignature>       
     623;;</Signatures> 
     624;;</ContinuityOfCareRecord>     
     625;</TEMPLATE>   
  • ccr/trunk/p/GPLVITALS.m

    r3 r34  
    1 GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08
    2  ;;0.1;CCDCCR;nopatch;noreleasedate
    3 EXTRACT(VITXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
    4     ;
    5     ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    6     ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
    7     ;
    8     N VITALSTMP,I
    9     S VITALSTMP="^TMP($J,""MISSINGVITALS"")"
    10     ; ZWR @VITXML
    11     D MISSING^GPLXPATH(VITXML,VITALSTMP) ; SEARCH XML FOR MISSING VARS
    12     I @VITALSTMP@(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
    13     . W "VITALS MISSING ",!
    14     . F I=1:1:@VITALSTMP@(0) W @VITALSTMP@(I),!
    15     Q
     1GPLVITALS       ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08
     2        ;;0.1;CCDCCR;nopatch;noreleasedate
     3EXTRACT(VITXML,DFN,VITOUTXML)   ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
     4           ;
     5           ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     6           ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
     7           ;
     8           N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
     9           D VITALS^ORQQVI(.VITRSLT,DFN,"","")
     10           I '$D(VITRSLT(1)) W "ERROR RUNNINIG VITALS RPC",! Q
     11           ;ZWR RPCRSLT
     12           S VITTVMAP=$NA(^TMP($J,"VITALS"))
     13           S VITTARYTMP=$NA(^TMP($J,"VITALARYTMP"))
     14           F J=1:1:VITRSLT(1)  D  ; FOR EACH VITAL IN THE LIST
     15           . I $D(VITRSLT(J)) D 
     16           . . S VITVMAP=$NA(@VITTVMAP@(J))
     17           . . K @VITVMAP
     18           . . I DEBUG W "VMAP= ",VMAP,!
     19           . . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
     20           . . S @VITVMAP@("DATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
     21           . . I $P(VITPTMP,U,2)="HT" D
     22           . . . S @VITVMAP@("HEIGHTWEIGHTDATATIME")=$P(VITPTMP,U,4)
     23           . . . S @VITVMAP@("HEIGHTWEIGHTSOURCE")=$P(VITPTMP,U,7)
     24           . . . S @VITVMAP@("HEIGHTSOURCEID")=$P(VITPTMP,U,1)
     25           . . . S @VITVMAP@("HEIGHTINCHES")=$P(VITPTMP,U,3)
     26           . . I $P(VITPTMP,U,2)="WT" D
     27           . . . S @VITVMAP@("WEIGHTSOURCEID")=$P(VITPTMP,U,1)
     28           . . . S @VITVMAP@("WEIGHTLBS")=$P(VITPTMP,U,3)
     29           . . S VITARYTMP=$NA(@VITTARYTMP@(J))
     30           . . K @VITARYTMP
     31           . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
     32           . . I J=1 D  ; FIRST ONE IS JUST A COPY
     33           . . . ; W "FIRST ONE",!
     34           . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
     35           . . . ; W "OUTXML ",OUTXML,!
     36           . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
     37           . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
     38           ;ZWR ^TMP($J,"VITALS",*)
     39           ;ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
     40           ; W "OUT OF FOR LOOP.",!
     41           ;ZWR
     42           ; ZWR @OUTXML
     43           ; $$HTML^DILF(
     44           N VITTMP,I
     45           D MISSING^GPLXPATH(VITXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
     46           I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
     47           . W "VITALS MISSING ",!
     48           . F I=1:1:VITTMP(0) W VITTMP(I),!
     49           Q
  • ccr/trunk/p/GPLXPATH.m

    r27 r34  
    1 GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
    2         ;;0.2;CCDCCR;nopatch;noreleasedate
    3         W "This is an XML XPATH utility library",!
    4         W !
    5         Q
    6         ;
    7 OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE
    8         ;
    9         N Y
    10         S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
    11         I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
    12         ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
    13         Q
    14         ;
    15 PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0)
    16         ;  VAL IS A STRING AND STK IS PASSED BY NAME
    17         ;
    18         I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
    19         S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
    20         S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
    21         Q
    22         ;
    23 POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
    24         ; VAL AND STK ARE PASSED BY REFERENCE
    25         ;
    26         I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY
    27         I @STK@(0)>0  D
    28         . S VAL=@STK@(@STK@(0))
    29         . K @STK@(@STK@(0))
    30         . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
    31         Q
    32         ;
    33 MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK
    34         ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
    35         S RTN=""
    36         N I
    37         ; W "STK= ",STK,!
    38         I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
    39         . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
    40         . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
    41         . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
    42         Q
    43         ;
    44 XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
    45         ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
    46         ; ISTR IS PASSED BY VALUE
    47         N CUR,TMP
    48         I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
    49         . S TMP=$P(ISTR,"<",2)
    50         I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
    51         . S TMP=$P(TMP,"/",2)
    52         S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
    53         ; W "CUR= ",CUR,!
    54         I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
    55          . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
    56         ; W "CUR2= ",CUR,!
    57         Q CUR
    58         ;
    59 INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index
    60         ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
    61         ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
    62         ; XML SECTION
    63         ; ZXML IS PASSED BY NAME
    64         N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
    65         N GPLSTK ; LEAVE OUT FOR DEBUGGING
    66         I '$D(@ZXML@(0))  D  ; NO XML PASSED
    67         . W "ERROR IN XML FILE",!
    68         S GPLSTK(0)=0 ; INITIALIZE STACK
    69         F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
    70         . S LINE=@ZXML@(I)
    71         . ;W LINE,!
    72         . S FOUND=0  ; INTIALIZED FOUND FLAG
    73         . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
    74         . I FOUND'=1  D
    75         . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
    76         . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE
    77         . . . ; W "FOUND ",LINE,!
    78         . . . S FOUND=1  ; SET FOUND FLAG
    79         . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
    80         . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
    81         . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
    82         . . . ; W "MDX=",MDX,!
    83         . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
    84         . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
    85         . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, IS NOT A MULTIPLE
    86         . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST LINE
    87         . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
    88         . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC
    89         . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
    90         . . . ; W "FOUND ",LINE,!
    91         . . . S FOUND=1  ; SET FOUND FLAG
    92         . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
    93         . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
    94         . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
    95         . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
    96         . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
    97         . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
    98         . . . . Q
    99         . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION
    100         . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
    101         . . . ; W "FOUND ",LINE,!
    102         . . . S FOUND=1  ; SET FOUND FLAG
    103         . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
    104         . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
    105         . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
    106         . . . ; W "MDX=",MDX,!
    107         . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
    108         . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
    109         . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, IS NOT A MULTIPLE
    110         . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
    111         S @ZXML@("INDEXED")=""
    112         S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
    113         Q
    114         ;
    115 QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
    116        ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
    117        ; IARY AND OARY ARE PASSED BY NAME
    118        I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
    119        . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
    120        N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
    121        N TMP,I,J,QXPATH
    122        S FIRST=1
    123        S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
    124        I XPATH'="//" D  ; NOT A ROOT QUERY
    125        . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
    126        . S FIRST=$P(TMP,"^",1)
    127        . S LAST=$P(TMP,"^",2)
    128        K @OARY
    129        S @OARY@(0)=+LAST-FIRST+1
    130        S J=1
    131        FOR I=FIRST:1:LAST  D
    132        . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
    133        . S J=J+1
    134        ; ZWR OARY
    135        Q
    136        ;
    137 XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
    138        ; INDEX WITH TWO PIECES START^FINISH
    139        ; IDX IS PASSED BY NAME
    140        Q $P(@IDX@(XPATH),"^",1)
    141        ;
    142 XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
    143        ; INDEX WITH TWO PIECES START^FINISH
    144        ; IDX IS PASSED BY NAME
    145        Q $P(@IDX@(XPATH),"^",2)
    146        ;
    147 START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
    148        ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
    149        ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
    150        Q $P(ISTR,";",2)
    151        ;
    152 FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
    153        ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
    154        Q $P(ISTR,";",3)
    155        ;
    156 ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
    157        ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
    158        Q $P(ISTR,";",1)
    159        ;
    160 BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
    161        ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
    162        ; DEST IS CLEARED TO START
    163        ; USES PUSH TO DO THE COPY
    164        N I
    165        K @BDEST
    166        F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
    167        . N J,ATMP
    168        . S ATMP=$$ARRAY(@BLIST@(I))
    169        . I DEBUG W "ATMP=",ATMP,!
    170        . I DEBUG W @BLIST@(I),!
    171        . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
    172        . . ; FOR EACH LINE IN THIS INSTR
    173        . . I DEBUG W "BDEST= ",BDEST,!
    174        . . I DEBUG W "ATMP= ",@ATMP@(J),!
    175        . . D PUSH(BDEST,@ATMP@(J))
    176        Q
    177        ;
    178 QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST
    179        ;
    180        I DEBUG W "QUEUEING ",BLST,!
    181        D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
    182        Q
    183        ;
    184 CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
    185        ; KILLS CPDEST FIRST
    186        N CPINSTR
    187        I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
    188        I @CPSRC@(0)<1 D  ; BAD LENGTH
    189        . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
    190        . Q
    191        ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE
    192        D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
    193        D BUILD("CPINSTR",CPDEST)
    194        Q
    195        ;
    196 QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
    197        ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
    198        ; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT
    199        ; USED TO INSERT CHILDREN NODES
    200        I @QOXML@(0)<1 D  ; MALFORMED XML
    201        . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
    202        . Q
    203        I DEBUG W "DOING QOPEN",!
    204        N S1,E1,QOT,QOTMP
    205        S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
    206        I $D(QOXPATH) D  ; XPATH PROVIDED
    207        . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
    208        . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
    209        I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
    210        . S E1=@QOXML@(0)-1
    211        D QUEUE(QOBLIST,QOXML,S1,E1)
    212        ; S QOTMP=QOXML_"^"_S1_"^"_E1
    213        ; D PUSH(QOBLIST,QOTMP)
    214        Q
    215        ;
    216 QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN
    217        ; ADDS THE LIST LINE OF QCXML TO QCBLIST
    218        ; USED TO FINISH INSERTING CHILDERN NODES
    219        ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
    220        ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
    221        I @QCXML@(0)<1 D  ; MALFORMED XML
    222        . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
    223        I DEBUG W "GOING TO CLOSE",!
    224        N S1,E1,QCT,QCTMP
    225        S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
    226        I $D(QCXPATH) D  ; XPATH PROVIDED
    227        . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
    228        . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
    229        I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
    230        . S S1=@QCXML@(0)
    231        D QUEUE(QCBLIST,QCXML,S1,E1)
    232        ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
    233        Q
    234        ;
    235 INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE
    236        ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
    237        ; OMITTED, INSERTION WILL BE AT THE ROOT
    238        ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
    239        ; XML AT THE END OF THE XPATH POINT
    240        ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
    241        N INSBLD,INSTMP
    242        I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
    243        I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
    244        I '$D(@INSXML@(0)) D  Q ; INSERT INTO AN EMPTY ARRAY
    245        . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
    246        I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
    247        . I $D(INSXPATH) D  ; XPATH PROVIDED
    248        . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
    249        . . I DEBUG ZWR INSBLD
    250        . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
    251        . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
    252        . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
    253        . I $D(INSXPATH) D  ; XPATH PROVIDED
    254        . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
    255        . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
    256        . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
    257        . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
    258        . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
    259        Q
    260        ;
    261 INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW
    262        ; INTO INNXML AT THE INNXPATH XPATH POINT
    263        ;
    264        N INNBLD,UXPATH
    265        N INNTBUF
    266        S INNTBUF=$NA(^TMP($J,"INNTBUF"))
    267        I '$D(INNXPATH) D  ; XPATH NOT PASSED
    268        . S UXPATH="//" ; USE ROOT XPATH
    269        I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
    270        I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
    271        . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
    272        . D BUILD("INNBLD",INNXML)
    273        I @INNXML@(0)>0  D  ; NOT EMPTY
    274        . D QOPEN("INNBLD",INNXML,UXPATH) ;
    275        . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
    276        . D QCLOSE("INNBLD",INNXML,UXPATH)
    277        . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
    278        . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
    279        Q
    280        ;
    281 REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT
    282        ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
    283        ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
    284        ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
    285        N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
    286        S OLD=$NA(^TMP($J,"REPLACE_OLD"))
    287        D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
    288        S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
    289        S XFIRST=$P(XNODE,"^",1)
    290        S XLAST=$P(XNODE,"^",2)
    291        D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
    292        I RENEW'="" D  ; NEW XML IS NOT NULL
    293        . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
    294        D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
    295        I DEBUG W "REPALCE PREBUILD",!
    296        I DEBUG ZWR REBLD
    297        D BUILD("REBLD","RTMP")
    298        K @REXML ; KILL WHAT WAS THERE
    299        D CP("RTMP",REXML) ; COPY IN THE RESULT
    300        Q
    301        ;
    302 MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
    303        ; W "Reporting on the missing",!
    304        ; W OARY
    305        I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
    306        N I
    307        S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
    308        F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
    309        . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
    310        . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
    311        . . Q
    312        Q
    313        ;
    314 MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY
    315         ; AND PUT THE RESULTS IN OXML
    316        I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
    317        I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
    318        N I,TNAM,TVAL
    319        S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
    320        F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
    321        . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
    322        . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
    323        . . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME
    324        . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
    325        . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
    326        . . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT
    327        W "MAPPED",!
    328        Q
    329        ;
    330 PARY(GLO) ;PRINT AN ARRAY
    331       N I
    332       F I=1:1:@GLO@(0) W @GLO@(I),!
    333       Q
    334       ;
    335 TEST  ; Run all the test cases
    336       D TESTALL^GPLUNIT("GPLXPATH")
    337       Q
    338       ;
    339 OLDTEST   ; RUN ALL THE TEST CASES
    340         N ZTMP
    341         D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
    342         D ZTEST^GPLUNIT(.ZTMP,"ALL")
    343         W "PASSED: ",TPASSED,!
    344         W "FAILED: ",TFAILED,!
    345         W !
    346         ; W "THE TESTS!",!
    347         ; ZWR ZTMP
    348         Q
    349         ;
    350 ZTEST(WHICH) ; RUN ONE SET OF TESTS
    351         N ZTMP
    352         S DEBUG=1
    353         D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
    354         D ZTEST^GPLUNIT(.ZTMP,WHICH)
    355         Q
    356         ;
    357 TLIST ; LIST THE TESTS
    358       N ZTMP
    359       D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
    360       D TLIST^GPLUNIT(.ZTMP)
    361       Q
    362       ;
    363 ;;><TEST>
    364 ;;><INIT>
    365 ;;>>>K GPL S GPL=""
    366 ;;>>>D PUSH^GPLXPATH("GPL","FIRST")
    367 ;;>>>D PUSH^GPLXPATH("GPL","SECOND")
    368 ;;>>>D PUSH^GPLXPATH("GPL","THIRD")
    369 ;;>>>D PUSH^GPLXPATH("GPL","FOURTH")
    370 ;;>>?GPL(0)=4
    371 ;;><INITXML>
    372 ;;>>>K GXML S GXML=""
    373 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
    374 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
    375 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
    376 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
    377 ;;>>>D PUSH^GPLXPATH("GXML","<FIFTH>")
    378 ;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@")
    379 ;;>>>D PUSH^GPLXPATH("GXML","</FIFTH>")
    380 ;;>>>D PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
    381 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
    382 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
    383 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
    384 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
    385 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
    386 ;;><INITXML2>
    387 ;;>>>K GXML S GXML=""
    388 ;;>>>D PUSH^GPLXPATH("GXML","<FIRST>")
    389 ;;>>>D PUSH^GPLXPATH("GXML","<SECOND>")
    390 ;;>>>D PUSH^GPLXPATH("GXML","<THIRD>")
    391 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
    392 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>")
    393 ;;>>>D PUSH^GPLXPATH("GXML","DATA2")
    394 ;;>>>D PUSH^GPLXPATH("GXML","</FOURTH>")
    395 ;;>>>D PUSH^GPLXPATH("GXML","</THIRD>")
    396 ;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>")
    397 ;;>>>D PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
    398 ;;>>>D PUSH^GPLXPATH("GXML","</_SECOND>")
    399 ;;>>>D PUSH^GPLXPATH("GXML","</SECOND>")
    400 ;;>>>D PUSH^GPLXPATH("GXML","</FIRST>")
    401 ;;><PUSHPOP>
    402 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
    403 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
    404 ;;>>?GPL(GPL(0))="FOURTH"
    405 ;;>>>D POP^GPLXPATH("GPL",.GX)
    406 ;;>>?GX="FOURTH"
    407 ;;>>?GPL(GPL(0))="THIRD"
    408 ;;>>>D POP^GPLXPATH("GPL",.GX)
    409 ;;>>?GX="THIRD"
    410 ;;>>?GPL(GPL(0))="SECOND"
    411 ;;><MKMDX>
    412 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
    413 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT")
    414 ;;>>>S GX=""
    415 ;;>>>D MKMDX^GPLXPATH("GPL",.GX)
    416 ;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
    417 ;;><XNAME>
    418 ;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
    419 ;;>>?$$XNAME^GPLXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
    420 ;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"
    421 ;;><INDEX>
    422 ;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
    423 ;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML")
    424 ;;>>>D INDEX^GPLXPATH("GXML")
    425 ;;>>?GXML("//FIRST/SECOND")="2^12"
    426 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
    427 ;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
    428 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4"
    429 ;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"
    430 ;;>>?GXML("//FIRST/SECOND")="2^12"
    431 ;;>>?GXML("//FIRST")="1^13"
    432 ;;><INDEX2>
    433 ;;>>>D ZTEST^GPLXPATH("INITXML2")
    434 ;;>>>D INDEX^GPLXPATH("GXML")
    435 ;;>>?GXML("//FIRST/SECOND")="2^12"
    436 ;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
    437 ;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"
    438 ;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
    439 ;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7"
    440 ;;>>?GXML("//FIRST")="1^13"
    441 ;;><MISSING>
    442 ;;>>>D ZTEST^GPLXPATH("INITXML")
    443 ;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
    444 ;;>>>D MISSING^GPLXPATH("GXML",OUTARY)
    445 ;;>>?@OUTARY@(1)="DATA1"
    446 ;;>>?@OUTARY@(2)="DATA2"
    447 ;;><MAP>
    448 ;;>>>D ZTEST^GPLXPATH("INITXML")
    449 ;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
    450 ;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
    451 ;;>>>S @MAPARY@("DATA2")="VALUE2"
    452 ;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY)
    453 ;;>>?@OUTARY@(6)="VALUE2"
    454 ;;><QUEUE>
    455 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3)
    456 ;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5)
    457 ;;>>?$P(BTLIST(2),";",2)=4
    458 ;;><BUILD>
    459 ;;>>>D ZTEST^GPLXPATH("INITXML")
    460 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
    461 ;;>>>D ZTEST^GPLXPATH("QUEUE")
    462 ;;>>>D BUILD^GPLXPATH("BTLIST","G3")
    463 ;;><CP>
    464 ;;>>>D ZTEST^GPLXPATH("INITXML")
    465 ;;>>>D CP^GPLXPATH("GXML","G2")
    466 ;;>>?G2(0)=13
    467 ;;><QOPEN>
    468 ;;>>>K G2,GBL
    469 ;;>>>D ZTEST^GPLXPATH("INITXML")
    470 ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
    471 ;;>>?$P(GBL(1),";",3)=12
    472 ;;>>>D BUILD^GPLXPATH("GBL","G2")
    473 ;;>>?G2(G2(0))="</SECOND>"
    474 ;;><QOPEN2>
    475 ;;>>>K G2,GBL
    476 ;;>>>D ZTEST^GPLXPATH("INITXML")
    477 ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
    478 ;;>>?$P(GBL(1),";",3)=11
    479 ;;>>>D BUILD^GPLXPATH("GBL","G2")
    480 ;;>>?G2(G2(0))="</SECOND>"
    481 ;;><QCLOSE>
    482 ;;>>>K G2,GBL
    483 ;;>>>D ZTEST^GPLXPATH("INITXML")
    484 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
    485 ;;>>?$P(GBL(1),";",3)=13
    486 ;;>>>D BUILD^GPLXPATH("GBL","G2")
    487 ;;>>?G2(G2(0))="</FIRST>"
    488 ;;><QCLOSE2>
    489 ;;>>>K G2,GBL
    490 ;;>>>D ZTEST^GPLXPATH("INITXML")
    491 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
    492 ;;>>?$P(GBL(1),";",3)=13
    493 ;;>>>D BUILD^GPLXPATH("GBL","G2")
    494 ;;>>?G2(G2(0))="</FIRST>"
    495 ;;>>?G2(1)="</THIRD>"
    496 ;;><INSERT>
    497 ;;>>>K G2,GBL,G3,G4
    498 ;;>>>D ZTEST^GPLXPATH("INITXML")
    499 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
    500 ;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
    501 ;;>>>D INSERT^GPLXPATH("G3","G2","//")
    502 ;;>>?G2(1)=GXML(9)
    503 ;;><REPLACE>
    504 ;;>>>K G2,GBL,G3
    505 ;;>>>D ZTEST^GPLXPATH("INITXML")
    506 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
    507 ;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
    508 ;;>>?GXML(3)="<FIFTH>"
    509 ;;><INSINNER>
    510 ;;>>>K GXML,G2,GBL,G3
    511 ;;>>>D ZTEST^GPLXPATH("INITXML")
    512 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
    513 ;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
    514 ;;>>?GXML(10)="<FIFTH>"
    515 ;;><INSINNER2>
    516 ;;>>>K GXML,G2,GBL,G3
    517 ;;>>>D ZTEST^GPLXPATH("INITXML")
    518 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
    519 ;;>>>D INSINNER^GPLXPATH("G2","G2")
    520 ;;>>?G2(8)="<FIFTH>"
    521 ;;></TEST>
     1GPLXPATH        ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
     2               ;;0.2;CCDCCR;nopatch;noreleasedate
     3               W "This is an XML XPATH utility library",!
     4               W !
     5               Q
     6               ;
     7OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
     8               ;
     9               N Y
     10               S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
     11               I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,!
     12               ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml")
     13               Q
     14               ;
     15PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
     16               ;  VAL IS A STRING AND STK IS PASSED BY NAME
     17               ;
     18               I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
     19               S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
     20               S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
     21               Q
     22               ;
     23POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
     24               ; VAL AND STK ARE PASSED BY REFERENCE
     25               ;
     26               I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY
     27               I @STK@(0)>0  D
     28               . S VAL=@STK@(@STK@(0))
     29               . K @STK@(@STK@(0))
     30               . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
     31               Q
     32               ;
     33MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
     34               ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS
     35               S RTN=""
     36               N I
     37               ; W "STK= ",STK,!
     38               I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
     39               . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
     40               . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
     41               . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
     42               Q
     43               ;
     44XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
     45               ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
     46               ; ISTR IS PASSED BY VALUE
     47               N CUR,TMP
     48               I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
     49               . S TMP=$P(ISTR,"<",2)
     50               I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
     51               . S TMP=$P(TMP,"/",2)
     52               S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
     53               ; W "CUR= ",CUR,!
     54               I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
     55                . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
     56               ; W "CUR2= ",CUR,!
     57               Q CUR
     58               ;
     59INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
     60               ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
     61               ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
     62               ; XML SECTION
     63               ; ZXML IS PASSED BY NAME
     64               N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND
     65               N GPLSTK ; LEAVE OUT FOR DEBUGGING
     66               I '$D(@ZXML@(0))  D  ; NO XML PASSED
     67               . W "ERROR IN XML FILE",!
     68               S GPLSTK(0)=0 ; INITIALIZE STACK
     69               F I=1:1:@ZXML@(0)  D  ; PROCESS THE ENTIRE ARRAY
     70               . S LINE=@ZXML@(I)
     71               . ;W LINE,!
     72               . S FOUND=0  ; INTIALIZED FOUND FLAG
     73               . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
     74               . I FOUND'=1  D
     75               . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
     76               . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE
     77               . . . ; W "FOUND ",LINE,!
     78               . . . S FOUND=1  ; SET FOUND FLAG
     79               . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
     80               . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
     81               . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
     82               . . . ; W "MDX=",MDX,!
     83               . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
     84               . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
     85               . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, IS NOT A MULTIPLE
     86               . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST LINE
     87               . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
     88               . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC
     89               . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
     90               . . . ; W "FOUND ",LINE,!
     91               . . . S FOUND=1  ; SET FOUND FLAG
     92               . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
     93               . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
     94               . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
     95               . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK
     96               . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
     97               . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
     98               . . . . Q
     99               . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN THE BEGINNING OF A SECTION
     100               . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
     101               . . . ; W "FOUND ",LINE,!
     102               . . . S FOUND=1  ; SET FOUND FLAG
     103               . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
     104               . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK
     105               . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX
     106               . . . ; W "MDX=",MDX,!
     107               . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
     108               . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
     109               . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, IS NOT A MULTIPLE
     110               . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
     111               S @ZXML@("INDEXED")=""
     112               S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH
     113               Q
     114               ;
     115QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
     116              ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
     117              ; IARY AND OARY ARE PASSED BY NAME
     118              I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
     119              . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
     120              N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
     121              N TMP,I,J,QXPATH
     122              S FIRST=1
     123              S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
     124              I XPATH'="//" D  ; NOT A ROOT QUERY
     125              . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
     126              . S FIRST=$P(TMP,"^",1)
     127              . S LAST=$P(TMP,"^",2)
     128              K @OARY
     129              S @OARY@(0)=+LAST-FIRST+1
     130              S J=1
     131              FOR I=FIRST:1:LAST  D
     132              . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
     133              . S J=J+1
     134              ; ZWR OARY
     135              Q
     136              ;
     137XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
     138              ; INDEX WITH TWO PIECES START^FINISH
     139              ; IDX IS PASSED BY NAME
     140              Q $P(@IDX@(XPATH),"^",1)
     141              ;
     142XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
     143              ; INDEX WITH TWO PIECES START^FINISH
     144              ; IDX IS PASSED BY NAME
     145              Q $P(@IDX@(XPATH),"^",2)
     146              ;
     147START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
     148              ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
     149              ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
     150              Q $P(ISTR,";",2)
     151              ;
     152FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
     153              ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
     154              Q $P(ISTR,";",3)
     155              ;
     156ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
     157              ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
     158              Q $P(ISTR,";",1)
     159              ;
     160BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
     161              ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
     162              ; DEST IS CLEARED TO START
     163              ; USES PUSH TO DO THE COPY
     164              N I
     165              K @BDEST
     166              F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
     167              . N J,ATMP
     168              . S ATMP=$$ARRAY(@BLIST@(I))
     169              . I DEBUG W "ATMP=",ATMP,!
     170              . I DEBUG W @BLIST@(I),!
     171              . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
     172              . . ; FOR EACH LINE IN THIS INSTR
     173              . . I DEBUG W "BDEST= ",BDEST,!
     174              . . I DEBUG W "ATMP= ",@ATMP@(J),!
     175              . . D PUSH(BDEST,@ATMP@(J))
     176              Q
     177              ;
     178QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
     179              ;
     180              I DEBUG W "QUEUEING ",BLST,!
     181              D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
     182              Q
     183              ;
     184CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
     185              ; KILLS CPDEST FIRST
     186              N CPINSTR
     187              I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,!
     188              I @CPSRC@(0)<1 D  ; BAD LENGTH
     189              . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
     190              . Q
     191              ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE
     192              D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
     193              D BUILD("CPINSTR",CPDEST)
     194              Q
     195              ;
     196QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
     197              ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
     198              ; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT
     199              ; USED TO INSERT CHILDREN NODES
     200              I @QOXML@(0)<1 D  ; MALFORMED XML
     201              . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
     202              . Q
     203              I DEBUG W "DOING QOPEN",!
     204              N S1,E1,QOT,QOTMP
     205              S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
     206              I $D(QOXPATH) D  ; XPATH PROVIDED
     207              . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
     208              . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
     209              I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
     210              . S E1=@QOXML@(0)-1
     211              D QUEUE(QOBLIST,QOXML,S1,E1)
     212              ; S QOTMP=QOXML_"^"_S1_"^"_E1
     213              ; D PUSH(QOBLIST,QOTMP)
     214              Q
     215              ;
     216QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
     217              ; ADDS THE LIST LINE OF QCXML TO QCBLIST
     218              ; USED TO FINISH INSERTING CHILDERN NODES
     219              ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
     220              ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
     221              I @QCXML@(0)<1 D  ; MALFORMED XML
     222              . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
     223              I DEBUG W "GOING TO CLOSE",!
     224              N S1,E1,QCT,QCTMP
     225              S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
     226              I $D(QCXPATH) D  ; XPATH PROVIDED
     227              . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
     228              . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
     229              I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
     230              . S S1=@QCXML@(0)
     231              D QUEUE(QCBLIST,QCXML,S1,E1)
     232              ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
     233              Q
     234              ;
     235INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
     236              ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
     237              ; OMITTED, INSERTION WILL BE AT THE ROOT
     238              ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
     239              ; XML AT THE END OF THE XPATH POINT
     240              ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
     241              N INSBLD,INSTMP
     242              I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
     243              I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
     244              I '$D(@INSXML@(0)) D  Q ; INSERT INTO AN EMPTY ARRAY
     245              . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
     246              I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
     247              . I $D(INSXPATH) D  ; XPATH PROVIDED
     248              . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
     249              . . I DEBUG ZWR INSBLD
     250              . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
     251              . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
     252              . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
     253              . I $D(INSXPATH) D  ; XPATH PROVIDED
     254              . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
     255              . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
     256              . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
     257              . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
     258              . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
     259              Q
     260              ;
     261INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
     262              ; INTO INNXML AT THE INNXPATH XPATH POINT
     263              ;
     264              N INNBLD,UXPATH
     265              N INNTBUF
     266              S INNTBUF=$NA(^TMP($J,"INNTBUF"))
     267              I '$D(INNXPATH) D  ; XPATH NOT PASSED
     268              . S UXPATH="//" ; USE ROOT XPATH
     269              I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
     270              I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
     271              . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
     272              . D BUILD("INNBLD",INNXML)
     273              I @INNXML@(0)>0  D  ; NOT EMPTY
     274              . D QOPEN("INNBLD",INNXML,UXPATH) ;
     275              . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
     276              . D QCLOSE("INNBLD",INNXML,UXPATH)
     277              . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
     278              . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
     279              Q
     280              ;
     281REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
     282              ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
     283              ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
     284              ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
     285              N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
     286              S OLD=$NA(^TMP($J,"REPLACE_OLD"))
     287              D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
     288              S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
     289              S XFIRST=$P(XNODE,"^",1)
     290              S XLAST=$P(XNODE,"^",2)
     291              D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
     292              I RENEW'="" D  ; NEW XML IS NOT NULL
     293              . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
     294              D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
     295              I DEBUG W "REPALCE PREBUILD",!
     296              I DEBUG ZWR REBLD
     297              D BUILD("REBLD","RTMP")
     298              K @REXML ; KILL WHAT WAS THERE
     299              D CP("RTMP",REXML) ; COPY IN THE RESULT
     300              Q
     301              ;
     302MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
     303              ; W "Reporting on the missing",!
     304              ; W OARY
     305              I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
     306              N I
     307              S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
     308              F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
     309              . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
     310              . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
     311              . . Q
     312              Q
     313              ;
     314MAP(IXML,INARY,OXML)    ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY
     315               ; AND PUT THE RESULTS IN OXML
     316              I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
     317              I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
     318              N I,TNAM,TVAL
     319              S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT
     320              F I=1:1:@OXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
     321              . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
     322              . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
     323              . . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME
     324              . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
     325              . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
     326              . . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT
     327              W "MAPPED",!
     328              Q
     329              ;
     330PARY(GLO)       ;PRINT AN ARRAY
     331             N I
     332             F I=1:1:@GLO@(0) W @GLO@(I),!
     333             Q
     334             ;
     335TEST    ; Run all the test cases
     336             D TESTALL^GPLUNIT("GPLXPATH")
     337             Q
     338             ;
     339OLDTEST   ; RUN ALL THE TEST CASES
     340               N ZTMP
     341               D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
     342               D ZTEST^GPLUNIT(.ZTMP,"ALL")
     343               W "PASSED: ",TPASSED,!
     344               W "FAILED: ",TFAILED,!
     345               W !
     346               ; W "THE TESTS!",!
     347               ; ZWR ZTMP
     348               Q
     349               ;
     350ZTEST(WHICH)    ; RUN ONE SET OF TESTS
     351               N ZTMP
     352               S DEBUG=1
     353               D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
     354               D ZTEST^GPLUNIT(.ZTMP,WHICH)
     355               Q
     356               ;
     357TLIST   ; LIST THE TESTS
     358             N ZTMP
     359             D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
     360             D TLIST^GPLUNIT(.ZTMP)
     361             Q
     362             ;
     363;;><TEST>       
     364;;><INIT>       
     365;;>>>K  GPL S GPL=""
     366;;>>>D  PUSH^GPLXPATH("GPL","FIRST")
     367;;>>>D  PUSH^GPLXPATH("GPL","SECOND")
     368;;>>>D  PUSH^GPLXPATH("GPL","THIRD")
     369;;>>>D  PUSH^GPLXPATH("GPL","FOURTH")
     370;;>>?GPL(0)=4   
     371;;><INITXML>   
     372;;>>>K  GXML S GXML=""
     373;;>>>D  PUSH^GPLXPATH("GXML","<FIRST>")
     374;;>>>D  PUSH^GPLXPATH("GXML","<SECOND>")
     375;;>>>D  PUSH^GPLXPATH("GXML","<THIRD>")
     376;;>>>D  PUSH^GPLXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
     377;;>>>D  PUSH^GPLXPATH("GXML","<FIFTH>")
     378;;>>>D  PUSH^GPLXPATH("GXML","@@DATA2@@")
     379;;>>>D  PUSH^GPLXPATH("GXML","</FIFTH>")
     380;;>>>D  PUSH^GPLXPATH("GXML","<SIXTH ID=""SELF"" />")
     381;;>>>D  PUSH^GPLXPATH("GXML","</THIRD>")
     382;;>>>D  PUSH^GPLXPATH("GXML","<SECOND>")
     383;;>>>D  PUSH^GPLXPATH("GXML","</SECOND>")
     384;;>>>D  PUSH^GPLXPATH("GXML","</SECOND>")
     385;;>>>D  PUSH^GPLXPATH("GXML","</FIRST>")
     386;;><INITXML2>   
     387;;>>>K  GXML S GXML=""
     388;;>>>D  PUSH^GPLXPATH("GXML","<FIRST>")
     389;;>>>D  PUSH^GPLXPATH("GXML","<SECOND>")
     390;;>>>D  PUSH^GPLXPATH("GXML","<THIRD>")
     391;;>>>D  PUSH^GPLXPATH("GXML","<FOURTH>DATA1</FOURTH>")
     392;;>>>D  PUSH^GPLXPATH("GXML","<FOURTH>")
     393;;>>>D  PUSH^GPLXPATH("GXML","DATA2")
     394;;>>>D  PUSH^GPLXPATH("GXML","</FOURTH>")
     395;;>>>D  PUSH^GPLXPATH("GXML","</THIRD>")
     396;;>>>D  PUSH^GPLXPATH("GXML","<_SECOND>")
     397;;>>>D  PUSH^GPLXPATH("GXML","<FOURTH>DATA3</FOURTH>")
     398;;>>>D  PUSH^GPLXPATH("GXML","</_SECOND>")
     399;;>>>D  PUSH^GPLXPATH("GXML","</SECOND>")
     400;;>>>D  PUSH^GPLXPATH("GXML","</FIRST>")
     401;;><PUSHPOP>   
     402;;>>>D  ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
     403;;>>>D  ZTEST^GPLUNIT(.ZTMP,"INIT")
     404;;>>?GPL(GPL(0))="FOURTH"       
     405;;>>>D  POP^GPLXPATH("GPL",.GX)
     406;;>>?GX="FOURTH"       
     407;;>>?GPL(GPL(0))="THIRD"       
     408;;>>>D  POP^GPLXPATH("GPL",.GX)
     409;;>>?GX="THIRD" 
     410;;>>?GPL(GPL(0))="SECOND"       
     411;;><MKMDX>     
     412;;>>>D  ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
     413;;>>>D  ZTEST^GPLUNIT(.ZTMP,"INIT")
     414;;>>>S  GX=""
     415;;>>>D  MKMDX^GPLXPATH("GPL",.GX)
     416;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"   
     417;;><XNAME>     
     418;;>>?$$XNAME^GPLXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"       
     419;;>>?$$XNAME^GPLXPATH("<SIXTH   ID=""SELF"" />")="SIXTH"
     420;;>>?$$XNAME^GPLXPATH("</THIRD>")="THIRD"       
     421;;><INDEX>     
     422;;>>>D  ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
     423;;>>>D  ZTEST^GPLUNIT(.ZTMP,"INITXML")
     424;;>>>D  INDEX^GPLXPATH("GXML")
     425;;>>?GXML("//FIRST/SECOND")="2^12"     
     426;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" 
     427;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"   
     428;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" 
     429;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8"   
     430;;>>?GXML("//FIRST/SECOND")="2^12"     
     431;;>>?GXML("//FIRST")="1^13"     
     432;;><INDEX2>     
     433;;>>>D  ZTEST^GPLXPATH("INITXML2")
     434;;>>>D  INDEX^GPLXPATH("GXML")
     435;;>>?GXML("//FIRST/SECOND")="2^12"     
     436;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"     
     437;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10"     
     438;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" 
     439;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" 
     440;;>>?GXML("//FIRST")="1^13"     
     441;;><MISSING>   
     442;;>>>D  ZTEST^GPLXPATH("INITXML")
     443;;>>>S  OUTARY="^TMP($J,""MISSINGTEST"")"
     444;;>>>D  MISSING^GPLXPATH("GXML",OUTARY)
     445;;>>?@OUTARY@(1)="DATA1"       
     446;;>>?@OUTARY@(2)="DATA2"       
     447;;><MAP>       
     448;;>>>D  ZTEST^GPLXPATH("INITXML")
     449;;>>>S  MAPARY="^TMP($J,""MAPVALUES"")"
     450;;>>>S  OUTARY="^TMP($J,""MAPTEST"")"
     451;;>>>S  @MAPARY@("DATA2")="VALUE2"
     452;;>>>D  MAP^GPLXPATH("GXML",MAPARY,OUTARY)
     453;;>>?@OUTARY@(6)="VALUE2"       
     454;;><QUEUE>     
     455;;>>>D  QUEUE^GPLXPATH("BTLIST","GXML",2,3)
     456;;>>>D  QUEUE^GPLXPATH("BTLIST","GXML",4,5)
     457;;>>?$P(BTLIST(2),";",2)=4     
     458;;><BUILD>     
     459;;>>>D  ZTEST^GPLXPATH("INITXML")
     460;;>>>D  QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
     461;;>>>D  ZTEST^GPLXPATH("QUEUE")
     462;;>>>D  BUILD^GPLXPATH("BTLIST","G3")
     463;;><CP> 
     464;;>>>D  ZTEST^GPLXPATH("INITXML")
     465;;>>>D  CP^GPLXPATH("GXML","G2")
     466;;>>?G2(0)=13   
     467;;><QOPEN>     
     468;;>>>K  G2,GBL
     469;;>>>D  ZTEST^GPLXPATH("INITXML")
     470;;>>>D  QOPEN^GPLXPATH("GBL","GXML")
     471;;>>?$P(GBL(1),";",3)=12       
     472;;>>>D  BUILD^GPLXPATH("GBL","G2")
     473;;>>?G2(G2(0))="</SECOND>"     
     474;;><QOPEN2>     
     475;;>>>K  G2,GBL
     476;;>>>D  ZTEST^GPLXPATH("INITXML")
     477;;>>>D  QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
     478;;>>?$P(GBL(1),";",3)=11       
     479;;>>>D  BUILD^GPLXPATH("GBL","G2")
     480;;>>?G2(G2(0))="</SECOND>"     
     481;;><QCLOSE>     
     482;;>>>K  G2,GBL
     483;;>>>D  ZTEST^GPLXPATH("INITXML")
     484;;>>>D  QCLOSE^GPLXPATH("GBL","GXML")
     485;;>>?$P(GBL(1),";",3)=13       
     486;;>>>D  BUILD^GPLXPATH("GBL","G2")
     487;;>>?G2(G2(0))="</FIRST>"       
     488;;><QCLOSE2>   
     489;;>>>K  G2,GBL
     490;;>>>D  ZTEST^GPLXPATH("INITXML")
     491;;>>>D  QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
     492;;>>?$P(GBL(1),";",3)=13       
     493;;>>>D  BUILD^GPLXPATH("GBL","G2")
     494;;>>?G2(G2(0))="</FIRST>"       
     495;;>>?G2(1)="</THIRD>"   
     496;;><INSERT>     
     497;;>>>K  G2,GBL,G3,G4
     498;;>>>D  ZTEST^GPLXPATH("INITXML")
     499;;>>>D  QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
     500;;>>>D  INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
     501;;>>>D  INSERT^GPLXPATH("G3","G2","//")
     502;;>>?G2(1)=GXML(9)     
     503;;><REPLACE>   
     504;;>>>K  G2,GBL,G3
     505;;>>>D  ZTEST^GPLXPATH("INITXML")
     506;;>>>D  QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
     507;;>>>D  REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND")
     508;;>>?GXML(3)="<FIFTH>" 
     509;;><INSINNER>   
     510;;>>>K  GXML,G2,GBL,G3
     511;;>>>D  ZTEST^GPLXPATH("INITXML")
     512;;>>>D  QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
     513;;>>>D  INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
     514;;>>?GXML(10)="<FIFTH>" 
     515;;><INSINNER2> 
     516;;>>>K  GXML,G2,GBL,G3
     517;;>>>D  ZTEST^GPLXPATH("INITXML")
     518;;>>>D  QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2")
     519;;>>>D  INSINNER^GPLXPATH("G2","G2")
     520;;>>?G2(8)="<FIFTH>"   
     521;;></TEST>     
Note: See TracChangeset for help on using the changeset viewer.