GMTSADH1 ;SLC/JER,MAM - Ad Hoc Summary Driver ; 09/21/2001
;;2.7;Health Summary;**1,37,47**;Oct 20, 1995
;
; External References
; DBIA 10026 ^DIR
; DBIA 10140 EN^XQORM
;
GETLIM ; Get Limits/Flags (external entry)
;
; Time
; Occurrence
; Selection Items
; Hospital Location Display
; ICD Text Display
; Provider Narrative Display
; CPT Modifier Display
;
N LISTFLG,GMCHANGE,GMW,QUIT S GMCHANGE=0 D LIST
F S LISTFLG=0 D ASKCMPS Q:$D(QUIT)!$D(DIROUT)
Q
LIST ; Lists defaults for Ad Hoc Summary
S LISTFLG=1,GMCHANGE=0
W @IOF,!," Default Limits and Selection Items",!!
W " Component Occ Time Hosp ICD Prov CPT Selection",!
W " Limit Limit Loc Txt Narr Mod Item(s)",!
N FLG,DTOUT S FLG=0
LIST1 ; Called by GMTSUP to list components
; FLG=1 for Ad Hoc Health Summary Type
; FLG=2 for other Health Summary Types
N GMI,DIR,DUOUT,GMW S DIR(0)="E"
S GMI=0 F S GMI=$O(GMTSEG(GMI)) Q:GMI'>0 D SCRNLNTH Q:$D(DUOUT)!($D(DTOUT)) D LISTLIM D:($D(GMTSEG(GMI))=11)&('FLG) LISTSEL Q:$D(DUOUT)!($D(DTOUT))
Q
SCRNLNTH ; Checks screen length
I $Y>(IOSL-4) W ! D ^DIR S:$D(DTOUT) DIROUT="" Q:$D(DUOUT)!($D(DTOUT)) W @IOF
Q
;
LISTLIM ; List Components and Limits for GMTSET() array
; Component Abbreviation
; Component Name
; If not called by GMTSUP:
; Time Limits
; Occurrence Limits
; Hospital Location
; ICD Text
; Provider Narrative
; CPT Modifier
;
N CREC S CREC=^GMT(142.1,$P(GMTSEG(GMI),U,2),0) W ! I FLG=2 D STAR
W $P(CREC,U,4),?5,$S($L($P(GMTSEG(GMI),U,5)):$P(GMTSEG(GMI),U,5),$L($P(CREC,U,9)):$P(CREC,U,9),1:$E($P(CREC,U),1,24))
W:'FLG ?28,$P(GMTSEG(GMI),U,3),?35,$P(GMTSEG(GMI),U,4)
W:'FLG ?42,$P(GMTSEG(GMI),U,6),?48,$E($P(GMTSEG(GMI),U,7),1,5)
W:'FLG ?53,$P(GMTSEG(GMI),U,8),?59,$P(GMTSEG(GMI),U,9)
Q
STAR ; Writes * to indicate added component when called by
; GMTSUP for Health Summary Type other than AD HOC
I $D(^GMT(142,+($G(GMTSTYP)),1,"C",$P(GMTSEG(GMI),U,2))) W " "
E W "*"
Q
LISTSEL ; Lists default selection items
N GMW,GMJ,GML S GMJ=$O(GMTSEG(GMI,0)),GML=0
F GMW=1:1 S GML=$O(GMTSEG(GMI,GMJ,GML)) Q:GML="" D SCRNLNTH Q:$D(DUOUT)!($D(DTOUT)) W:GMW'=1 ! W ?64,$E($P(@(GMTSEG(GMI,GMJ,0)_GMTSEG(GMI,GMJ,GML)_",0)"),U),1,15)
Q
ASKCMPS ; Asks for components for new limits/sel items
N GMI,GMW,GMX,ASKCPQIT,DIC,X,XQORM,Y I LISTFLG D
. W !!,"To change limits, selection items, hospital location display, ICD"
. W !,"text display, provider narrative display, or CPT Modifiers, enter "
. W !,"components, one at a time or more than one, separated by commas."
. W !,"You may select new components if you wish."
S XQORM=GMTSTYP_";GMT(142,",XQORM("??")="D HELP^GMTSADH3"
S XQORM(0)="A",XQORM("A")="Select COMPONENT(S) to EDIT or other COMPONENT(S) to ADD: "
D EN^XQORM S:$D(DTOUT)!(X="^^") (DIROUT,QUIT)=1 I $D(DIROUT) Q
I +Y,(X?1"^^".E) G ASKCMPS
I $S(X="^":1,X=""&(GMCHANGE=0):1,1:0) S QUIT="" Q
I X="",GMCHANGE D ASKLIST Q
I X["^" W " ??" Q
S GMCHANGE=1,GMI=0 F S GMI=$O(Y(GMI)) Q:GMI="" S GMX=^GMT(142,+GMTSTYP,1,+Y(GMI),0) W !!,$P(Y(GMI),U,3) D CMPCOND Q:$D(DUOUT)!($D(DIROUT))
S:'$D(DIROUT) LISTFLG=1
Q
CMPCOND ; Checks component for new limits/sel items
N OLD,SBS,CREC,SREC,STRN,CPCDQIT S OLD=0 I $D(GMTSEGI($P(GMX,U,2))) S SBS=GMTSEGI($P(GMX,U,2)),OLD=1
S CREC=^GMT(142.1,$P(GMX,U,2),0)
I OLD=0 S GMTSEGC=GMTSEGC+1,SREC=GMX,STRN=+GMX D LOAD1^GMTSADH S SBS=GMJ
D CMPLIM^GMTSADH2
Q
ASKLIST ; Asks whether to relist Component
N DIR,X,Y S DIR(0)="YA",DIR("A")="Would you like to see Component Limits and Selection Items again? (Y/N): ",DIR("B")="NO" W !
D ^DIR I Y'>0,(GMCHANGE=1) S QUIT=1 Q
S:$D(DTOUT) DIROUT=1 I $D(DIROUT) Q
I $D(DIRUT),'$D(DUOUT) W " ??"
I $D(DIRUT)!(Y=0) Q
D LIST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSADH1 3996 printed Sep 23, 2025@19:33:01 Page 2
GMTSADH1 ;SLC/JER,MAM - Ad Hoc Summary Driver ; 09/21/2001
+1 ;;2.7;Health Summary;**1,37,47**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10026 ^DIR
+5 ; DBIA 10140 EN^XQORM
+6 ;
GETLIM ; Get Limits/Flags (external entry)
+1 ;
+2 ; Time
+3 ; Occurrence
+4 ; Selection Items
+5 ; Hospital Location Display
+6 ; ICD Text Display
+7 ; Provider Narrative Display
+8 ; CPT Modifier Display
+9 ;
+10 NEW LISTFLG,GMCHANGE,GMW,QUIT
SET GMCHANGE=0
DO LIST
+11 FOR
SET LISTFLG=0
DO ASKCMPS
if $DATA(QUIT)!$DATA(DIROUT)
QUIT
+12 QUIT
LIST ; Lists defaults for Ad Hoc Summary
+1 SET LISTFLG=1
SET GMCHANGE=0
+2 WRITE @IOF,!," Default Limits and Selection Items",!!
+3 WRITE " Component Occ Time Hosp ICD Prov CPT Selection",!
+4 WRITE " Limit Limit Loc Txt Narr Mod Item(s)",!
+5 NEW FLG,DTOUT
SET FLG=0
LIST1 ; Called by GMTSUP to list components
+1 ; FLG=1 for Ad Hoc Health Summary Type
+2 ; FLG=2 for other Health Summary Types
+3 NEW GMI,DIR,DUOUT,GMW
SET DIR(0)="E"
+4 SET GMI=0
FOR
SET GMI=$ORDER(GMTSEG(GMI))
if GMI'>0
QUIT
DO SCRNLNTH
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
DO LISTLIM
if ($DATA(GMTSEG(GMI))=11)&('FLG)
DO LISTSEL
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+5 QUIT
SCRNLNTH ; Checks screen length
+1 IF $Y>(IOSL-4)
WRITE !
DO ^DIR
if $DATA(DTOUT)
SET DIROUT=""
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
WRITE @IOF
+2 QUIT
+3 ;
LISTLIM ; List Components and Limits for GMTSET() array
+1 ; Component Abbreviation
+2 ; Component Name
+3 ; If not called by GMTSUP:
+4 ; Time Limits
+5 ; Occurrence Limits
+6 ; Hospital Location
+7 ; ICD Text
+8 ; Provider Narrative
+9 ; CPT Modifier
+10 ;
+11 NEW CREC
SET CREC=^GMT(142.1,$PIECE(GMTSEG(GMI),U,2),0)
WRITE !
IF FLG=2
DO STAR
+12 WRITE $PIECE(CREC,U,4),?5,$SELECT($LENGTH($PIECE(GMTSEG(GMI),U,5)):$PIECE(GMTSEG(GMI),U,5),$LENGTH($PIECE(CREC,U,9)):$PIECE(CREC,U,9),1:$EXTRACT($PIECE(CREC,U),1,24))
+13 if 'FLG
WRITE ?28,$PIECE(GMTSEG(GMI),U,3),?35,$PIECE(GMTSEG(GMI),U,4)
+14 if 'FLG
WRITE ?42,$PIECE(GMTSEG(GMI),U,6),?48,$EXTRACT($PIECE(GMTSEG(GMI),U,7),1,5)
+15 if 'FLG
WRITE ?53,$PIECE(GMTSEG(GMI),U,8),?59,$PIECE(GMTSEG(GMI),U,9)
+16 QUIT
STAR ; Writes * to indicate added component when called by
+1 ; GMTSUP for Health Summary Type other than AD HOC
+2 IF $DATA(^GMT(142,+($GET(GMTSTYP)),1,"C",$PIECE(GMTSEG(GMI),U,2)))
WRITE " "
+3 IF '$TEST
WRITE "*"
+4 QUIT
LISTSEL ; Lists default selection items
+1 NEW GMW,GMJ,GML
SET GMJ=$ORDER(GMTSEG(GMI,0))
SET GML=0
+2 FOR GMW=1:1
SET GML=$ORDER(GMTSEG(GMI,GMJ,GML))
if GML=""
QUIT
DO SCRNLNTH
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
if GMW'=1
WRITE !
WRITE ?64,$EXTRACT($PIECE(@(GMTSEG(GMI,GMJ,0)_GMTSEG(GMI,GMJ,GML)_",0)"),U),1,15)
+3 QUIT
ASKCMPS ; Asks for components for new limits/sel items
+1 NEW GMI,GMW,GMX,ASKCPQIT,DIC,X,XQORM,Y
IF LISTFLG
Begin DoDot:1
+2 WRITE !!,"To change limits, selection items, hospital location display, ICD"
+3 WRITE !,"text display, provider narrative display, or CPT Modifiers, enter "
+4 WRITE !,"components, one at a time or more than one, separated by commas."
+5 WRITE !,"You may select new components if you wish."
End DoDot:1
+6 SET XQORM=GMTSTYP_";GMT(142,"
SET XQORM("??")="D HELP^GMTSADH3"
+7 SET XQORM(0)="A"
SET XQORM("A")="Select COMPONENT(S) to EDIT or other COMPONENT(S) to ADD: "
+8 DO EN^XQORM
if $DATA(DTOUT)!(X="^^")
SET (DIROUT,QUIT)=1
IF $DATA(DIROUT)
QUIT
+9 IF +Y
IF (X?1"^^".E)
GOTO ASKCMPS
+10 IF $SELECT(X="^":1,X=""&(GMCHANGE=0):1,1:0)
SET QUIT=""
QUIT
+11 IF X=""
IF GMCHANGE
DO ASKLIST
QUIT
+12 IF X["^"
WRITE " ??"
QUIT
+13 SET GMCHANGE=1
SET GMI=0
FOR
SET GMI=$ORDER(Y(GMI))
if GMI=""
QUIT
SET GMX=^GMT(142,+GMTSTYP,1,+Y(GMI),0)
WRITE !!,$PIECE(Y(GMI),U,3)
DO CMPCOND
if $DATA(DUOUT)!($DATA(DIROUT))
QUIT
+14 if '$DATA(DIROUT)
SET LISTFLG=1
+15 QUIT
CMPCOND ; Checks component for new limits/sel items
+1 NEW OLD,SBS,CREC,SREC,STRN,CPCDQIT
SET OLD=0
IF $DATA(GMTSEGI($PIECE(GMX,U,2)))
SET SBS=GMTSEGI($PIECE(GMX,U,2))
SET OLD=1
+2 SET CREC=^GMT(142.1,$PIECE(GMX,U,2),0)
+3 IF OLD=0
SET GMTSEGC=GMTSEGC+1
SET SREC=GMX
SET STRN=+GMX
DO LOAD1^GMTSADH
SET SBS=GMJ
+4 DO CMPLIM^GMTSADH2
+5 QUIT
ASKLIST ; Asks whether to relist Component
+1 NEW DIR,X,Y
SET DIR(0)="YA"
SET DIR("A")="Would you like to see Component Limits and Selection Items again? (Y/N): "
SET DIR("B")="NO"
WRITE !
+2 DO ^DIR
IF Y'>0
IF (GMCHANGE=1)
SET QUIT=1
QUIT
+3 if $DATA(DTOUT)
SET DIROUT=1
IF $DATA(DIROUT)
QUIT
+4 IF $DATA(DIRUT)
IF '$DATA(DUOUT)
WRITE " ??"
+5 IF $DATA(DIRUT)!(Y=0)
QUIT
+6 DO LIST
+7 QUIT
