PXRMDEV.m

PXRMDEV ;SLC/PKR - This is a driver for testing Clinical Reminders. ;03/12/2013

 ;;2.0;CLINICAL REMINDERS;**4,6,11,16,18,24,26**;Feb 04, 2005;Build 404

 ;

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

CMOUT(PXRHM,NL,OUTPUT) ;Do formatted Clinical Maintenance output.

 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL

 N TEMP,TEXT,TYPE

 S TEXT=$S(PXRHM=0:"Due Now ",PXRHM=1:"Summary ",PXRHM=5:"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:"

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

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

 S TEMP=$G(^TMP("PXRHM",$J,RIEN,RNAME))

 S STATUS=$P(TEMP,U,1)

 S DUE=$$DDATE^PXRMDATE($P(TEMP,U,2))

 S LAST=$$DDATE^PXRMDATE($P(TEMP,U,3))

 S STATCOL=41-($L(STATUS)/2)

 S DUECOL=53-($L(DUE)/2)

 S LASTCOL=67-($L(LAST)/2)

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

 S TEXT=$$REPEAT^XLFSTR(" ",36)_"--STATUS-- --DUE DATE--  --LAST DONE--"

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

 S TEXT=RNAME_$$REPEAT^XLFSTR(" ",(STATCOL-$L(RNAME)))_STATUS

 S TEXT=TEXT_$$REPEAT^XLFSTR(" ",(DUECOL-$L(TEXT)))_DUE

 S TEXT=TEXT_$$REPEAT^XLFSTR(" ",(LASTCOL-$L(TEXT)))_LAST

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

 S LNUM=0

 F  S LNUM=$O(^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM)) Q:LNUM=""  D

 . S NL=NL+1,OUTPUT(NL)=^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM)

 Q

 ;

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

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, 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_"::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

 ;

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

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

 N BOP,DEFARR,FIEVAL,FINDING,IND,JND,NL,NOUT,OUTPUT,PNAME

 N PXRMDEBG,PXRMDEFS,PXRMID

 N REF,TEXTOUT,TFIEVAL,TTEXT,X

 ;This is a debugging run so set PXRMDEBG.

 S NL=0,PXRMDEBG=1

 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)

 ;

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

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

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

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

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

 .. S NL=NL+1,OUTPUT(NL)=" Function finding "_FFN_"="_FIEVAL(FFN)

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

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

 ;

 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 $D(^TMP("PXRHM",$J)) D CMOUT(PXRHM,.NL,.OUTPUT)

 I $D(^TMP("PXRMMHVC",$J)) D MHVOUT(PXRHM,.NL,.OUTPUT)

 K ^TMP("PXRM",$J),^TMP("PXRHM",$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

 ;

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

MHVOUT(PXRHM,NL,OUTPUT) ;Do formatted MHV combined output.

 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME

 N STATUS,STATCOL,TEMP,TEXT,TYPE

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

 S NL=NL+1,OUTPUT(NL)="MHV Summary and Detailed Output:"

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

 S TEMP=^TMP("PXRMMHVC",$J,RIEN,"STATUS")

 S STATUS=$P(TEMP,U,1)

 S DUE=$$DDATE^PXRMDATE($P(TEMP,U,2))

 S LAST=$$DDATE^PXRMDATE($P(TEMP,U,3))

 S STATCOL=41-($L(STATUS)/2)

 S DUECOL=53-($L(DUE)/2)

 S LASTCOL=67-($L(LAST)/2)

 S RNAME=$P(^PXD(811.9,RIEN,0),U,3)

 I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1)

 S TEXT=$$REPEAT^XLFSTR(" ",36)_"--STATUS-- --DUE DATE--  --LAST DONE--"

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

 S TEXT=RNAME_$$REPEAT^XLFSTR(" ",(STATCOL-$L(RNAME)))_STATUS

 S TEXT=TEXT_$$REPEAT^XLFSTR(" ",(DUECOL-$L(TEXT)))_DUE

 S TEXT=TEXT_$$REPEAT^XLFSTR(" ",(LASTCOL-$L(TEXT)))_LAST

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

 I '$D(^TMP("PXRMMHVC",$J)) Q

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

 .; W !!,"---------- Detailed Output ----------"

 . S NL=NL+1,OUTPUT(NL)="---------- Detailed Output ----------"

 . S LNUM=0

 . F  S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)) Q:LNUM=""  D

 .. S NL=NL+1,OUTPUT(NL)=^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)

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

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

 . S NL=NL+1,OUTPUT(NL)="---------- Summary Output ----------"

 . S LNUM=0

 . F  S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)) Q:LNUM=""  D

 .. S NL=NL+1,OUTPUT(NL)=^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)

 Q

 ;

