Changeset 41

Timestamp:

Jul 4, 2008, 10:29:14 AM (16 years ago)

Author:

George Lilly

Message:

More work on the spacing of lines

File:

• ccr/trunk/p/GPLCCR.m (modified) (1 diff)

ccr/trunk/p/GPLCCR.m

@@ -1 +1 @@
 GPLCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
-          ;;0.1;CCDCCR;nopatch;noreleasedate
-          ;
-          ; EXPORT A CCR
-          ;
+;;0.1;CCDCCR;nopatch;noreleasedate
+     ;
+     ; EXPORT A CCR
+     ;
 EXPORT   ; EXPORT ENTRY POINT FOR CCR
-            ; Select a patient.
-            S DIC=2,DIC(0)="AEMQ" D ^DIC
-            I Y<1 Q ; EXIT
-            S DFN=$P(Y,U,1) ; SET THE PATIENT
-            N CCRGLO
-            D CCRRPC(.CCRGLO,DFN,"CCR","","","")
-            S OARY=$NA(^TMP($J,DFN,"CCR",1))
-            S ONAM="PAT_"_DFN_"_CCR_V1.xml"
-            S ODIR="/home/glilly/CCROUT"
-            ;S ODIR="/home/cedwards/"
-            D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
-            Q
-            ;
+       ; Select a patient.
+       S DIC=2,DIC(0)="AEMQ" D ^DIC
+       I Y<1 Q ; EXIT
+       S DFN=$P(Y,U,1) ; SET THE PATIENT
+       N CCRGLO
+       D CCRRPC(.CCRGLO,DFN,"CCR","","","")
+       S OARY=$NA(^TMP($J,DFN,"CCR",1))
+       S ONAM="PAT_"_DFN_"_CCR_V1.xml"
+       S ODIR="/home/glilly/CCROUT"
+       ;S ODIR="/home/cedwards/"
+       D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
+       Q
+       ;
 CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
-            ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
-            ; DFN IS PATIENT IEN
-            ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
-            ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
-            ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
-            ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
-            ; - NULL MEANS NOW
-            ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
-            ;    "TO" VARIABLES
-            ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
-            S DEBUG=0
-            S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
-            S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
-            S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS
-            ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
-            S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
-            D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
-            D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
-            ;
-            ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
-            ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
-            D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
-            D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
-            D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-            I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
-            ;
-            D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
-            ;
-            K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
-            S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR STEPS
-            D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
-            N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
-            F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
-            . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
-            . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
-            . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
-            . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
-            . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
-            . S IXML="INXML"
-            . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
-            . ; W OXML,!
-            . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
-            . W "RUNNING ",CALL,!
-            . X CALL
-            . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-            . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
-            . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-            D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
-            Q
-            ;
-INITSTPS(TAB)       ; INITIALIZE CCR PROCESSING STEPS
-            ; TAB IS PASSED BY NAME
-            ; W "TAB= ",TAB,!
-            D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
-            D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
-            Q
-        ;
+    ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
+    ; DFN IS PATIENT IEN
+    ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
+    ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
+    ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
+    ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
+    ; - NULL MEANS NOW
+    ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
+    ;    "TO" VARIABLES
+    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
+    S DEBUG=0
+    S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
+    S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+    S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS
+    ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
+    S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
+    D LOAD^GPLCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
+    D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
+    ;
+    ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
+    ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
+    D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+    I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+    ;
+    D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
+    ;
+    K ^TMP($J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
+    S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR STEPS
+    D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
+    N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
+    F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
+    . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
+    . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
+    . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
+    . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
+    . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
+    . S IXML="INXML"
+    . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
+    . ; W OXML,!
+    . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
+    . W "RUNNING ",CALL,!
+    . X CALL
+    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
+    . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+    . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
+    D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+    Q
+    ;
+INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+    ; TAB IS PASSED BY NAME
+    ; W "TAB= ",TAB,!
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")")
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")")
+    Q
+    ;
 HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
-            N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
-            ; K @VMAP
-            S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$FMTHL7^XLFDT($$NOW^XLFDT),"DT")
-            I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
-            . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
-            . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
-            . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY
-            . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES,
-            . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
-            I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
-            . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
-            N CTMP
-            D MAP^GPLXPATH(CXML,VMAP,"CTMP")
-            D CP^GPLXPATH("CTMP",CXML)
-            Q
-            ;
-ACTLST(AXML,ACTRTN)         ; RETURN THE ACTOR LIST FOR THE XML IN AXML
-            ; AXML AND ACTRTN ARE PASSED BY NAME
-            ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
-            ; P1= OBJECTID - ACTORPATIENT_2
-            ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
-            ;     OR INSTITUTION
-            ;     OR PERSON(IN PATIENT FILE IE NOK)
-            ; P3= IEN RECORD NUMBER FOR ACTOR - 2
-            N I,J,K,L
-            K @ACTRTN ; CLEAR RETURN ARRAY
-            F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
-            . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
-            . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
-            . . W "<ActorID>=>",J,!
-            . . I J'="" S K(J)="" ; HASHING ACTOR
-            . . ;  TO GET RID OF DUPLICATES
-            S I="" ; GOING TO $O THROUGH THE HASH
-            F J=0:0 D  Q:$O(K(I))=""
-            . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
-            . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
-            . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
-            . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
-            . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
-            Q
-            ;
+    N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
+    ; K @VMAP
+    S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$FMTHL7^XLFDT($$NOW^XLFDT),"DT")
+    I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
+    . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+    . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
+    . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY
+    . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES,
+    . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+    I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
+    . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
+    N CTMP
+    D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+    D CP^GPLXPATH("CTMP",CXML)
+    Q
+    ;
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+    ; AXML AND ACTRTN ARE PASSED BY NAME
+    ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
+    ; P1= OBJECTID - ACTORPATIENT_2
+    ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
+    ;OR INSTITUTION
+    ;  OR PERSON(IN PATIENT FILE IE NOK)
+    ; P3= IEN RECORD NUMBER FOR ACTOR - 2
+    N I,J,K,L
+    K @ACTRTN ; CLEAR RETURN ARRAY
+    F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+    . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
+    . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+    . . W "<ActorID>=>",J,!
+    . . I J'="" S K(J)="" ; HASHING ACTOR
+    . . ;  TO GET RID OF DUPLICATES
+    S I="" ; GOING TO $O THROUGH THE HASH
+    F J=0:0 D  Q:$O(K(I))=""
+    . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+    . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
+    . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
+    . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
+    . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
+    Q
+    ;
 TEST    ; RUN ALL THE TEST CASES
-          D TESTALL^GPLUNIT("GPLCCR")
-          Q
-          ;
-ZTEST(WHICH)       ; RUN ONE SET OF TESTS
-          N ZTMP
-          D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-          D ZTEST^GPLUNIT(.ZTMP,WHICH)
-          Q
-          ;
+  D TESTALL^GPLUNIT("GPLCCR")
+  Q
+  ;
+ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+  N ZTMP
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+  D ZTEST^GPLUNIT(.ZTMP,WHICH)
+  Q
+  ;
 TLIST     ; LIST THE TESTS
-          N ZTMP
-          D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-          D TLIST^GPLUNIT(.ZTMP)
-          Q
-          ;
+  N ZTMP
+  D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
+  D TLIST^GPLUNIT(.ZTMP)
+  Q
+  ;
 ;;><TEST>
 ;;><PROBLEMS>