119 lines
3.8 KiB
Mathematica
119 lines
3.8 KiB
Mathematica
GMTSPXHR ; SLC/SBW,KER - PCE Clinical Reminders/Maint ; 06/15/2005
|
|
;;2.7;Health Summary;**8,22,23,28,34,56,63,75**;Oct 20, 1995;Build 21
|
|
;
|
|
; External References
|
|
; DBIA 2182 MAIN^PXRM
|
|
;
|
|
MAIN ; Entry Point for Clinical Reminders
|
|
N CM,GMFLAG,HVET,HVDISP
|
|
S (HVET,CM)=0
|
|
I GMTSEGH["CR" S GMFLAG=0
|
|
I GMTSEGH["CRS" S GMFLAG=1
|
|
I GMTSEGH["CM" S GMFLAG=5,CM=1
|
|
I GMTSEGH["CMB" S GMFLAG=4,CM=1
|
|
I GMTSEGH["MHVD" S HVET=1,CM=1,HVDISP=11
|
|
I GMTSEGH["MHVS" S HVET=1,CM=1,HVDISP=10
|
|
Q:+$G(GMTSAGE)'>0!($G(SEX)="")!($G(DFN)'>0)
|
|
I HVET=1 D HVET Q
|
|
Q:$O(GMTSEG(GMTSEGN,811.9,0))'>0
|
|
N GMCR,GMFIRST,CRSEG,GMDISP
|
|
S GMCR=0,GMFIRST=1
|
|
F S GMCR=$O(GMTSEG(GMTSEGN,811.9,GMCR)) Q:'GMCR D Q:$D(GMTSQIT)
|
|
. S CRSEG=GMTSEG(GMTSEGN,811.9,GMCR)
|
|
. K ^TMP("PXRHM",$J),^TMP("PXRM",$J)
|
|
. D MAIN^PXRM(DFN,CRSEG,+$G(GMFLAG),1)
|
|
. D:+$D(^TMP("PXRHM",$J)) GETCR
|
|
I +$G(GMDISP)'>0 D CKP^GMTSUP Q:$D(GMTSQIT) W "Selected Clinical Reminders not due.",!
|
|
K ^TMP("PXRHM",$J),^TMP("PXRM",$J)
|
|
Q
|
|
;
|
|
HVET ;
|
|
N GMFIRST
|
|
K ^TMP("PXRHM",$J),^TMP("PXRMHV",$J)
|
|
S GMFIRST=1
|
|
D HS^PXRMHVET(DFN,HVDISP)
|
|
D:+$D(^TMP("PXRMHV",$J)) GETCRH
|
|
I +$G(GMDISP)'>0 D CKP^GMTSUP Q:$D(GMTSQIT) W "No Patient Reminders found.",!
|
|
K ^TMP("PXRHM",$J),^TMP("PXRMHV",$J)
|
|
Q
|
|
;
|
|
GETCR ; Get reminders that were returned
|
|
N ITEM,GMDT,GMN0,X,GMTSDAT,GMTSDUE,GMREM
|
|
I HVET=1 D GETCRH
|
|
S ITEM=0
|
|
F S ITEM=$O(^TMP("PXRHM",$J,ITEM)) Q:ITEM'>0 D Q:$D(GMTSQIT)
|
|
. S GMREM=""
|
|
. F S GMREM=$O(^TMP("PXRHM",$J,ITEM,GMREM)) Q:GMREM="" D CRDISP Q:$D(GMTSQIT)
|
|
Q
|
|
;
|
|
GETCRH ; Get Reminders that were returned for MyHealtheVet
|
|
N ITEM,GMDT,GMN0,X,GMTSDAT,GMTSDUE,GMREM,GMSTATUS
|
|
S GMSTATUS=""
|
|
F S GMSTATUS=$O(^TMP("PXRMHV",$J,GMSTATUS)) Q:GMSTATUS="" D Q:$D(GMTSQIT)
|
|
.S GMREM="" F S GMREM=$O(^TMP("PXRMHV",$J,GMSTATUS,GMREM)) Q:GMREM="" D Q:$D(GMTSQIT)
|
|
..S ITEM=0 F S ITEM=$O(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM)) Q:ITEM'>0 D CRDISP Q:$D(GMTSQIT)
|
|
Q
|
|
;
|
|
CRDISP ; Display reminder data
|
|
N DUECOL,HIST,LASTCOL,STATUS,STATCOL,TYPE
|
|
I HVET=0 S GMN0=$G(^TMP("PXRHM",$J,ITEM,GMREM))
|
|
I HVET=1 S GMN0=$G(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM))
|
|
Q:GMN0']""
|
|
S STATUS=$P(GMN0,U,1)
|
|
S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDUE=X
|
|
S X=$P(GMN0,U,3) D REGDT4^GMTSU S GMTSDAT=X
|
|
S TYPE=$P(GMN0,U,4)
|
|
I TYPE["E" S HIST="(hist)"
|
|
I TYPE["X" S HIST="(exp)"
|
|
S GMDISP=1
|
|
D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
I GMTSNPG D HDR,CKP^GMTSUP Q:$D(GMTSQIT)
|
|
I GMTSNPG D HDR
|
|
S STATCOL=41-($L(STATUS)/2)
|
|
S DUECOL=53-($L(GMTSDUE)/2)
|
|
S LASTCOL=67-($L(GMTSDAT)/2)
|
|
W GMREM,?STATCOL,STATUS,?DUECOL,GMTSDUE,?LASTCOL,GMTSDAT,?73,$G(HIST),!
|
|
I 'CM Q
|
|
; Display activity data on reminder
|
|
I HVET=1 D HVETCM Q
|
|
;;commented out the following because I believe it is outdated
|
|
;S GMDT=0
|
|
;F S GMDT=$O(^TMP("PXRHM",$J,ITEM,GMREM,GMDT)) Q:+GMDT'>0 D Q:$D(GMTSQIT)
|
|
;. S GMN0=$G(^TMP("PXRHM",$J,ITEM,GMREM,GMDT))
|
|
;. Q:GMN0']""
|
|
;. I $P(GMN0,U,2) S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDAT=X
|
|
;. D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
;. I GMTSNPG D HDR
|
|
;. W ?5,$P(GMN0,U)," on record - ",$G(GMTSDAT),", ",$P(GMN0,U,3),!
|
|
;; Display maintenance criteria for reminder
|
|
S GMDT=0
|
|
F S GMDT=$O(^TMP("PXRHM",$J,ITEM,GMREM,"TXT",GMDT)) Q:+GMDT'>0 D Q:$D(GMTSQIT)
|
|
. D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
. I GMTSNPG D HDR
|
|
. W ?5,$G(^TMP("PXRHM",$J,ITEM,GMREM,"TXT",GMDT)),!
|
|
W !
|
|
Q
|
|
HVETCM ;
|
|
; Display maintenance criteria for reminder
|
|
S GMDT=0
|
|
F S GMDT=$O(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM,"TXT",GMDT)) Q:+GMDT'>0 D Q:$D(GMTSQIT)
|
|
. D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
. I GMTSNPG D HDR
|
|
. W ?5,$G(^TMP("PXRMHV",$J,GMSTATUS,GMREM,ITEM,"TXT",GMDT)),!
|
|
W !
|
|
Q
|
|
;
|
|
HDR ; Header
|
|
I GMFIRST D FIRST Q:$D(GMTSQIT) S GMFIRST=0
|
|
W ?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",!
|
|
Q
|
|
;
|
|
FIRST ; Display Disclaimer
|
|
N GMREC
|
|
S GMREC=0
|
|
F S GMREC=$O(^TMP("PXRM",$J,"DISC",GMREC)) Q:+GMREC'>0 D Q:$D(GMTSQIT)
|
|
. D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
. W ?1,$G(^TMP("PXRM",$J,"DISC",GMREC)),!
|
|
W !
|
|
Q
|