Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMOUTM.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMOUTM.m
r613 r623 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 ; 1 PXRMOUTM ; SLC/PKR - MyHealtheVet output. ;10/12/2005 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 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," 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,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 ;================================================ 93 MHVS(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 ;================================================ 103 WEB(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 TracChangeset
for help on using the changeset viewer.
