PXRMDEV.m

PXRMDEV ;SLC/PKR - This is a driver for testing Clinical Reminders. ;06/23/2020

 ;;2.0;CLINICAL REMINDERS;**4,6,11,16,18,24,26,47,45,46,42**;Feb 04, 2005;Build 245

 ;

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

DEB ;Prompt for patient and reminder by name input component.

 N DATE,DFN,DIC,DIR,DIROUT,DTOUT,DUOUT,HASFF,HASTERM,IND

 N PXRHM,PXRMFFSS,PXRMITEM,PXRMTDEB,X,Y

 S DIC=2,DIC("A")="Select Patient: "

 S DIC(0)="AEQMZ"

GPAT1 D ^DIC

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S DFN=+$P(Y,U,1)

 I DFN=-1 G GPAT1

 S DIC=811.9,DIC("A")="Select Reminder: "

GREM1 D ^DIC

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S PXRMITEM=+$P(Y,U,1)

 I PXRMITEM=-1 G GREM1

 S DIR(0)="LA"_U_"0"

 S DIR("A")="Enter component number 0, 1, 5, 10, 11, 12, 55: "

 D ^DIR

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 I X="" S X=5

 S PXRHM=X

 S DIR(0)="DA^"_0_"::ETX"

 S DIR("A")="Enter date for reminder evaluation: "

 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 W !

 D ^DIR K DIR

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S DATE=Y

 S (HASFF,HASTERM,PXRMFFSS,PXRMTDEB)=0

 I $D(^PXD(811.9,PXRMITEM,25,"B")) S HASFF=1

 I HASFF S PXRMFFSS=$$ASKYN^PXRMEUT("N","Display step-by-step function finding evaluation","","")

 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S HASTERM=1

 I 'HASTERM D

 . S IND=0

 . F  S IND=+$O(^PXD(811.9,PXRMITEM,20,"EDEP",IND)) Q:IND=0  D

 .. I $D(^PXD(811.9,PXRMITEM,20,"EDEP",IND,"PXRMD(811.5,")) S HASTERM=1

 I HASTERM S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","")

 D DOREM(DFN,PXRMITEM,PXRHM,DATE)

 Q

 ;

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

DEV ;Prompt for patient and reminder by name and evaluation date.

 N DATE,DFN,DIC,DIROUT,DIRUT,DTOUT,DUOUT,HASFF,HASTERM,IND

 N PXRHM,PXRMFFSS,PXRMITEM,PXRMTDEB,REF,X,Y

 S DIC=2,DIC("A")="Select Patient: "

 S DIC(0)="AEQMZ"

GPAT2 D ^DIC

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S DFN=+$P(Y,U,1)

 I DFN=-1 G GPAT2

 S DIC=811.9,DIC("A")="Select Reminder: "

GREM2 D ^DIC

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S PXRMITEM=+$P(Y,U,1)

 I PXRMITEM=-1 G GREM2

 S PXRHM=5

 S DIR(0)="DA^"_0_"::ET"

 S DIR("A")="Enter date for reminder evaluation: "

 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 W !

 D ^DIR K DIR

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S DATE=Y

 S (HASFF,HASTERM,PXRMFFSS,PXRMTDEB)=0

 I $D(^PXD(811.9,PXRMITEM,25,"B")) S HASFF=1

 I HASFF S PXRMFFSS=$$ASKYN^PXRMEUT("N","Display step-by-step function finding evaluation","","")

 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S HASTERM=1

 I 'HASTERM D

 . S IND=0

 . F  S IND=+$O(^PXD(811.9,PXRMITEM,20,"EDEP",IND)) Q:IND=0  D

 .. I $D(^PXD(811.9,PXRMITEM,20,"EDEP",IND,"PXRMD(811.5,")) S HASTERM=1

 I HASTERM S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","")

 D DOREM(DFN,PXRMITEM,PXRHM,DATE)

 Q

 ;

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

