Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDEV.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDEV.m
r613 r623 1 PXRMDEV ; SLC/PKR - This is a driver for testing Clinical Reminders.;01/24/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;================================================== 5 CMOUT ;Do formatted Clinical Maintenance output. 6 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE 7 W !!,"Formatted Output:" 8 S RIEN=$O(^TMP("PXRHM",$J,"")) 9 S RNAME=$O(^TMP("PXRHM",$J,RIEN,"")) 10 S TEMP=$G(^TMP("PXRHM",$J,RIEN,RNAME)) 11 S STATUS=$P(TEMP,U,1) 12 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2)) 13 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3)) 14 S STATCOL=41-($L(STATUS)/2) 15 S DUECOL=53-($L(DUE)/2) 16 S LASTCOL=67-($L(LAST)/2) 17 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",! 18 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,! 19 S LNUM=0 20 F S LNUM=$O(^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM)) Q:LNUM="" D 21 . W !,^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM) 22 Q 23 ; 24 ;================================================== 25 DEB ;Prompt for patient and reminder by name input component. 26 N DATE,DFN,DIC,DIR,DIROUT,DTOUT,DUOUT,PXRMITEM,PXRHM,PXRMTDEB,X,Y 27 S DIC=2,DIC("A")="Select Patient: " 28 S DIC(0)="AEQMZ" 29 D ^DIC 30 I $D(DTOUT)!$D(DUOUT) Q 31 S DFN=+$P(Y,U,1) 32 I DFN=-1 W !,"No patient selected!" Q 33 S DIC=811.9,DIC("A")="Select Reminder: " 34 D ^DIC 35 I $D(DIROUT)!$D(DIRUT) Q 36 I $D(DTOUT)!$D(DUOUT) Q 37 S PXRMITEM=+$P(Y,U,1) 38 I PXRMITEM=-1 W !,"No reminder selected!" Q 39 S DIR(0)="LA"_U_"0" 40 S DIR("A")="Enter component number 0, 1, 5, 10, 11, 12: " 41 D ^DIR 42 I $D(DIROUT)!$D(DIRUT) Q 43 I $D(DTOUT)!$D(DUOUT) Q 44 I X="" S X=5 45 S PXRHM=X 46 S DIR(0)="DA^"_0_"::ETX" 47 S DIR("A")="Enter date for reminder evaluation: " 48 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D") 49 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 50 W ! 51 D ^DIR K DIR 52 I $D(DIROUT)!$D(DIRUT) Q 53 I $D(DTOUT)!$D(DUOUT) Q 54 S DATE=Y 55 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","") 56 D DOREM(DFN,PXRMITEM,PXRHM,DATE) 57 Q 58 ; 59 ;================================================== 60 DEV ;Prompt for patient and reminder by name and evaluation date. 61 N DATE,DFN,DIC,DIROUT,DIRUT,DTOUT,DUOUT,PXRMITEM,PXRHM,PXRMTDEB,REF,X,Y 62 S DIC=2,DIC("A")="Select Patient: " 63 S DIC(0)="AEQMZ" 64 D ^DIC 65 I $D(DIROUT)!$D(DIRUT) Q 66 I $D(DTOUT)!$D(DUOUT) Q 67 S DFN=+$P(Y,U,1) 68 S DIC=811.9,DIC("A")="Select Reminder: " 69 D ^DIC 70 I $D(DIROUT)!$D(DIRUT) Q 71 I $D(DTOUT)!$D(DUOUT) Q 72 S PXRMITEM=+$P(Y,U,1) 73 S PXRHM=5 74 S DIR(0)="DA^"_0_"::ETX" 75 S DIR("A")="Enter date for reminder evaluation: " 76 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D") 77 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 78 W ! 79 D ^DIR K DIR 80 I $D(DIROUT)!$D(DIRUT) Q 81 I $D(DTOUT)!$D(DUOUT) Q 82 S DATE=Y 83 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","") 84 D DOREM(DFN,PXRMITEM,PXRHM,DATE) 85 Q 86 ; 87 ;================================================== 88 DOREM(DFN,PXRMITEM,PXRMHM,DATE) ;Do the reminder 89 N DEFARR,FIEVAL,FINDING,PXRMDEBG,PXRMID,REF,TFIEVAL 90 ;This is a debugging run so set PXRMDEBG. 91 S PXRMDEBG=1 92 D DEF^PXRMLDR(PXRMITEM,.DEFARR) 93 I +$G(DATE)=0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL) 94 I +$G(DATE)>0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL,DATE) 95 ; 96 W !!,"The elements of the FIEVAL array are:" 97 S REF="FIEVAL" 98 D AWRITE^PXRMUTIL(REF) 99 ; 100 I $G(PXRMTDEB) D 101 . W !!,"Term findings:" 102 . S REF="TFIEVAL" 103 . S FINDING=0 104 . F S FINDING=$O(^TMP("PXRMTDEB",$J,FINDING)) Q:FINDING="" D 105 .. K TFIEVAL M TFIEVAL(FINDING)=^TMP("PXRMTDEB",$J,FINDING) 106 .. W !,"Finding ",FINDING,":" 107 .. D AWRITE^PXRMUTIL(REF) 108 . K ^TMP("PXRMTDEB",$J) 109 ; 110 W !!,"The elements of the ^TMP(PXRMID,$J) array are:" 111 I $D(PXRMID) S REF="^TMP(PXRMID,$J)" D AWRITE^PXRMUTIL(REF) K ^TMP(PXRMID,$J) 112 ; 113 W !!,"The elements of the ^TMP(""PXRHM"",$J) array are:" 114 S REF="^TMP(""PXRHM"",$J)" 115 D AWRITE^PXRMUTIL(REF) 116 ; 117 I $D(^TMP("PXRHM",$J)) D CMOUT 118 I PXRHM=12 D MHVCOUT 119 K ^TMP("PXRM",$J),^TMP("PXRHM",$J),^TMP("PXRMMHVC",$J) 120 Q 121 ;================================================== 122 MHVCOUT ;Do formatted MHV combined output. 123 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE 124 W !!,"Formatted Output:" 125 S RIEN=$O(^TMP("PXRMMHVC",$J,"")) 126 S TEMP=^TMP("PXRMMHVC",$J,RIEN,"STATUS") 127 S STATUS=$P(TEMP,U,1) 128 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2)) 129 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3)) 130 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2)) 131 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3)) 132 S STATCOL=41-($L(STATUS)/2) 133 S DUECOL=53-($L(DUE)/2) 134 S LASTCOL=67-($L(LAST)/2) 135 S RNAME=$P(^PXD(811.9,RIEN,0),U,3) 136 I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1) 137 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",! 138 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,! 139 W !!,"---------- Detailed Output ----------" 140 S LNUM=0 141 F S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)) Q:LNUM="" D 142 . W !,^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM) 143 W !!,"---------- Summary Output ----------" 144 S LNUM=0 145 F S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)) Q:LNUM="" D 146 . W !,^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM) 147 Q 148 ; 1 PXRMDEV ; SLC/PKR - This is a driver for testing Clinical Reminders.;05/04/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;================================================== 5 CMOUT ;Do formatted Clinical Maintenance output. 6 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE 7 W !!,"Formatted Output:" 8 S RIEN=$O(^TMP("PXRHM",$J,"")) 9 S RNAME=$O(^TMP("PXRHM",$J,RIEN,"")) 10 S TEMP=$G(^TMP("PXRHM",$J,RIEN,RNAME)) 11 S STATUS=$P(TEMP,U,1) 12 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2)) 13 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3)) 14 S STATCOL=41-($L(STATUS)/2) 15 S DUECOL=53-($L(DUE)/2) 16 S LASTCOL=67-($L(LAST)/2) 17 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",! 18 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,! 19 S LNUM=0 20 F S LNUM=$O(^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM)) Q:LNUM="" D 21 . W !,^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM) 22 Q 23 ; 24 ;================================================== 25 DEB ;Prompt for patient and reminder by name input component. 26 N DATE,DFN,DIC,DIR,DIROUT,DTOUT,DUOUT,PXRMITEM,PXRHM,PXRMTDEB,X,Y 27 S DIC=2,DIC("A")="Select Patient: " 28 S DIC(0)="AEQMZ" 29 D ^DIC 30 I $D(DTOUT)!$D(DUOUT) Q 31 S DFN=+$P(Y,U,1) 32 I DFN=-1 W !,"No patient selected!" Q 33 S DIC=811.9,DIC("A")="Select Reminder: " 34 S DIC("S")="I $P(^PXD(811.9,Y,100),U,4)'[""L""" 35 D ^DIC 36 I $D(DIROUT)!$D(DIRUT) Q 37 I $D(DTOUT)!$D(DUOUT) Q 38 S PXRMITEM=+$P(Y,U,1) 39 I PXRMITEM=-1 W !,"No reminder selected!" Q 40 S DIR(0)="LA"_U_"0" 41 S DIR("A")="Enter component number 0, 1, 5, 10, 11, 12: " 42 D ^DIR 43 I $D(DIROUT)!$D(DIRUT) Q 44 I $D(DTOUT)!$D(DUOUT) Q 45 I X="" S X=5 46 S PXRHM=X 47 S DIR(0)="DA^"_0_"::ETX" 48 S DIR("A")="Enter date for reminder evaluation: " 49 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D") 50 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 51 W ! 52 D ^DIR K DIR 53 I $D(DIROUT)!$D(DIRUT) Q 54 I $D(DTOUT)!$D(DUOUT) Q 55 S DATE=Y 56 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","") 57 D DOREM(DFN,PXRMITEM,PXRHM,DATE) 58 Q 59 ; 60 ;================================================== 61 DEV ;Prompt for patient and reminder by name and evaluation date. 62 N DATE,DFN,DIC,DIROUT,DIRUT,DTOUT,DUOUT,PXRMITEM,PXRHM,PXRMTDEB,REF,X,Y 63 S DIC=2,DIC("A")="Select Patient: " 64 S DIC(0)="AEQMZ" 65 D ^DIC 66 I $D(DIROUT)!$D(DIRUT) Q 67 I $D(DTOUT)!$D(DUOUT) Q 68 S DFN=+$P(Y,U,1) 69 S DIC=811.9,DIC("A")="Select Reminder: " 70 S DIC("S")="I $P(^PXD(811.9,Y,100),U,4)'[""L""" 71 D ^DIC 72 I $D(DIROUT)!$D(DIRUT) Q 73 I $D(DTOUT)!$D(DUOUT) Q 74 S PXRMITEM=+$P(Y,U,1) 75 S PXRHM=5 76 S DIR(0)="DA^"_0_"::ETX" 77 S DIR("A")="Enter date for reminder evaluation: " 78 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D") 79 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 80 W ! 81 D ^DIR K DIR 82 I $D(DIROUT)!$D(DIRUT) Q 83 I $D(DTOUT)!$D(DUOUT) Q 84 S DATE=Y 85 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","") 86 D DOREM(DFN,PXRMITEM,PXRHM,DATE) 87 Q 88 ; 89 ;================================================== 90 DOREM(DFN,PXRMITEM,PXRMHM,DATE) ;Do the reminder 91 N DEFARR,FIEVAL,FINDING,PXRMDEBG,PXRMID,REF,TFIEVAL 92 ;This is a debugging run so set PXRMDEBG. 93 S PXRMDEBG=1 94 D DEF^PXRMLDR(PXRMITEM,.DEFARR) 95 I +$G(DATE)=0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL) 96 I +$G(DATE)>0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL,DATE) 97 ; 98 W !!,"The elements of the FIEVAL array are:" 99 S REF="FIEVAL" 100 D AWRITE^PXRMUTIL(REF) 101 ; 102 I $G(PXRMTDEB) D 103 . W !!,"Term findings:" 104 . S REF="TFIEVAL" 105 . S FINDING=0 106 . F S FINDING=$O(^TMP("PXRMTDEB",$J,FINDING)) Q:FINDING="" D 107 .. K TFIEVAL M TFIEVAL(FINDING)=^TMP("PXRMTDEB",$J,FINDING) 108 .. W !,"Finding ",FINDING,":" 109 .. D AWRITE^PXRMUTIL(REF) 110 . K ^TMP("PXRMTDEB",$J) 111 ; 112 W !!,"The elements of the ^TMP(PXRMID,$J) array are:" 113 I $D(PXRMID) S REF="^TMP(PXRMID,$J)" D AWRITE^PXRMUTIL(REF) K ^TMP(PXRMID,$J) 114 ; 115 W !!,"The elements of the ^TMP(""PXRHM"",$J) array are:" 116 S REF="^TMP(""PXRHM"",$J)" 117 D AWRITE^PXRMUTIL(REF) 118 ; 119 I $D(^TMP("PXRHM",$J)) D CMOUT 120 I PXRHM=12 D MHVCOUT 121 K ^TMP("PXRM",$J),^TMP("PXRHM",$J),^TMP("PXRMMHVC",$J) 122 Q 123 ;================================================== 124 MHVCOUT ;Do formatted MHV combined output. 125 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE 126 W !!,"Formatted Output:" 127 S RIEN=$O(^TMP("PXRMMHVC",$J,"")) 128 S TEMP=^TMP("PXRMMHVC",$J,RIEN,"STATUS") 129 S STATUS=$P(TEMP,U,1) 130 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2)) 131 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3)) 132 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2)) 133 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3)) 134 S STATCOL=41-($L(STATUS)/2) 135 S DUECOL=53-($L(DUE)/2) 136 S LASTCOL=67-($L(LAST)/2) 137 S RNAME=$P(^PXD(811.9,RIEN,0),U,3) 138 I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1) 139 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",! 140 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,! 141 W !!,"---------- Detailed Output ----------" 142 S LNUM=0 143 F S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)) Q:LNUM="" D 144 . W !,^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM) 145 W !!,"---------- Summary Output ----------" 146 S LNUM=0 147 F S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)) Q:LNUM="" D 148 . W !,^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM) 149 Q 150 ;
Note:
See TracChangeset
for help on using the changeset viewer.
