Changeset 1330 for ccr/branches/ohum/p/C0CCPT.m
- Timestamp:
- Jan 3, 2012, 11:45:29 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CCPT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CCPT.m
r1329 r1330 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 1 C0CCPT ;;BSL;RETURN CPT DATA; 2 ;Sequence Managers Software GPL;;;;;Build 1 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 ;OHUM/RUT 3111228 Date Range for Notes 22 S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X 23 ;OHUM/RUT 24 S Z="" 25 F S Z=$O(NOTE(Z)) Q:Z="" D 26 . S DT=$P(^TIU(8925,Z,0),U,7) 27 . I $G(STDT)]"" D 28 .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED 29 . I $G(ENDDT)]"" D 30 .. I ENDDT<DT S NOTE(Z)="D" 31 . I NOTE(Z)="D" K NOTE(Z) 32 D VISIT 33 Q 34 VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT 35 S ILST=1,X0="",X12="",VISIT="",LST="",X811="" 36 S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D 37 . S X0=^TIU(8925,IEN,0),X12=$G(^(12)) 38 . S VISIT=$P(X12,U,7) 39 . I 'VISIT S VISIT=$P(X0,U,3) 40 . K ^TMP("PXKENC",$J) 41 . Q:VISIT=""!(VISIT'>0) 42 . D ENCEVENT^PXKENC(VISIT,1) 43 . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q 44 . S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D 45 .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0) 46 .. ;Q:$P(X0,U,4)'="P" 47 .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U) 48 .. S PRIM=($P(X0,U,4)="P") 49 .. S ILST=ILST+1 50 .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM 51 .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM 52 . S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D 53 .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811)) 54 .. S CODE=$P(X0,U) 55 .. S:CODE CODE=$P(^ICD9(CODE,0),U) 56 .. S CAT=$P(X802,U) 57 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 58 .. S NARR=$P(X0,U,4) 59 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 60 .. S PRIM=($P(X0,U,12)="P") 61 .. S PRV=$P(X12,U,4) 62 .. S ILST=ILST+1 63 .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV 64 .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV 65 . S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D 66 .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811)) 67 .. ;S CODE=$P(X0,U) 68 .. S CODE=$O(^ICPT("B",$P(X0,U),0)) 69 .. S:CODE CODE=$P(^ICPT(CODE,0),U) 70 .. S CAT=$P(X802,U) 71 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U) 72 .. S NARR=$P(X0,U,4) 73 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U) 74 .. S QTY=$P(X0,U,16) 75 .. S PRV=$P(X12,U,4) 76 .. S MCNT=0,MIDX=0,MODS="" 77 .. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D 78 ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0)) 79 ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN 80 .. I +MCNT S MODS=MCNT_MODS 81 .. S ILST=ILST+1 82 .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 83 .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS 84 . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".") 85 . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10 86 . I $G(TXT)=1 D GETNOTE(IEN) 87 Q 88 GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT 89 ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT" 90 Q:'$D(VISIT(IEN,"CPT")) 91 S TXTCNT=0 92 F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D 93 . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0) 94 Q
Note:
See TracChangeset
for help on using the changeset viewer.