PXRMDEV   ;SLC/PKR - This is a driver for testing Clinical Reminders. ;03/12/2013

 +1       ;;2.0;CLINICAL REMINDERS;**4,6,11,16,18,24,26**;Feb 04, 2005;Build 404

 +2       ;

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

CMOUT(PXRHM,NL,OUTPUT) ;Do formatted Clinical Maintenance output.

 +1        NEW DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL

 +2        NEW TEMP,TEXT,TYPE

 +3        SET TEXT=$SELECT(PXRHM=0:"Due Now ",PXRHM=1:"Summary ",PXRHM=5:"Maintenance ",PXRHM=55:"Order Check ",1:"")

 +4        SET NL=NL+1

           SET OUTPUT(NL)=""

           SET NL=NL+1

           SET OUTPUT(NL)=""

 +5        SET NL=NL+1

           SET OUTPUT(NL)=TEXT_"Output:"

 +6        SET RIEN=$ORDER(^TMP("PXRHM",$JOB,""))

 +7        SET RNAME=$ORDER(^TMP("PXRHM",$JOB,RIEN,""))

 +8        SET TEMP=$GET(^TMP("PXRHM",$JOB,RIEN,RNAME))

 +9        SET STATUS=$PIECE(TEMP,U,1)

 +10       SET DUE=$$DDATE^PXRMDATE($PIECE(TEMP,U,2))

 +11       SET LAST=$$DDATE^PXRMDATE($PIECE(TEMP,U,3))

 +12       SET STATCOL=41-($LENGTH(STATUS)/2)

 +13       SET DUECOL=53-($LENGTH(DUE)/2)

 +14       SET LASTCOL=67-($LENGTH(LAST)/2)

 +15       SET NL=NL+1

           SET OUTPUT(NL)=""

           SET NL=NL+1

           SET OUTPUT(NL)=""

 +16       SET TEXT=$$REPEAT^XLFSTR(" ",36)_"--STATUS-- --DUE DATE--  --LAST DONE--"

 +17       SET NL=NL+1

           SET OUTPUT(NL)=TEXT

 +18       SET TEXT=RNAME_$$REPEAT^XLFSTR(" ",(STATCOL-$LENGTH(RNAME)))_STATUS

 +19       SET TEXT=TEXT_$$REPEAT^XLFSTR(" ",(DUECOL-$LENGTH(TEXT)))_DUE

 +20       SET TEXT=TEXT_$$REPEAT^XLFSTR(" ",(LASTCOL-$LENGTH(TEXT)))_LAST

 +21       SET NL=NL+1

           SET OUTPUT(NL)=TEXT

 +22       SET LNUM=0

 +23       FOR 

               SET LNUM=$ORDER(^TMP("PXRHM",$JOB,RIEN,RNAME,"TXT",LNUM))

               IF LNUM=""

                   QUIT 

               Begin DoDot:1

 +24               SET NL=NL+1

                   SET OUTPUT(NL)=^TMP("PXRHM",$JOB,RIEN,RNAME,"TXT",LNUM)

               End DoDot:1

 +25       QUIT 

 +26      ;

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

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, 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_"::ETX"

 +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      ;==================================================

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

 +1        NEW BOP,DEFARR,FIEVAL,FINDING,IND,JND,NL,NOUT,OUTPUT,PNAME

 +2        NEW PXRMDEBG,PXRMDEFS,PXRMID

 +3        NEW REF,TEXTOUT,TFIEVAL,TTEXT,X

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

 +5        SET NL=0

           SET PXRMDEBG=1

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

 +7        IF +$GET(DATE)=0

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

 +8        IF +$GET(DATE)>0

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

 +9       ;

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

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

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

 +11      ;

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

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

 +14       IF PNAME=""

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

 +15       SET NL=NL+1

           SET OUTPUT(NL)="Reminder: "_PNAME

 +16       SET NL=NL+1

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

 +17       SET NL=NL+1

           SET OUTPUT(NL)=" "

 +18       SET NL=NL+1

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

 +19       SET REF="FIEVAL"

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

 +21       SET IND=0

 +22       FOR 

               SET IND=$ORDER(TTEXT(IND))

               IF IND=""

                   QUIT 

               Begin DoDot:1

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

                       SET NL=NL+1

                       SET OUTPUT(NL)=TTEXT(IND)

                       QUIT 

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

 +25               FOR JND=1:1:NOUT

                       SET NL=NL+1

                       SET OUTPUT(NL)=TEXTOUT(JND)

               End DoDot:1

 +26      ;

 +27       IF $GET(PXRMFFSS)

               Begin DoDot:1

 +28               NEW FFN,STEP

 +29               SET NL=NL+1

                   SET OUTPUT(NL)=""

                   SET NL=NL+1

                   SET OUTPUT(NL)=""

 +30               SET NL=NL+1

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

 +31               SET FFN=""

 +32               FOR 

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

                       IF FFN=""

                           QUIT 

                       Begin DoDot:2

 +33                       SET NL=NL+1

                           SET OUTPUT(NL)=""

 +34                       SET NL=NL+1

                           SET OUTPUT(NL)=" Function finding "_FFN_"="_FIEVAL(FFN)

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

 +36                       FOR JND=1:1:NOUT

                               SET NL=NL+1

                               SET OUTPUT(NL)=TEXTOUT(JND)

 +37                       SET NL=NL+1

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

 +38                       SET NL=NL+1

                           SET OUTPUT(NL)="Step  Result"

 +39                       SET STEP=0

 +40                       FOR 

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

                               IF STEP=""

                                   QUIT 

                               Begin DoDot:3

 +41                               SET NL=NL+1

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

                               End DoDot:3

                       End DoDot:2

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

               End DoDot:1

 +43       IF $GET(PXRMTDEB)

               Begin DoDot:1

 +44               SET NL=NL+1

                   SET OUTPUT(NL)=""

                   SET NL=NL+1

                   SET OUTPUT(NL)=""

 +45               SET NL=NL+1

                   SET OUTPUT(NL)="Term findings:"

 +46               SET REF="TFIEVAL"

 +47               SET FINDING=0

 +48               FOR 

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

                       IF FINDING=""

                           QUIT 

                       Begin DoDot:2

 +49                       KILL TFIEVAL

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

 +50                       SET NL=NL+1

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

 +51                       KILL TTEXT

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

 +53                       SET IND=0

 +54                       FOR 

                               SET IND=$ORDER(TTEXT(IND))

                               IF IND=""

                                   QUIT 

                               SET NL=NL+1

                               SET OUTPUT(NL)=TTEXT(IND)

                       End DoDot:2

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

               End DoDot:1

 +56      ;

 +57       IF $DATA(^TMP(PXRMID,$JOB))

               Begin DoDot:1

 +58               SET NL=NL+1

                   SET OUTPUT(NL)=""

                   SET NL=NL+1

                   SET OUTPUT(NL)=""

 +59               SET NL=NL+1

                   SET OUTPUT(NL)="The elements of the ^TMP(PXRMID,$J) array are:"

 +60               SET REF="^TMP(PXRMID,$J)"

 +61               KILL TTEXT

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

 +63               SET IND=0

 +64               FOR 

                       SET IND=$ORDER(TTEXT(IND))

                       IF IND=""

                           QUIT 

                       SET NL=NL+1

                       SET OUTPUT(NL)=TTEXT(IND)

 +65               KILL ^TMP(PXRMID,$JOB)

               End DoDot:1

 +66      ;

 +67       IF $DATA(^TMP("PXRHM",$JOB))

               Begin DoDot:1

 +68               SET NL=NL+1

                   SET OUTPUT(NL)=""

                   SET NL=NL+1

                   SET OUTPUT(NL)=""

 +69               SET NL=NL+1

                   SET OUTPUT(NL)="The elements of the ^TMP(""PXRHM"",$J) array are:"

 +70               SET REF="^TMP(""PXRHM"",$J)"

 +71               KILL TTEXT

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

 +73               SET IND=0

 +74               FOR 

                       SET IND=$ORDER(TTEXT(IND))

                       IF IND=""

                           QUIT 

                       SET NL=NL+1

                       SET OUTPUT(NL)=TTEXT(IND)

               End DoDot:1

 +75      ;

 +76       IF $DATA(^TMP("PXRHM",$JOB))

               DO CMOUT(PXRHM,.NL,.OUTPUT)

 +77       IF $DATA(^TMP("PXRMMHVC",$JOB))

               DO MHVOUT(PXRHM,.NL,.OUTPUT)

 +78       KILL ^TMP("PXRM",$JOB),^TMP("PXRHM",$JOB),^TMP("PXRMMHVC",$JOB)

 +79       SET BOP=$$BORP^PXRMUTIL("P")

 +80       IF BOP="B"

               Begin DoDot:1

 +81               SET X="IORESET"

 +82               DO ENDR^%ZISS