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


Ignore:
Timestamp:
Oct 1, 2012, 9:32:46 PM (12 years ago)
Author:
Sam Habiel
Message:

Merged Routines in OHUM branch back in main tree

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • ccr/trunk/p

  • ccr/trunk/p/C0CCPT.m

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