source: ccr/trunk/p/C0CCPT.m@ 1806

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

Changed license to AGPL. Some clean-up for XINDEX

  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CCPT.m1290
    /ccr/branches/ohum/p/C0CCPT.m1291-1543
    /ccr/branches/ohum/p/p/C0CCPT.m1287-1289
File size: 4.3 KB
Line 
1C0CCPT ;;BSL;RETURN CPT DATA;
2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
3 ; (C) George Lilly 2010
4 ;
5 ; This program is free software: you can redistribute it and/or modify
6 ; it under the terms of the GNU Affero General Public License as
7 ; published by the Free Software Foundation, either version 3 of the
8 ; License, or (at your option) any later version.
9 ;
10 ; This program is distributed in the hope that it will be useful,
11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ; GNU Affero General Public License for more details.
14 ;
15 ; You should have received a copy of the GNU Affero General Public License
16 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
17 ;
18ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
19 ;DFN=PATIENT IEN
20 ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
21 ;ENDDT=END DATE IN 3100101 FORMAT
22 ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
23 ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
24 ;ALL INCLUSIVE IN THAT DIRECTION
25 ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
26 ;BUILD INTO NOTE(Y)=""
27 S U="^",X=""
28 F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D
29 . S Y=""
30 . F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D
31 .. S NOTE(Y)=""
32 ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
33 ;GET DATE OF NOTE
34 ;RUT 3120109 Changing DATE in FILMAN's FORMAT
35 ;OHUM/RUT 3111228 Date Range for Notes
36 ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
37 N FLAGS1,FLAGS2
38 S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1)
39 S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2)
40 ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART")
41 ;OHUM/RUT
42 ;RUT
43 S Z=""
44 F S Z=$O(NOTE(Z)) Q:Z="" D
45 . S DT=$P(^TIU(8925,Z,0),U,7)
46 . I $G(STDT)]"" D
47 .. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED
48 . I $G(ENDDT)]"" D
49 .. I ENDDT<DT S NOTE(Z)="D"
50 . I NOTE(Z)="D" K NOTE(Z)
51 D VISIT
52 Q
53VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
54 S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
55 S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D
56 . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
57 . S VISIT=$P(X12,U,7)
58 . I 'VISIT S VISIT=$P(X0,U,3)
59 . K ^TMP("PXKENC",$J)
60 . Q:VISIT=""!(VISIT'>0)
61 . D ENCEVENT^PXKENC(VISIT,1)
62 . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
63 . S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D
64 .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
65 .. ;Q:$P(X0,U,4)'="P"
66 .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
67 .. S PRIM=($P(X0,U,4)="P")
68 .. S ILST=ILST+1
69 .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
70 .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
71 . S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D
72 .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
73 .. S CODE=$P(X0,U)
74 .. S:CODE CODE=$P(^ICD9(CODE,0),U)
75 .. S CAT=$P(X802,U)
76 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
77 .. S NARR=$P(X0,U,4)
78 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
79 .. S PRIM=($P(X0,U,12)="P")
80 .. S PRV=$P(X12,U,4)
81 .. S ILST=ILST+1
82 .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
83 .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
84 . S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D
85 .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
86 .. ;S CODE=$P(X0,U)
87 .. S CODE=$O(^ICPT("B",$P(X0,U),0))
88 .. S:CODE CODE=$P(^ICPT(CODE,0),U)
89 .. S CAT=$P(X802,U)
90 .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
91 .. S NARR=$P(X0,U,4)
92 .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
93 .. S QTY=$P(X0,U,16)
94 .. S PRV=$P(X12,U,4)
95 .. S MCNT=0,MIDX=0,MODS=""
96 .. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D
97 ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
98 ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
99 .. I +MCNT S MODS=MCNT_MODS
100 .. S ILST=ILST+1
101 .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
102 .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
103 . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
104 . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
105 . I $G(TXT)=1 D GETNOTE(IEN)
106 Q
107GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
108 ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
109 Q:'$D(VISIT(IEN,"CPT"))
110 S TXTCNT=0
111 F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D
112 . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
113 Q
Note: See TracBrowser for help on using the repository browser.