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