GMTSPXHR ; SLC/SBW,KER - PCE Clinical Reminders/Maint ; 06/15/2005
;;2.7;Health Summary;**8,22,23,28,34,56,63,75,82**;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 '$D(GMTSOBJ("COMPONENT HEADER")),$D(GMTSOBJ("REPORT HEADER")),GMFIRST=1 W !!
I GMTSNPG D HDR,CKP^GMTSUP Q:$D(GMTSQIT)
I GMTSNPG D HDR
I GMFIRST W ?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",! S GMFIRST=0
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 ; Component Header
Q:'$D(GMTSOBJ("COMPONENT HEADER"))
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
GMTSPXHR ; SLC/SBW,KER - PCE Clinical Reminders/Maint ; 06/15/2005
+1 ;;2.7;Health Summary;**8,22,23,28,34,56,63,75,82**;Oct 20, 1995;Build 21
+2 ;
+3 ; External References
+4 ; DBIA 2182 MAIN^PXRM
+5 ;
MAIN ; Entry Point for Clinical Reminders
+1 NEW CM,GMFLAG,HVET,HVDISP
+2 SET (HVET,CM)=0
+3 IF GMTSEGH["CR"
SET GMFLAG=0
+4 IF GMTSEGH["CRS"
SET GMFLAG=1
+5 IF GMTSEGH["CM"
SET GMFLAG=5
SET CM=1
+6 IF GMTSEGH["CMB"
SET GMFLAG=4
SET CM=1
+7 IF GMTSEGH["MHVD"
SET HVET=1
SET CM=1
SET HVDISP=11
+8 IF GMTSEGH["MHVS"
SET HVET=1
SET CM=1
SET HVDISP=10
+9 IF +$GET(GMTSAGE)'>0!($GET(SEX)="")!($GET(DFN)'>0)
QUIT
+10 IF HVET=1
DO HVET
QUIT
+11 IF $ORDER(GMTSEG(GMTSEGN,811.9,0))'>0
QUIT
+12 NEW GMCR,GMFIRST,CRSEG,GMDISP
+13 SET GMCR=0
SET GMFIRST=1
+14 FOR
SET GMCR=$ORDER(GMTSEG(GMTSEGN,811.9,GMCR))
IF 'GMCR
QUIT
Begin DoDot:1
+15 SET CRSEG=GMTSEG(GMTSEGN,811.9,GMCR)
+16 KILL ^TMP("PXRHM",$JOB),^TMP("PXRM",$JOB)
+17 DO MAIN^PXRM(DFN,CRSEG,+$GET(GMFLAG),1)
+18 IF +$DATA(^TMP("PXRHM",$JOB))
DO GETCR
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+19 IF +$GET(GMDISP)'>0
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE "Selected Clinical Reminders not due.",!
+20 KILL ^TMP("PXRHM",$JOB),^TMP("PXRM",$JOB)
+21 QUIT
+22 ;
HVET ;
+1 NEW GMFIRST
+2 KILL ^TMP("PXRHM",$JOB),^TMP("PXRMHV",$JOB)
+3 SET GMFIRST=1
+4 DO HS^PXRMHVET(DFN,HVDISP)
+5 IF +$DATA(^TMP("PXRMHV",$JOB))
DO GETCRH
+6 IF +$GET(GMDISP)'>0
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE "No Patient Reminders found.",!
+7 KILL ^TMP("PXRHM",$JOB),^TMP("PXRMHV",$JOB)
+8 QUIT
+9 ;
GETCR ; Get reminders that were returned
+1 NEW ITEM,GMDT,GMN0,X,GMTSDAT,GMTSDUE,GMREM
+2 IF HVET=1
DO GETCRH
+3 SET ITEM=0
+4 FOR
SET ITEM=$ORDER(^TMP("PXRHM",$JOB,ITEM))
IF ITEM'>0
QUIT
Begin DoDot:1
+5 SET GMREM=""
+6 FOR
SET GMREM=$ORDER(^TMP("PXRHM",$JOB,ITEM,GMREM))
IF GMREM=""
QUIT
DO CRDISP
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+7 QUIT
+8 ;
GETCRH ; Get Reminders that were returned for MyHealtheVet
+1 NEW ITEM,GMDT,GMN0,X,GMTSDAT,GMTSDUE,GMREM,GMSTATUS
+2 SET GMSTATUS=""
+3 FOR
SET GMSTATUS=$ORDER(^TMP("PXRMHV",$JOB,GMSTATUS))
IF GMSTATUS=""
QUIT
Begin DoDot:1
+4 SET GMREM=""
FOR
SET GMREM=$ORDER(^TMP("PXRMHV",$JOB,GMSTATUS,GMREM))
IF GMREM=""
QUIT
Begin DoDot:2
+5 SET ITEM=0
FOR
SET ITEM=$ORDER(^TMP("PXRMHV",$JOB,GMSTATUS,GMREM,ITEM))
IF ITEM'>0
QUIT
DO CRDISP
IF $DATA(GMTSQIT)
QUIT
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+6 QUIT
+7 ;
CRDISP ; Display reminder data
+1 NEW DUECOL,HIST,LASTCOL,STATUS,STATCOL,TYPE
+2 IF HVET=0
SET GMN0=$GET(^TMP("PXRHM",$JOB,ITEM,GMREM))
+3 IF HVET=1
SET GMN0=$GET(^TMP("PXRMHV",$JOB,GMSTATUS,GMREM,ITEM))
+4 IF GMN0']""
QUIT
+5 SET STATUS=$PIECE(GMN0,U,1)
+6 SET X=$PIECE(GMN0,U,2)
DO REGDT4^GMTSU
SET GMTSDUE=X
+7 SET X=$PIECE(GMN0,U,3)
DO REGDT4^GMTSU
SET GMTSDAT=X
+8 SET TYPE=$PIECE(GMN0,U,4)
+9 IF TYPE["E"
SET HIST="(hist)"
+10 IF TYPE["X"
SET HIST="(exp)"
+11 SET GMDISP=1
+12 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+13 IF '$DATA(GMTSOBJ("COMPONENT HEADER"))
IF $DATA(GMTSOBJ("REPORT HEADER"))
IF GMFIRST=1
WRITE !!
+14 IF GMTSNPG
DO HDR
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+15 IF GMTSNPG
DO HDR
+16 IF GMFIRST
WRITE ?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",!
SET GMFIRST=0
+17 SET STATCOL=41-($LENGTH(STATUS)/2)
+18 SET DUECOL=53-($LENGTH(GMTSDUE)/2)
+19 SET LASTCOL=67-($LENGTH(GMTSDAT)/2)
+20 WRITE GMREM,?STATCOL,STATUS,?DUECOL,GMTSDUE,?LASTCOL,GMTSDAT,?73,$GET(HIST),!
+21 IF 'CM
QUIT
+22 ; Display activity data on reminder
+23 IF HVET=1
DO HVETCM
QUIT
+24 ;;commented out the following because I believe it is outdated
+25 ;S GMDT=0
+26 ;F S GMDT=$O(^TMP("PXRHM",$J,ITEM,GMREM,GMDT)) Q:+GMDT'>0 D Q:$D(GMTSQIT)
+27 ;. S GMN0=$G(^TMP("PXRHM",$J,ITEM,GMREM,GMDT))
+28 ;. Q:GMN0']""
+29 ;. I $P(GMN0,U,2) S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDAT=X
+30 ;. D CKP^GMTSUP Q:$D(GMTSQIT)
+31 ;. I GMTSNPG D HDR
+32 ;. W ?5,$P(GMN0,U)," on record - ",$G(GMTSDAT),", ",$P(GMN0,U,3),!
+33 ;; Display maintenance criteria for reminder
+34 SET GMDT=0
+35 FOR
SET GMDT=$ORDER(^TMP("PXRHM",$JOB,ITEM,GMREM,"TXT",GMDT))
IF +GMDT'>0
QUIT
Begin DoDot:1
+36 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+37 IF GMTSNPG
DO HDR
+38 WRITE ?5,$GET(^TMP("PXRHM",$JOB,ITEM,GMREM,"TXT",GMDT)),!
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+39 WRITE !
+40 QUIT
HVETCM ;
+1 ; Display maintenance criteria for reminder
+2 SET GMDT=0
+3 FOR
SET GMDT=$ORDER(^TMP("PXRMHV",$JOB,GMSTATUS,GMREM,ITEM,"TXT",GMDT))
IF +GMDT'>0
QUIT
Begin DoDot:1
+4 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+5 IF GMTSNPG
DO HDR
+6 WRITE ?5,$GET(^TMP("PXRMHV",$JOB,GMSTATUS,GMREM,ITEM,"TXT",GMDT)),!
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+7 WRITE !
+8 QUIT
+9 ;
HDR ; Component Header
+1 IF '$DATA(GMTSOBJ("COMPONENT HEADER"))
QUIT
+2 NEW GMREC
SET GMREC=0
+3 FOR
SET GMREC=$ORDER(^TMP("PXRM",$JOB,"DISC",GMREC))
IF +GMREC'>0
QUIT
Begin DoDot:1
+4 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+5 WRITE ?1,$GET(^TMP("PXRM",$JOB,"DISC",GMREC)),!
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+6 WRITE !
+7 QUIT
