PXRMCF.m

PXRMCF ;SLC/PKR - Handle computed findings. ;02/07/2014

 ;;2.0;CLINICAL REMINDERS;**6,12,18,26**;Feb 04, 2005;Build 404

 ;

 ;=======================================================

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")=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

 .. 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

 ;

PXRMCF    ;SLC/PKR - Handle computed findings. ;02/07/2014

 +1       ;;2.0;CLINICAL REMINDERS;**6,12,18,26**;Feb 04, 2005;Build 404

 +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")=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                       IF COND'=""

                               SET FIEVAL(NP,"CONDITION")=CONVAL

 +46                       SET FIEVAL(NP,"DATE")=DATE(IND)

 +47                       MERGE FIEVAL(NP,"TEXT")=TEXT(IND)

 +48                       MERGE FIEVAL(NP)=DATA(IND)

 +49                       IF $GET(PXRMDEBG)

                               MERGE FIEVAL(NP,"CSUB")=DATA(IND)

                       End DoDot:2

               End DoDot:1

 +50      ;

 +51      ;Save the finding result.

 +52       DO SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)

 +53       SET FIEVAL("FILE NUMBER")=FILENUM

 +54       QUIT 

 +55      ;

 +56      ;=======================================================

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      ;