GMTSPXHR.m

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