DISP01(FIEVAL) ;For Education Topics, Exams, and Health Factors the Print Name

 ;is displayed in the Clinical Maintenance Output. Since Print Names

 ;are not unique it can be difficult to determine what the actual

 ;finding is so display the .01.

 N IEN,IND

 S IND=0

 F  S IND=+$O(FIEVAL(IND)) Q:IND=0  D

 . I FIEVAL(IND)=0 Q

 . S IEN=$P(FIEVAL(IND,"FINDING"),";",1)

 . I FIEVAL(IND,"FILE NUMBER")=9000010.16 S FIEVAL(IND,"NAME")=$P(^AUTTEDT(IEN,0),U,1)

 . I FIEVAL(IND,"FILE NUMBER")=9000010.13 S FIEVAL(IND,"NAME")=$P(^AUTTEXAM(IEN,0),U,1)

 . I FIEVAL(IND,"FILE NUMBER")=9000010.23 S FIEVAL(IND,"FACTOR")=$P(^AUTTHF(IEN,0),U,1)

 Q

 ;

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

DOREM(DFN,PXRMITEM,PXRHM,DATE) ;Do the reminder

 ;Reference to XLFSHAN ICR #6157

 N BOP,DEFARR,END,FFN,FFNUMBER,FIEVAL,FINDING,IND,JND,NL,NOUT,OUTPUT

 N PNAME,PXRMDEBG,PXRMID,REF,RIEN,RNAME,START,STATUS

 N TEXT,TEXTOUT,TFIEVAL,TTEXT,WSTART,WEND,X

 ;This is a debugging run so set PXRMDEBG.

 S NL=0,PXRMDEBG=1

 S WSTART=$H

 S START=$$CPUTIME^XLFSHAN

 D DEF^PXRMLDR(PXRMITEM,.DEFARR)

 I +$G(DATE)=0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL)

 I +$G(DATE)>0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL,DATE)

 S END=$$CPUTIME^XLFSHAN

 S WEND=$H

 ;

 I $D(^TMP(PXRMID,$J,"FFDEB")) M FIEVAL=^TMP(PXRMID,$J,"FFDEB") K ^TMP(PXRMID,$J,"FFDEB")

 ;

 S TTEXT=^PXD(811.9,PXRMITEM,0)

 S PNAME=$P(TTEXT,U,2)

 I PNAME="" S PNAME=$P(TTEXT,U,1)

 S NL=NL+1,OUTPUT(NL)="Reminder: "_PNAME

 S NL=NL+1,OUTPUT(NL)="Patient: "_$$GET1^DIQ(2,DFN,.01)

 S NL=NL+1,OUTPUT(NL)="Reminder evaluation cpu time: "_$$ETIMEMS^XLFSHAN(START,END)

 S NL=NL+1,OUTPUT(NL)="Reminder evaluation clock time: "_$$HDIFF^XLFDT(WEND,WSTART,2)_" seconds"

 S NL=NL+1,OUTPUT(NL)=" "

 S NL=NL+1,OUTPUT(NL)="The elements of the FIEVAL array are:"

 S FFN="FF"

 F  S FFN=$O(FIEVAL(FFN)) Q:FFN'["FF"  D

 . S FFNUMBER=$P(FFN,"FF",2)

 . M FIEVAL("FF",FFNUMBER)=FIEVAL(FFN)

 . K FIEVAL(FFN)

 D DISP01(.FIEVAL)

 S REF="FIEVAL"

 D ACOPY^PXRMUTIL(REF,"TTEXT()")

 S IND=0

 F  S IND=$O(TTEXT(IND)) Q:IND=""  D

 . I $L(TTEXT(IND))<79 S NL=NL+1,OUTPUT(NL)=TTEXT(IND) Q

 . D FORMATS^PXRMTEXT(1,79,TTEXT(IND),.NOUT,.TEXTOUT)

 . F JND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(JND)

 ;

 I $G(PXRMFFSS) D

 . N FFN,STEP

 . S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="Step-by-step function finding evaluation:"

 . S FFNUMBER=0

 . F  S FFNUMBER=+$O(FIEVAL("FF",FFNUMBER)) Q:FFNUMBER=0  D

 .. S NL=NL+1,OUTPUT(NL)=""

 .. S NL=NL+1,OUTPUT(NL)=" Function finding "_FFNUMBER_"="_FIEVAL("FF",FFNUMBER)

 .. D FORMATS^PXRMTEXT(1,79,$P(FIEVAL("FF",FFNUMBER,"DETAIL"),U,2),.NOUT,.TEXTOUT)

 .. S FFN="FF"_FFNUMBER

 .. F JND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(JND)

 .. S NL=NL+1,OUTPUT(NL)=" = "_^TMP("PXRMFFSS",$J,FFN,0)

 .. S NL=NL+1,OUTPUT(NL)="Step  Result"

 .. S STEP=0

 .. F  S STEP=$O(^TMP("PXRMFFSS",$J,FFN,STEP)) Q:STEP=""  D

 ... S NL=NL+1,OUTPUT(NL)=$$RJ^XLFSTR(STEP_".",4," ")_"  "_^TMP("PXRMFFSS",$J,FFN,STEP)

 . K ^TMP("PXRMFFSS",$J)

 .;

 I $G(PXRMTDEB) D

 . S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="Term findings:"

 . S REF="TFIEVAL"

 . S FINDING=0

 . F  S FINDING=$O(^TMP("PXRMTDEB",$J,FINDING)) Q:FINDING=""  D

 .. K TFIEVAL M TFIEVAL(FINDING)=^TMP("PXRMTDEB",$J,FINDING)

 .. S NL=NL+1,OUTPUT(NL)="Finding "_FINDING_":"

 .. K TTEXT

 .. D ACOPY^PXRMUTIL(REF,"TTEXT()")

 .. S IND=0

 .. F  S IND=$O(TTEXT(IND)) Q:IND=""  S NL=NL+1,OUTPUT(NL)=TTEXT(IND)

 . K ^TMP("PXRMTDEB",$J)

 ;

 ;If CF.VA-ELIGIBILITY has been used as a finding display the VAEL array.

 I $D(^TMP("PXRMELIG",$J)) D

 . N VAEL

 . M VAEL=^TMP("PXRMELIG",$J)

 . K ^TMP("PXRMELIG",$J),TTEXT

 . D ACOPY^PXRMUTIL("VAEL","TTEXT()")

 . S NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="VAEL array returned by ELIG^VADPT:"

 . S IND=0

 . F  S IND=$O(TTEXT(IND)) Q:IND=""  S NL=NL+1,OUTPUT(NL)=TTEXT(IND)

 ;

 ;Display the demographic variables.

 S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 S NL=NL+1,OUTPUT(NL)="The demographic variables are:"

 S IND=""

 F  S IND=$O(^TMP("PXRMDEM",$J,IND)) Q:IND=""  D

 . S TEXT=^TMP("PXRMDEM",$J,IND)

 . I (IND="DOB")!(IND="DOD")!(IND="LAD") S TEXT=$$FMTE^XLFDT(TEXT,"5Z")

 . S NL=NL+1,OUTPUT(NL)=IND_"="_TEXT

 K ^TMP("PXRMDEM",$J)

 ;

 I $D(^TMP(PXRMID,$J)) D

 . S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="The elements of the ^TMP(PXRMID,$J) array are:"

 . S REF="^TMP(PXRMID,$J)"

 . K TTEXT

 . D ACOPY^PXRMUTIL(REF,"TTEXT()")

 . S IND=0

 . F  S IND=$O(TTEXT(IND)) Q:IND=""  S NL=NL+1,OUTPUT(NL)=TTEXT(IND)

 . K ^TMP(PXRMID,$J)

 ;

 I $D(^TMP("PXRHM",$J)) D

 . S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="The elements of the ^TMP(""PXRHM"",$J) array are:"

 . S REF="^TMP(""PXRHM"",$J)"

 . K TTEXT

 . D ACOPY^PXRMUTIL(REF,"TTEXT()")

 . S IND=0

 . F  S IND=$O(TTEXT(IND)) Q:IND=""  S NL=NL+1,OUTPUT(NL)=TTEXT(IND)

 ;

 I (PXRHM=0)!(PXRHM=1)!(PXRHM=5)!(PXRHM=55) D

 . S TEXT=$S(PXRHM=0:"Due Now ",PXRHM=1:"Summary ",PXRHM=5:"Clinical Maintenance ",PXRHM=55:"Order Check ",1:"")

 . S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)=TEXT_"Output:"

 . D FMTOUT^PXRMFMTO("PXRHM",.NL,.OUTPUT)

 I (PXRHM=10)!(PXRHM=11) D

 . S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="MHV "_$S(PXRHM=10:"Summary",PXRHM=11:"Detailed")_" Output:"

 . S RIEN=$O(^TMP("PXRHM",$J,""))

 . S RNAME=$O(^TMP("PXRHM",$J,RIEN,""))

 . S STATUS=$P($G(^TMP("PXRHM",$J,RIEN,RNAME)),U,1)

 . I STATUS="" S STATUS="UNKNOWN"

 . M ^TMP("PXRMMHV",$J,STATUS,RNAME,RIEN)=^TMP("PXRHM",$J,RIEN,RNAME)

 . D MHVOUT^PXRMFMTO("PXRMMHV",STATUS,RNAME,RIEN,.NL,.OUTPUT)

 I PXRHM=12 D

 . S NL=NL+1,OUTPUT(NL)="",NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="MHV Combined Output:"

 . D MHVCOUT^PXRMFMTO("PXRMMHVC",.NL,.OUTPUT)

 K ^TMP("PXRM",$J),^TMP("PXRHM",$J),^TMP("PXRMMHV",$J),^TMP("PXRMMHVC",$J)

 S BOP=$$BORP^PXRMUTIL("P")

 I BOP="B" D

 . S X="IORESET"

 . D ENDR^%ZISS

 . D BROWSE^DDBR("OUTPUT","NR","Reminder Test")

 . W IORESET

 . D KILL^%ZISS

 I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")

 Q

 ;

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

