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
+83 DO BROWSE^DDBR("OUTPUT","NR","Reminder Test")
+84 WRITE IORESET
+85 DO KILL^%ZISS
End DoDot:1
+86 IF BOP="P"
DO GPRINT^PXRMUTIL("OUTPUT")
+87 QUIT
+88 ;
+89 ;==================================================
MHVOUT(PXRHM,NL,OUTPUT) ;Do formatted MHV combined output.
+1 NEW DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME
+2 NEW STATUS,STATCOL,TEMP,TEXT,TYPE
+3 SET NL=NL+1
SET OUTPUT(NL)=""
SET NL=NL+1
SET OUTPUT(NL)=""
+4 SET NL=NL+1
SET OUTPUT(NL)="MHV Summary and Detailed Output:"
+5 SET RIEN=$ORDER(^TMP("PXRMMHVC",$JOB,""))
+6 SET TEMP=^TMP("PXRMMHVC",$JOB,RIEN,"STATUS")
+7 SET STATUS=$PIECE(TEMP,U,1)
+8 SET DUE=$$DDATE^PXRMDATE($PIECE(TEMP,U,2))
+9 SET LAST=$$DDATE^PXRMDATE($PIECE(TEMP,U,3))
+10 SET STATCOL=41-($LENGTH(STATUS)/2)
+11 SET DUECOL=53-($LENGTH(DUE)/2)
+12 SET LASTCOL=67-($LENGTH(LAST)/2)
+13 SET RNAME=$PIECE(^PXD(811.9,RIEN,0),U,3)
+14 IF RNAME=""
SET RNAME=$PIECE(^PXD(811.9,RIEN,0),U,1)
+15 SET TEXT=$$REPEAT^XLFSTR(" ",36)_"--STATUS-- --DUE DATE-- --LAST DONE--"
+16 SET NL=NL+1
SET OUTPUT(NL)=TEXT
+17 SET TEXT=RNAME_$$REPEAT^XLFSTR(" ",(STATCOL-$LENGTH(RNAME)))_STATUS
+18 SET TEXT=TEXT_$$REPEAT^XLFSTR(" ",(DUECOL-$LENGTH(TEXT)))_DUE
+19 SET TEXT=TEXT_$$REPEAT^XLFSTR(" ",(LASTCOL-$LENGTH(TEXT)))_LAST
+20 SET NL=NL+1
SET OUTPUT(NL)=TEXT
+21 IF '$DATA(^TMP("PXRMMHVC",$JOB))
QUIT
+22 IF (PXRHM=11)!(PXRHM=12)
Begin DoDot:1
+23 ; W !!,"---------- Detailed Output ----------"
+24 SET NL=NL+1
SET OUTPUT(NL)="---------- Detailed Output ----------"
+25 SET LNUM=0
+26 FOR
SET LNUM=$ORDER(^TMP("PXRMMHVC",$JOB,RIEN,"DETAIL",LNUM))
IF LNUM=""
QUIT
Begin DoDot:2
+27 SET NL=NL+1
SET OUTPUT(NL)=^TMP("PXRMMHVC",$JOB,RIEN,"DETAIL",LNUM)
End DoDot:2
End DoDot:1
+28 IF (PXRHM=10)!(PXRHM=12)
Begin DoDot:1
+29 SET NL=NL+1
SET OUTPUT(NL)=""
SET NL=NL+1
SET OUTPUT(NL)=""
+30 SET NL=NL+1
SET OUTPUT(NL)="---------- Summary Output ----------"
+31 SET LNUM=0
+32 FOR
SET LNUM=$ORDER(^TMP("PXRMMHVC",$JOB,RIEN,"SUMMARY",LNUM))
IF LNUM=""
QUIT
Begin DoDot:2
+33 SET NL=NL+1
SET OUTPUT(NL)=^TMP("PXRMMHVC",$JOB,RIEN,"SUMMARY",LNUM)
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
