source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMRCPT.m@ 761

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1PXRMRCPT ; SLC/PKR - Code to handle radiology CPT data. ;08/23/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;==============================================
5FPDAT(DFN,TAXARR,NOCC,BDT,EDT,STATUSA,FLIST) ;Find data for a
6 ;patient. The expanded taxonomy stores radiology data by procedure
7 ;ien i.e.,
8 ;^PXD(811.3,N,71,"RCPTP",RADPROC,DA)
9 ;^PXD(811.3,81,DA,0)=ICPTP
10 N DA,DATE,FIEVT,ICPTP,IND,NOCCABS,NFOUND,PFINDPA
11 N RADPROC,SDIR,TE,TDATE,TIND,TF,TLIST,TS
12 I $G(^PXRMINDX(70,"DATE BUILT"))="" D Q
13 . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),70)
14 I '$D(^PXRMINDX(70,"PI",DFN)) Q
15 I '$D(TAXARR(71)) Q
16 S $P(PFINDPA(0),U,8)=BDT
17 S $P(PFINDPA(0),U,11)=EDT
18 S $P(PFINDPA(0),U,14)=NOCC
19 S SDIR=$S(NOCC<0:+1,1:-1)
20 F IND=1:1:STATUSA(0) S PFINDPA(5,IND)=STATUSA(IND)
21 ;Get the start and end of the taxonomy, for radiology these are
22 ;actually radiology procedures, which we use to get to the CPT codes.
23 S TS=$O(TAXARR(71,""))-1
24 S TE=$O(TAXARR(71,""),-1)
25 S NFOUND=0
26 S RADPROC=TS
27 F S RADPROC=$O(^PXRMINDX(70,"PI",DFN,RADPROC)) Q:(RADPROC>TE)!(RADPROC="") D
28 . I '$D(TAXARR(71,RADPROC)) Q
29 . K FIEVT
30 . D FIEVAL^PXRMINDX(70,"PI",DFN,RADPROC,.PFINDPA,.FIEVT)
31 . I FIEVT D
32 .. S DA=$O(TAXARR(71,RADPROC,""))
33 .. S ICPTP=TAXARR(71,RADPROC,DA,0)
34 .. S IND=0
35 .. F S IND=+$O(FIEVT(IND)) Q:IND=0 D
36 ... S NFOUND=NFOUND+1
37 ... S TLIST(FIEVT(IND,"DATE"),NFOUND)=FIEVT(IND,"DAS")_U_ICPTP_U_RADPROC_U_"CPT"
38 ... I NFOUND>NGET D
39 .... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
40 .... K TLIST(TDATE,TIND)
41 ;Return up to NOCC of the most recent entries.
42 S NOCCABS=$S(NOCC<0:-NOCC,1:NOCC)
43 S NFOUND=0
44 S DATE=""
45 F S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCCABS) D
46 . S IND=0
47 . F S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NOCCABS) D
48 .. S NFOUND=NFOUND+1
49 .. S FLIST(DATE,NFOUND,70)=TLIST(DATE,IND)
50 Q
51 ;
52 ;==============================================
53GPLIST(TAXARR,PFINDPA,PLIST) ;Build a patient list for radiology CPT entries.
54 N DA,DAS,DATE,DFN,ICPTP,NFOUND
55 N RADPROC,TEMP,TF,TLIST,VALUE
56 I $G(^PXRMINDX(70,"DATE BUILT"))="" D Q
57 . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),70)
58 S TLIST="GPLIST_PXRMRCPT"
59 S RADPROC=""
60 F S RADPROC=$O(TAXARR(71,RADPROC)) Q:RADPROC="" D
61 . I '$D(^PXRMINDX(70,"IP",RADPROC)) Q
62 . S DA=$O(TAXARR(71,RADPROC,""))
63 . S ICPTP=$P(TAXARR(71,RADPROC,DA,0),U,1)
64 . K ^TMP($J,TLIST)
65 . D GPLIST^PXRMINDL(70,"IP",RADPROC,.PFINDPA,TLIST)
66 . F TF=0,1 D
67 .. S DFN=0
68 .. F S DFN=$O(^TMP($J,TLIST,TF,DFN)) Q:DFN="" D
69 ... S NFOUND=0
70 ... F S NFOUND=$O(^TMP($J,TLIST,TF,DFN,RADPROC,NFOUND)) Q:NFOUND="" D
71 .... S TEMP=^TMP($J,TLIST,TF,DFN,RADPROC,NFOUND,70)
72 .... S DAS=$P(TEMP,U,1)
73 .... S DATE=$P(TEMP,U,2)
74 .... S VALUE=$P(TEMP,U,4)
75 .... S ^TMP($J,PLIST,TF,DFN,DATE,70)=DAS_U_DATE_U_ICPTP_U_"CPT"_U_VALUE
76 K ^TMP($J,TLIST)
77 Q
78 ;
79 ;==============================================
80MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
81 N CODE,CPT,CPTDATA,DATE,ICPTP,IND,JND,NAME,NOUT,SNAME,TEMP,TEXTOUT
82 S NAME="Radiology Procedure = "
83 S IND=0
84 F S IND=$O(OCCLIST(IND)) Q:IND="" D
85 . S DATE=IFIEVAL(IND,"DATE")
86 . S ICPTP=IFIEVAL(IND,"CODEP")
87 . S CPTDATA=$$CPT^ICPTCOD(ICPTP)
88 . S CODE=$P(CPTDATA,U,2)
89 . S SNAME=$P(CPTDATA,U,3)
90 . S TEMP=" "_IFIEVAL(IND,"PROCEDURE")
91 . S TEMP=NAME_SNAME_" ("_$$EDATE^PXRMDATE(DATE)_")"
92 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
93 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
94 S NLINES=NLINES+1,TEXT(NLINES)=""
95 Q
96 ;
97 ;==============================================
98OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
99 ;maintenance output. The CPT information is: DATE, ICPT CODE,
100 ;SHORT NAME, PROVIDER NARRATIVE.
101 N CODE,CPT,CPTDATA,DATE,ICPTP,IND,JND,NOUT,SNAME,TAXIEN,TEMP,TEXTOUT
102 S TEMP=IFIEVAL("FINDING")
103 S TAXIEN=$P(TEMP,";",1)
104 S TEMP="Radiology Procedure(s) from taxonomy "_$P(^PXD(811.2,TAXIEN,0),U,1)
105 S NLINES=NLINES+1
106 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_TEMP
107 S IND=0
108 F S IND=$O(OCCLIST(IND)) Q:IND="" D
109 . S DATE=IFIEVAL(IND,"DATE")
110 . S TEMP=$$EDATE^PXRMDATE(DATE)
111 . S ICPTP=IFIEVAL(IND,"CODEP")
112 . S CPTDATA=$$CPT^ICPTCOD(ICPTP)
113 . S CODE=$P(CPTDATA,U,2)
114 . S SNAME=$P(CPTDATA,U,3)
115 . S TEMP=TEMP_" "_IFIEVAL(IND,"PROCEDURE")
116 . S TEMP=TEMP_"-CPT: "_CODE_" "_SNAME
117 . S TEMP=TEMP_" Status: "_IFIEVAL(IND,"STATUS")
118 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
119 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
120 S NLINES=NLINES+1,TEXT(NLINES)=""
121 Q
122 ;
Note: See TracBrowser for help on using the repository browser.