Changeset 38 for ccr/trunk/p/GPLCCR.m


Ignore:
Timestamp:
Jul 3, 2008, 8:26:40 PM (16 years ago)
Author:
George Lilly
Message:

Cleaned up leading spaces

File:
1 edited

Legend:

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

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