- 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 Jan 18, 2025@02:58:04 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