[673] | 1 | C0CCPT ;;BSL;RETURN CPT DATA;
|
---|
| 2 | ;Sequence Managers Software GPL
|
---|
| 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
|
---|
[675] | 32 | S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
|
---|
[673] | 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),".")
|
---|
[780] | 82 | . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
|
---|
[673] | 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"
|
---|
[681] | 87 | Q:'$D(VISIT(IEN,"CPT"))
|
---|
[673] | 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
|
---|