source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMOUTC.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1PXRMOUTC ; SLC/PKR - Clinical Maintenance output. ;07/06/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;================================================
4CM(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL) ;Prepare the
5 ;clinical maintenance output.
6 N IND,JND,FIDATA,FINDING,FLIST,FTYPE
7 N HDR,NHDR,IFIEVAL,LIST,NFLINES,NTXT,NUM
8 N TEMP,TEXT
9 S NTXT=0
10 ;Check for a dead patient
11 I +$G(PXRMPDEM("DOD"))>0 D
12 . S TEMP=$$FMTE^XLFDT(PXRMPDEM("DOD"),"5DZ")
13 . S TEXT="Patient is deceased, date of death: "_TEMP
14 . D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
15 ;Display the frequency information only if there is resolution logic.
16 I RESLOGIC'="" D FREQ(.DEFARR,.NTXT,.TEXT)
17 ;Output the AGE match/no match text.
18 D AGE^PXRMFNFT(PXRMPDEM("DFN"),.DEFARR,.FIEVAL,.NTXT)
19 ;Process the findings in the order: patient cohort, resolution,
20 ;age, and informational.
21 M FIDATA=FIEVAL
22 F FTYPE="PCL","RES","AGE","INFO" D
23 . S LIST=$S(FTYPE="PCL":DEFARR(32),FTYPE="RES":DEFARR(36),FTYPE="AGE":DEFARR(40),FTYPE="INFO":DEFARR(42))
24 .;Output the general logic text.
25 . I FTYPE="PCL" D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,FTYPE,"D",.DEFARR,.NTXT)
26 . I FTYPE="RES",$P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,FTYPE,"D",.DEFARR,.NTXT)
27 .;Process the findings for each type.
28 . K TEXT
29 . S (NHDR,NFLINES)=0
30 . S NUM=+$P(LIST,U,1)
31 . S FLIST=$P(LIST,U,2)
32 . F IND=1:1:NUM D
33 .. S FINDING=$P(FLIST,";",IND)
34 ..;No output for age or sex findings.
35 .. I (FINDING="AGE")!(FINDING="SEX") Q
36 ..;Make sure each finding is processed only once.
37 .. I '$D(FIDATA(FINDING)) Q
38 .. K IFIEVAL
39 .. ;I FIEVAL(FINDING) M IFIEVAL=FIEVAL(FINDING)
40 .. ;E S IFIEVAL=0
41 .. I FIEVAL(FINDING) D
42 ... M IFIEVAL=FIEVAL(FINDING)
43 ...;Remove any false occurrences so they are not displayed.
44 ... S JND=0
45 ... F S JND=+$O(IFIEVAL(JND)) Q:JND=0 K:'IFIEVAL(JND) IFIEVAL(JND)
46 .. E S IFIEVAL=0
47 ..;If the finding is false all we need to do is process the not found
48 ..;text. If it is true we also need to output the finding information.
49 .. I IFIEVAL D FOUT(1,.IFIEVAL,.NFLINES,.TEXT)
50 ..;Output the found/not found text for the finding.
51FNF .. D FINDING^PXRMFNFT(3,PXRMPDEM("DFN"),FINDING,.IFIEVAL,.NFLINES,.TEXT)
52 ..;Make sure each finding is processed only once.
53 .. K FIDATA(FINDING)
54 .;
55 .;If there was any text for this finding type create a header.
56 . D HEADER(FTYPE,NFLINES,RESDATE,.NHDR,.HDR)
57 .;Output the header and the finding text.
58 . D ADDTXTA^PXRMOUTU(1,PXRMRM,.NTXT,NHDR,.HDR)
59 . D COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT)
60 ;Output INFO nodes
61 D INFO^PXRMOUTU(PXRMITEM,.NTXT)
62 Q
63 ;
64 ;================================================
65FOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Do output for individual findings
66 ;in the FINDING array.
67 I $D(IFIEVAL("TERM")) D OUTPUT^PXRMTERM(1,.IFIEVAL,.NFLINES,.TEXT) Q
68 N FTYPE
69 S FTYPE=$P(IFIEVAL("FINDING"),U,1)
70 S FTYPE=$P(FTYPE,";",2)
71 I FTYPE="AUTTEDT(" D OUTPUT^PXRMEDU(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
72 I FTYPE="AUTTEXAM(" D OUTPUT^PXRMEXAM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
73 I FTYPE="AUTTHF(" D OUTPUT^PXRMHF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
74 I FTYPE="AUTTIMM(" D OUTPUT^PXRMIMM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
75 I FTYPE="AUTTSK(" D OUTPUT^PXRMSKIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
76 I FTYPE="GMRD(120.51," D OUTPUT^PXRMVITL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
77 I FTYPE="LAB(60," D OUTPUT^PXRMLAB(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
78 I FTYPE="ORD(101.43," D OUTPUT^PXRMORDR(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
79 I FTYPE="PS(50.605," D OUTPUT^PXRMDRCL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
80 I FTYPE="PSDRUG(" D OUTPUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
81 I FTYPE="PSNDF(50.6," D OUTPUT^PXRMDGEN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
82 I FTYPE="PS(55," D OUTPUT^PXRMDIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
83 I FTYPE="PS(55NVA," D OUTPUT^PXRMDNVA(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
84 I FTYPE="PSRX(" D OUTPUT^PXRMDOUT(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
85 I FTYPE="PXD(811.2," D OUTPUT^PXRMTAX(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
86 I FTYPE="PXRMD(802.4," D OUTPUT^PXRMFF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
87 I FTYPE="PXRMD(810.9," D OUTPUT^PXRMLOCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
88 I FTYPE="PXRMD(811.4," D OUTPUT^PXRMCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
89 I FTYPE="RAMIS(71," D OUTPUT^PXRMRAD(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
90 I FTYPE="YTT(601.71," D OUTPUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
91 Q
92 ;
93 ;================================================
94FREQ(DEFARR,NTXT,TEXT) ;Display the frequency information.
95 N FREQ,TEMP
96 ;If there was a custom date due print out that information.
97 I $D(^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")) D
98 . S TEMP=^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")
99 . S TEXT=$$OUTPUT^PXRMCDUE(TEMP,.DEFARR)
100 . I DEFARR(31)["AGE" D
101 .. S TEMP=$G(^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG"))
102 .. I TEMP'="" S TEXT=TEXT_" Applicable"_$$FMTAGE^PXRMAGE($P(TEMP,U,2),$P(TEMP,U,3))_"."
103 . D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
104 E D
105 . S TEMP=$G(^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG"))
106 . I TEMP'="" D
107 .. S FREQ=$P(TEMP,U,1)
108 .. S TEXT=$$FMTFREQ^PXRMAGE(FREQ)
109 .. I FREQ=-1 S TEXT=TEXT_" for this patient."
110 .. I DEFARR(31)["AGE",FREQ'=-1 S TEXT=TEXT_$$FMTAGE^PXRMAGE($P(TEMP,U,2),$P(TEMP,U,3))_"."
111 .. D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
112 Q
113 ;
114 ;================================================
115HEADER(FTYPE,NLINES,RESDATE,NHDR,HDR) ;Create a finding header.
116 I FTYPE="RES" D Q
117 . I +RESDATE'=0 D Q
118 .. S HDR(2)="Resolution: Last done "_$$EDATE^PXRMDATE(RESDATE)
119 .. S NHDR=2
120 .. S HDR(1)="\\"
121 . I '$D(HDR(2)),NLINES>0 D
122 .. S HDR(2)="Resolution:"
123 .. S NHDR=2
124 .. S HDR(1)="\\"
125 ;
126 I NLINES=0 Q
127 I FTYPE="PCL" D Q
128 . S NHDR=2
129 . S HDR(1)="\\"
130 . S HDR(2)="Cohort:"
131 ;
132 I FTYPE="AGE" D Q
133 . S NHDR=2
134 . S HDR(1)="\\"
135 . S HDR(2)="Age/Frequency:"
136 ;
137 I FTYPE="INFO" D Q
138 . S NHDR=2
139 . S HDR(1)="\\"
140 . S HDR(2)="Information:"
141 Q
142 ;
Note: See TracBrowser for help on using the repository browser.