Changeset 1336 for ccr/trunk/p/C0CCPT.m


Ignore:
Timestamp:
Jan 4, 2012, 9:39:08 PM (14 years ago)
Author:
George Lilly
Message:

removed tabs

File:
1 edited

Legend:

Unmodified
Added
Removed

  • ccr/trunk/p/C0CCPT.m

    r1331 r1336  
    1 C0CCPT  ;;BSL;RETURN CPT DATA;
    2         ;Sequence Managers Software GPL;;;;;Build 38
    3         ;Copied into C0C namespace from SQMCPT with permission from
    4         ;Brian Lord - and with our thanks. gpl 01/20/2010
    5 ENTRY(DFN,STDT,ENDDT,TXT)       ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
    6         ;DFN=PATIENT IEN
    7         ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
    8         ;ENDDT=END DATE IN 3100101 FORMAT
    9         ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
    10         ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
    11                ;ALL INCLUSIVE IN THAT DIRECTION
    12                ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
    13                ;BUILD INTO NOTE(Y)=""
    14                S U="^",X=""
    15                F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
    16                . S Y=""
    17                . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
    18                .. S NOTE(Y)=""
    19                ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
    20                ;GET DATE OF NOTE
    21                S Z=""
    22                F  S Z=$O(NOTE(Z)) Q:Z=""  D
    23                . S DT=$P(^TIU(8925,Z,0),U,7)
    24                . I $G(STDT)]"" D
    25                .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
    26                . I $G(ENDDT)]"" D
    27                .. I ENDDT<DT S NOTE(Z)="D"
    28                . I NOTE(Z)="D" K NOTE(Z)
    29         D VISIT
    30                Q
    31 VISIT     ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
    32         S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
    33         S IEN=""  F  S IEN=$O(NOTE(IEN)) Q:IEN=""  D
    34         . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
    35         . S VISIT=$P(X12,U,7)
    36         . I 'VISIT S VISIT=$P(X0,U,3)
    37         . K ^TMP("PXKENC",$J)
    38         . Q:VISIT=""!(VISIT'>0)
    39         . D ENCEVENT^PXKENC(VISIT,1)
    40         . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
    41         . S IPRV=0 F  S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV  D
    42         .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
    43         .. ;Q:$P(X0,U,4)'="P"
    44         .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
    45         .. S PRIM=($P(X0,U,4)="P")
    46         .. S ILST=ILST+1
    47         .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
    48         .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
    49         . S IPOV=0 F  S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV  D
    50         .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
    51         .. S CODE=$P(X0,U)
    52         .. S:CODE CODE=$P(^ICD9(CODE,0),U)
    53         .. S CAT=$P(X802,U)
    54         .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
    55         .. S NARR=$P(X0,U,4)
    56         .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
    57         .. S PRIM=($P(X0,U,12)="P")
    58         .. S PRV=$P(X12,U,4)
    59         .. S ILST=ILST+1
    60         .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
    61         .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
    62         . S ICPT=0 F  S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT  D
    63         .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
    64         .. ;S CODE=$P(X0,U)
    65         .. S CODE=$O(^ICPT("B",$P(X0,U),0))
    66         .. S:CODE CODE=$P(^ICPT(CODE,0),U)
    67         .. S CAT=$P(X802,U)
    68         .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
    69         .. S NARR=$P(X0,U,4)
    70         .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
    71         .. S QTY=$P(X0,U,16)
    72         .. S PRV=$P(X12,U,4)
    73         .. S MCNT=0,MIDX=0,MODS=""
    74         .. F  S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX  D
    75         ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
    76         ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
    77         .. I +MCNT S MODS=MCNT_MODS
    78         .. S ILST=ILST+1
    79         .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
    80         .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
    81         . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
    82         . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
    83         . I $G(TXT)=1 D GETNOTE(IEN)
    84         Q
    85 GETNOTE(IEN)    ;GET THE TEXT THAT GOES WITH VISIT
    86         ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
    87         Q:'$D(VISIT(IEN,"CPT"))
    88         S TXTCNT=0
    89         F  S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0))  D
    90         . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
    91         Q
     1C0CCPT ;;BSL;RETURN CPT DATA;
     2 ;Sequence Managers Software GPL;;;;;Build 38
     3 ;Copied into C0C namespace from SQMCPT with permission from
     4 ;Brian Lord - and with our thanks. gpl 01/20/2010
     5ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
     6 ;DFN=PATIENT IEN
     7 ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
     8 ;ENDDT=END DATE IN 3100101 FORMAT
     9 ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
     10 ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
     11        ;ALL INCLUSIVE IN THAT DIRECTION
     12        ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
     13        ;BUILD INTO NOTE(Y)=""
     14        S U="^",X=""
     15        F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
     16        . S Y=""
     17        . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
     18        .. S NOTE(Y)=""
     19        ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
     20        ;GET DATE OF NOTE
     21        S Z=""
     22        F  S Z=$O(NOTE(Z)) Q:Z=""  D
     23        . S DT=$P(^TIU(8925,Z,0),U,7)
     24        . I $G(STDT)]"" D
     25        .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
     26        . I $G(ENDDT)]"" D
     27        .. I ENDDT<DT S NOTE(Z)="D"
     28        . I NOTE(Z)="D" K NOTE(Z)
     29 D VISIT
     30        Q
     31VISIT   ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
     32 S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
     33 S IEN=""  F  S IEN=$O(NOTE(IEN)) Q:IEN=""  D
     34 . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
     35 . S VISIT=$P(X12,U,7)
     36 . I 'VISIT S VISIT=$P(X0,U,3)
     37 . K ^TMP("PXKENC",$J)
     38 . Q:VISIT=""!(VISIT'>0)
     39 . D ENCEVENT^PXKENC(VISIT,1)
     40 . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
     41 . S IPRV=0 F  S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV  D
     42 .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
     43 .. ;Q:$P(X0,U,4)'="P"
     44 .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
     45 .. S PRIM=($P(X0,U,4)="P")
     46 .. S ILST=ILST+1
     47 .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
     48 .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
     49 . S IPOV=0 F  S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV  D
     50 .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
     51 .. S CODE=$P(X0,U)
     52 .. S:CODE CODE=$P(^ICD9(CODE,0),U)
     53 .. S CAT=$P(X802,U)
     54 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
     55 .. S NARR=$P(X0,U,4)
     56 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
     57 .. S PRIM=($P(X0,U,12)="P")
     58 .. S PRV=$P(X12,U,4)
     59 .. S ILST=ILST+1
     60 .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
     61 .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
     62 . S ICPT=0 F  S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT  D
     63 .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
     64 .. ;S CODE=$P(X0,U)
     65 .. S CODE=$O(^ICPT("B",$P(X0,U),0))
     66 .. S:CODE CODE=$P(^ICPT(CODE,0),U)
     67 .. S CAT=$P(X802,U)
     68 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
     69 .. S NARR=$P(X0,U,4)
     70 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
     71 .. S QTY=$P(X0,U,16)
     72 .. S PRV=$P(X12,U,4)
     73 .. S MCNT=0,MIDX=0,MODS=""
     74 .. F  S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX  D
     75 ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
     76 ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
     77 .. I +MCNT S MODS=MCNT_MODS
     78 .. S ILST=ILST+1
     79 .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
     80 .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
     81 . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
     82 . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
     83 . I $G(TXT)=1 D GETNOTE(IEN)
     84 Q
     85GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
     86 ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
     87 Q:'$D(VISIT(IEN,"CPT"))
     88 S TXTCNT=0
     89 F  S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0))  D
     90 . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
     91 Q
Note: See TracChangeset for help on using the changeset viewer.