1 | PXRMOUTM ; SLC/PKR - MyHealtheVet output. ;07/06/2007
|
---|
2 | ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
|
---|
3 | ;
|
---|
4 | ;================================================
|
---|
5 | FOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Do output for individual findings
|
---|
6 | ;in the FINDING array.
|
---|
7 | I $D(IFIEVAL("TERM")) D MHVOUT^PXRMTERM(1,.IFIEVAL,.NFLINES,.TEXT) Q
|
---|
8 | N FTYPE
|
---|
9 | S FTYPE=$P(IFIEVAL("FINDING"),U,1)
|
---|
10 | S FTYPE=$P(FTYPE,";",2)
|
---|
11 | I FTYPE="AUTTEDT(" D MHVOUT^PXRMEDU(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
12 | I FTYPE="AUTTEXAM(" D MHVOUT^PXRMEXAM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
13 | I FTYPE="AUTTHF(" D MHVOUT^PXRMHF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
14 | I FTYPE="AUTTIMM(" D MHVOUT^PXRMIMM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
15 | I FTYPE="AUTTSK(" D MHVOUT^PXRMSKIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
16 | I FTYPE="GMRD(120.51," D MHVOUT^PXRMVITL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
17 | I FTYPE="LAB(60," D MHVOUT^PXRMLAB(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
18 | I FTYPE="ORD(101.43," D MHVOUT^PXRMORDR(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
19 | I FTYPE="PS(50.605," D MHVOUT^PXRMDRCL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
20 | I FTYPE="PSDRUG(" D MHVOUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
21 | I FTYPE="PS(55," D MHVOUT^PXRMDIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
22 | I FTYPE="PS(55NVA," D MHVOUT^PXRMDNVA(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
23 | I FTYPE="PSRX(" D MHVOUT^PXRMDOUT(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
24 | I FTYPE="PSNDF(50.6," D MHVOUT^PXRMDGEN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
25 | I FTYPE="PXD(811.2," D MHVOUT^PXRMTAX(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
26 | I FTYPE="PXRMD(802.4," D MHVOUT^PXRMFF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
27 | I FTYPE="PXRMD(810.9," D MHVOUT^PXRMLOCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
28 | I FTYPE="PXRMD(811.4," D MHVOUT^PXRMCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
29 | I FTYPE="RAMIS(71," D MHVOUT^PXRMRAD(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
30 | I FTYPE="YTT(601.71," D MHVOUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
|
---|
31 | Q
|
---|
32 | ;
|
---|
33 | ;================================================
|
---|
34 | MHVC(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL) ;Prepare the
|
---|
35 | ;MyHealtheVet combined output.
|
---|
36 | N PNAME,RIEN
|
---|
37 | S RIEN=DEFARR("IEN")
|
---|
38 | S PNAME=$O(^TMP("PXRHM",$J,RIEN,""))
|
---|
39 | S ^TMP("PXRMMHVC",$J,RIEN,"STATUS")=^TMP("PXRHM",$J,RIEN,PNAME)
|
---|
40 | D MHVD(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,0)
|
---|
41 | M ^TMP("PXRMMHVC",$J,RIEN,"DETAIL")=^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
|
---|
42 | K ^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
|
---|
43 | D MHVS(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,0)
|
---|
44 | M ^TMP("PXRMMHVC",$J,RIEN,"SUMMARY")=^TMP("PXRHM",$J,RIEN,PNAME,"TXT")
|
---|
45 | K ^TMP("PXRHM",$J,RIEN,PNAME)
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | ;================================================
|
---|
49 | MHVD(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
|
---|
50 | ;MyHealtheVet detailed output.
|
---|
51 | N IND,JND,FIDATA,FINDING,FLIST,FTYPE
|
---|
52 | N HDR,NHDR,IFIEVAL,LIST,NFLINES,NTXT,NUM
|
---|
53 | N TEXT
|
---|
54 | S NTXT=0
|
---|
55 | ;Output the AGE match/no match text.
|
---|
56 | D AGE^PXRMFNFT(PXRMPDEM("DFN"),.DEFARR,.FIEVAL,.NTXT)
|
---|
57 | ;Process the findings in the order: patient cohort, resolution,
|
---|
58 | ;age, and informational.
|
---|
59 | M FIDATA=FIEVAL
|
---|
60 | F FTYPE="PCL","RES","AGE","INFO" D
|
---|
61 | . S LIST=$S(FTYPE="PCL":DEFARR(32),FTYPE="RES":DEFARR(36),FTYPE="AGE":DEFARR(40),FTYPE="INFO":DEFARR(42))
|
---|
62 | .;Output the general logic text.
|
---|
63 | . I FTYPE="PCL" D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,FTYPE,"D",.DEFARR,.NTXT)
|
---|
64 | . I FTYPE="RES",$P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,FTYPE,"D",.DEFARR,.NTXT)
|
---|
65 | .;Process the findings for each type.
|
---|
66 | . K TEXT
|
---|
67 | . S (NHDR,NFLINES)=0
|
---|
68 | . S NUM=+$P(LIST,U,1)
|
---|
69 | . S FLIST=$P(LIST,U,2)
|
---|
70 | . F IND=1:1:NUM D
|
---|
71 | .. S FINDING=$P(FLIST,";",IND)
|
---|
72 | ..;No output for age or sex findings.
|
---|
73 | .. I (FINDING="AGE")!(FINDING="SEX") Q
|
---|
74 | ..;Make sure each finding is processed only once.
|
---|
75 | .. I '$D(FIDATA(FINDING)) Q
|
---|
76 | .. K IFIEVAL
|
---|
77 | .. ;I FIEVAL(FINDING) M IFIEVAL=FIEVAL(FINDING)
|
---|
78 | .. ;E S IFIEVAL=0
|
---|
79 | .. I FIEVAL(FINDING) D
|
---|
80 | ... M IFIEVAL=FIEVAL(FINDING)
|
---|
81 | ...;Remove any false occurrences so they are not displayed.
|
---|
82 | ... S JND=0
|
---|
83 | ... F S JND=+$O(IFIEVAL(JND)) Q:JND=0 K:'IFIEVAL(JND) IFIEVAL(JND)
|
---|
84 | .. E S IFIEVAL=0
|
---|
85 | ..;Output the found/not found text for the finding.
|
---|
86 | .. D FINDING^PXRMFNFT(3,PXRMPDEM("DFN"),FINDING,.IFIEVAL,.NFLINES,.TEXT)
|
---|
87 | ..;If the finding is true output the finding information.
|
---|
88 | .. I IFIEVAL D FOUT(1,.IFIEVAL,.NFLINES,.TEXT)
|
---|
89 | ..;Make sure each finding is processed only once.
|
---|
90 | .. K FIDATA(FINDING)
|
---|
91 | .;
|
---|
92 | .;If there was any text for this finding type create a header.
|
---|
93 | .;Output the header and the finding text.
|
---|
94 | . D COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT)
|
---|
95 | I WEB D WEB(DEFARR("IEN"),.NTXT)
|
---|
96 | Q
|
---|
97 | ;
|
---|
98 | ;================================================
|
---|
99 | MHVS(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
|
---|
100 | ;MyHealtheVet summary output.
|
---|
101 | N NTXT
|
---|
102 | S NTXT=0
|
---|
103 | D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,"PCL","S",.DEFARR,.NTXT)
|
---|
104 | I $P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,"RES","S",.DEFARR,.NTXT)
|
---|
105 | I WEB D WEB(DEFARR("IEN"),.NTXT)
|
---|
106 | Q
|
---|
107 | ;
|
---|
108 | ;================================================
|
---|
109 | WEB(RIEN,NTXT) ;Output the web site information.
|
---|
110 | N DES,IEN,IND,NL,TEXT,TITLE,URL
|
---|
111 | I '$D(^PXD(811.9,RIEN,50)) Q
|
---|
112 | S TEXT="\\ Please check these web sites for more information:\\"
|
---|
113 | D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
|
---|
114 | S IEN=0
|
---|
115 | F S IEN=+$O(^PXD(811.9,RIEN,50,IEN)) Q:IEN=0 D
|
---|
116 | . S TEXT=$G(^PXD(811.9,RIEN,50,IEN,0))
|
---|
117 | . S URL=$P(TEXT,U,1)
|
---|
118 | . I URL="" Q
|
---|
119 | . S TITLE=$P(TEXT,U,2)
|
---|
120 | . S DES=$D(^PXD(811.9,RIEN,50,IEN,1))
|
---|
121 | . S TEXT(1)="Web Site: "_TITLE_"\\"
|
---|
122 | . S TEXT(2)="URL: "_URL_$S('DES:"\\",1:"")
|
---|
123 | . D ADDTXTA^PXRMOUTU(2,PXRMRM,.NTXT,2,.TEXT)
|
---|
124 | .;If there is a description output it.
|
---|
125 | . I 'DES Q
|
---|
126 | . K TEXT
|
---|
127 | . S (IND,NL)=0
|
---|
128 | . F S IND=+$O(^PXD(811.9,RIEN,50,IEN,1,IND)) Q:IND=0 D
|
---|
129 | .. S NL=NL+1
|
---|
130 | .. S TEXT(NL)=^PXD(811.9,RIEN,50,IEN,1,IND,0)
|
---|
131 | . S TEXT(NL)=TEXT(NL)_"\\"
|
---|
132 | . D ADDTXTA^PXRMOUTU(3,PXRMRM,.NTXT,NL,.TEXT)
|
---|
133 | Q
|
---|
134 | ;
|
---|