GMTSPXHR ; SLC/SBW,KER - PCE Clinical Reminders/Maint ; 02/27/2015
;;2.7;Health Summary;**8,22,23,28,34,56,63,75,82,89,113**;Oct 20, 1995;Build 47
;
; External References
; DBIA 2182 MAIN^PXRM
;
MAIN ; Entry Point for Clinical Reminders
N CM,GMFLAG,GMSEP,HVET,HVDISP
S (HVET,CM)=0
I GMTSEGH["CR" S GMFLAG=0,GMSEP=0
I GMTSEGH["CRS" S GMFLAG=1,GMSEP=0
I GMTSEGH["CM" S GMFLAG=5,CM=1,GMSEP=1
I GMTSEGH["CMB" S GMFLAG=4,CM=1,GMSEP=1
I GMTSEGH["CF" S GMFLAG=5,CM=1,GMSEP=1
I GMTSEGH["CLD" S GMFLAG=1,CM=0,GMSEP=0
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
W !
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
;
CRDISP ; Display reminder data
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 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)
N IND,NL,GMTSTEXT,START
S NL=0
I HVET=0 D Q
. I GMTSEGH["CF" D
.. D FINDINGS("PXRHM",.NL,.GMTSTEXT)
.. S START=1
.. I GMFIRST S GMFIRST=0
.. I 'GMFIRST,GMSEP W !
. I GMTSEGH["CLD" D LASTDONE("PXRHM",.NL,.GMTSTEXT) S START=1
. I (GMTSEGH["CM")!(GMTSEGH["CR") D
.. D FMTOUT^PXRMFMTO("PXRHM",.NL,.GMTSTEXT)
.. S START=2
.. I GMFIRST W !,GMTSTEXT(1) S GMFIRST=0
.. I 'GMFIRST,GMSEP W !
. F IND=START:1:NL D
.. D CKP^GMTSUP Q:$D(GMTSQIT)
.. I GMTSNPG D HDR
.. W !,GMTSTEXT(IND)
I HVET=1 D HVETDISP
Q
;
FINDINGS(TMPSUB,NL,OUTPUT) ;Findings component.
I '$D(^TMP(TMPSUB,$J)) Q
N FREQ,LNUM,RIEN,RNAME,TEMP
S RIEN=$O(^TMP(TMPSUB,$J,""))
S RNAME=$O(^TMP(TMPSUB,$J,RIEN,""))
S NL=NL+1,OUTPUT(NL)=RNAME
S LNUM=0
F S LNUM=$O(^TMP(TMPSUB,$J,RIEN,RNAME,"TXT",LNUM)) Q:LNUM="" D
. I ^TMP(TMPSUB,$J,RIEN,RNAME,"TXT",LNUM)["Frequency" Q
. S NL=NL+1,OUTPUT(NL)=^TMP(TMPSUB,$J,RIEN,RNAME,"TXT",LNUM)
Q
;
GETCR ; Get reminders that were returned
N ITEM,GMDT,GMN0,GMTSDAT,GMTSDUE,GMREM,X
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,GMTSDAT,GMTSDUE,GMREM,GMSTATUS,X
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
;
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
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
;
HVETDISP ;MHV output.
N IND,NL
S NL=0
D MHVOUT^PXRMFMTO("PXRMHV",GMSTATUS,GMREM,ITEM,.NL,.GMTSTEXT)
I GMFIRST W !,GMTSTEXT(1) S GMFIRST=0
F IND=2:1:NL D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. I GMTSNPG D HDR
. W !,GMTSTEXT(IND)
W !
Q
;
LASTDONE(TMPSUB,NL,OUTPUT) ;Last Done component.
I '$D(^TMP(TMPSUB,$J)) Q
N DFMT,FREQ,LAST,RIEN,RNAME,STATUS,TEMP,TEXT
S RIEN=$O(^TMP(TMPSUB,$J,""))
S RNAME=$O(^TMP(TMPSUB,$J,RIEN,""))
S FREQ=$G(^TMP(TMPSUB,$J,RIEN,RNAME,"FREQ"))
S TEMP=$G(^TMP(TMPSUB,$J,RIEN,RNAME))
S DFMT=$S(FREQ["H":"5Z",1:"5DZ")
S STATUS=$P(TEMP,U,1)
S LAST=$S(STATUS="N/A":"N/A",1:$$DDATE^PXRMDATE($P(TEMP,U,3),DFMT))
S TEXT=RNAME_$$REPEAT^XLFSTR(" ",(41-$L(RNAME)))_LAST
S NL=NL+1,OUTPUT(NL)=TEXT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPXHR 4398 printed Oct 16, 2024@18:00:36 Page 2
GMTSPXHR ; SLC/SBW,KER - PCE Clinical Reminders/Maint ; 02/27/2015
+1 ;;2.7;Health Summary;**8,22,23,28,34,56,63,75,82,89,113**;Oct 20, 1995;Build 47
+2 ;
+3 ; External References
+4 ; DBIA 2182 MAIN^PXRM
+5 ;
MAIN ; Entry Point for Clinical Reminders
+1 NEW CM,GMFLAG,GMSEP,HVET,HVDISP
+2 SET (HVET,CM)=0
+3 IF GMTSEGH["CR"
SET GMFLAG=0
SET GMSEP=0
+4 IF GMTSEGH["CRS"
SET GMFLAG=1
SET GMSEP=0
+5 IF GMTSEGH["CM"
SET GMFLAG=5
SET CM=1
SET GMSEP=1
+6 IF GMTSEGH["CMB"
SET GMFLAG=4
SET CM=1
SET GMSEP=1
+7 IF GMTSEGH["CF"
SET GMFLAG=5
SET CM=1
SET GMSEP=1
+8 IF GMTSEGH["CLD"
SET GMFLAG=1
SET CM=0
SET GMSEP=0
+9 IF GMTSEGH["MHVD"
SET HVET=1
SET CM=1
SET HVDISP=11
+10 IF GMTSEGH["MHVS"
SET HVET=1
SET CM=1
SET HVDISP=10
+11 if +$GET(GMTSAGE)'>0!($GET(SEX)="")!($GET(DFN)'>0)
QUIT
+12 IF HVET=1
DO HVET
QUIT
+13 if $ORDER(GMTSEG(GMTSEGN,811.9,0))'>0
QUIT
+14 WRITE !
+15 NEW GMCR,GMFIRST,CRSEG,GMDISP
+16 SET GMCR=0
SET GMFIRST=1
+17 FOR
SET GMCR=$ORDER(GMTSEG(GMTSEGN,811.9,GMCR))
if 'GMCR
QUIT
Begin DoDot:1
+18 SET CRSEG=GMTSEG(GMTSEGN,811.9,GMCR)
+19 KILL ^TMP("PXRHM",$JOB),^TMP("PXRM",$JOB)
+20 DO MAIN^PXRM(DFN,CRSEG,+$GET(GMFLAG),1)
+21 if +$DATA(^TMP("PXRHM",$JOB))
DO GETCR
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+22 IF +$GET(GMDISP)'>0
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Selected Clinical Reminders not due.",!
+23 KILL ^TMP("PXRHM",$JOB),^TMP("PXRM",$JOB)
+24 QUIT
+25 ;
CRDISP ; Display reminder data
+1 IF HVET=0
SET GMN0=$GET(^TMP("PXRHM",$JOB,ITEM,GMREM))
+2 IF HVET=1
SET GMN0=$GET(^TMP("PXRMHV",$JOB,GMSTATUS,GMREM,ITEM))
+3 if GMN0']""
QUIT
+4 SET GMDISP=1
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 IF '$DATA(GMTSOBJ("COMPONENT HEADER"))
IF $DATA(GMTSOBJ("REPORT HEADER"))
IF GMFIRST=1
WRITE !
+7 IF GMTSNPG
DO HDR
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 NEW IND,NL,GMTSTEXT,START
+9 SET NL=0
+10 IF HVET=0
Begin DoDot:1
+11 IF GMTSEGH["CF"
Begin DoDot:2
+12 DO FINDINGS("PXRHM",.NL,.GMTSTEXT)
+13 SET START=1
+14 IF GMFIRST
SET GMFIRST=0
+15 IF 'GMFIRST
IF GMSEP
WRITE !
End DoDot:2
+16 IF GMTSEGH["CLD"
DO LASTDONE("PXRHM",.NL,.GMTSTEXT)
SET START=1
+17 IF (GMTSEGH["CM")!(GMTSEGH["CR")
Begin DoDot:2
+18 DO FMTOUT^PXRMFMTO("PXRHM",.NL,.GMTSTEXT)
+19 SET START=2
+20 IF GMFIRST
WRITE !,GMTSTEXT(1)
SET GMFIRST=0
+21 IF 'GMFIRST
IF GMSEP
WRITE !
End DoDot:2
+22 FOR IND=START:1:NL
Begin DoDot:2
+23 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+24 IF GMTSNPG
DO HDR
+25 WRITE !,GMTSTEXT(IND)
End DoDot:2
End DoDot:1
QUIT
+26 IF HVET=1
DO HVETDISP
+27 QUIT
+28 ;
FINDINGS(TMPSUB,NL,OUTPUT) ;Findings component.
+1 IF '$DATA(^TMP(TMPSUB,$JOB))
QUIT
+2 NEW FREQ,LNUM,RIEN,RNAME,TEMP
+3 SET RIEN=$ORDER(^TMP(TMPSUB,$JOB,""))
+4 SET RNAME=$ORDER(^TMP(TMPSUB,$JOB,RIEN,""))
+5 SET NL=NL+1
SET OUTPUT(NL)=RNAME
+6 SET LNUM=0
+7 FOR
SET LNUM=$ORDER(^TMP(TMPSUB,$JOB,RIEN,RNAME,"TXT",LNUM))
if LNUM=""
QUIT
Begin DoDot:1
+8 IF ^TMP(TMPSUB,$JOB,RIEN,RNAME,"TXT",LNUM)["Frequency"
QUIT
+9 SET NL=NL+1
SET OUTPUT(NL)=^TMP(TMPSUB,$JOB,RIEN,RNAME,"TXT",LNUM)
End DoDot:1
+10 QUIT
+11 ;
GETCR ; Get reminders that were returned
+1 NEW ITEM,GMDT,GMN0,GMTSDAT,GMTSDUE,GMREM,X
+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,GMTSDAT,GMTSDUE,GMREM,GMSTATUS,X
+2 SET GMSTATUS=""
+3 FOR
SET GMSTATUS=$ORDER(^TMP("PXRMHV",$JOB,GMSTATUS))
if GMSTATUS=""
QUIT
Begin DoDot:1
+4 SET GMREM=""
+5 FOR
SET GMREM=$ORDER(^TMP("PXRMHV",$JOB,GMSTATUS,GMREM))
if GMREM=""
QUIT
Begin DoDot:2
+6 SET ITEM=0
+7 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
+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
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 ;
HVETDISP ;MHV output.
+1 NEW IND,NL
+2 SET NL=0
+3 DO MHVOUT^PXRMFMTO("PXRMHV",GMSTATUS,GMREM,ITEM,.NL,.GMTSTEXT)
+4 IF GMFIRST
WRITE !,GMTSTEXT(1)
SET GMFIRST=0
+5 FOR IND=2:1:NL
Begin DoDot:1
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+7 IF GMTSNPG
DO HDR
+8 WRITE !,GMTSTEXT(IND)
End DoDot:1
+9 WRITE !
+10 QUIT
+11 ;
LASTDONE(TMPSUB,NL,OUTPUT) ;Last Done component.
+1 IF '$DATA(^TMP(TMPSUB,$JOB))
QUIT
+2 NEW DFMT,FREQ,LAST,RIEN,RNAME,STATUS,TEMP,TEXT
+3 SET RIEN=$ORDER(^TMP(TMPSUB,$JOB,""))
+4 SET RNAME=$ORDER(^TMP(TMPSUB,$JOB,RIEN,""))
+5 SET FREQ=$GET(^TMP(TMPSUB,$JOB,RIEN,RNAME,"FREQ"))
+6 SET TEMP=$GET(^TMP(TMPSUB,$JOB,RIEN,RNAME))
+7 SET DFMT=$SELECT(FREQ["H":"5Z",1:"5DZ")
+8 SET STATUS=$PIECE(TEMP,U,1)
+9 SET LAST=$SELECT(STATUS="N/A":"N/A",1:$$DDATE^PXRMDATE($PIECE(TEMP,U,3),DFMT))
+10 SET TEXT=RNAME_$$REPEAT^XLFSTR(" ",(41-$LENGTH(RNAME)))_LAST
+11 SET NL=NL+1
SET OUTPUT(NL)=TEXT
+12 QUIT
+13 ;
