Changeset 76


Ignore:
Timestamp:
Jul 27, 2008, 4:37:10 PM (16 years ago)
Author:
George Lilly
Message:

Fixed CCD structure, added Narrative to Problems

Location:
ccr/trunk/p
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • ccr/trunk/p/GPLCCD.m

    r75 r76  
    8181    D QUERY^GPLXPATH(CCRGLO,ZX,"ACTT1")
    8282    D PATIENT^GPLACTORS("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
    83     D PARY^GPLXPATH("ACTT2")
     83    I DEBUG D PARY^GPLXPATH("ACTT2")
    8484    D REPLACE^GPLXPATH(CCRGLO,"ACTT2",ZX)
    85     D PARY^GPLXPATH(CCRGLO)
     85    I DEBUG D PARY^GPLXPATH(CCRGLO)
    8686    K ACTT1 K ACCT2
    8787    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
    … …  
    109109    . I CCD D QUERY^GPLXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
    110110    . I CCD D UNSHAVE("ITMP",OXML)
     111    . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
    111112    . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
    112113    . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
    … …  
    122123    . W "TRIMMED",J,!
    123124    . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
     125    I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
     126    . N I
     127    . F I=1:1:@CCRGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
     128    . . I @CCRGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
     129    . . . S @CCRGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
     130    . . I @CCRGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
     131    . . . S @CCRGLO@(I)="</structuredBody></component>"
    124132    S @CCRGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
    125133    S @CCRGLO@(@CCRGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE

  • ccr/trunk/p/GPLCCR.m

    r74 r76  
    5050    ;    IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
    5151    S DEBUG=0
     52    S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
    5253    S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
    5354    S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR

  • ccr/trunk/p/GPLPROBS.m

    r60 r76  
    7373          ; ZWR @OUTXML
    7474          ; $$HTML^DILF(
     75          ; GENERATE THE NARITIVE HTML FOR THE CCD
     76          I CCD D  ; IF THIS IS FOR A CCD
     77          . N HTMP,I,ZX
     78          . S ZX="<text><table border=""1"" width=""100%""><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>"
     79          . D PUSH^GPLXPATH("HTMP",ZX) ; HEADER OF THE TABLE
     80          . F I=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
     81          . . S VMAP=$NA(@TVMAP@(I))
     82          . . S ZX="<tr><td>" ; BEGIN ROW AND COL
     83          . . D PUSH^GPLXPATH("HTMP",ZX) ; ADD TO BUFFER
     84          . . S ZX=@VMAP@("PROBLEMDESCRIPTION")
     85          . . I ZX="" S ZX=" " ; SET TO BLANK SO IT DOESN'T GET TRIMMED
     86          . . D PUSH^GPLXPATH("HTMP",ZX)
     87          . . D PUSH^GPLXPATH("HTMP","</td><td>") ; NEXT COL
     88          . . S ZX=@VMAP@("PROBLEMDATEOFONSET")
     89          . . I ZX="" S ZX="Unknown" ; SET TO UNKNOWN
     90          . . D PUSH^GPLXPATH("HTMP",ZX)
     91          . . D PUSH^GPLXPATH("HTMP","</td><td>") ; NEXT COL
     92          . . D PUSH^GPLXPATH("HTMP","Active") ; WE ONLY DO ACTIVE
     93          . . D PUSH^GPLXPATH("HTMP","</td></tr>") ; END OF COL AND ROW
     94          . D PUSH^GPLXPATH("HTMP","</tbody></table></text>") ; END TABLE
     95          . D INSB4^GPLXPATH(OUTXML,"HTMP") ; INSERT AT TOP OF SECTION
    7596          N PROBSTMP,I
    7697          D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS

  • ccr/trunk/p/GPLXPATH.m

    r75 r76  
    299299         Q
    300300         ;
     301INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
     302        ; BUT XDEST AN XNEW ARE PASSED BY NAME
     303        N XBLD,XTMP
     304        D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
     305        D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
     306        D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
     307        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
     308        D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
     309        I DEBUG D PARY("XDEST")
     310        Q
     311        ;
    301312REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
    302313         ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
    … …  
    362373         . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
    363374         . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS
    364          . . . W "IN MAPPING LOOP: ",TSTR,!
     375         . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
    365376         . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
    366377         . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
    … …  
    369380         . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
    370381         . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
    371          . . W TSTR
     382         . . I DEBUG W TSTR
    372383         W "MAPPED",!
    373384         Q
    … …  
    375386TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
    376387       ; THEXML IS PASSED BY NAME
    377        N I,J,TMPXML,DEL,FOUND
     388       N I,J,TMPXML,DEL,FOUND,INTXT
    378389       S FOUND=0
     390       S INTXT=0
    379391       W "DELETING EMPTY ELEMENTS",!
    380392       F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
    381393       . S J=@THEXML@(I)
     394       . I J["<text>" D
     395       . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
     396       . . W "IN HTML SECTION",!
    382397       . N JM,JP ; JMINUS AND JPLUS
    383398       . S JM=@THEXML@(I-1) ; LINE BEFORE
     399       . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
    384400       . S JP=@THEXML@(I+1) ; LINE AFTER
    385        . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
    386        . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
    387        . . W I,J,JP,!
    388        . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
    389        . . S DEL(I)="" ; SET LINE TO DELETE
    390        . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
    391        . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
    392        . . W I,J,!
    393        . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
    394        . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
    395        . . I JM=JPX D  ;
    396        . . . W I,JM_J_JPX,!
    397        . . . S DEL(I-1)=""
    398        . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
     401       . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
     402       . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
     403       . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
     404       . . . W I,J,JP,!
     405       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
     406       . . . S DEL(I)="" ; SET LINE TO DELETE
     407       . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
     408       . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
     409       . . . W I,J,!
     410       . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
     411       . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
     412       . . . I JM=JPX D  ;
     413       . . . . W I,JM_J_JPX,!
     414       . . . . S DEL(I-1)=""
     415       . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
    399416       ; . I J'["><" D PUSH("TMPXML",J)
    400417       I FOUND D  ; NEED TO DELETE THINGS
    … …  
    405422       Q FOUND
    406423       ;
     424UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
     425        ; XSEC IS A SECTION PASSED BY NAME
     426        N XBLD,XTMP
     427        D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
     428        D BUILD("XBLD","XTMP") ; BUILD THE RESULT
     429        D CP("XTMP",XSEC) ; REPLACE PASSED XML
     430        Q
     431        ;
    407432PARY(GLO)       ;PRINT AN ARRAY
    408433        N I
Note: See TracChangeset for help on using the changeset viewer.