Routine: GMTSADH1

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)

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))

SCRNLNTH ; Checks screen length

 I $Y>(IOSL-4) W ! D ^DIR S:$D(DTOUT) DIROUT="" Q:$D(DUOUT)!($D(DTOUT))  W @IOF

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)

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 "*"

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)

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSADH1   3996     printed  Feb 18, 2025@23:23:19                                                                                                                                                                                                    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

GMTSADH1.m