source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMVPOV.m@ 1423

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1PXRMVPOV ; SLC/PKR - Code to handle VPOV ;10/21/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;====================================================
5FPDAT(DFN,TAXARR,NGET,SDIR,BDT,EDT,FLIST) ;Find data for a patient.
6 N DAS,DATE,DS,EDTT,ICDP,IND,NFOUND,NODE,NNODE,TE,TLIST,TS
7 N TDATE,TIND
8 I $G(^PXRMINDX(9000010.07,"DATE BUILT"))="" D Q
9 . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.07)
10 I '$D(^PXRMINDX(9000010.07,"PPI",DFN)) Q
11 S NNODE=+$P($G(TAXARR("PDS",9000010.07,80)),U,2)
12 I NNODE=0 Q
13 S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
14 S DS=$S(SDIR=+1:BDT-.000001,1:EDTT)
15 S TS=$O(TAXARR(80,""))-1
16 S TE=$O(TAXARR(80,""),-1)
17 S NFOUND=0
18 F IND=1:1:NNODE D
19 . S NODE=TAXARR("PDS",9000010.07,80,IND)
20 . S ICDP=TS
21 . F S ICDP=$O(^PXRMINDX(9000010.07,"PPI",DFN,NODE,ICDP)) Q:(ICDP>TE)!(ICDP="") D
22 .. I '$D(TAXARR(80,ICDP)) Q
23 .. S DATE=DS
24 .. F S DATE=+$O(^PXRMINDX(9000010.07,"PPI",DFN,NODE,ICDP,DATE),SDIR) Q:$S(DATE=0:1,DATE<BDT:1,DATE>EDTT:1,1:0) D
25 ... S DAS=$O(^PXRMINDX(9000010.07,"PPI",DFN,NODE,ICDP,DATE,""))
26 ... S NFOUND=NFOUND+1
27 ... S TLIST(DATE,NFOUND)=DAS_U_ICDP_U_NODE
28 ... I NFOUND>NGET D
29 .... S TDATE=$O(TLIST(""),-SDIR),TIND=$O(TLIST(TDATE,""))
30 .... K TLIST(TDATE,TIND)
31 ;Return up to NGET of the most recent entries.
32 S NFOUND=0
33 S DATE=""
34 F S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NGET) D
35 . S IND=0
36 . F S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NGET) D
37 .. S NFOUND=NFOUND+1
38 .. S FLIST(DATE,NFOUND,9000010.07)=TLIST(DATE,IND)
39 Q
40 ;
41 ;====================================================
42GETDATA(DAS,FIEVT) ;Return data for a specified V POV entry.
43 ;DBIA #4250
44 D VPOV^PXPXRM(DAS,.FIEVT)
45 Q
46 ;
47 ;====================================================
48GPLIST(TAXARR,NOCC,BDT,EDT,PLIST) ;Build patient list for V POV entries.
49 N DAS,DATE,DFN,DS,ICDP,IND,NFOUND,NODE,NNODE,TEMP,TLIST
50 I $G(^PXRMINDX(9000010.07,"DATE BUILT"))="" D Q
51 . D NOINDEX^PXRMERRH("TX",TAXARR("IEN"),9000010.07)
52 S TLIST="GPLIST_PXRMVPOV"
53 S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
54 S NNODE=+$P($G(TAXARR("PDS",9000010.07,80)),U,2)
55 I NNODE=0 Q
56 S ICDP=""
57 F S ICDP=$O(TAXARR(80,ICDP)) Q:(ICDP="") D
58 . I '$D(^PXRMINDX(9000010.07,"IPP",ICDP)) Q
59 . F IND=1:1:NNODE D
60 .. S NODE=TAXARR("PDS",9000010.07,80,IND)
61 .. I '$D(^PXRMINDX(9000010.07,"IPP",ICDP,NODE)) Q
62 .. S DFN=0
63 .. F S DFN=$O(^PXRMINDX(9000010.07,"IPP",ICDP,NODE,DFN)) Q:DFN="" D
64 ... S DATE=DS
65 ... F S DATE=+$O(^PXRMINDX(9000010.07,"IPP",ICDP,NODE,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT) D
66 .... S DAS=$O(^PXRMINDX(9000010.07,"IPP",ICDP,NODE,DFN,DATE,""))
67 .... S ^TMP($J,TLIST,DFN,DATE,DAS)=ICDP_U_"ICD9"_U_NODE
68 ;Return up to NOCC of the most recent entries for each patient.
69 S DFN=0
70 F S DFN=$O(^TMP($J,TLIST,DFN)) Q:DFN="" D
71 . S NFOUND=0
72 . S DATE=""
73 . F S DATE=$O(^TMP($J,TLIST,DFN,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D
74 .. S DAS=""
75 .. F S DAS=$O(^TMP($J,TLIST,DFN,DATE,DAS)) Q:DAS="" D
76 ... S NFOUND=NFOUND+1
77 ... S TEMP=^TMP($J,TLIST,DFN,DATE,DAS)
78 ... S ICDP=$P(TEMP,U,1)
79 ... S ^TMP($J,PLIST,1,DFN,NFOUND,9000010.07)=DAS_U_DATE_U_TEMP
80 K ^TMP($J,TLIST)
81 Q
82 ;
83 ;====================================================
84MHVOUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
85 N CODE,D0,DIAG,EM,ICD9P,ICD9ZN,IND,JND,NAME,NIN,NOUT,PN,RANK
86 N TEMP,TEXTIN,TEXTOUT,VDATE
87 S NAME="Encounter Diagnosis = "
88 S IND=0
89 F S IND=$O(OCCLIST(IND)) Q:IND="" D
90 . S VDATE=IFIEVAL(IND,"DATE")
91 . S ICD9P=IFIEVAL(IND,"CODEP")
92 . S D0=$G(^AUPNVPOV(IFIEVAL(IND,"DAS"),0))
93 . S ICD9ZN=$$ICDDX^ICDCODE(ICD9P,VDATE)
94 . S CODE=$P(ICD9ZN,U,2)
95 . S DIAG=$P(ICD9ZN,U,4)
96 . S RANK=IFIEVAL(IND,"PRIMARY/SECONDARY")
97 . S TEMP=NAME_DIAG_" ("_$$EDATE^PXRMDATE(VDATE)_")"
98 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
99 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
100 S NLINES=NLINES+1,TEXT(NLINES)=""
101 Q
102 ;
103 ;====================================================
104OUTPUT(INDENT,OCCLIST,IFIEVAL,NLINES,TEXT) ;Produce the clinical
105 ;maintenance output. The VPOV information is: DATE, ICD9 IEN,
106 ;ICD9 CODE, MODIFIER, PROVIDER NARRATIVE.
107 N CODE,D0,DIAG,EM,ICD9P,ICD9ZN,IND,JND,NIN,NOUT,PN,RANK
108 N TEMP,TEXTIN,TEXTOUT,VDATE
109 S NLINES=NLINES+1
110 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Encounter Diagnosis:"
111 S IND=0
112 F S IND=$O(OCCLIST(IND)) Q:IND="" D
113 . S VDATE=IFIEVAL(IND,"DATE")
114 . S TEMP=$$EDATE^PXRMDATE(VDATE)
115 . S ICD9P=IFIEVAL(IND,"CODEP")
116 . S D0=$G(^AUPNVPOV(IFIEVAL(IND,"DAS"),0))
117 . S ICD9ZN=$$ICDDX^ICDCODE(ICD9P,VDATE)
118 . S CODE=$P(ICD9ZN,U,2)
119 . S DIAG=$P(ICD9ZN,U,4)
120 . S RANK=IFIEVAL(IND,"PRIMARY/SECONDARY")
121 . S TEMP=TEMP_" "_CODE_" "_DIAG_" rank: "
122 . S TEMP=TEMP_$$EXTERNAL^DILFD(9000010.07,.12,"",RANK,.EM)
123 . S TEXTIN(1)=TEMP_"\\",NIN=1
124 . S PN=$P(D0,U,4)
125 . I PN'="" S PN=$P($G(^AUTNPOV(PN,0)),U,1)
126 . I PN="" S PN="MISSING"
127 . I PN'=DIAG S TEXTIN(2)="Prov. Narr. - "_PN,NIN=2
128 . D FORMAT^PXRMTEXT(INDENT+2,PXRMRM,NIN,.TEXTIN,.NOUT,.TEXTOUT)
129 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
130 . I IFIEVAL(IND,"COMMENTS")'="" D
131 .. S TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
132 .. D FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
133 .. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
134 S NLINES=NLINES+1,TEXT(NLINES)=""
135 Q
136 ;
Note: See TracBrowser for help on using the repository browser.