source: ccr/branches/ohum/p/C0CCPT.m@ 1476

Last change on this file since 1476 was 1433, checked in by Sam Habiel, 12 years ago

Update based on OHUM's latest routines

File size: 3.9 KB
Line 
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 TracBrowser for help on using the repository browser.