TERM ;

 N DFN,DIC,DIROUT,DIRUT,DTOUT,DUOUT

 N FIEVAL,FINDPA,IND,MAXOCC,OCC,TERMIEN,TERMARR

 S DIC=2,DIC("A")="Select Patient: "

 S DIC(0)="AEQMZ"

TPAT D ^DIC

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S DFN=+$P(Y,U,1)

 I DFN=-1 G TPAT

 S DIC=811.5,DIC("A")="Select Reminder Term: "

TTERM D ^DIC

 I $D(DIROUT)!$D(DIRUT) Q

 I $D(DTOUT)!$D(DUOUT) Q

 S TERMIEN=+$P(Y,U,1)

 I TERMIEN=-1 G TTERM

 D TERM^PXRMLDR(TERMIEN,.TERMARR)

 S IND=0,MAXOCC=1

 F  S IND=+$O(TERMARR(20,IND)) Q:IND=0  D

 . I $P(TERMARR(20,IND,3),U,3)=1 S MAXOCC=50 Q

 . S OCC=+$P(TERMARR(20,IND,0),U,14)

 . I OCC>MAXOCC S MAXOCC=OCC

 S $P(FINDPA(0),U,14)=MAXOCC

 D IEVALTER^PXRMTERM(DFN,.FINDPA,.TERMARR,1,.FIEVAL)

 D DISP01(.FIEVAL)

 W !,"The term is "_$S($G(FIEVAL(1))=1:"True",1:"False")

 W !,"FIEVAL:"

 D AWRITE^PXRMUTIL("FIEVAL")

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMDEV   9949     printed  Feb 18, 2025@23:10:04                                                                                                                                                                                                     Page 2

