Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMOUTC.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/PXRMOUTC.m
r613 r623 1 PXRMOUTC ; SLC/PKR - Clinical Maintenance output. ;07/06/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ;================================================ 4 CM(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. 51 FNF .. 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 ;================================================ 65 FOUT(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 ;================================================ 94 FREQ(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 ;================================================ 115 HEADER(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 ; 1 PXRMOUTC ; SLC/PKR - Clinical Maintenance output. ;10/07/2005 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ;================================================ 4 CM(DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,FIEVAL) ;Prepare the 5 ;clinical maintenance output. 6 N IND,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 ..;If the finding is false all we need to do is process the not found 42 ..;text. If it is true we also need to output the finding information. 43 .. I IFIEVAL D FOUT(1,.IFIEVAL,.NFLINES,.TEXT) 44 ..;Output the found/not found text for the finding. 45 FNF .. D FINDING^PXRMFNFT(3,PXRMPDEM("DFN"),FINDING,.IFIEVAL,.NFLINES,.TEXT) 46 ..;Make sure each finding is processed only once. 47 .. K FIDATA(FINDING) 48 .; 49 .;If there was any text for this finding type create a header. 50 . D HEADER(FTYPE,NFLINES,RESDATE,.NHDR,.HDR) 51 .;Output the header and the finding text. 52 . D ADDTXTA^PXRMOUTU(1,PXRMRM,.NTXT,NHDR,.HDR) 53 . D COPYTXT^PXRMOUTU(.NTXT,NFLINES,.TEXT) 54 ;Output INFO nodes 55 D INFO^PXRMOUTU(PXRMITEM,.NTXT) 56 Q 57 ; 58 ;================================================ 59 FOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Do output for individual findings 60 ;in the FINDING array. 61 I $D(IFIEVAL("TERM")) D OUTPUT^PXRMTERM(1,.IFIEVAL,.NFLINES,.TEXT) Q 62 N FTYPE 63 S FTYPE=$P(IFIEVAL("FINDING"),U,1) 64 S FTYPE=$P(FTYPE,";",2) 65 I FTYPE="AUTTEDT(" D OUTPUT^PXRMEDU(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 66 I FTYPE="AUTTEXAM(" D OUTPUT^PXRMEXAM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 67 I FTYPE="AUTTHF(" D OUTPUT^PXRMHF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 68 I FTYPE="AUTTIMM(" D OUTPUT^PXRMIMM(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 69 I FTYPE="AUTTSK(" D OUTPUT^PXRMSKIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 70 I FTYPE="GMRD(120.51," D OUTPUT^PXRMVITL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 71 I FTYPE="LAB(60," D OUTPUT^PXRMLAB(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 72 I FTYPE="ORD(101.43," D OUTPUT^PXRMORDR(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 73 I FTYPE="PS(50.605," D OUTPUT^PXRMDRCL(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 74 I FTYPE="PSDRUG(" D OUTPUT^PXRMDRUG(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 75 I FTYPE="PSNDF(50.6," D OUTPUT^PXRMDGEN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 76 I FTYPE="PS(55," D OUTPUT^PXRMDIN(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 77 I FTYPE="PS(55NVA," D OUTPUT^PXRMDNVA(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 78 I FTYPE="PSRX(" D OUTPUT^PXRMDOUT(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 79 I FTYPE="PXD(811.2," D OUTPUT^PXRMTAX(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 80 I FTYPE="PXRMD(802.4," D OUTPUT^PXRMFF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 81 I FTYPE="PXRMD(810.9," D OUTPUT^PXRMLOCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 82 I FTYPE="PXRMD(811.4," D OUTPUT^PXRMCF(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 83 I FTYPE="RAMIS(71," D OUTPUT^PXRMRAD(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 84 I FTYPE="YTT(601," D OUTPUT^PXRMMH(INDENT,.IFIEVAL,.NLINES,.TEXT) Q 85 Q 86 ; 87 ;================================================ 88 FREQ(DEFARR,NTXT,TEXT) ;Display the frequency information. 89 N FREQ,TEMP 90 ;If there was a custom date due print out that information. 91 I $D(^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")) D 92 . S TEMP=^TMP(PXRMPID,$J,PXRMITEM,"zCDUE") 93 . S TEXT=$$OUTPUT^PXRMCDUE(TEMP,.DEFARR) 94 . I DEFARR(31)["AGE" D 95 .. S TEMP=$G(^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG")) 96 .. I TEMP'="" S TEXT=TEXT_" Applicable"_$$FMTAGE^PXRMAGE($P(TEMP,U,2),$P(TEMP,U,3))_"." 97 . D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT) 98 E D 99 . S TEMP=$G(^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG")) 100 . I TEMP'="" D 101 .. S FREQ=$P(TEMP,U,1) 102 .. S TEXT=$$FMTFREQ^PXRMAGE(FREQ) 103 .. I FREQ=-1 S TEXT=TEXT_" for this patient." 104 .. I DEFARR(31)["AGE",FREQ'=-1 S TEXT=TEXT_$$FMTAGE^PXRMAGE($P(TEMP,U,2),$P(TEMP,U,3))_"." 105 .. D ADDTXT^PXRMOUTU(1,PXRMRM,.NTXT,TEXT) 106 Q 107 ; 108 ;================================================ 109 HEADER(FTYPE,NLINES,RESDATE,NHDR,HDR) ;Create a finding header. 110 I FTYPE="RES" D Q 111 . I +RESDATE'=0 D Q 112 .. S HDR(2)="Resolution: Last done "_$$EDATE^PXRMDATE(RESDATE) 113 .. S NHDR=2 114 .. S HDR(1)="\\" 115 . I '$D(HDR(2)),NLINES>0 D 116 .. S HDR(2)="Resolution:" 117 .. S NHDR=2 118 .. S HDR(1)="\\" 119 ; 120 I NLINES=0 Q 121 I FTYPE="PCL" D Q 122 . S NHDR=2 123 . S HDR(1)="\\" 124 . S HDR(2)="Cohort:" 125 ; 126 I FTYPE="AGE" D Q 127 . S NHDR=2 128 . S HDR(1)="\\" 129 . S HDR(2)="Age/Frequency:" 130 ; 131 I FTYPE="INFO" D Q 132 . S NHDR=2 133 . S HDR(1)="\\" 134 . S HDR(2)="Information:" 135 Q 136 ;
Note:
See TracChangeset
for help on using the changeset viewer.
