source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMOUTM.m@ 1800

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

revised back to 6/30/08 version
File size: 5.3 KB
Line 
1PXRMOUTM ; SLC/PKR - MyHealtheVet output. ;10/12/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;================================================
5FOUT(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," D MHVOUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT) Q
31 Q
32 ;
33 ;================================================
34MHVC(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 ;================================================
49MHVD(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
50 ;MyHealtheVet detailed output.
51 N IND,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 ..;Output the found/not found text for the finding.
80 .. D FINDING^PXRMFNFT(3,PXRMPDEM("DFN"),FINDING,.IFIEVAL,.NFLINES,.TEXT)
81 ..;If the finding is true output the finding information.
82 .. I IFIEVAL D FOUT(1,.IFIEVAL,.NFLINES,.TEXT)
83 ..;Make sure each finding is processed only once.
84 .. K FIDATA(FINDING)
85 .;
86 .;If there was any text for this finding type create a header.
87 .;Output the header and the finding text.
88 . D COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT)
89 I WEB D WEB(DEFARR("IEN"),.NTXT)
90 Q
91 ;
92 ;================================================
93MHVS(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL,WEB) ;Prepare the
94 ;MyHealtheVet summary output.
95 N NTXT
96 S NTXT=0
97 D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),PCLOGIC,"PCL","S",.DEFARR,.NTXT)
98 I $P(PCLOGIC,U,1) D LOGIC^PXRMFNFT(PXRMPDEM("DFN"),RESLOGIC,"RES","S",.DEFARR,.NTXT)
99 I WEB D WEB(DEFARR("IEN"),.NTXT)
100 Q
101 ;
102 ;================================================
103WEB(RIEN,NTXT) ;Output the web site information.
104 N DES,IEN,IND,NL,TEXT,TITLE,URL
105 I '$D(^PXD(811.9,RIEN,50)) Q
106 S TEXT="\\ Please check these web sites for more information:\\"
107 D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT)
108 S IEN=0
109 F S IEN=+$O(^PXD(811.9,RIEN,50,IEN)) Q:IEN=0 D
110 . S TEXT=$G(^PXD(811.9,RIEN,50,IEN,0))
111 . S URL=$P(TEXT,U,1)
112 . I URL="" Q
113 . S TITLE=$P(TEXT,U,2)
114 . S DES=$D(^PXD(811.9,RIEN,50,IEN,1))
115 . S TEXT(1)="Web Site: "_TITLE_"\\"
116 . S TEXT(2)="URL: "_URL_$S('DES:"\\",1:"")
117 . D ADDTXTA^PXRMOUTU(2,PXRMRM,.NTXT,2,.TEXT)
118 .;If there is a description output it.
119 . I 'DES Q
120 . K TEXT
121 . S (IND,NL)=0
122 . F S IND=+$O(^PXD(811.9,RIEN,50,IEN,1,IND)) Q:IND=0 D
123 .. S NL=NL+1
124 .. S TEXT(NL)=^PXD(811.9,RIEN,50,IEN,1,IND,0)
125 . S TEXT(NL)=TEXT(NL)_"\\"
126 . D ADDTXTA^PXRMOUTU(3,PXRMRM,.NTXT,NL,.TEXT)
127 Q
128 ;
Note: See TracBrowser for help on using the repository browser.