PXRMFNFT ; SLC/PKR - Process found/not found text. ;04/01/2022
;;2.0;CLINICAL REMINDERS;**4,12,16,47,46,65**;Feb 04, 2005;Build 438
;
;===============
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
;
;===============
CRLOGIC(DFN,NUMLINES,WPNODE,NTXT) ;Output the CONTRAINDICATED and REFUSED
;true and not true text.
I +NUMLINES'>0 Q
N CCSUBO,CSUBTEXT,CTIUO,FORMAT,LC,NCSUBL,NIN,NLINES,NTIUL
N TEXT,TEXTIN,TIUTEXT
;If CCSUBO is true the text contains a CSUB object.
S CCSUBO=$S(NUMLINES["C":1,1:0)
;If CTIUO is true the text contains a TIU object.
S CTIUO=$S(NUMLINES["T":1,1:0)
S NIN=+NUMLINES,NLINES=0
F LC=1:1:NIN S TEXTIN(LC)=^PXD(811.9,PXRMITEM,WPNODE,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
;
;===============
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 NLINES=$S(LOGTYPE="PCL":DEFARR(72),LOGTYPE="RES":DEFARR(77),1:0)
E S NLINES=$S(LOGTYPE="PCL":DEFARR(62),LOGTYPE="RES":DEFARR(67),1:0)
S FI=$P(LOGSTR,U,1)
S NIN=$S(FI=1:$P(NLINES,U,1),FI=0:$P(NLINES,U,2),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)
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
;SUB=83 Contraindicated true text
;SUB=84 Contraindicated false text
;SUB=93 Refused true tex
;SUB=94 Refused false text
F SUB=60,61,65,66,70,71,75,76,83,84,93,94 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"
.. I SUB=83 S TTYPE="contraindicated true text"
.. I SUB=84 S TTYPE="contraindicated false text"
.. I SUB=93 S TTYPE="refused true text"
.. I SUB=94 S TTYPE="refused false 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
. I SUB=83 S CSTR=LC
. I SUB=84 S ^PXD(811.9,RIEN,85)=CSTR_U_LC
. I SUB=93 S CSTR=LC
. I SUB=94 S ^PXD(811.9,RIEN,95)=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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMFNFT 14639 printed Sep 23, 2025@19:21:30 Page 2
PXRMFNFT ; SLC/PKR - Process found/not found text. ;04/01/2022
+1 ;;2.0;CLINICAL REMINDERS;**4,12,16,47,46,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;===============
AGE(DFN,DEFARR,FIEVAL,NTXT) ;Output the age match/no match
+1 ;text.
+2 NEW CCSUBO,CSUBTEXT,CTIUO,FI,IC,LC,NCSUBL,NIN,NLINES,NTIUL
+3 NEW TEXT,TEXTIN,TIUTEXT
+4 IF '$DATA(FIEVAL("AGE"))
QUIT
+5 SET NLINES=0
+6 SET IC=""
+7 FOR
SET IC=$ORDER(FIEVAL("AGE",IC))
if IC=""
QUIT
Begin DoDot:1
+8 SET FI=$SELECT(FIEVAL("AGE",IC):1,1:2)
+9 SET NIN=$PIECE(DEFARR(7,IC,3),U,FI)
+10 IF +NIN=0
QUIT
+11 ;If CCSUBO is true the text contains a CSUB object.
+12 SET CCSUBO=$SELECT(NIN["C":1,1:0)
+13 ;If CTIUO is true the text contains a TIU object.
+14 SET CTIUO=$SELECT(NIN["T":1,1:0)
+15 SET NIN=+NIN
+16 KILL TEXTIN
+17 FOR LC=1:1:NIN
SET TEXTIN(LC)=^PXD(811.9,PXRMITEM,7,IC,FI,LC,0)
+18 SET NIN=NIN+1
SET TEXTIN(NIN)="\\"
+19 IF CCSUBO
DO FNFTXTCSUBO(NIN,.TEXTIN,.NCSUBL,.CSUBTEXT,.FIEVAL)
+20 IF CTIUO
Begin DoDot:2
+21 NEW VSTR
SET VSTR=""
+22 IF CCSUBO
DO FNFTXTTIUO(NCSUBL,.CSUBTEXT,DFN,VSTR,.NTIUL,.TIUTEXT)
+23 IF 'CCSUBO
DO FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
End DoDot:2
+24 IF CTIUO
DO FNFTXTF(1,NTIUL,.TIUTEXT,.NLINES,.TEXT)
+25 IF CCSUBO&('CTIUO)
DO FNFTXTF(1,NCSUBL,.CSUBTEXT,.NLINES,.TEXT)
+26 IF ('CTIUO)&('CCSUBO)
DO FNFTXTF(1,NIN,.TEXTIN,.NLINES,.TEXT)
End DoDot:1
+27 DO COPYTXT^PXRMOUTU(.NTXT,NLINES,.TEXT)
+28 QUIT
+29 ;
+30 ;===============
ALLWSP(TEXT) ;If $P(TEXT,"\\",IND) is all whitespace, ASCII characters < 33
+1 ;return 1, otherwise return 0.
+2 NEW ACHAR,ALLWSP,IND,JND,LEN,NDSP,TEMP
+3 SET ALLWSP=1
+4 SET NDSP=$LENGTH(TEXT,"\\")
+5 FOR IND=1:1:NDSP
Begin DoDot:1
+6 IF ALLWSP=0
SET IND=NDSP
QUIT
+7 SET TEMP=$PIECE(TEXT,"\\",IND)
+8 SET LEN=$LENGTH(TEMP)
+9 FOR JND=1:1:LEN
Begin DoDot:2
+10 IF ALLWSP=0
SET JND=LEN
QUIT
+11 SET ACHAR=$ASCII(TEMP,JND)
+12 IF ACHAR>32
SET ALLWSP=0
End DoDot:2
End DoDot:1
+13 QUIT ALLWSP
+14 ;
+15 ;===============
CRLOGIC(DFN,NUMLINES,WPNODE,NTXT) ;Output the CONTRAINDICATED and REFUSED
+1 ;true and not true text.
+2 IF +NUMLINES'>0
QUIT
+3 NEW CCSUBO,CSUBTEXT,CTIUO,FORMAT,LC,NCSUBL,NIN,NLINES,NTIUL
+4 NEW TEXT,TEXTIN,TIUTEXT
+5 ;If CCSUBO is true the text contains a CSUB object.
+6 SET CCSUBO=$SELECT(NUMLINES["C":1,1:0)
+7 ;If CTIUO is true the text contains a TIU object.
+8 SET CTIUO=$SELECT(NUMLINES["T":1,1:0)
+9 SET NIN=+NUMLINES
SET NLINES=0
+10 FOR LC=1:1:NIN
SET TEXTIN(LC)=^PXD(811.9,PXRMITEM,WPNODE,LC,0)
+11 SET NIN=NIN+1
SET TEXTIN(NIN)="\\"
+12 IF $EXTRACT(TEXTIN(1),1,5)="'FMT:"
Begin DoDot:1
+13 SET FORMAT=0
+14 SET TEXTIN(1)=$PIECE(TEXTIN(1),"'FMT:",2)
End DoDot:1
+15 IF '$TEST
SET FORMAT=1
+16 IF CCSUBO
DO FNFTXTCSUBO(NIN,.TEXTIN,.NCSUBL,.CSUBTEXT,.FIEVAL)
+17 IF CTIUO
Begin DoDot:1
+18 NEW VSTR
SET VSTR=""
+19 IF CCSUBO
DO FNFTXTTIUO(NCSUBL,.CSUBTEXT,DFN,VSTR,.NTIUL,.TIUTEXT)
+20 IF 'CCSUBO
DO FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
End DoDot:1
+21 IF CTIUO
DO FNFTXTF(1,NTIUL,.TIUTEXT,.NLINES,.TEXT)
+22 IF CCSUBO&('CTIUO)
DO FNFTXTF(1,NCSUBL,.CSUBTEXT,.NLINES,.TEXT)
+23 IF ('CTIUO)&('CCSUBO)
DO FNFTXTF(1,NIN,.TEXTIN,.NLINES,.TEXT)
+24 DO COPYTXT^PXRMOUTU(.NTXT,NLINES,.TEXT)
+25 QUIT
+26 ;
+27 ;===============
FINDING(DFN,FINDING,FIEVAL,IFIEVAL,NLINES,TEXT) ;Output the finding found/not
+1 ;found text.
+2 NEW CCSUBO,CSUBTEXT,CTIUO,FI,LC,NCSUBL,NIN,NODE,NTIUL
+3 NEW TEMP,TEXTIN,TIUTEXT
+4 SET FI=$SELECT(IFIEVAL:1,1:2)
+5 SET NODE=$SELECT(FINDING["FF":25,1:20)
+6 SET TEMP=$GET(DEFARR(NODE,FINDING,6))
+7 SET NIN=$PIECE(TEMP,U,FI)
+8 IF +NIN=0
QUIT
+9 ;If CCSUBO is true the text contains a CSUB object.
+10 SET CCSUBO=$SELECT(NIN["C":1,1:0)
+11 ;If CTIUO is true the text contains a TIU object.
+12 SET CTIUO=$SELECT(NIN["T":1,1:0)
+13 IF FINDING["FF"
SET FINDING=$PIECE(FINDING,"FF",2)
+14 SET NIN=+NIN
+15 FOR LC=1:1:NIN
SET TEXTIN(LC)=^PXD(811.9,PXRMITEM,NODE,FINDING,FI,LC,0)
+16 SET NIN=NIN+1
SET TEXTIN(NIN)="\\"
+17 IF CCSUBO
DO FNFTXTCSUBO(NIN,.TEXTIN,.NCSUBL,.CSUBTEXT,.FIEVAL)
+18 IF CTIUO
Begin DoDot:1
+19 NEW VSTR
+20 IF $DATA(IFIEVAL("VISIT"))
Begin DoDot:2
+21 NEW TEMP,VDATE,VLOC,VSC
+22 SET TEMP=^AUPNVSIT(IFIEVAL("VISIT"),0)
+23 SET VDATE=$PIECE(TEMP,U,1)
+24 SET VLOC=$PIECE(TEMP,U,22)
+25 SET VSC=$PIECE(TEMP,U,7)
+26 SET VSTR=VLOC_";"_VDATE_";"_VSC
End DoDot:2
+27 IF '$TEST
SET VSTR=""
+28 IF CCSUBO
DO FNFTXTTIUO(NCSUBL,.CSUBTEXT,DFN,VSTR,.NTIUL,.TIUTEXT)
+29 IF 'CCSUBO
DO FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
End DoDot:1
+30 IF CTIUO
DO FNFTXTF(1,NTIUL,.TIUTEXT,.NLINES,.TEXT)
+31 IF CCSUBO&('CTIUO)
DO FNFTXTF(1,NCSUBL,.CSUBTEXT,.NLINES,.TEXT)
+32 IF ('CTIUO)&('CCSUBO)
DO FNFTXTF(1,NIN,.TEXTIN,.NLINES,.TEXT)
+33 QUIT
+34 ;
+35 ;===============
FNFTXTCSUBO(NIN,TEXTIN,NOUT,TEXTOUT,FIEVAL) ;Process Found/Not Found Text that
+1 ;contains CSUB objects.
+2 NEW IND
+3 SET NOUT=0
+4 FOR IND=1:1:NIN
Begin DoDot:1
+5 SET NOUT=NOUT+1
+6 IF TEXTIN(IND)'["$$CSUB"
SET TEXTOUT(NOUT)=TEXTIN(IND)
QUIT
+7 SET TEXTOUT(NOUT)=$$CSUBOBJ^PXRMCSUBOBJ(TEXTIN(IND),.FIEVAL)
End DoDot:1
+8 QUIT
+9 ;
+10 ;===============
FNFTXTF(INDENT,NIN,TEXTIN,NLINES,TEXT) ;Format Found/Not Found Text.
+1 ;If the original text contains objects they have been processed.
+2 ;Handles 'FMT{...}FMT blocks.
+3 NEW BEND,BSTART,INBLOCK,IND,DONE,END,JND,LEN,NTFMT,NOUT,NSBL
+4 NEW SKIP,START,TEMP,TEXTFMT,TEXTOUT,TEXTSBL,TEXTSTRING
+5 ;Process SBL blocks.
+6 DO SBL(NIN,.TEXTIN,.NSBL,.TEXTSBL)
+7 SET INBLOCK=0
SET NTFMT=0
+8 FOR IND=1:1:NSBL
Begin DoDot:1
+9 SET TEMP=TEXTSBL(IND)
+10 IF INBLOCK=0
Begin DoDot:2
+11 SET BSTART=$FIND(TEMP,"'FMT{",1)
+12 IF BSTART=0
SET NTFMT=NTFMT+1
SET TEXTFMT(NTFMT)=TEMP
QUIT
+13 IF BSTART>0
Begin DoDot:3
+14 SET INBLOCK=1
SET END=BSTART-6
+15 ;If there is text before the non-format block format it.
+16 IF END>0
SET NTFMT=NTFMT+1
SET TEXTFMT(NTFMT)=$EXTRACT(TEMP,1,END)
+17 IF NTFMT>0
Begin DoDot:4
+18 DO FORMAT^PXRMTEXT(INDENT,PXRMRM,NTFMT,.TEXTFMT,.NOUT,.TEXTOUT)
+19 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+20 SET NTFMT=0
+21 KILL TEXTFMT
End DoDot:4
End DoDot:3
End DoDot:2
+22 IF INBLOCK>0
Begin DoDot:2
+23 SET START=$SELECT(INBLOCK=1:BSTART,1:1)
SET BEND=$FIND(TEMP,"}FMT")
+24 IF BEND=0
Begin DoDot:3
+25 SET INBLOCK=INBLOCK+1
+26 IF $EXTRACT(TEMP,START)="_"
SET TEXT(NLINES)=TEXT(NLINES)_$EXTRACT(TEMP,START+1,$LENGTH(TEMP))
+27 IF '$TEST
SET NLINES=NLINES+1
SET TEXT(NLINES)=$EXTRACT(TEMP,START,$LENGTH(TEMP))
End DoDot:3
+28 IF BEND>0
Begin DoDot:3
+29 IF $EXTRACT(TEMP,1)="_"
SET TEXT(NLINES)=TEXT(NLINES)_$EXTRACT(TEMP,2,BEND-5)
+30 IF '$TEST
SET NLINES=NLINES+1
SET TEXT(NLINES)=$EXTRACT(TEMP,START,BEND-5)
+31 SET INBLOCK=0
SET END=$LENGTH(TEMP)
+32 IF END'<BEND
SET NTFMT=NTFMT+1
SET TEXTFMT(NTFMT)=$EXTRACT(TEMP,BEND,END)
End DoDot:3
End DoDot:2
End DoDot:1
+33 IF NTFMT=0
QUIT
+34 ;Remaining text to format.
+35 DO FORMAT^PXRMTEXT(INDENT,PXRMRM,NTFMT,.TEXTFMT,.NOUT,.TEXTOUT)
+36 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+37 QUIT
+38 ;
+39 ;===============
FNFTXTO(INDENT,NIN,TEXTIN,DFN,VSTR,NLINES,TEXT) ;This entry point is used
+1 ;by GETOCTXT^PXRMORCH.
+2 NEW IND,NFOUT,NTIUL,TEXTFOUT,TIUTEXT
+3 SET NFOUT=0
+4 DO FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
+5 DO FNFTXTF(INDENT,NTIUL,.TIUTEXT,.NFOUT,.TEXTFOUT)
+6 FOR IND=1:1:NFOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTFOUT(IND)
+7 QUIT
+8 ;
+9 ;===============
FNFTXTTIUO(NIN,TEXTIN,DFN,VSTR,NOUT,TEXTOUT) ;Process Found/Not Found
+1 ;Text that contains TIU objects.
+2 NEW IND,INOBJECT,JND,OBJLINE,NOL,TA
+3 ;Make sure this works if it is being called a part of an object.
+4 IF $DATA(^TMP("TIUBOIL",$JOB))
Begin DoDot:1
+5 KILL ^TMP("PXRMTIUBOIL",$JOB)
+6 MERGE ^TMP("PXRMTIUBOIL",$JOB)=^TMP("TIUBOIL",$JOB)
+7 SET INOBJECT=1
End DoDot:1
+8 IF '$TEST
SET INOBJECT=0
+9 SET NOUT=0
+10 KILL TEXTOUT
+11 FOR IND=1:1:NIN
Begin DoDot:1
+12 IF TEXTIN(IND)'["|"
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=TEXTIN(IND)
QUIT
+13 SET OBJLINE(1,0)=TEXTIN(IND)
+14 KILL ^TMP("TIUBOIL",$JOB)
+15 DO BLRPLT^TIUSRVD(.TA,"",DFN,VSTR,"OBJLINE")
+16 SET NOL=$PIECE(^TMP("TIUBOIL",$JOB,0),U,3)
+17 FOR JND=1:1:NOL
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=^TMP("TIUBOIL",$JOB,JND,0)
End DoDot:1
+18 KILL ^TMP("TIUBOIL",$JOB)
+19 IF INOBJECT
MERGE ^TMP("TIUBOIL",$JOB)=^TMP("PXRMTIUBOIL",$JOB)
KILL ^TMP("PXRMTIUBOIL",$JOB)
+20 QUIT
+21 ;
+22 ;===============
LOGIC(DFN,LOGSTR,LOGTYPE,TTYPE,DEFARR,FIEVAL,NTXT) ;Output the detailed
+1 ;logic found/not found text.
+2 IF LOGSTR=""
QUIT
+3 NEW CCSUBO,CSUBTEXT,CTIUO,FI,FORMAT,LC,NCSUBL,NIN,NLINES,NTIUL,SUB
+4 NEW TEXT,TEXTIN,TIUTEXT
+5 IF TTYPE="S"
SET NLINES=$SELECT(LOGTYPE="PCL":DEFARR(72),LOGTYPE="RES":DEFARR(77),1:0)
+6 IF '$TEST
SET NLINES=$SELECT(LOGTYPE="PCL":DEFARR(62),LOGTYPE="RES":DEFARR(67),1:0)
+7 SET FI=$PIECE(LOGSTR,U,1)
+8 SET NIN=$SELECT(FI=1:$PIECE(NLINES,U,1),FI=0:$PIECE(NLINES,U,2),1:0)
+9 IF +NIN=0
QUIT
+10 ;If CCSUBO is true the text contains a CSUB object.
+11 SET CCSUBO=$SELECT(NIN["C":1,1:0)
+12 ;If CTIUO is true the text contains a TIU object.
+13 SET CTIUO=$SELECT(NIN["T":1,1:0)
+14 IF TTYPE="S"
Begin DoDot:1
+15 IF LOGTYPE="PCL"
IF FI=1
SET SUB=70
+16 IF LOGTYPE="PCL"
IF FI=0
SET SUB=71
+17 IF LOGTYPE="RES"
IF FI=1
SET SUB=75
+18 IF LOGTYPE="RES"
IF FI=0
SET SUB=76
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 IF LOGTYPE="PCL"
IF FI=1
SET SUB=60
+21 IF LOGTYPE="PCL"
IF FI=0
SET SUB=61
+22 IF LOGTYPE="RES"
IF FI=1
SET SUB=65
+23 IF LOGTYPE="RES"
IF FI=0
SET SUB=66
End DoDot:1
+24 SET NLINES=0
+25 FOR LC=1:1:+NIN
SET TEXTIN(LC)=^PXD(811.9,PXRMITEM,SUB,LC,0)
+26 SET NIN=NIN+1
SET TEXTIN(NIN)="\\"
+27 IF $EXTRACT(TEXTIN(1),1,5)="'FMT:"
Begin DoDot:1
+28 SET FORMAT=0
+29 SET TEXTIN(1)=$PIECE(TEXTIN(1),"'FMT:",2)
End DoDot:1
+30 IF '$TEST
SET FORMAT=1
+31 IF CCSUBO
DO FNFTXTCSUBO(NIN,.TEXTIN,.NCSUBL,.CSUBTEXT,.FIEVAL)
+32 IF CTIUO
Begin DoDot:1
+33 NEW VSTR
SET VSTR=""
+34 IF CCSUBO
DO FNFTXTTIUO(NCSUBL,.CSUBTEXT,DFN,VSTR,.NTIUL,.TIUTEXT)
+35 IF 'CCSUBO
DO FNFTXTTIUO(NIN,.TEXTIN,DFN,VSTR,.NTIUL,.TIUTEXT)
End DoDot:1
+36 IF CTIUO
DO FNFTXTF(1,NTIUL,.TIUTEXT,.NLINES,.TEXT)
+37 IF CCSUBO&('CTIUO)
DO FNFTXTF(1,NCSUBL,.CSUBTEXT,.NLINES,.TEXT)
+38 IF ('CTIUO)&('CCSUBO)
DO FNFTXTF(1,NIN,.TEXTIN,.NLINES,.TEXT)
+39 DO COPYTXT^PXRMOUTU(.NTXT,NLINES,.TEXT)
+40 QUIT
+41 ;
+42 ;===============
SBL(NIN,TEXTIN,NOUT,TEXTOUT) ;Process SBL{...}SBL blocks.
+1 NEW BEND,BSTART,END,INBLOCK,JND,SBLSTRING,SKIP,START,TEMP
+2 SET INBLOCK=0
SET NOUT=0
SET SBLSTRING=""
+3 FOR JND=1:1:NIN
Begin DoDot:1
+4 SET TEMP=TEXTIN(JND)
+5 SET BSTART=$SELECT(INBLOCK=0:$FIND(TEMP,"SBL{"),1:0)
+6 IF (INBLOCK=0)
IF (BSTART=0)
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=TEMP
QUIT
+7 ;If BSTART>5 there is text before the start of the SBL{ block.
+8 IF BSTART>5
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=$EXTRACT(TEMP,1,BSTART-6)
SET INBLOCK=INBLOCK+1
+9 SET BEND=$FIND(TEMP,"}SBL")
+10 IF (BSTART>0)
IF (BEND)>0
Begin DoDot:2
+11 SET SBLSTRING=$EXTRACT(TEMP,BSTART,BEND-5)
+12 SET SKIP=$$ALLWSP(SBLSTRING)
+13 IF 'SKIP
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=SBLSTRING
+14 ;If there is text after the SBL block add it.
+15 SET END=$LENGTH(TEMP)
+16 IF END>BEND
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=$EXTRACT(TEMP,BEND,END)
End DoDot:2
QUIT
+17 IF ((INBLOCK>0)!(BSTART>0))
IF (BEND=0)
Begin DoDot:2
+18 SET INBLOCK=INBLOCK+1
+19 SET END=$LENGTH(TEMP)
+20 SET START=$SELECT(BSTART>0:BSTART,1:1)
+21 SET SBLSTRING=SBLSTRING_$EXTRACT(TEMP,START,END)
+22 IF TEMP'["\\"
QUIT
+23 SET SKIP=$$ALLWSP(SBLSTRING)
+24 IF 'SKIP
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=SBLSTRING
+25 SET SBLSTRING=""
End DoDot:2
QUIT
+26 IF (INBLOCK>0)
IF (BEND>0)
Begin DoDot:2
+27 SET INBLOCK=0
+28 SET SBLSTRING=SBLSTRING_$EXTRACT(TEMP,1,BEND-5)
+29 SET SKIP=$$ALLWSP(SBLSTRING)
+30 IF 'SKIP
SET NOUT=NOUT+1
SET TEXTOUT(NOUT)=SBLSTRING
+31 SET SBLSTRING=""
+32 ;If there is text after the SBL block add it.
+33 SET END=$LENGTH(TEMP)
+34 IF END>BEND
SET TEXTOUT(NOUT)=TEXTOUT(NOUT)_$EXTRACT(TEMP,BEND,END)
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
+37 ;===============
SNMLA(RIEN) ;Set the number of match lines for the age match text.
+1 NEW IND,JND,LC,MATCHLC,NCSUB,NPIPE,RES,TEXT,WMSG
+2 SET IND=0
+3 FOR
SET IND=+$ORDER(^PXD(811.9,RIEN,7,IND))
if IND=0
QUIT
Begin DoDot:1
+4 ;Age match text
+5 SET (JND,LC,NCSUB,NPIPE)=0
+6 FOR
SET JND=$ORDER(^PXD(811.9,RIEN,7,IND,1,JND))
if JND=""
QUIT
Begin DoDot:2
+7 SET TEXT=^PXD(811.9,RIEN,7,IND,1,JND,0)
+8 IF TEXT["$$CSUB"
SET NCSUB=NCSUB+1
+9 SET NPIPE=NPIPE+$LENGTH(TEXT,"|")-1
+10 SET LC=LC+1
End DoDot:2
+11 SET MATCHLC=LC
+12 IF (NPIPE#2)=1
Begin DoDot:2
+13 SET WMSG="match text for age range "_IND
+14 DO TIUOBJW(WMSG,NPIPE)
End DoDot:2
+15 IF NCSUB>0
SET MATCHLC=MATCHLC_"C"
+16 IF NPIPE>1
SET MATCHLC=MATCHLC_"T"
+17 ;Age no match text
+18 SET (JND,LC,NCSUB,NPIPE)=0
+19 FOR
SET JND=$ORDER(^PXD(811.9,RIEN,7,IND,2,JND))
if JND=""
QUIT
Begin DoDot:2
+20 SET TEXT=^PXD(811.9,RIEN,7,IND,2,JND,0)
+21 IF TEXT["$$CSUB"
SET NCSUB=NCSUB+1
+22 SET NPIPE=NPIPE+$LENGTH(TEXT,"|")-1
+23 SET LC=LC+1
End DoDot:2
+24 IF (NPIPE#2)=1
Begin DoDot:2
+25 SET WMSG="no match text for age range "_IND
+26 DO TIUOBJW(WMSG,NPIPE)
End DoDot:2
+27 IF NCSUB>0
SET LC=LC_"C"
+28 IF NPIPE>1
SET LC=LC_"T"
+29 SET ^PXD(811.9,RIEN,7,IND,3)=MATCHLC_U_LC
End DoDot:1
+30 QUIT
+31 ;
+32 ;===============
SNMLF(RIEN,NODE) ;Set the number of found lines for the found text.
+1 ;For regular and function findings.
+2 NEW IND,JND,LC,NCSUB,NFL,NNAME,NPIPE,RES,TEXT,WMSG
+3 SET NNAME=$SELECT(NODE=20:"finding",NODE=25:"function finding",1:"?")
+4 SET IND=0
+5 FOR
SET IND=+$ORDER(^PXD(811.9,RIEN,NODE,IND))
if IND=0
QUIT
Begin DoDot:1
+6 ;Found text
+7 SET (JND,LC,NCSUB,NPIPE)=0
+8 FOR
SET JND=$ORDER(^PXD(811.9,RIEN,NODE,IND,1,JND))
if JND=""
QUIT
Begin DoDot:2
+9 SET TEXT=^PXD(811.9,RIEN,NODE,IND,1,JND,0)
+10 IF TEXT["$$CSUB"
SET NCSUB=NCSUB+1
+11 SET NPIPE=NPIPE+$LENGTH(TEXT,"|")-1
+12 SET LC=LC+1
End DoDot:2
+13 SET NFL=LC
+14 IF (NPIPE#2)=1
Begin DoDot:2
+15 SET WMSG="found text for "_NNAME_" "_IND
+16 DO TIUOBJW(WMSG,NPIPE)
End DoDot:2
+17 IF NCSUB>0
SET NFL=NFL_"C"
+18 IF NPIPE>1
SET NFL=NFL_"T"
+19 ;Not found text
+20 SET (JND,LC,NCSUB,NPIPE)=0
+21 FOR
SET JND=$ORDER(^PXD(811.9,RIEN,NODE,IND,2,JND))
if JND=""
QUIT
Begin DoDot:2
+22 SET TEXT=^PXD(811.9,RIEN,NODE,IND,2,JND,0)
+23 IF TEXT["$$CSUB"
SET NCSUB=NCSUB+1
+24 SET NPIPE=NPIPE+$LENGTH(TEXT,"|")-1
+25 SET LC=LC+1
End DoDot:2
+26 IF (NPIPE#2)=1
Begin DoDot:2
+27 SET WMSG="not found text for "_NNAME_" "_IND
+28 DO TIUOBJW(WMSG,NPIPE)
End DoDot:2
+29 IF NCSUB>0
SET LC=LC_"C"
+30 IF NPIPE>1
SET LC=LC_"T"
+31 SET ^PXD(811.9,RIEN,NODE,IND,6)=NFL_U_LC
End DoDot:1
+32 QUIT
+33 ;
+34 ;===============
SNMLL(RIEN) ;Set the number of lines for the logic found/not found
+1 ;text. Append a "T" to the number of lines if the text contains
+2 ;a TIU object.
+3 NEW CSTR,CSUB,IND,LC,NPIPE,RES,SUB,TEXT,TTYPE
+4 ;SUB=60 General cohort found text
+5 ;SUB=61 General cohort not found text
+6 ;SUB=65 General resolution found text
+7 ;SUB=66 General resolution not found text
+8 ;SUB=70 Summary cohort found text
+9 ;SUB=71 Summary cohort not found text
+10 ;SUB=75 Summary resolution found text
+11 ;SUB=76 Summary resolution not found text
+12 ;SUB=83 Contraindicated true text
+13 ;SUB=84 Contraindicated false text
+14 ;SUB=93 Refused true tex
+15 ;SUB=94 Refused false text
+16 FOR SUB=60,61,65,66,70,71,75,76,83,84,93,94
Begin DoDot:1
+17 SET (IND,LC,NCSUB,NPIPE)=0
+18 FOR
SET IND=$ORDER(^PXD(811.9,RIEN,SUB,IND))
if IND=""
QUIT
Begin DoDot:2
+19 SET TEXT=^PXD(811.9,RIEN,SUB,IND,0)
+20 IF TEXT["$$CSUB"
SET NCSUB=NCSUB+1
+21 SET NPIPE=NPIPE+$LENGTH(TEXT,"|")-1
+22 SET LC=LC+1
End DoDot:2
+23 IF (NPIPE#2)=1
Begin DoDot:2
+24 IF SUB=60
SET TTYPE="general cohort found text"
+25 IF SUB=61
SET TTYPE="general cohort not found text"
+26 IF SUB=65
SET TTYPE="general resolution found text"
+27 IF SUB=66
SET TTYPE="general resolution not found text"
+28 IF SUB=70
SET TTYPE="summary cohort found text"
+29 IF SUB=71
SET TTYPE="summary cohort not found text"
+30 IF SUB=75
SET TTYPE="summary resolution found text"
+31 IF SUB=76
SET TTYPE="summary resolution not found text"
+32 IF SUB=83
SET TTYPE="contraindicated true text"
+33 IF SUB=84
SET TTYPE="contraindicated false text"
+34 IF SUB=93
SET TTYPE="refused true text"
+35 IF SUB=94
SET TTYPE="refused false text"
+36 DO TIUOBJW(TTYPE,NPIPE)
End DoDot:2
+37 IF NCSUB>0
SET LC=LC_"C"
+38 IF NPIPE>1
SET LC=LC_"T"
+39 IF SUB=60
SET CSTR=LC
+40 IF SUB=61
SET ^PXD(811.9,RIEN,62)=CSTR_U_LC
+41 IF SUB=65
SET CSTR=LC
+42 IF SUB=66
SET ^PXD(811.9,RIEN,67)=CSTR_U_LC
+43 IF SUB=70
SET CSTR=LC
+44 IF SUB=71
SET ^PXD(811.9,RIEN,72)=CSTR_U_LC
+45 IF SUB=75
SET CSTR=LC
+46 IF SUB=76
SET ^PXD(811.9,RIEN,77)=CSTR_U_LC
+47 IF SUB=83
SET CSTR=LC
+48 IF SUB=84
SET ^PXD(811.9,RIEN,85)=CSTR_U_LC
+49 IF SUB=93
SET CSTR=LC
+50 IF SUB=94
SET ^PXD(811.9,RIEN,95)=CSTR_U_LC
End DoDot:1
+51 QUIT
+52 ;
+53 ;===============
TIUOBJW(WMSG,NPIPE) ;Odd number of "|" characters in text, issue
+1 ;a warning that TIU OBJ expansion will not work.
+2 NEW TEXT
+3 SET TEXT(1)=""
+4 SET TEXT(2)="Warning, "_WMSG_" has "_NPIPE_" ""|"" characters."
+5 SET TEXT(3)="Because this is an odd number, TIU Object expansion will not work."
+6 DO MES^XPDUTL(.TEXT)
+7 QUIT
+8 ;
