PXRMCF ;SLC/PKR - Handle computed findings. ;11/18/2019
;;2.0;CLINICAL REMINDERS;**6,12,18,26,42**;Feb 04, 2005;Build 245
;
;=======================================================
HELP(IEN) ;Display help for a computed finding.
N ANS,IND,N,OUTPUT,TEMP,TEXT
S TEMP=^PXRMD(811.4,IEN,0)
S TEXT="Display help for CF."_$P(TEMP,U,1)
S ANS=$$ASKYN^PXRMEUT("N",TEXT)
I ANS=0 Q
S TITLE="Computed Finding Description"
S OUTPUT(1)="Computed finding: "_$P(TEMP,U,1)
S OUTPUT(2)="Type: "_$$EXTERNAL^DILFD(811.4,5,"",$P(TEMP,U,5),"")
S OUTPUT(3)="Class: "_$$EXTERNAL^DILFD(811.4,100,"",$P(^PXRMD(811.4,IEN,100),U,1),"")
S OUTPUT(4)=""
S IND=0,NL=4
F S IND=+$O(^PXRMD(811.4,IEN,1,IND)) Q:IND=0 D
. S NL=NL+1,OUTPUT(NL)=^PXRMD(811.4,IEN,1,IND,0)
I NL=4 S OUTPUT(4)="There is no description for this computed finding."
D BROWSE^DDBR("OUTPUT","NR","Computed Finding Help")
Q
;
;=======================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate computed findings.
N FIEVT,FILENUM,FINDING,FINDPA,ITEM
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
S ITEM=""
F S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:+ITEM=0 D
. S FINDING=""
. F S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0 D
.. K FINDPA
.. M FINDPA=DEFARR(20,FINDING)
.. K FIEVT
.. D FIEVAL(FILENUM,DFN,ITEM,.FINDPA,.FIEVT)
.. M FIEVAL(FINDING)=FIEVT
.. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
Q
;
;=======================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Patient list evaluator.
;Return the list in ^TMP($J,PLIST)
N ITEM,FILENUM,PFINDPA
N TEMP,TFINDING,TFINDPA
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
S ITEM=""
F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
. S TFINDING=""
. F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
.. K PFINDPA,TFINDPA
.. M TFINDPA=TERMARR(20,TFINDING)
..;Set the finding parameters.
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
.. D GPLIST(FILENUM,ITEM,.PFINDPA,PLIST)
Q
;
;=======================================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;General term
;evaluator.
N FIEVT,FILENUM,ITEM,PFINDPA
N TEMP,TFINDING,TFINDPA
S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
S ITEM=""
F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
. S TFINDING=""
. F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
.. K FIEVT,PFINDPA,TFINDPA
.. M TFINDPA=TERMARR(20,TFINDING)
..;Set the finding parameters.
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
.. D FIEVAL(FILENUM,DFN,ITEM,.PFINDPA,.FIEVT)
.. M TFIEVAL(TFINDING)=FIEVT
.. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
Q
;
;=======================================================
FIEVAL(FILENUM,DFN,ITEM,PFINDPA,FIEVAL) ;
;Evaluate regular patient findings.
N BDT,CASESEN,COND,CONVAL,DAS,DATA,DATE,EDT,FLIST,ICOND,IND
N NFOUND,NGET,NOCC,NP,PDATA,ROUTINE
N SAVE,SDIR,STATUSA,TEMP,TEST,TEXT,TYPE,UCIFS,VALUE,VSLIST
;Set the finding search parameters.
D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
I $G(PXRMDEBG) S FIEVAL("BDTE")=BDT,FIEVAL("EDTE")=EDT
S SDIR=$S(NOCC<0:+1,1:-1)
S TEST=PFINDPA(15)
D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
;Make sure NGET has the same sign as NOCC.
I NGET'=NOCC S NGET=NGET*($$ABS^XLFMTH(NOCC)/NOCC)
S TEMP=^PXRMD(811.4,ITEM,0)
S TYPE=$P(TEMP,U,5)
I TYPE="" S TYPE="S"
I TYPE="S" D
. S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,.TEST,.DATE,.VALUE,.TEXT)"
. D @ROUTINE
.;Make sure that the date is in range.
. I TEST,DATE'<BDT,DATE'>EDT S NFOUND=1
. E S NFOUND=0
. I NFOUND D
.. S TEST(1)=TEST,DATE(1)=DATE,TEXT(1)=$G(TEXT)
.. S DATA(1,"VALUE")=$G(VALUE)
.. I $D(VALUE)=11 S IND="" F S IND=$O(VALUE(IND)) Q:IND="" S DATA(1,IND)=VALUE(IND)
I TYPE="M" D
. S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)"
. D @ROUTINE
I TYPE'="S",TYPE'="M" D
. S NFOUND=0
. S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","COMPUTED FINDING - WRONG TYPE")="Warning: CF "_TYPE_" is not suitable for reminder evaluation."
I NFOUND=0 S FIEVAL=0 Q
S NP=0
F IND=1:1:NFOUND Q:NP=NOCC D
. S DATA(IND,"DATE")=DATE(IND)
. I TEST(IND),COND'="" D
.. K PDATA M PDATA=DATA(IND)
.. S CONVAL=$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.PDATA)
. E S CONVAL=TEST(IND)
. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
. I SAVE D
.. S NP=NP+1
.. S FIEVAL(NP)=CONVAL
.. ;S FIEVAL(NP,"CONDITION TEXT")=ICOND
.. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
.. S FIEVAL(NP,"DATE")=DATE(IND)
.. M FIEVAL(NP,"TEXT")=TEXT(IND)
.. M FIEVAL(NP)=DATA(IND)
.. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=DATA(IND)
;
;Save the finding result.
D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
S FIEVAL("FILE NUMBER")=FILENUM
Q
;
;=======================================================
GPLIST(FILENUM,CFIEN,PFINDPA,PLIST) ;Add to the patient list
;for a regular file.
N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DATA,DFN,FLIST
N ICOND,IND,IPLIST
N NOCC,NOCCABS,NFOUND,NGET,NP,PARAM,ROUTINE
N SAVE,STATUSA,TEMP,TEXT,TGLIST,TPLIST,TYPE
N UCIFS,VALUE,VSLIST
S TEMP=^PXRMD(811.4,CFIEN,0)
S TYPE=$P(TEMP,U,5)
I TYPE'="L" Q
S TGLIST="GPLIST_PXRMCF"
S PARAM=PFINDPA(15)
;Set the finding search parameters.
D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
S NOCCABS=$$ABS^XLFMTH(NOCC)
D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCCABS)
K ^TMP($J,TGLIST)
S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(NGET,BDT,EDT,TGLIST,PARAM)"
D @ROUTINE
;Routine should return:
;^TMP($J,TGLIST,DFN,N)=DAS_U_DATE_U_FILENUM_U_ITEM_U_VALUE
;Data values for condition are returned in
;^TMP($J,TGLIST,DFN,N,SUB)=DATA(SUB)
S DFN=""
F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
. K TPLIST
. M TPLIST=^TMP($J,TGLIST,DFN)
. S (IND,NFOUND)=0
. K IPLIST
. F S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCCABS) D
.. S TEMP=TPLIST(IND)
.. K DATA M DATA=TPLIST(IND)
.. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.DATA),1:1)
.. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
.. I SAVE D
... S NFOUND=NFOUND+1
... S IPLIST(CONVAL,DFN,CFIEN,NFOUND,FILENUM)=TEMP
. M ^TMP($J,PLIST)=IPLIST
K ^TMP($J,TGLIST)
Q
;
;=======================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
N DATA,DATE,FIEN,IND,JND,KND,NAME,NOUT,PNAME,TEMP,TEXTOUT,VALUE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
S TEMP=^PXRMD(811.4,FIEN,0)
S PNAME=$P(TEMP,U,4)
I PNAME="" S PNAME=$P(TEMP,U,1)
S NAME="Computed Finding: "_PNAME_" = "
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S VALUE=$G(IFIEVAL(IND,"VALUE"))
. S DATE=IFIEVAL(IND,"DATE")
. S TEMP=NAME_VALUE_" ("_$$EDATE^PXRMDATE(DATE)_")"
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
.;If there is additional text output each line separately.
. S KND=""
. F S KND=$O(IFIEVAL(IND,"TEXT",KND)) Q:KND="" D
.. D FORMATS^PXRMTEXT(INDENT+4,PXRMRM,IFIEVAL(IND,"TEXT",KND),.NOUT,.TEXTOUT)
.. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
;=======================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
;maintenance output.
N DATA,DATE,FIEN,IND,JND,KND,NOUT,PNAME,TEMP,TEXTOUT,VALUE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
S TEMP=^PXRMD(811.4,FIEN,0)
S PNAME=$P(TEMP,U,4)
I PNAME="" S PNAME=$P(TEMP,U,1)
S NLINES=NLINES+1
S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Computed Finding: "_PNAME
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S DATE=IFIEVAL(IND,"DATE")
. S TEMP=$$EDATE^PXRMDATE(DATE)
. S VALUE=$G(IFIEVAL(IND,"VALUE"))
. I VALUE'="" S TEMP=TEMP_" value - "_VALUE
.;If there is text append it.
. I $G(IFIEVAL(IND,"TEXT"))'="" S TEMP=TEMP_"; "_IFIEVAL(IND,"TEXT")
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
.;If there is additional text output each line separately.
. S KND=""
. F S KND=$O(IFIEVAL(IND,"TEXT",KND)) Q:KND="" D
.. D FORMATS^PXRMTEXT(INDENT+4,PXRMRM,IFIEVAL(IND,"TEXT",KND),.NOUT,.TEXTOUT)
.. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCF 8479 printed Oct 16, 2024@17:44:01 Page 2
PXRMCF ;SLC/PKR - Handle computed findings. ;11/18/2019
+1 ;;2.0;CLINICAL REMINDERS;**6,12,18,26,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;=======================================================
HELP(IEN) ;Display help for a computed finding.
+1 NEW ANS,IND,N,OUTPUT,TEMP,TEXT
+2 SET TEMP=^PXRMD(811.4,IEN,0)
+3 SET TEXT="Display help for CF."_$PIECE(TEMP,U,1)
+4 SET ANS=$$ASKYN^PXRMEUT("N",TEXT)
+5 IF ANS=0
QUIT
+6 SET TITLE="Computed Finding Description"
+7 SET OUTPUT(1)="Computed finding: "_$PIECE(TEMP,U,1)
+8 SET OUTPUT(2)="Type: "_$$EXTERNAL^DILFD(811.4,5,"",$PIECE(TEMP,U,5),"")
+9 SET OUTPUT(3)="Class: "_$$EXTERNAL^DILFD(811.4,100,"",$PIECE(^PXRMD(811.4,IEN,100),U,1),"")
+10 SET OUTPUT(4)=""
+11 SET IND=0
SET NL=4
+12 FOR
SET IND=+$ORDER(^PXRMD(811.4,IEN,1,IND))
if IND=0
QUIT
Begin DoDot:1
+13 SET NL=NL+1
SET OUTPUT(NL)=^PXRMD(811.4,IEN,1,IND,0)
End DoDot:1
+14 IF NL=4
SET OUTPUT(4)="There is no description for this computed finding."
+15 DO BROWSE^DDBR("OUTPUT","NR","Computed Finding Help")
+16 QUIT
+17 ;
+18 ;=======================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate computed findings.
+1 NEW FIEVT,FILENUM,FINDING,FINDPA,ITEM
+2 SET FILENUM=$$GETFNUM^PXRMDATA(ENODE)
+3 SET ITEM=""
+4 FOR
SET ITEM=$ORDER(DEFARR("E",ENODE,ITEM))
if +ITEM=0
QUIT
Begin DoDot:1
+5 SET FINDING=""
+6 FOR
SET FINDING=$ORDER(DEFARR("E",ENODE,ITEM,FINDING))
if +FINDING=0
QUIT
Begin DoDot:2
+7 KILL FINDPA
+8 MERGE FINDPA=DEFARR(20,FINDING)
+9 KILL FIEVT
+10 DO FIEVAL(FILENUM,DFN,ITEM,.FINDPA,.FIEVT)
+11 MERGE FIEVAL(FINDING)=FIEVT
+12 SET FIEVAL(FINDING,"FINDING")=$PIECE(FINDPA(0),U,1)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
+15 ;=======================================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Patient list evaluator.
+1 ;Return the list in ^TMP($J,PLIST)
+2 NEW ITEM,FILENUM,PFINDPA
+3 NEW TEMP,TFINDING,TFINDPA
+4 SET FILENUM=$$GETFNUM^PXRMDATA(ENODE)
+5 SET ITEM=""
+6 FOR
SET ITEM=$ORDER(TERMARR("E",ENODE,ITEM))
if +ITEM=0
QUIT
Begin DoDot:1
+7 SET TFINDING=""
+8 FOR
SET TFINDING=$ORDER(TERMARR("E",ENODE,ITEM,TFINDING))
if +TFINDING=0
QUIT
Begin DoDot:2
+9 KILL PFINDPA,TFINDPA
+10 MERGE TFINDPA=TERMARR(20,TFINDING)
+11 ;Set the finding parameters.
+12 DO SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+13 DO GPLIST(FILENUM,ITEM,.PFINDPA,PLIST)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
+16 ;=======================================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;General term
+1 ;evaluator.
+2 NEW FIEVT,FILENUM,ITEM,PFINDPA
+3 NEW TEMP,TFINDING,TFINDPA
+4 SET FILENUM=$$GETFNUM^PXRMDATA(ENODE)
+5 SET ITEM=""
+6 FOR
SET ITEM=$ORDER(TERMARR("E",ENODE,ITEM))
if +ITEM=0
QUIT
Begin DoDot:1
+7 SET TFINDING=""
+8 FOR
SET TFINDING=$ORDER(TERMARR("E",ENODE,ITEM,TFINDING))
if +TFINDING=0
QUIT
Begin DoDot:2
+9 KILL FIEVT,PFINDPA,TFINDPA
+10 MERGE TFINDPA=TERMARR(20,TFINDING)
+11 ;Set the finding parameters.
+12 DO SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+13 DO FIEVAL(FILENUM,DFN,ITEM,.PFINDPA,.FIEVT)
+14 MERGE TFIEVAL(TFINDING)=FIEVT
+15 SET TFIEVAL(TFINDING,"FINDING")=$PIECE(TFINDPA(0),U,1)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ;=======================================================
FIEVAL(FILENUM,DFN,ITEM,PFINDPA,FIEVAL) ;
+1 ;Evaluate regular patient findings.
+2 NEW BDT,CASESEN,COND,CONVAL,DAS,DATA,DATE,EDT,FLIST,ICOND,IND
+3 NEW NFOUND,NGET,NOCC,NP,PDATA,ROUTINE
+4 NEW SAVE,SDIR,STATUSA,TEMP,TEST,TEXT,TYPE,UCIFS,VALUE,VSLIST
+5 ;Set the finding search parameters.
+6 DO SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
+7 IF $GET(PXRMDEBG)
SET FIEVAL("BDTE")=BDT
SET FIEVAL("EDTE")=EDT
+8 SET SDIR=$SELECT(NOCC<0:+1,1:-1)
+9 SET TEST=PFINDPA(15)
+10 DO SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
+11 SET NGET=$SELECT(UCIFS:50,$DATA(STATUSA):50,1:NOCC)
+12 ;Make sure NGET has the same sign as NOCC.
+13 IF NGET'=NOCC
SET NGET=NGET*($$ABS^XLFMTH(NOCC)/NOCC)
+14 SET TEMP=^PXRMD(811.4,ITEM,0)
+15 SET TYPE=$PIECE(TEMP,U,5)
+16 IF TYPE=""
SET TYPE="S"
+17 IF TYPE="S"
Begin DoDot:1
+18 SET ROUTINE=$PIECE(TEMP,U,3)_"^"_$PIECE(TEMP,U,2)_"(DFN,.TEST,.DATE,.VALUE,.TEXT)"
+19 DO @ROUTINE
+20 ;Make sure that the date is in range.
+21 IF TEST
IF DATE'<BDT
IF DATE'>EDT
SET NFOUND=1
+22 IF '$TEST
SET NFOUND=0
+23 IF NFOUND
Begin DoDot:2
+24 SET TEST(1)=TEST
SET DATE(1)=DATE
SET TEXT(1)=$GET(TEXT)
+25 SET DATA(1,"VALUE")=$GET(VALUE)
+26 IF $DATA(VALUE)=11
SET IND=""
FOR
SET IND=$ORDER(VALUE(IND))
if IND=""
QUIT
SET DATA(1,IND)=VALUE(IND)
End DoDot:2
End DoDot:1
+27 IF TYPE="M"
Begin DoDot:1
+28 SET ROUTINE=$PIECE(TEMP,U,3)_"^"_$PIECE(TEMP,U,2)_"(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)"
+29 DO @ROUTINE
End DoDot:1
+30 IF TYPE'="S"
IF TYPE'="M"
Begin DoDot:1
+31 SET NFOUND=0
+32 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"WARNING","COMPUTED FINDING - WRONG TYPE")="Warning: CF "_TYPE_" is not suitable for reminder evaluation."
End DoDot:1
+33 IF NFOUND=0
SET FIEVAL=0
QUIT
+34 SET NP=0
+35 FOR IND=1:1:NFOUND
if NP=NOCC
QUIT
Begin DoDot:1
+36 SET DATA(IND,"DATE")=DATE(IND)
+37 IF TEST(IND)
IF COND'=""
Begin DoDot:2
+38 KILL PDATA
MERGE PDATA=DATA(IND)
+39 SET CONVAL=$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.PDATA)
End DoDot:2
+40 IF '$TEST
SET CONVAL=TEST(IND)
+41 SET SAVE=$SELECT('UCIFS:1,(UCIFS&CONVAL):1,1:0)
+42 IF SAVE
Begin DoDot:2
+43 SET NP=NP+1
+44 SET FIEVAL(NP)=CONVAL
+45 ;S FIEVAL(NP,"CONDITION TEXT")=ICOND
+46 IF COND'=""
SET FIEVAL(NP,"CONDITION")=CONVAL
+47 SET FIEVAL(NP,"DATE")=DATE(IND)
+48 MERGE FIEVAL(NP,"TEXT")=TEXT(IND)
+49 MERGE FIEVAL(NP)=DATA(IND)
+50 IF $GET(PXRMDEBG)
MERGE FIEVAL(NP,"CSUB")=DATA(IND)
End DoDot:2
End DoDot:1
+51 ;
+52 ;Save the finding result.
+53 DO SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
+54 SET FIEVAL("FILE NUMBER")=FILENUM
+55 QUIT
+56 ;
+57 ;=======================================================
GPLIST(FILENUM,CFIEN,PFINDPA,PLIST) ;Add to the patient list
+1 ;for a regular file.
+2 NEW BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DATA,DFN,FLIST
+3 NEW ICOND,IND,IPLIST
+4 NEW NOCC,NOCCABS,NFOUND,NGET,NP,PARAM,ROUTINE
+5 NEW SAVE,STATUSA,TEMP,TEXT,TGLIST,TPLIST,TYPE
+6 NEW UCIFS,VALUE,VSLIST
+7 SET TEMP=^PXRMD(811.4,CFIEN,0)
+8 SET TYPE=$PIECE(TEMP,U,5)
+9 IF TYPE'="L"
QUIT
+10 SET TGLIST="GPLIST_PXRMCF"
+11 SET PARAM=PFINDPA(15)
+12 ;Set the finding search parameters.
+13 DO SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
+14 SET NOCCABS=$$ABS^XLFMTH(NOCC)
+15 DO SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
+16 SET NGET=$SELECT(UCIFS:50,$DATA(STATUSA):50,1:NOCCABS)
+17 KILL ^TMP($JOB,TGLIST)
+18 SET ROUTINE=$PIECE(TEMP,U,3)_"^"_$PIECE(TEMP,U,2)_"(NGET,BDT,EDT,TGLIST,PARAM)"
+19 DO @ROUTINE
+20 ;Routine should return:
+21 ;^TMP($J,TGLIST,DFN,N)=DAS_U_DATE_U_FILENUM_U_ITEM_U_VALUE
+22 ;Data values for condition are returned in
+23 ;^TMP($J,TGLIST,DFN,N,SUB)=DATA(SUB)
+24 SET DFN=""
+25 FOR
SET DFN=$ORDER(^TMP($JOB,TGLIST,DFN))
if DFN=""
QUIT
Begin DoDot:1
+26 KILL TPLIST
+27 MERGE TPLIST=^TMP($JOB,TGLIST,DFN)
+28 SET (IND,NFOUND)=0
+29 KILL IPLIST
+30 FOR
SET IND=$ORDER(TPLIST(IND))
if (IND="")!(NFOUND=NOCCABS)
QUIT
Begin DoDot:2
+31 SET TEMP=TPLIST(IND)
+32 KILL DATA
MERGE DATA=TPLIST(IND)
+33 SET CONVAL=$SELECT(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.DATA),1:1)
+34 SET SAVE=$SELECT('UCIFS:1,(UCIFS&CONVAL):1,1:0)
+35 IF SAVE
Begin DoDot:3
+36 SET NFOUND=NFOUND+1
+37 SET IPLIST(CONVAL,DFN,CFIEN,NFOUND,FILENUM)=TEMP
End DoDot:3
End DoDot:2
+38 MERGE ^TMP($JOB,PLIST)=IPLIST
End DoDot:1
+39 KILL ^TMP($JOB,TGLIST)
+40 QUIT
+41 ;
+42 ;=======================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW DATA,DATE,FIEN,IND,JND,KND,NAME,NOUT,PNAME,TEMP,TEXTOUT,VALUE
+2 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+3 SET TEMP=^PXRMD(811.4,FIEN,0)
+4 SET PNAME=$PIECE(TEMP,U,4)
+5 IF PNAME=""
SET PNAME=$PIECE(TEMP,U,1)
+6 SET NAME="Computed Finding: "_PNAME_" = "
+7 SET IND=0
+8 FOR
SET IND=+$ORDER(IFIEVAL(IND))
if IND=0
QUIT
Begin DoDot:1
+9 SET VALUE=$GET(IFIEVAL(IND,"VALUE"))
+10 SET DATE=IFIEVAL(IND,"DATE")
+11 SET TEMP=NAME_VALUE_" ("_$$EDATE^PXRMDATE(DATE)_")"
+12 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+13 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+14 ;If there is additional text output each line separately.
+15 SET KND=""
+16 FOR
SET KND=$ORDER(IFIEVAL(IND,"TEXT",KND))
if KND=""
QUIT
Begin DoDot:2
+17 DO FORMATS^PXRMTEXT(INDENT+4,PXRMRM,IFIEVAL(IND,"TEXT",KND),.NOUT,.TEXTOUT)
+18 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:2
End DoDot:1
+19 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+20 QUIT
+21 ;
+22 ;=======================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 NEW DATA,DATE,FIEN,IND,JND,KND,NOUT,PNAME,TEMP,TEXTOUT,VALUE
+3 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+4 SET TEMP=^PXRMD(811.4,FIEN,0)
+5 SET PNAME=$PIECE(TEMP,U,4)
+6 IF PNAME=""
SET PNAME=$PIECE(TEMP,U,1)
+7 SET NLINES=NLINES+1
+8 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Computed Finding: "_PNAME
+9 SET IND=0
+10 FOR
SET IND=+$ORDER(IFIEVAL(IND))
if IND=0
QUIT
Begin DoDot:1
+11 SET DATE=IFIEVAL(IND,"DATE")
+12 SET TEMP=$$EDATE^PXRMDATE(DATE)
+13 SET VALUE=$GET(IFIEVAL(IND,"VALUE"))
+14 IF VALUE'=""
SET TEMP=TEMP_" value - "_VALUE
+15 ;If there is text append it.
+16 IF $GET(IFIEVAL(IND,"TEXT"))'=""
SET TEMP=TEMP_"; "_IFIEVAL(IND,"TEXT")
+17 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+18 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
+19 ;If there is additional text output each line separately.
+20 SET KND=""
+21 FOR
SET KND=$ORDER(IFIEVAL(IND,"TEXT",KND))
if KND=""
QUIT
Begin DoDot:2
+22 DO FORMATS^PXRMTEXT(INDENT+4,PXRMRM,IFIEVAL(IND,"TEXT",KND),.NOUT,.TEXTOUT)
+23 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:2
End DoDot:1
+24 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+25 QUIT
+26 ;
