Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMFNFT

PXRMFNFT.m

Go to the documentation of this file.
PXRMFNFT ; SLC/PKR - Process found/not found text. ;05/29/2020
 ;;2.0;CLINICAL REMINDERS;**4,12,16,47,46**;Feb 04, 2005;Build 236
 ;
 ;===============
AGE(DFN,DEFARR,FIEVAL,NTXT) ;Output the age match/no match
 ;text.
 N CCSUBO,CSUBTEXT,CTIUO,FI,IC,LC,NCSUBL,NIN,NLINES,NTIUL
 N TEXT,TEXTIN,TIUTEXT
 I '$D(FIEVAL("AGE")) Q
 S NLINES=0
 S IC=""
 F  S IC=$O(FIEVAL("AGE",IC)) Q:IC=""  D
 . S FI=$S(FIEVAL("AGE",IC):1,1:2)
 . S NIN=$P(DEFARR(7,IC,3),U,FI)
 . I +NIN=0 Q
 .;If CCSUBO is true the text contains a CSUB object.
 . S CCSUBO=$S(NIN["C":1,1:0)
 .;If CTIUO is true the text contains a TIU object.
 . S CTIUO=$S(NIN["T":1,1:0)
 . S NIN=+NIN
 . K TEXTIN
 . F LC=1:1:NIN S TEXTIN(LC)=^PXD(811.9,PXRMITEM,7,IC,FI,LC,0)
 . S NIN=NIN+1,TEXTIN(NIN)="\\"
 . I CCSUBO D FNFTXTCSUBO(NIN,.TEXTIN,.NCSUBL,.CSUBTEXT,.FIEVAL)
 . I CTIUO D
 .. N VSTR S VSTR=""
 .. I CCSUBO D FNFTXTTIUO(NCSUBL,.CSUBTEXT,DFN,VSTR,.NTIUL,.TIUTEXT)
 .. I 'CCSUBO D FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
 . I CTIUO D FNFTXTF(1,NTIUL,.TIUTEXT,.NLINES,.TEXT)
 . I CCSUBO&('CTIUO) D FNFTXTF(1,NCSUBL,.CSUBTEXT,.NLINES,.TEXT)
 . I ('CTIUO)&('CCSUBO) D FNFTXTF(1,NIN,.TEXTIN,.NLINES,.TEXT)
 D COPYTXT^PXRMOUTU(.NTXT,NLINES,.TEXT)
 Q
 ;
 ;===============
ALLWSP(TEXT) ;If $P(TEXT,"\\",IND) is all whitespace, ASCII characters < 33
 ;return 1, otherwise return 0.
 N ACHAR,ALLWSP,IND,JND,LEN,NDSP,TEMP
 S ALLWSP=1
 S NDSP=$L(TEXT,"\\")
 F IND=1:1:NDSP D
 . I ALLWSP=0 S IND=NDSP Q
 . S TEMP=$P(TEXT,"\\",IND)
 . S LEN=$L(TEMP)
 . F JND=1:1:LEN D
 .. I ALLWSP=0 S JND=LEN Q
 .. S ACHAR=$A(TEMP,JND)
 .. I ACHAR>32 S ALLWSP=0
 Q ALLWSP
 ;
 ;===============
FINDING(DFN,FINDING,FIEVAL,IFIEVAL,NLINES,TEXT) ;Output the finding found/not
 ;found text.
 N CCSUBO,CSUBTEXT,CTIUO,FI,LC,NCSUBL,NIN,NODE,NTIUL
 N TEMP,TEXTIN,TIUTEXT
 S FI=$S(IFIEVAL:1,1:2)
 S NODE=$S(FINDING["FF":25,1:20)
 S TEMP=$G(DEFARR(NODE,FINDING,6))
 S NIN=$P(TEMP,U,FI)
 I +NIN=0 Q
 ;If CCSUBO is true the text contains a CSUB object.
 S CCSUBO=$S(NIN["C":1,1:0)
 ;If CTIUO is true the text contains a TIU object.
 S CTIUO=$S(NIN["T":1,1:0)
 I FINDING["FF" S FINDING=$P(FINDING,"FF",2)
 S NIN=+NIN
 F LC=1:1:NIN S TEXTIN(LC)=^PXD(811.9,PXRMITEM,NODE,FINDING,FI,LC,0)
 S NIN=NIN+1,TEXTIN(NIN)="\\"
 I CCSUBO D FNFTXTCSUBO(NIN,.TEXTIN,.NCSUBL,.CSUBTEXT,.FIEVAL)
 I CTIUO D
 . N VSTR
 . I $D(IFIEVAL("VISIT")) D
 .. N TEMP,VDATE,VLOC,VSC
 .. S TEMP=^AUPNVSIT(IFIEVAL("VISIT"),0)
 .. S VDATE=$P(TEMP,U,1)
 .. S VLOC=$P(TEMP,U,22)
 .. S VSC=$P(TEMP,U,7)
 .. S VSTR=VLOC_";"_VDATE_";"_VSC
 . E  S VSTR=""
 . I CCSUBO D FNFTXTTIUO(NCSUBL,.CSUBTEXT,DFN,VSTR,.NTIUL,.TIUTEXT)
 . I 'CCSUBO D FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
 I CTIUO D FNFTXTF(1,NTIUL,.TIUTEXT,.NLINES,.TEXT)
 I CCSUBO&('CTIUO) D FNFTXTF(1,NCSUBL,.CSUBTEXT,.NLINES,.TEXT)
 I ('CTIUO)&('CCSUBO) D FNFTXTF(1,NIN,.TEXTIN,.NLINES,.TEXT)
 Q
 ;
 ;===============
FNFTXTCSUBO(NIN,TEXTIN,NOUT,TEXTOUT,FIEVAL) ;Process Found/Not Found Text that
 ;contains CSUB objects.
 N IND
 S NOUT=0
 F IND=1:1:NIN D
 . S NOUT=NOUT+1
 . I TEXTIN(IND)'["$$CSUB" S TEXTOUT(NOUT)=TEXTIN(IND) Q
 . S TEXTOUT(NOUT)=$$CSUBOBJ^PXRMCSUBOBJ(TEXTIN(IND),.FIEVAL)
 Q
 ;
 ;===============
FNFTXTF(INDENT,NIN,TEXTIN,NLINES,TEXT) ;Format Found/Not Found Text.
 ;If the original text contains objects they have been processed.
 ;Handles 'FMT{...}FMT blocks.
 N BEND,BSTART,INBLOCK,IND,DONE,END,JND,LEN,NTFMT,NOUT,NSBL
 N SKIP,START,TEMP,TEXTFMT,TEXTOUT,TEXTSBL,TEXTSTRING
 ;Process SBL blocks.
 D SBL(NIN,.TEXTIN,.NSBL,.TEXTSBL)
 S INBLOCK=0,NTFMT=0
 F IND=1:1:NSBL D
 . S TEMP=TEXTSBL(IND)
 . I INBLOCK=0 D
 .. S BSTART=$F(TEMP,"'FMT{",1)
 .. I BSTART=0 S NTFMT=NTFMT+1,TEXTFMT(NTFMT)=TEMP Q
 .. I BSTART>0 D
 ... S INBLOCK=1,END=BSTART-6
 ...;If there is text before the non-format block format it.
 ... I END>0 S NTFMT=NTFMT+1,TEXTFMT(NTFMT)=$E(TEMP,1,END)
 ... I NTFMT>0 D
 .... D FORMAT^PXRMTEXT(INDENT,PXRMRM,NTFMT,.TEXTFMT,.NOUT,.TEXTOUT)
 .... F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
 .... S NTFMT=0
 .... K TEXTFMT
 . I INBLOCK>0 D
 .. S START=$S(INBLOCK=1:BSTART,1:1),BEND=$F(TEMP,"}FMT")
 .. I BEND=0 D
 ... S INBLOCK=INBLOCK+1
 ... I $E(TEMP,START)="_" S TEXT(NLINES)=TEXT(NLINES)_$E(TEMP,START+1,$L(TEMP))
 ... E  S NLINES=NLINES+1,TEXT(NLINES)=$E(TEMP,START,$L(TEMP))
 .. I BEND>0 D
 ... I $E(TEMP,1)="_" S TEXT(NLINES)=TEXT(NLINES)_$E(TEMP,2,BEND-5)
 ... E  S NLINES=NLINES+1,TEXT(NLINES)=$E(TEMP,START,BEND-5)
 ... S INBLOCK=0,END=$L(TEMP)
 ... I END'<BEND S NTFMT=NTFMT+1,TEXTFMT(NTFMT)=$E(TEMP,BEND,END)
 I NTFMT=0 Q
 ;Remaining text to format.
 D FORMAT^PXRMTEXT(INDENT,PXRMRM,NTFMT,.TEXTFMT,.NOUT,.TEXTOUT)
 F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
 Q
 ;
 ;===============
FNFTXTO(INDENT,NIN,TEXTIN,DFN,VSTR,NLINES,TEXT) ;This entry point is used
 ;by GETOCTXT^PXRMORCH.
 N IND,NFOUT,NTIUL,TEXTFOUT,TIUTEXT
 S NFOUT=0
 D FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
 D FNFTXTF(INDENT,NTIUL,.TIUTEXT,.NFOUT,.TEXTFOUT)
 F IND=1:1:NFOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTFOUT(IND)
 Q
 ;
 ;===============
FNFTXTTIUO(NIN,TEXTIN,DFN,VSTR,NOUT,TEXTOUT) ;Process Found/Not Found 
 ;Text that contains TIU objects.
 N IND,INOBJECT,JND,OBJLINE,NOL,TA
 ;Make sure this works if it is being called a part of an object.
 I $D(^TMP("TIUBOIL",$J)) D
 . K ^TMP("PXRMTIUBOIL",$J)
 . M ^TMP("PXRMTIUBOIL",$J)=^TMP("TIUBOIL",$J)
 . S INOBJECT=1
 E  S INOBJECT=0
 S NOUT=0
 K TEXTOUT
 F IND=1:1:NIN D
 . I TEXTIN(IND)'["|" S NOUT=NOUT+1,TEXTOUT(NOUT)=TEXTIN(IND) Q
 . S OBJLINE(1,0)=TEXTIN(IND)
 . K ^TMP("TIUBOIL",$J)
 . D BLRPLT^TIUSRVD(.TA,"",DFN,VSTR,"OBJLINE")
 . S NOL=$P(^TMP("TIUBOIL",$J,0),U,3)
 . F JND=1:1:NOL S NOUT=NOUT+1,TEXTOUT(NOUT)=^TMP("TIUBOIL",$J,JND,0)
 K ^TMP("TIUBOIL",$J)
 I INOBJECT M ^TMP("TIUBOIL",$J)=^TMP("PXRMTIUBOIL",$J) K ^TMP("PXRMTIUBOIL",$J)
 Q
 ;
 ;===============
LOGIC(DFN,LOGSTR,LOGTYPE,TTYPE,DEFARR,FIEVAL,NTXT) ;Output the detailed
 ;logic found/not found text.
 I LOGSTR="" Q
 N CCSUBO,CSUBTEXT,CTIUO,FI,FORMAT,LC,NCSUBL,NIN,NLINES,NTIUL,SUB
 N TEXT,TEXTIN,TIUTEXT
 I TTYPE="S" S NIN=$S(LOGTYPE="PCL":DEFARR(72),LOGTYPE="RES":DEFARR(77),1:0)
 E  S NIN=$S(LOGTYPE="PCL":DEFARR(62),LOGTYPE="RES":DEFARR(67),1:0)
 I +NIN=0 Q
 ;If CCSUBO is true the text contains a CSUB object.
 S CCSUBO=$S(NIN["C":1,1:0)
 ;If CTIUO is true the text contains a TIU object.
 S CTIUO=$S(NIN["T":1,1:0)
 S FI=$P(LOGSTR,U,1)
 S NIN=$S(FI=1:$P(NIN,U,1),FI=0:$P(NIN,U,2),1:0)
 I +NIN=0 Q
 I TTYPE="S" D
 . I LOGTYPE="PCL",FI=1 S SUB=70
 . I LOGTYPE="PCL",FI=0 S SUB=71
 . I LOGTYPE="RES",FI=1 S SUB=75
 . I LOGTYPE="RES",FI=0 S SUB=76
 E  D
 . I LOGTYPE="PCL",FI=1 S SUB=60
 . I LOGTYPE="PCL",FI=0 S SUB=61
 . I LOGTYPE="RES",FI=1 S SUB=65
 . I LOGTYPE="RES",FI=0 S SUB=66
 S NLINES=0
 F LC=1:1:+NIN S TEXTIN(LC)=^PXD(811.9,PXRMITEM,SUB,LC,0)
 S NIN=NIN+1,TEXTIN(NIN)="\\"
 I $E(TEXTIN(1),1,5)="'FMT:" D
 . S FORMAT=0
 . S TEXTIN(1)=$P(TEXTIN(1),"'FMT:",2)
 E  S FORMAT=1
 I CCSUBO D FNFTXTCSUBO(NIN,.TEXTIN,.NCSUBL,.CSUBTEXT,.FIEVAL)
 I CTIUO D
 . N VSTR S VSTR=""
 . I CCSUBO D FNFTXTTIUO(NCSUBL,.CSUBTEXT,DFN,VSTR,.NTIUL,.TIUTEXT)
 . I 'CCSUBO D FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
 I CTIUO D FNFTXTF(1,NTIUL,.TIUTEXT,.NLINES,.TEXT)
 I CCSUBO&('CTIUO) D FNFTXTF(1,NCSUBL,.CSUBTEXT,.NLINES,.TEXT)
 I ('CTIUO)&('CCSUBO) D FNFTXTF(1,NIN,.TEXTIN,.NLINES,.TEXT)
 D COPYTXT^PXRMOUTU(.NTXT,NLINES,.TEXT)
 Q
 ;
 ;===============
SBL(NIN,TEXTIN,NOUT,TEXTOUT) ;Process SBL{...}SBL blocks.
 N BEND,BSTART,END,INBLOCK,JND,SBLSTRING,SKIP,START,TEMP
 S INBLOCK=0,NOUT=0,SBLSTRING=""
 F JND=1:1:NIN D
 . S TEMP=TEXTIN(JND)
 . S BSTART=$S(INBLOCK=0:$F(TEMP,"SBL{"),1:0)
 . I (INBLOCK=0),(BSTART=0) S NOUT=NOUT+1,TEXTOUT(NOUT)=TEMP Q
 .;If BSTART>5 there is text before the start of the SBL{ block.
 . I BSTART>5 S NOUT=NOUT+1,TEXTOUT(NOUT)=$E(TEMP,1,BSTART-6),INBLOCK=INBLOCK+1
 . S BEND=$F(TEMP,"}SBL")
 . I (BSTART>0),(BEND)>0 D  Q
 .. S SBLSTRING=$E(TEMP,BSTART,BEND-5)
 .. S SKIP=$$ALLWSP(SBLSTRING)
 .. I 'SKIP S NOUT=NOUT+1,TEXTOUT(NOUT)=SBLSTRING
 ..;If there is text after the SBL block add it.
 .. S END=$L(TEMP)
 .. I END>BEND S NOUT=NOUT+1,TEXTOUT(NOUT)=$E(TEMP,BEND,END)
 . I ((INBLOCK>0)!(BSTART>0)),(BEND=0) D  Q
 .. S INBLOCK=INBLOCK+1
 .. S END=$L(TEMP)
 .. S START=$S(BSTART>0:BSTART,1:1)
 .. S SBLSTRING=SBLSTRING_$E(TEMP,START,END)
 .. I TEMP'["\\" Q
 .. S SKIP=$$ALLWSP(SBLSTRING)
 .. I 'SKIP S NOUT=NOUT+1,TEXTOUT(NOUT)=SBLSTRING
 .. S SBLSTRING=""
 . I (INBLOCK>0),(BEND>0) D
 .. S INBLOCK=0
 .. S SBLSTRING=SBLSTRING_$E(TEMP,1,BEND-5)
 .. S SKIP=$$ALLWSP(SBLSTRING)
 .. I 'SKIP S NOUT=NOUT+1,TEXTOUT(NOUT)=SBLSTRING
 .. S SBLSTRING=""
 ..;If there is text after the SBL block add it.
 .. S END=$L(TEMP)
 .. I END>BEND S TEXTOUT(NOUT)=TEXTOUT(NOUT)_$E(TEMP,BEND,END)
 Q
 ;
 ;===============
SNMLA(RIEN) ;Set the number of match lines for the age match text.
 N IND,JND,LC,MATCHLC,NCSUB,NPIPE,RES,TEXT,WMSG
 S IND=0
 F  S IND=+$O(^PXD(811.9,RIEN,7,IND)) Q:IND=0  D
 .;Age match text
 . S (JND,LC,NCSUB,NPIPE)=0
 . F  S JND=$O(^PXD(811.9,RIEN,7,IND,1,JND)) Q:JND=""  D
 .. S TEXT=^PXD(811.9,RIEN,7,IND,1,JND,0)
 .. I TEXT["$$CSUB" S NCSUB=NCSUB+1
 .. S NPIPE=NPIPE+$L(TEXT,"|")-1
 .. S LC=LC+1
 . S MATCHLC=LC
 . I (NPIPE#2)=1 D
 .. S WMSG="match text for age range "_IND
 .. D TIUOBJW(WMSG,NPIPE)
 . I NCSUB>0 S MATCHLC=MATCHLC_"C"
 . I NPIPE>1 S MATCHLC=MATCHLC_"T"
 .;Age no match text
 . S (JND,LC,NCSUB,NPIPE)=0
 . F  S JND=$O(^PXD(811.9,RIEN,7,IND,2,JND)) Q:JND=""  D
 .. S TEXT=^PXD(811.9,RIEN,7,IND,2,JND,0)
 .. I TEXT["$$CSUB" S NCSUB=NCSUB+1
 .. S NPIPE=NPIPE+$L(TEXT,"|")-1
 .. S LC=LC+1
 . I (NPIPE#2)=1 D
 .. S WMSG="no match text for age range "_IND
 .. D TIUOBJW(WMSG,NPIPE)
 . I NCSUB>0 S LC=LC_"C"
 . I NPIPE>1 S LC=LC_"T"
 . S ^PXD(811.9,RIEN,7,IND,3)=MATCHLC_U_LC
 Q
 ;
 ;===============
SNMLF(RIEN,NODE) ;Set the number of found lines for the found text.
 ;For regular and function findings.
 N IND,JND,LC,NCSUB,NFL,NNAME,NPIPE,RES,TEXT,WMSG
 S NNAME=$S(NODE=20:"finding",NODE=25:"function finding",1:"?")
 S IND=0
 F  S IND=+$O(^PXD(811.9,RIEN,NODE,IND)) Q:IND=0  D
 .;Found text
 . S (JND,LC,NCSUB,NPIPE)=0
 . F  S JND=$O(^PXD(811.9,RIEN,NODE,IND,1,JND)) Q:JND=""  D
 .. S TEXT=^PXD(811.9,RIEN,NODE,IND,1,JND,0)
 .. I TEXT["$$CSUB" S NCSUB=NCSUB+1
 .. S NPIPE=NPIPE+$L(TEXT,"|")-1
 .. S LC=LC+1
 . S NFL=LC
 . I (NPIPE#2)=1 D
 .. S WMSG="found text for "_NNAME_" "_IND
 .. D TIUOBJW(WMSG,NPIPE)
 . I NCSUB>0 S NFL=NFL_"C"
 . I NPIPE>1 S NFL=NFL_"T"
 .;Not found text
 . S (JND,LC,NCSUB,NPIPE)=0
 . F  S JND=$O(^PXD(811.9,RIEN,NODE,IND,2,JND)) Q:JND=""  D
 .. S TEXT=^PXD(811.9,RIEN,NODE,IND,2,JND,0)
 .. I TEXT["$$CSUB" S NCSUB=NCSUB+1
 .. S NPIPE=NPIPE+$L(TEXT,"|")-1
 .. S LC=LC+1
 . I (NPIPE#2)=1 D
 .. S WMSG="not found text for "_NNAME_" "_IND
 .. D TIUOBJW(WMSG,NPIPE)
 . I NCSUB>0 S LC=LC_"C"
 . I NPIPE>1 S LC=LC_"T"
 . S ^PXD(811.9,RIEN,NODE,IND,6)=NFL_U_LC
 Q
 ;
 ;===============
SNMLL(RIEN) ;Set the number of lines for the logic found/not found
 ;text. Append a "T" to the number of lines if the text contains
 ;a TIU object.
 N CSTR,CSUB,IND,LC,NPIPE,RES,SUB,TEXT,TTYPE
 ;SUB=60 General cohort found text
 ;SUB=61 General cohort not found text
 ;SUB=65 General resolution found text
 ;SUB=66 General resolution not found text
 ;SUB=70 Summary cohort found text
 ;SUB=71 Summary cohort not found text
 ;SUB=75 Summary resolution found text
 ;SUB=76 Summary resolution not found text
 F SUB=60,61,65,66,70,71,75,76 D
 . S (IND,LC,NCSUB,NPIPE)=0
 . F  S IND=$O(^PXD(811.9,RIEN,SUB,IND)) Q:IND=""  D
 .. S TEXT=^PXD(811.9,RIEN,SUB,IND,0)
 .. I TEXT["$$CSUB" S NCSUB=NCSUB+1
 .. S NPIPE=NPIPE+$L(TEXT,"|")-1
 .. S LC=LC+1
 . I (NPIPE#2)=1 D
 .. I SUB=60 S TTYPE="general cohort found text"
 .. I SUB=61 S TTYPE="general cohort not found text"
 .. I SUB=65 S TTYPE="general resolution found text"
 .. I SUB=66 S TTYPE="general resolution not found text"
 .. I SUB=70 S TTYPE="summary cohort found text"
 .. I SUB=71 S TTYPE="summary cohort not found text"
 .. I SUB=75 S TTYPE="summary resolution found text"
 .. I SUB=76 S TTYPE="summary resolution not found text"
 .. D TIUOBJW(TTYPE,NPIPE)
 . I NCSUB>0 S LC=LC_"C"
 . I NPIPE>1 S LC=LC_"T"
 . I SUB=60 S CSTR=LC
 . I SUB=61 S ^PXD(811.9,RIEN,62)=CSTR_U_LC
 . I SUB=65 S CSTR=LC
 . I SUB=66 S ^PXD(811.9,RIEN,67)=CSTR_U_LC
 . I SUB=70 S CSTR=LC
 . I SUB=71 S ^PXD(811.9,RIEN,72)=CSTR_U_LC
 . I SUB=75 S CSTR=LC
 . I SUB=76 S ^PXD(811.9,RIEN,77)=CSTR_U_LC
 Q
 ;
 ;===============
TIUOBJW(WMSG,NPIPE) ;Odd number of "|" characters in text, issue
 ;a warning that TIU OBJ expansion will not work.
 N TEXT
 S TEXT(1)=""
 S TEXT(2)="Warning, "_WMSG_" has "_NPIPE_" ""|"" characters."
 S TEXT(3)="Because this is an odd number, TIU Object expansion will not work."
 D MES^XPDUTL(.TEXT)
 Q
 ;