PXRMDEV   ;SLC/PKR - This is a driver for testing Clinical Reminders. ;06/23/2020

 +1       ;;2.0;CLINICAL REMINDERS;**4,6,11,16,18,24,26,47,45,46,42**;Feb 04, 2005;Build 245

 +2       ;

 +3       ;===============

DEB       ;Prompt for patient and reminder by name input component.

 +1        NEW DATE,DFN,DIC,DIR,DIROUT,DTOUT,DUOUT,HASFF,HASTERM,IND

 +2        NEW PXRHM,PXRMFFSS,PXRMITEM,PXRMTDEB,X,Y

 +3        SET DIC=2

           SET DIC("A")="Select Patient: "

 +4        SET DIC(0)="AEQMZ"

GPAT1      DO ^DIC

 +1        IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT 

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +3        SET DFN=+$PIECE(Y,U,1)

 +4        IF DFN=-1

               GOTO GPAT1

 +5        SET DIC=811.9

           SET DIC("A")="Select Reminder: "

GREM1      DO ^DIC

 +1        IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT 

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +3        SET PXRMITEM=+$PIECE(Y,U,1)

 +4        IF PXRMITEM=-1

               GOTO GREM1

 +5        SET DIR(0)="LA"_U_"0"

 +6        SET DIR("A")="Enter component number 0, 1, 5, 10, 11, 12, 55: "

 +7        DO ^DIR

 +8        IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT 

 +9        IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +10       IF X=""

               SET X=5

 +11       SET PXRHM=X

 +12       SET DIR(0)="DA^"_0_"::ETX"

 +13       SET DIR("A")="Enter date for reminder evaluation: "

 +14       SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 +15       SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +16       WRITE !

 +17       DO ^DIR

           KILL DIR

 +18       IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT 

 +19       IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +20       SET DATE=Y

 +21       SET (HASFF,HASTERM,PXRMFFSS,PXRMTDEB)=0

 +22       IF $DATA(^PXD(811.9,PXRMITEM,25,"B"))

               SET HASFF=1

 +23       IF HASFF

               SET PXRMFFSS=$$ASKYN^PXRMEUT("N","Display step-by-step function finding evaluation","","")

 +24       IF $DATA(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,"))

               SET HASTERM=1

 +25       IF 'HASTERM

               Begin DoDot:1

 +26               SET IND=0

 +27               FOR 

                       SET IND=+$ORDER(^PXD(811.9,PXRMITEM,20,"EDEP",IND))

                       if IND=0

                           QUIT 

                       Begin DoDot:2

 +28                       IF $DATA(^PXD(811.9,PXRMITEM,20,"EDEP",IND,"PXRMD(811.5,"))

                               SET HASTERM=1

                       End DoDot:2

               End DoDot:1

 +29       IF HASTERM

               SET PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","")

 +30       DO DOREM(DFN,PXRMITEM,PXRHM,DATE)

 +31       QUIT 

 +32      ;

 +33      ;===============

DEV       ;Prompt for patient and reminder by name and evaluation date.

 +1        NEW DATE,DFN,DIC,DIROUT,DIRUT,DTOUT,DUOUT,HASFF,HASTERM,IND

 +2        NEW PXRHM,PXRMFFSS,PXRMITEM,PXRMTDEB,REF,X,Y

 +3        SET DIC=2

           SET DIC("A")="Select Patient: "

 +4        SET DIC(0)="AEQMZ"

GPAT2      DO ^DIC

 +1        IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT 

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +3        SET DFN=+$PIECE(Y,U,1)

 +4        IF DFN=-1

               GOTO GPAT2

 +5        SET DIC=811.9

           SET DIC("A")="Select Reminder: "

GREM2      DO ^DIC

 +1        IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT 

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +3        SET PXRMITEM=+$PIECE(Y,U,1)

 +4        IF PXRMITEM=-1

               GOTO GREM2

 +5        SET PXRHM=5

 +6        SET DIR(0)="DA^"_0_"::ET"

 +7        SET DIR("A")="Enter date for reminder evaluation: "

 +8        SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 +9        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +10       WRITE !

 +11       DO ^DIR

           KILL DIR

 +12       IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT 

 +13       IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +14       SET DATE=Y

 +15       SET (HASFF,HASTERM,PXRMFFSS,PXRMTDEB)=0

 +16       IF $DATA(^PXD(811.9,PXRMITEM,25,"B"))

               SET HASFF=1

 +17       IF HASFF

               SET PXRMFFSS=$$ASKYN^PXRMEUT("N","Display step-by-step function finding evaluation","","")

 +18       IF $DATA(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,"))

               SET HASTERM=1

 +19       IF 'HASTERM

               Begin DoDot:1

 +20               SET IND=0

 +21               FOR 

                       SET IND=+$ORDER(^PXD(811.9,PXRMITEM,20,"EDEP",IND))

                       if IND=0

                           QUIT 

                       Begin DoDot:2

 +22                       IF $DATA(^PXD(811.9,PXRMITEM,20,"EDEP",IND,"PXRMD(811.5,"))

                               SET HASTERM=1

                       End DoDot:2

               End DoDot:1

 +23       IF HASTERM

               SET PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","")

 +24       DO DOREM(DFN,PXRMITEM,PXRHM,DATE)

 +25       QUIT 

 +26      ;

 +27      ;===============

DISP01(FIEVAL) ;For Education Topics, Exams, and Health Factors the Print Name

 +1       ;is displayed in the Clinical Maintenance Output. Since Print Names

 +2       ;are not unique it can be difficult to determine what the actual

 +3       ;finding is so display the .01.

 +4        NEW IEN,IND

 +5        SET IND=0

 +6        FOR 

               SET IND=+$ORDER(FIEVAL(IND))

               if IND=0

                   QUIT 

               Begin DoDot:1

 +7                IF FIEVAL(IND)=0

                       QUIT 

 +8                SET IEN=$PIECE(FIEVAL(IND,"FINDING"),";",1)

 +9                IF FIEVAL(IND,"FILE NUMBER")=9000010.16

                       SET FIEVAL(IND,"NAME")=$PIECE(^AUTTEDT(IEN,0),U,1)

 +10               IF FIEVAL(IND,"FILE NUMBER")=9000010.13

                       SET FIEVAL(IND,"NAME")=$PIECE(^AUTTEXAM(IEN,0),U,1)

 +11               IF FIEVAL(IND,"FILE NUMBER")=9000010.23

                       SET FIEVAL(IND,"FACTOR")=$PIECE(^AUTTHF(IEN,0),U,1)

               End DoDot:1

 +12       QUIT 

 +13      ;

 +14      ;===============

DOREM(DFN,PXRMITEM,PXRHM,DATE) ;Do the reminder

 +1       ;Reference to XLFSHAN ICR #6157

 +2        NEW BOP,DEFARR,END,FFN,FFNUMBER,FIEVAL,FINDING,IND,JND,NL,NOUT,OUTPUT

 +3        NEW PNAME,PXRMDEBG,PXRMID,REF,RIEN,RNAME,START,STATUS

 +4        NEW TEXT,TEXTOUT,TFIEVAL,TTEXT,WSTART,WEND,X

 +5       ;This is a debugging run so set PXRMDEBG.

 +6        SET NL=0

           SET PXRMDEBG=1

 +7        SET WSTART=$HOROLOG

 +8        SET START=$$CPUTIME^XLFSHAN

 +9        DO DEF^PXRMLDR(PXRMITEM,.DEFARR)

 +10       IF +$GET(DATE)=0

               DO EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL)

 +11       IF +$GET(DATE)>0

               DO EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL,DATE)

 +12       SET END=$$CPUTIME^XLFSHAN

 +13       SET WEND=$HOROLOG

 +14      ;

 +15       IF $DATA(^TMP(PXRMID,$JOB,"FFDEB"))

               MERGE FIEVAL=^TMP(PXRMID,$JOB,"FFDEB")

               KILL ^TMP(PXRMID,$JOB,"FFDEB")

 +16      ;

 +17       SET TTEXT=^PXD(811.9,PXRMITEM,0)

 +18       SET PNAME=$PIECE(TTEXT,U,2)

 +19       IF PNAME=""

               SET PNAME=$PIECE(TTEXT,U,1)

 +20       SET NL=NL+1

           SET OUTPUT(NL)="Reminder: "_PNAME

 +21       SET NL=NL+1

           SET OUTPUT(NL)="Patient: "_$$GET1^DIQ(2,DFN,.01)

 +22       SET NL=NL+1

           SET OUTPUT(NL)="Reminder evaluation cpu time: "_$$ETIMEMS^XLFSHAN(START,END)

 +23       SET NL=NL+1

           SET OUTPUT(NL)="Reminder evaluation clock time: "_$$HDIFF^XLFDT(WEND,WSTART,2)_" seconds"

 +24       SET NL=NL+1

           SET OUTPUT(NL)=" "

 +25       SET NL=NL+1

           SET OUTPUT(NL)="The elements of the FIEVAL array are:"

 +26       SET FFN="FF"

 +27       FOR 

               SET FFN=$ORDER(FIEVAL(FFN))

               if FFN'["FF"

                   QUIT 

               Begin DoDot:1

 +28               SET FFNUMBER=$PIECE(FFN,"FF",2)

 +29               MERGE FIEVAL("FF",FFNUMBER)=FIEVAL(FFN)

 +30               KILL FIEVAL(FFN)

               End DoDot:1

 +31       DO DISP01(.FIEVAL)

 +32       SET REF="FIEVAL"

 +33       DO ACOPY^PXRMUTIL(REF,"TTEXT()")

 +34       SET IND=0

 +35       FOR 

               SET IND=$ORDER(TTEXT(IND))

               if IND=""

                   QUIT 

               Begin DoDot:1

 +36               IF $LENGTH(TTEXT(IND))<79

                       SET NL=NL+1

                       SET OUTPUT(NL)=TTEXT(IND)

                       QUIT 

 +37               DO FORMATS^PXRMTEXT(1,79,TTEXT(IND),.NOUT,.TEXTOUT)

 +38               FOR JND=1:1:NOUT

                       SET NL=NL+1

                       SET OUTPUT(NL)=TEXTOUT(JND)

               End DoDot:1

 +39      ;

 +40       IF $GET(PXRMFFSS)

               Begin DoDot:1

 +41               NEW FFN,STEP

 +42               SET NL=NL+1

                   SET OUTPUT(NL)=""

                   SET NL=NL+1

                   SET OUTPUT(NL)=""

 +43               SET NL=NL+1

                   SET OUTPUT(NL)="Step-by-step function finding evaluation:"

 +44               SET FFNUMBER=0

 +45               FOR 

                       SET FFNUMBER=+$ORDER(FIEVAL("FF",FFNUMBER))

                       if FFNUMBER=0

                           QUIT 

                       Begin DoDot:2

 +46                       SET NL=NL+1

                           SET OUTPUT(NL)=""

 +47                       SET NL=NL+1

                           SET OUTPUT(NL)=" Function finding "_FFNUMBER_"="_FIEVAL("FF",FFNUMBER)

 +48                       DO FORMATS^PXRMTEXT(1,79,$PIECE(FIEVAL("FF",FFNUMBER,"DETAIL"),U,2),.NOUT,.TEXTOUT)

 +49                       SET FFN="FF"_FFNUMBER

 +50                       FOR JND=1:1:NOUT

                               SET NL=NL+1

                               SET OUTPUT(NL)=TEXTOUT(JND)

 +51                       SET NL=NL+1

                           SET OUTPUT(NL)=" = "_^TMP("PXRMFFSS",$JOB,FFN,0)

 +52                       SET NL=NL+1

                           SET OUTPUT(NL)="Step  Result"

 +53                       SET STEP=0

 +54                       FOR 

                               SET STEP=$ORDER(^TMP("PXRMFFSS",$JOB,FFN,STEP))

                               if STEP=""

                                   QUIT 

                               Begin DoDot:3

 +55                               SET NL=NL+1

                                   SET OUTPUT(NL)=$$RJ^XLFSTR(STEP_".",4," ")_"  "_^TMP("PXRMFFSS",$JOB,FFN,STEP)

                               End DoDot:3

                       End DoDot:2

 +56               KILL ^TMP("PXRMFFSS",$JOB)

 +57      ;

               End DoDot:1

 +58       IF $GET(PXRMTDEB)

               Begin DoDot:1

 +59               SET NL=NL+1

                   SET OUTPUT(NL)=""

                   SET NL=NL+1

                   SET OUTPUT(NL)=""

 +60               SET NL=NL+1

                   SET OUTPUT(NL)="Term findings:"

 +61               SET REF="TFIEVAL"

 +62               SET FINDING=0

 +63               FOR 

                       SET FINDING=$ORDER(^TMP("PXRMTDEB",$JOB,FINDING))

                       if FINDING=""

                           QUIT 

                       Begin DoDot:2

 +64                       KILL TFIEVAL

                           MERGE TFIEVAL(FINDING)=^TMP("PXRMTDEB",$JOB,FINDING)

 +65                       SET NL=NL+1

                           SET OUTPUT(NL)="Finding "_FINDING_":"

 +66                       KILL TTEXT

 +67                       DO ACOPY^PXRMUTIL(REF,"TTEXT()")

 +68                       SET IND=0

 +69                       FOR 

                               SET IND=$ORDER(TTEXT(IND))

                               if IND=""

                                   QUIT 

                               SET NL=NL+1

                               SET OUTPUT(NL)=TTEXT(IND)

                       End DoDot:2

 +70               KILL ^TMP("PXRMTDEB",$JOB)

               End DoDot:1

 +71      ;

 +72      ;If CF.VA-ELIGIBILITY has been used as a finding display the VAEL array.

 +73       IF $DATA(^TMP("PXRMELIG",$JOB))

               Begin DoDot:1

 +74               NEW VAEL

 +75               MERGE VAEL=^TMP("PXRMELIG",$JOB)

 +76               KILL ^TMP("PXRMELIG",$JOB),TTEXT

 +77               DO ACOPY^PXRMUTIL("VAEL","TTEXT()")

 +78               SET NL=NL+1

                   SET OUTPUT(NL)=""

 +79               SET NL=NL+1

                   SET OUTPUT(NL)="VAEL array returned by ELIG^VADPT:"

 +80               SET IND=0

 +81               FOR 

                       SET IND=$ORDER(TTEXT(IND))

                       if IND=""

                           QUIT 

                       SET NL=NL+1

                       SET OUTPUT(NL)=TTEXT(IND)

               End DoDot:1

 +82      ;

 +83      ;Display the demographic variables.

 +84       SET NL=NL+1

           SET OUTPUT(NL)=""

           SET NL=NL+1

           SET OUTPUT(NL)=""

 +85       SET NL=NL+1

           SET OUTPUT(NL)="The demographic variables are:"

 +86       SET IND=""

 +87       FOR 

               SET IND=$ORDER(^TMP("PXRMDEM",$JOB,IND))

               if IND=""

                   QUIT 

               Begin DoDot:1

 +88               SET TEXT=^TMP("PXRMDEM",$JOB,IND)

 +89               IF (IND="DOB")!(IND="DOD")!(IND="LAD")

                       SET TEXT=$$FMTE^XLFDT(TEXT,"5Z")

 +90               SET NL=NL+1