GMTS1 ; SLC/JER,KER - Health Summary Driver ; 05/22/2008
;;2.7;Health Summary;**7,16,24,28,37,49,58,89**;Oct 20, 1995;Build 61
;
; External References
; DBIA 10076 ^XUSEC(
; DBIA 10000 C^%DTC
; DBIA 10000 NOW^%DTC
;
EN ; Entry Point to Generate a Summary
;
; Requires: DFN, GMTSTITL, GMTSEG()
; GMTSEGI(), GMTSEGC, DUZ(2)
;
; $I & IO MUST BE VALID, CALLER MUST CLOSE OUTPUT DEVICE
;
START ; Health Summary
N GMSUPRES,GMTSICF,GMTSPXD1,GMTSPXD2,GMTSBEG,GMTSEND
S GMSUPRES=$P($G(^GMT(142,+$G(GMTSTYP),0)),U,5)
I $D(GMSUPRES),$D(GMTSOBJ),'$D(GMTSOBJ("SUPPRESS COMPONENTS")) S GMSUPRES="N"
S:$D(GMTSOBJ("SUPPRESS COMPONENTS")) GMSUPRES="Y"
U IO S GMTSLO=3,GMTSLPG=0
D DEM^GMTSU
W:$E(IOST)="C"&('$D(GMTSOBJ)) @IOF D OUTPUT
K GMTSCVD,GMTSCKP,GMTSNPG,GMTSPG,GMTSQIT,GMTSHDR,GMTSHD2,GMTSBRK,GMTSLCMP,GMTSDTC
K GMTSEGN,GMTSE,GMTSEGR,GMTSEQ,GMTSEGH,GMTSEGL,GMTSDLM,GMTSDLS,GMTSNDM,GMTSN,GMTSQ
Q
;
OUTPUT ; Loop through GMTSEG()
D NOW^%DTC S X=% D REGDTM4^GMTSU S GMTSDTM=X
I +$G(GMTSPX1)&+$G(GMTSPX2) D ; Allows date range for data
. S GMTS2=9999999-$P(GMTSPX2,"."),GMTS1=9999999-$P(GMTSPX1,".")-.24
. ; For GMTS1 want to get everything till Midnight
. S X=GMTSPX1 D REGDT4^GMTSU S GMTSPXD1=X
. S X=GMTSPX2 D REGDT4^GMTSU S GMTSPXD2=X
D HEADER^GMTSUP
K GMTSQIT S GMTSEGN=""
N STR
F S GMTSEGN=$O(GMTSEG(GMTSEGN)) Q:GMTSEGN="" D I $D(GMTSQIT),(GMTSQIT="") Q
. K GMTSQIT S GMTSEQ=$P(GMTSEG(GMTSEGN),U,1)
. S GMTSE=$P(GMTSEG(GMTSEGN),U,2) D SEGMNT D:GMTSEGN=GMTSEGC LASTPG
I $D(GMTSOBJ),+($O(GMTSEG(0)))=0 D
.S STR=$S(GMTSOBJ("NO DATA")'="":" "_GMTSOBJ("NO DATA"),1:" No data available")
.W !,STR
S GMTSHDR=$E(GMTSHDR,1,3)_" END "_$E(GMTSHDR,9,79)
S:$D(GMTSOBJ) GMTSHDR=$E(GMTSHDR,1,74)
S:$D(GMTSOBJE) GMTSHDR="",$P(GMTSHDR,"*",74)="*"
I '$D(GMTSOBJ)!($D(GMTSOBJ("CONFIDENTIAL"))) W:$E(IOST)'="C" !,GMTSHDR,!
I '$D(GMTSOBJ) H:$E(IOST)="C" 1
W:'+$G(GMPSAP)&('$D(GMTSOBJ))&('$D(GMTSOBJE)) @IOF
I $D(GMTSQIT) D EXIT
Q
;
LASTPG ; Allows User to branch to an earlier component (last page)
Q:$E(IOST)'="C"!(IOT="HFS")!$D(GMTSQIT)
I +$G(GMPSAP),IOSL>998,$G(GMPAT(+$O(GMPAT(0),-1)))'=DFN Q
; No footer when IOSL > 998 and action profile is printed.
I IOSL>998,+$G(GMPSAP) Q
; No footer when IOSL > 998 and this isn't the last patient.
I IOSL>998,$G(GMPAT(+$O(GMPAT(""),-1)))'=$G(DFN) Q
I '$D(GMTSOBJ) F I=$Y:1:$S((IOSL-GMTSLO)'>64:(IOSL-GMTSLO),1:(24-GMTSLO)) W !
I $D(GMTSQIT),(GMTSQIT>0) K GMTSQIT
S GMTSLPG=1 D CKP^GMTSUP
Q
EXIT ; Clean up and quit
K ZTSK
Q
SEGMNT ; Output a Component Type
N GMTSLOCK,GMTSDBL,GMOOTXT,GMPXICDF,GMPXHLOC,GMPXNARR,GMPXCMOD,GMPXCM,GMTSWRIT,GMSEL
I $D(GMTSQIT),(GMTSQIT]"") K GMTSQIT
S X=^GMT(142.1,GMTSE,0)
S GMTSEGH=$S($P(X,U,4)]"":$P(X,U,4)_" - ",1:"")_$S($P(GMTSEG(GMTSEGN),U,5)]"":$P(GMTSEG(GMTSEGN),U,5),$P(X,U,9)]"":$P(X,U,9),1:" "_$P(X,U,1)),GMTSEGR=$P(X,"^",2)
Q:GMTSEGR=""
S GMTSLOCK=$P(X,U,7),GMTSDBL=$P(X,U,6),GMOOTXT=$P(X,U,8),GMPXCM=$P(X,U,14)
S GMPXHLOC=$P(GMTSEG(GMTSEGN),U,6),GMPXNARR=$P(GMTSEG(GMTSEGN),U,8)
S GMPXCMOD=$P(GMTSEG(GMTSEGN),U,9) S:GMPXCM'="Y" GMPXCMOD="N"
S GMPXICDF=$P(GMTSEG(GMTSEGN),U,7)
S GMTSNDM=$P(GMTSEG(GMTSEGN),U,3),GMTSDLM=$P(GMTSEG(GMTSEGN),U,4) S:GMTSNDM="" GMTSNDM=-1
; Allow for date range for data
S:+$G(GMTSPX1)&+$G(GMTSPX2) GMTSDLM=""
S GMTSDLS=""
I GMTSDLM?1N.N!(GMTSDLM?1N.N1"D") S GMTSDLS=+GMTSDLM_" day"
S:GMTSDLM?1N.N1"W" GMTSDLS=+GMTSDLM_" week",GMTSDLM=+GMTSDLM*7
S:GMTSDLM?1N.N1"M" GMTSDLS=+GMTSDLM_" month",GMTSDLM=+GMTSDLM*30.4
S:GMTSDLM?1N.N1"Y" GMTSDLS=+GMTSDLM_" year",GMTSDLM=+GMTSDLM*365.25
S GMTSDLM=+GMTSDLM
S:+GMTSDLS>1 GMTSDLS=GMTSDLS_"s"
S GMTSEGL="" I GMTSNDM>0!(GMTSDLM>0) S GMTSEGL=" (max "_$S(GMTSNDM>0:GMTSNDM_$S(GMTSNDM=1:" occurrence",1:" occurrences")_$S(GMTSDLM>0:" or ",1:""),1:"")_$S(GMTSDLM>0:GMTSDLS,1:"")_")"
K GMTSDLS,GMTSN
D NOW^%DTC S GMTSDTC=%,DT=$P(%,".") K %,%H,%I
; Use date range unless variables empty
; GMTS1=Most recent inverted date
; GMTS2=To date in the past in an inverted date format
I +$G(GMTSPX1)'>0!(+$G(GMTSPX2)'>0) D
. I GMTSDLM'>0 S (GMTS2,GMTSDLM)=9999999,GMTS1=6666666
. E S X1=GMTSDTC,X2=-GMTSDLM D C^%DTC S GMTSDLM=9999999-X,GMTS2=GMTSDLM,GMTS1=9999999-(GMTSDTC+.0001) K X1,X2
; Set GMTSBEG to be GMTS2 uninverted
S GMTSBEG=$S(GMTS2=9999999:1,1:9999999-GMTS2)
; Set GMTSEND to be GMTS1 uninverted
S GMTSEND=$S(GMTS1=6666666:9999999,1:$P(9999999-GMTS1,".")_".235959")
; GMTSWRIT is used to print component heading on 1st write
S GMTSWRIT=1
I GMTSDBL]"",("PT"[GMTSDBL) D Q
. D:GMTSDBL="T" TDISBLD^GMTS2
. D:GMTSDBL="P"&$D(GMTSPRM) PDISBLD^GMTS2
I GMTSLOCK]"",('$D(^XUSEC(GMTSLOCK,DUZ))) D NOMATCH^GMTS2 Q
S GMSEL=$P($G(^GMT(142.1,GMTSE,1,1,0)),U)
I GMSEL]"",$O(GMTSEG(GMTSEGN,GMSEL,0))'>0 D NOSELECT^GMTS2 Q
S GMTSNPG=0,GMTSWRIT=1
D @($P(GMTSEGR,";",1)_U_$P(GMTSEGR,";",2))
D NODATA^GMTS2 S GMTSWRIT=1
K GMTSDLM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTS1 5086 printed Dec 13, 2024@01:56:52 Page 2
GMTS1 ; SLC/JER,KER - Health Summary Driver ; 05/22/2008
+1 ;;2.7;Health Summary;**7,16,24,28,37,49,58,89**;Oct 20, 1995;Build 61
+2 ;
+3 ; External References
+4 ; DBIA 10076 ^XUSEC(
+5 ; DBIA 10000 C^%DTC
+6 ; DBIA 10000 NOW^%DTC
+7 ;
EN ; Entry Point to Generate a Summary
+1 ;
+2 ; Requires: DFN, GMTSTITL, GMTSEG()
+3 ; GMTSEGI(), GMTSEGC, DUZ(2)
+4 ;
+5 ; $I & IO MUST BE VALID, CALLER MUST CLOSE OUTPUT DEVICE
+6 ;
START ; Health Summary
+1 NEW GMSUPRES,GMTSICF,GMTSPXD1,GMTSPXD2,GMTSBEG,GMTSEND
+2 SET GMSUPRES=$PIECE($GET(^GMT(142,+$GET(GMTSTYP),0)),U,5)
+3 IF $DATA(GMSUPRES)
IF $DATA(GMTSOBJ)
IF '$DATA(GMTSOBJ("SUPPRESS COMPONENTS"))
SET GMSUPRES="N"
+4 if $DATA(GMTSOBJ("SUPPRESS COMPONENTS"))
SET GMSUPRES="Y"
+5 USE IO
SET GMTSLO=3
SET GMTSLPG=0
+6 DO DEM^GMTSU
+7 if $EXTRACT(IOST)="C"&('$DATA(GMTSOBJ))
WRITE @IOF
DO OUTPUT
+8 KILL GMTSCVD,GMTSCKP,GMTSNPG,GMTSPG,GMTSQIT,GMTSHDR,GMTSHD2,GMTSBRK,GMTSLCMP,GMTSDTC
+9 KILL GMTSEGN,GMTSE,GMTSEGR,GMTSEQ,GMTSEGH,GMTSEGL,GMTSDLM,GMTSDLS,GMTSNDM,GMTSN,GMTSQ
+10 QUIT
+11 ;
OUTPUT ; Loop through GMTSEG()
+1 DO NOW^%DTC
SET X=%
DO REGDTM4^GMTSU
SET GMTSDTM=X
+2 ; Allows date range for data
IF +$GET(GMTSPX1)&+$GET(GMTSPX2)
Begin DoDot:1
+3 SET GMTS2=9999999-$PIECE(GMTSPX2,".")
SET GMTS1=9999999-$PIECE(GMTSPX1,".")-.24
+4 ; For GMTS1 want to get everything till Midnight
+5 SET X=GMTSPX1
DO REGDT4^GMTSU
SET GMTSPXD1=X
+6 SET X=GMTSPX2
DO REGDT4^GMTSU
SET GMTSPXD2=X
End DoDot:1
+7 DO HEADER^GMTSUP
+8 KILL GMTSQIT
SET GMTSEGN=""
+9 NEW STR
+10 FOR
SET GMTSEGN=$ORDER(GMTSEG(GMTSEGN))
if GMTSEGN=""
QUIT
Begin DoDot:1
+11 KILL GMTSQIT
SET GMTSEQ=$PIECE(GMTSEG(GMTSEGN),U,1)
+12 SET GMTSE=$PIECE(GMTSEG(GMTSEGN),U,2)
DO SEGMNT
if GMTSEGN=GMTSEGC
DO LASTPG
End DoDot:1
IF $DATA(GMTSQIT)
IF (GMTSQIT="")
QUIT
+13 IF $DATA(GMTSOBJ)
IF +($ORDER(GMTSEG(0)))=0
Begin DoDot:1
+14 SET STR=$SELECT(GMTSOBJ("NO DATA")'="":" "_GMTSOBJ("NO DATA"),1:" No data available")
+15 WRITE !,STR
End DoDot:1
+16 SET GMTSHDR=$EXTRACT(GMTSHDR,1,3)_" END "_$EXTRACT(GMTSHDR,9,79)
+17 if $DATA(GMTSOBJ)
SET GMTSHDR=$EXTRACT(GMTSHDR,1,74)
+18 if $DATA(GMTSOBJE)
SET GMTSHDR=""
SET $PIECE(GMTSHDR,"*",74)="*"
+19 IF '$DATA(GMTSOBJ)!($DATA(GMTSOBJ("CONFIDENTIAL")))
if $EXTRACT(IOST)'="C"
WRITE !,GMTSHDR,!
+20 IF '$DATA(GMTSOBJ)
if $EXTRACT(IOST)="C"
HANG 1
+21 if '+$GET(GMPSAP)&('$DATA(GMTSOBJ))&('$DATA(GMTSOBJE))
WRITE @IOF
+22 IF $DATA(GMTSQIT)
DO EXIT
+23 QUIT
+24 ;
LASTPG ; Allows User to branch to an earlier component (last page)
+1 if $EXTRACT(IOST)'="C"!(IOT="HFS")!$DATA(GMTSQIT)
QUIT
+2 IF +$GET(GMPSAP)
IF IOSL>998
IF $GET(GMPAT(+$ORDER(GMPAT(0),-1)))'=DFN
QUIT
+3 ; No footer when IOSL > 998 and action profile is printed.
+4 IF IOSL>998
IF +$GET(GMPSAP)
QUIT
+5 ; No footer when IOSL > 998 and this isn't the last patient.
+6 IF IOSL>998
IF $GET(GMPAT(+$ORDER(GMPAT(""),-1)))'=$GET(DFN)
QUIT
+7 IF '$DATA(GMTSOBJ)
FOR I=$Y:1:$SELECT((IOSL-GMTSLO)'>64:(IOSL-GMTSLO),1:(24-GMTSLO))
WRITE !
+8 IF $DATA(GMTSQIT)
IF (GMTSQIT>0)
KILL GMTSQIT
+9 SET GMTSLPG=1
DO CKP^GMTSUP
+10 QUIT
EXIT ; Clean up and quit
+1 KILL ZTSK
+2 QUIT
SEGMNT ; Output a Component Type
+1 NEW GMTSLOCK,GMTSDBL,GMOOTXT,GMPXICDF,GMPXHLOC,GMPXNARR,GMPXCMOD,GMPXCM,GMTSWRIT,GMSEL
+2 IF $DATA(GMTSQIT)
IF (GMTSQIT]"")
KILL GMTSQIT
+3 SET X=^GMT(142.1,GMTSE,0)
+4 SET GMTSEGH=$SELECT($PIECE(X,U,4)]"":$PIECE(X,U,4)_" - ",1:"")_$SELECT($PIECE(GMTSEG(GMTSEGN),U,5)]"":$PIECE(GMTSEG(GMTSEGN),U,5),$PIECE(X,U,9)]"":$PIECE(X,U,9),1:" "_$PIECE(X,U,1))
SET GMTSEGR=$PIECE(X,"^",2)
+5 if GMTSEGR=""
QUIT
+6 SET GMTSLOCK=$PIECE(X,U,7)
SET GMTSDBL=$PIECE(X,U,6)
SET GMOOTXT=$PIECE(X,U,8)
SET GMPXCM=$PIECE(X,U,14)
+7 SET GMPXHLOC=$PIECE(GMTSEG(GMTSEGN),U,6)
SET GMPXNARR=$PIECE(GMTSEG(GMTSEGN),U,8)
+8 SET GMPXCMOD=$PIECE(GMTSEG(GMTSEGN),U,9)
if GMPXCM'="Y"
SET GMPXCMOD="N"
+9 SET GMPXICDF=$PIECE(GMTSEG(GMTSEGN),U,7)
+10 SET GMTSNDM=$PIECE(GMTSEG(GMTSEGN),U,3)
SET GMTSDLM=$PIECE(GMTSEG(GMTSEGN),U,4)
if GMTSNDM=""
SET GMTSNDM=-1
+11 ; Allow for date range for data
+12 if +$GET(GMTSPX1)&+$GET(GMTSPX2)
SET GMTSDLM=""
+13 SET GMTSDLS=""
+14 IF GMTSDLM?1N.N!(GMTSDLM?1N.N1"D")
SET GMTSDLS=+GMTSDLM_" day"
+15 if GMTSDLM?1N.N1"W"
SET GMTSDLS=+GMTSDLM_" week"
SET GMTSDLM=+GMTSDLM*7
+16 if GMTSDLM?1N.N1"M"
SET GMTSDLS=+GMTSDLM_" month"
SET GMTSDLM=+GMTSDLM*30.4
+17 if GMTSDLM?1N.N1"Y"
SET GMTSDLS=+GMTSDLM_" year"
SET GMTSDLM=+GMTSDLM*365.25
+18 SET GMTSDLM=+GMTSDLM
+19 if +GMTSDLS>1
SET GMTSDLS=GMTSDLS_"s"
+20 SET GMTSEGL=""
IF GMTSNDM>0!(GMTSDLM>0)
SET GMTSEGL=" (max "_$SELECT(GMTSNDM>0:GMTSNDM_$SELECT(GMTSNDM=1:" occurrence",1:" occurrences")_$SELECT(GMTSDLM>0:" or ",1:""),1:"")_$SELECT(GMTSDLM>0:GMTSDLS,1:"")_")"
+21 KILL GMTSDLS,GMTSN
+22 DO NOW^%DTC
SET GMTSDTC=%
SET DT=$PIECE(%,".")
KILL %,%H,%I
+23 ; Use date range unless variables empty
+24 ; GMTS1=Most recent inverted date
+25 ; GMTS2=To date in the past in an inverted date format
+26 IF +$GET(GMTSPX1)'>0!(+$GET(GMTSPX2)'>0)
Begin DoDot:1
+27 IF GMTSDLM'>0
SET (GMTS2,GMTSDLM)=9999999
SET GMTS1=6666666
+28 IF '$TEST
SET X1=GMTSDTC
SET X2=-GMTSDLM
DO C^%DTC
SET GMTSDLM=9999999-X
SET GMTS2=GMTSDLM
SET GMTS1=9999999-(GMTSDTC+.0001)
KILL X1,X2
End DoDot:1
+29 ; Set GMTSBEG to be GMTS2 uninverted
+30 SET GMTSBEG=$SELECT(GMTS2=9999999:1,1:9999999-GMTS2)
+31 ; Set GMTSEND to be GMTS1 uninverted
+32 SET GMTSEND=$SELECT(GMTS1=6666666:9999999,1:$PIECE(9999999-GMTS1,".")_".235959")
+33 ; GMTSWRIT is used to print component heading on 1st write
+34 SET GMTSWRIT=1
+35 IF GMTSDBL]""
IF ("PT"[GMTSDBL)
Begin DoDot:1
+36 if GMTSDBL="T"
DO TDISBLD^GMTS2
+37 if GMTSDBL="P"&$DATA(GMTSPRM)
DO PDISBLD^GMTS2
End DoDot:1
QUIT
+38 IF GMTSLOCK]""
IF ('$DATA(^XUSEC(GMTSLOCK,DUZ)))
DO NOMATCH^GMTS2
QUIT
+39 SET GMSEL=$PIECE($GET(^GMT(142.1,GMTSE,1,1,0)),U)
+40 IF GMSEL]""
IF $ORDER(GMTSEG(GMTSEGN,GMSEL,0))'>0
DO NOSELECT^GMTS2
QUIT
+41 SET GMTSNPG=0
SET GMTSWRIT=1
+42 DO @($PIECE(GMTSEGR,";",1)_U_$PIECE(GMTSEGR,";",2))
+43 DO NODATA^GMTS2
SET GMTSWRIT=1
+44 KILL GMTSDLM
+45 QUIT
