151 lines
5.0 KiB
Mathematica
151 lines
5.0 KiB
Mathematica
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
|
|
;
|