source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDGPT.m@ 1683

Last change on this file since 1683 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1PXRMDGPT ; SLC/PKR - Code to handle DGPT (Patient Treatment File) data. ;08/03/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;============================================
5FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,TYPE,FLIST) ;Find data for a patient.
6 ;TYPE is ICD0 or ICD9
7 N DA,DAS,DATE,DNODE,DS,EDTT,ICDP,IND,NFOUND,NODE,NODEAT,NNODE
8 N SUB,TE,TDATE,TIND,TLIST,TS
9 I $G(^PXRMINDX(45,"DATE BUILT"))="" D Q
10 . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),45)
11 I '$D(^PXRMINDX(45,TYPE,"PNI",DFN)) Q
12 S SUB=$S(TYPE="ICD0":80.1,TYPE="ICD9":80,1:0)
13 I SUB=0 Q
14 S NNODE=+$P($G(TAXARR("PDS",45,SUB)),U,2)
15 I NNODE=0 Q
16 ;Get the start and end of the taxonomy.
17 S TS=$O(TAXARR(SUB,""))-1
18 S TE=$O(TAXARR(SUB,""),-1)
19 S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
20 S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
21 S NFOUND=0
22 F IND=1:1:NNODE D
23 . S NODE=TAXARR("PDS",45,SUB,IND)
24 . S ICDP=TS
25 . F S ICDP=$O(^PXRMINDX(45,TYPE,"PNI",DFN,NODE,ICDP)) Q:(ICDP>TE)!(ICDP="") D
26 .. I '$D(TAXARR(SUB,ICDP)) Q
27 .. S DATE=DS
28 .. F S DATE=+$O(^PXRMINDX(45,TYPE,"PNI",DFN,NODE,ICDP,DATE),SDIR) Q:$S(DATE=0:1,DATE<BDT:1,DATE>EDTT:1,1:0) D
29 ... S DAS=""
30 ... F S DAS=$O(^PXRMINDX(45,TYPE,"PNI",DFN,NODE,ICDP,DATE,DAS)) Q:DAS="" D
31 .... S NFOUND=NFOUND+1
32 .... S TLIST(DATE,NFOUND)=DAS_U_ICDP_U_NODE_U_TYPE
33 .... I NFOUND>NGET D
34 ..... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
35 ..... K TLIST(TDATE,TIND)
36 ;Return up to NGET of the most recent entries.
37 S NFOUND=0
38 S DATE=""
39 F S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NGET) D
40 . S IND=0
41 . F S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NGET) D
42 .. S NFOUND=NFOUND+1
43 .. S FLIST(DATE,NFOUND,45)=TLIST(DATE,IND)
44 Q
45 ;
46 ;============================================
47GETDATA(DAS,FIEVT) ;Return data for a specificed PTF entry.
48 D PTF^DGPTPXRM(DAS,.FIEVT)
49 Q
50 ;
51 ;============================================
52GPLIST(TAXARR,NOCC,BDT,EDT,TYPE,PLIST) ;Get data for a patient.
53 ;TYPE is ICD0 or ICD9
54 N DA,DA1,DAS,DATE,DFN,DNODE,DS,ICDP
55 N NFOUND,NODE,NNODE,SUB,TEMP,TLIST
56 I $G(^PXRMINDX(45,"DATE BUILT"))="" D Q
57 . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),45)
58 S SUB=$S(TYPE="ICD0":80.1,TYPE="ICD9":80,1:0)
59 I SUB=0 Q
60 S TLIST="GPLIST_PXRMDGPT"
61 K ^TMP($J,TLIST)
62 S NNODE=+$P($G(TAXARR("PDS",45,SUB)),U,2)
63 I NNODE=0 Q
64 S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
65 S ICDP=""
66 F S ICDP=$O(TAXARR(SUB,ICDP)) Q:ICDP="" D
67 . I '$D(^PXRMINDX(45,TYPE,"INP",ICDP)) Q
68 . F IND=1:1:NNODE D
69 .. S NODE=TAXARR("PDS",45,SUB,IND)
70 .. I '$D(^PXRMINDX(45,TYPE,"INP",ICDP,NODE)) Q
71 .. S DFN=0
72 .. F S DFN=$O(^PXRMINDX(45,TYPE,"INP",ICDP,NODE,DFN)) Q:DFN="" D
73 ... S DATE=DS
74 ... F S DATE=+$O(^PXRMINDX(45,TYPE,"INP",ICDP,NODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT) D
75 .... S DAS=$O(^PXRMINDX(45,TYPE,"INP",ICDP,NODE,DFN,DATE,""))
76 .... S ^TMP($J,TLIST,DFN,DATE,DAS)=ICDP_U_TYPE_U_NODE
77 ;Return up to NOCC of the most recent entries for each patient.
78 S DFN=0
79 F S DFN=$O(^TMP($J,TLIST,DFN)) Q:DFN="" D
80 . S NFOUND=0
81 . S DATE=""
82 . F S DATE=$O(^TMP($J,TLIST,DFN,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D
83 .. S DAS=""
84 .. F S DAS=$O(^TMP($J,TLIST,DFN,DATE,DAS)) Q:DAS="" D
85 ... S NFOUND=NFOUND+1
86 ... S TEMP=^TMP($J,TLIST,DFN,DATE,DAS)
87 ... S ^TMP($J,PLIST,1,DFN,DATE,45)=DAS_U_DATE_U_TEMP
88 K ^TMP($J,TLIST)
89 Q
90 ;
91 ;============================================
92MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
93 I IFIEVAL("FILE SPECIFIC")["ICD0" D MHVOUT0(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
94 I IFIEVAL("FILE SPECIFIC")["ICD9" D MHVOUT9(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
95 Q
96 ;
97 ;============================================
98MHVOUT0(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
99 N CODE,D0,DATE,ICD0ZN,IND,JND,NAME,NODE,NOUT,PROC
100 N TEMP,TEXTOUT
101 S NAME="Hospitalization Procedure = "
102 S IND=0
103 F S IND=$O(OCCLIST(IND)) Q:IND="" D
104 . S DATE=IFIEVAL(IND,"DATE")
105 . S D0=$P(IFIEVAL(IND,"CODEP"),";",1)
106 . S ICD0ZN=$$ICDOP^ICDCODE(D0,DATE)
107 . S CODE=$P(ICD0ZN,U,2)
108 . S PROC=$P(ICD0ZN,U,5)
109 . S TEMP=NAME_PROC_" ("_$$EDATE^PXRMDATE(DATE)_")"
110 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
111 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
112 S NLINES=NLINES+1,TEXT(NLINES)=""
113 Q
114 ;
115 ;============================================
116MHVOUT9(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
117 N CODE,DATE,DIAG,ICD9P,ICD9ZN,IND,JND,NAME,NODE,NOUT
118 N TEMP,TEXTOUT
119 S NAME="Hospitalization Diagnosis = "
120 S IND=0
121 F S IND=$O(OCCLIST(IND)) Q:IND="" D
122 . S DATE=IFIEVAL(IND,"DATE")
123 . S ICD9P=IFIEVAL(IND,"CODEP")
124 . S ICD9ZN=$$ICDDX^ICDCODE(ICD9P,DATE)
125 . S CODE=$P(ICD9ZN,U,2)
126 . S DIAG=$P(ICD9ZN,U,4)
127 . S TEMP=NAME_DIAG_" ("_$$EDATE^PXRMDATE(DATE)_")"
128 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
129 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
130 S NLINES=NLINES+1,TEXT(NLINES)=""
131 Q
132 ;
133 ;============================================
134OUTICD0(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
135 ;maintenance output.
136 N CODE,D0,DATE,ICD0ZN,IND,JND,NODE,NOUT,PROC
137 N TEMP,TEXTOUT
138 S NLINES=NLINES+1
139 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Hospitalization Procedure: "
140 S IND=0
141 F S IND=$O(OCCLIST(IND)) Q:IND="" D
142 . S DATE=IFIEVAL(IND,"DATE")
143 . S TEMP=$$EDATE^PXRMDATE(DATE)
144 . S D0=$P(IFIEVAL(IND,"CODEP"),";",1)
145 . S ICD0ZN=$$ICDOP^ICDCODE(D0,DATE)
146 . S CODE=$P(ICD0ZN,U,2)
147 . S PROC=$P(ICD0ZN,U,5)
148 . S NODE=$P(IFIEVAL(IND,"FILE SPECIFIC"),U,1)
149 . S TEMP=TEMP_" "_CODE_" "_PROC_" data node: "_NODE
150 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
151 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
152 S NLINES=NLINES+1,TEXT(NLINES)=""
153 Q
154 ;
155 ;============================================
156OUTICD9(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
157 ;maintenance output.
158 N CODE,DATE,DIAG,ICD9P,ICD9ZN,IND,JND,NODE,NOUT
159 N TEMP,TEXTOUT
160 S NLINES=NLINES+1
161 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Hospitalization Diagnosis: "
162 S IND=0
163 F S IND=$O(OCCLIST(IND)) Q:IND="" D
164 . S DATE=IFIEVAL(IND,"DATE")
165 . S TEMP=$$EDATE^PXRMDATE(DATE)
166 . S ICD9P=IFIEVAL(IND,"CODEP")
167 . S ICD9ZN=$$ICDDX^ICDCODE(ICD9P,DATE)
168 . S CODE=$P(ICD9ZN,U,2)
169 . S DIAG=$P(ICD9ZN,U,4)
170 . S NODE=$P(IFIEVAL(IND,"FILE SPECIFIC"),U,1)
171 . S TEMP=TEMP_" "_CODE_" "_DIAG_" data node: "_NODE
172 . I $G(IFIEVAL(IND,"FEE BASIS")) S TEMP=TEMP_" (Fee)"
173 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
174 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
175 S NLINES=NLINES+1,TEXT(NLINES)=""
176 Q
177 ;
178 ;============================================
179OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
180 ;maintenance output.
181 I IFIEVAL("FILE SPECIFIC")["ICD0" D OUTICD0(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
182 I IFIEVAL("FILE SPECIFIC")["ICD9" D OUTICD9(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
183 Q
184 ;
Note: See TracBrowser for help on using the repository browser.