VistA-WorldVistAEHR/r/CLINICAL_REMINDERS-PXRM/PXRMDEV.m

PXRMDEV ; SLC/PKR - This is a driver for testing Clinical Reminders.;05/04/2006
 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 ;
 ;==================================================
CMOUT ;Do formatted Clinical Maintenance output.
 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE
 W !!,"Formatted 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=$$EDATE^PXRMDATE($P(TEMP,U,2))
 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3))
 S STATCOL=41-($L(STATUS)/2)
 S DUECOL=53-($L(DUE)/2)
 S LASTCOL=67-($L(LAST)/2)
 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",!
 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,!
 S LNUM=0
 F  S LNUM=$O(^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM)) Q:LNUM=""  D
 . W !,^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,PXRMITEM,PXRHM,PXRMTDEB,X,Y
 S DIC=2,DIC("A")="Select Patient: "
 S DIC(0)="AEQMZ"
 D ^DIC
 I $D(DTOUT)!$D(DUOUT) Q
 S DFN=+$P(Y,U,1)
 I DFN=-1 W !,"No patient selected!" Q
 S DIC=811.9,DIC("A")="Select Reminder: "
 S DIC("S")="I $P(^PXD(811.9,Y,100),U,4)'[""L"""
 D ^DIC
 I $D(DIROUT)!$D(DIRUT) Q
 I $D(DTOUT)!$D(DUOUT) Q
 S PXRMITEM=+$P(Y,U,1)
 I PXRMITEM=-1 W !,"No reminder selected!" Q
 S DIR(0)="LA"_U_"0"
 S DIR("A")="Enter component number 0, 1, 5, 10, 11, 12: "
 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
 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) 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,PXRMITEM,PXRHM,PXRMTDEB,REF,X,Y
 S DIC=2,DIC("A")="Select Patient: "
 S DIC(0)="AEQMZ"
 D ^DIC
 I $D(DIROUT)!$D(DIRUT) Q
 I $D(DTOUT)!$D(DUOUT) Q
 S DFN=+$P(Y,U,1)
 S DIC=811.9,DIC("A")="Select Reminder: "
 S DIC("S")="I $P(^PXD(811.9,Y,100),U,4)'[""L"""
 D ^DIC
 I $D(DIROUT)!$D(DIRUT) Q
 I $D(DTOUT)!$D(DUOUT) Q
 S PXRMITEM=+$P(Y,U,1)
 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
 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","")
 D DOREM(DFN,PXRMITEM,PXRHM,DATE)
 Q
 ;
 ;==================================================
DOREM(DFN,PXRMITEM,PXRMHM,DATE) ;Do the reminder
 N DEFARR,FIEVAL,FINDING,PXRMDEBG,PXRMID,REF,TFIEVAL
 ;This is a debugging run so set PXRMDEBG.
 S 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)
 ;
 W !!,"The elements of the FIEVAL array are:"
 S REF="FIEVAL"
 D AWRITE^PXRMUTIL(REF)
 ;
 I $G(PXRMTDEB) D
 . W !!,"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)
 .. W !,"Finding ",FINDING,":"
 .. D AWRITE^PXRMUTIL(REF)
 . K ^TMP("PXRMTDEB",$J)
 ;
 W !!,"The elements of the ^TMP(PXRMID,$J) array are:"
 I $D(PXRMID) S REF="^TMP(PXRMID,$J)" D AWRITE^PXRMUTIL(REF) K ^TMP(PXRMID,$J)
 ;
 W !!,"The elements of the ^TMP(""PXRHM"",$J) array are:"
 S REF="^TMP(""PXRHM"",$J)"
 D AWRITE^PXRMUTIL(REF)
 ;
 I $D(^TMP("PXRHM",$J)) D CMOUT
 I PXRHM=12 D MHVCOUT
 K ^TMP("PXRM",$J),^TMP("PXRHM",$J),^TMP("PXRMMHVC",$J)
 Q
 ;==================================================
MHVCOUT ;Do formatted MHV combined output.
 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE
 W !!,"Formatted Output:"
 S RIEN=$O(^TMP("PXRMMHVC",$J,""))
 S TEMP=^TMP("PXRMMHVC",$J,RIEN,"STATUS")
 S STATUS=$P(TEMP,U,1)
 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2))
 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3))
 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2))
 S LAST=$$EDATE^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)
 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",!
 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,!
 W !!,"---------- Detailed Output ----------"
 S LNUM=0
 F  S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)) Q:LNUM=""  D
 . W !,^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)
 W !!,"---------- Summary Output ----------"
 S LNUM=0
 F  S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)) Q:LNUM=""  D
 . W !,^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)
 Q
 ;