GMTSLOAD ;SLC/JER - Loads Ad Hoc Summary Type ; 02/27/2002
;;2.7;Health Summary;**23,30,36,37,49**;Oct 20, 1995
;
; External References
; DBIA 10026 ^DIR
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
MAIN ; Controls branching and execution
N DIC,DIROUT,DIRUT,DIR,GMI,GMW,GMTJ,GMTNM,GMTSEG,GMTSFUNC,GMTSI,GMTSIFN,GMTSWHL,INCLUDE,S2,X,Y
W !!,"This option rebuilds the Ad Hoc Health Summary to include ALL components",!
W "alphabetized by name. If you wish, you may exclude DISABLED components.",!
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO",DIR("?")="Answer ""Y"" or ""N"", ""NO"" to exit this option."
D ^DIR Q:Y=0 W !
I $S($D(DIRUT):1,$D(DIROUT):1,1:0) Q
S DIR("?")="Answer ""Y"" or ""N"", ""YES"" to include DISABLED components."
S DIR("A")="Should DISABLED components be included",DIR("B")="YES"
D ^DIR
I $S($D(DIRUT):1,$D(DIROUT):1,1:0) Q
S INCLUDE=Y
ENPOST ; Entry point from Post-init
; Call with INCLUDE=0 to exclude DISABLED components
; Call with INCLUDE=1 to include DISABLED components
N NEWREC,GMTSTYP,DLAYGO
S DLAYGO=142
S DIC=142,DIC(0)="LXF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT K DIC
I +Y'>0 D NOFILE Q
S (GMTSIFN,GMTSTYP)=+Y,NEWREC=+$P(Y,U,3)
S:'$D(^GMT(142,GMTSIFN,1,0)) ^(0)="^142.01IA^0^0"
S GMTNM="" F GMI=1:1 S GMTNM=$O(^GMT(142.1,"B",GMTNM)) Q:GMTNM']"" S GMTJ=$O(^(GMTNM,0)) Q:GMTJ'>0 D LOAD
S GMTSI=0 I 'NEWREC F S GMTSI=$O(^GMT(142,GMTSIFN,1,GMTSI)) Q:GMTSI'>0 D PURGE^GMTSRN
D BMES^XPDUTL(" Rebuilding Ad Hoc Summary")
D RNMBR^GMTSRN
D MES^XPDUTL(" Done")
Q
NOFILE ; GMTS HS ADHOC OPTION Summary Type is missing
D MES^XPDUTL(" ")
D BMES^XPDUTL("** GMTS AD HOC OPTION Summary Type is missing **")
Q
;
LOAD ; Loads GMTSEG(GMI)=Sequence ^ Component ^ Occurrence Limit ^
; Time Limit ^^ Hospital Location ^ ICD Text Displayed ^
; Provider Narratived Displayed ^ CPT Modifier Displayed
;
; Needs GMTJ Pointer to Component 142.1
; GMTSTYP Pointer to Type 142
; GMI Pointer to Structure 142.01 in GMTSEG(GMI)
;
N COMP,TYPE,OCC,TIME,GMSEQ,HOSPLOC,ICDTEXT,PROVNARR,CPTMOD
Q:'$D(^GMT(142.1,GMTJ,0))
S GMSEQ=$O(^GMT(142,"AE",GMTJ,GMTSTYP,0))
I GMSEQ>0 D
. S COMP=$P($G(^GMT(142.1,GMTJ,0)),U,5),TYPE=$P($G(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,3)
. S OCC=$S(COMP="Y":TYPE,1:"")
. S COMP=$P($G(^GMT(142.1,GMTJ,0)),U,3),TYPE=$P($G(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,4)
. S TIME=$S(COMP="Y":TYPE,1:"")
. S COMP=$P($G(^GMT(142.1,GMTJ,0)),U,10),TYPE=$P($G(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,6)
. S HOSPLOC=$S(COMP="Y":TYPE,1:"")
. S COMP=$P($G(^GMT(142.1,GMTJ,0)),U,11),TYPE=$P($G(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,7)
. S ICDTEXT=$S(COMP="Y":TYPE,1:"")
. S COMP=$P($G(^GMT(142.1,GMTJ,0)),U,12),TYPE=$P($G(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,8)
. S PROVNARR=$S(COMP="Y":TYPE,1:"")
. S COMP=$P($G(^GMT(142.1,GMTJ,0)),U,14),TYPE=$P($G(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,9)
. S CPTMOD=$S((COMP="Y"&(TYPE'="N")):"Y",(COMP="Y"&(TYPE="N")):"N",1:"")
E D
. S OCC=$S($P(^GMT(142.1,GMTJ,0),U,5)="Y":10,1:"")
. S TIME=$S($P(^GMT(142.1,GMTJ,0),U,3)="Y":"1Y",1:"")
. S HOSPLOC=$S($P(^GMT(142.1,GMTJ,0),U,10)="Y":"Y",1:"")
. S ICDTEXT=$S($P(^GMT(142.1,GMTJ,0),U,11)="Y":"L",1:"")
. S PROVNARR=$S($P(^GMT(142.1,GMTJ,0),U,12)="Y":"Y",1:"")
. S CPTMOD=$S($P(^GMT(142.1,GMTJ,0),U,14)="Y":"Y",1:"")
D SETSEG
Q
;
SETSEG ; Set Segment
; GMTSEG(GMI)
S GMI=+($G(GMI)) Q:GMI=0 N OFF S OFF=$S($P(^GMT(142.1,GMTJ,0),U,6)="P":1,$P(^(0),U,6)="T":1,1:0)
I (+($G(INCLUDE))=0),(OFF=1) Q
S GMTSEG(GMI)=(5*GMI)_U_GMTJ_U_OCC_U_TIME_U_U_HOSPLOC_U_ICDTEXT_U_PROVNARR_U_CPTMOD
I GMSEQ>0 D SETSEL
Q
SETSEL ; Sets up selection items
; GMTSEG(GMI,GMSEL)=Selection item
N GMSEL,GMITEM,GMW,S2
S GMSEL=0 F S GMSEL=$O(^GMT(142,GMTSTYP,1,+GMSEQ,1,GMSEL)) Q:GMSEL'>0 S GMITEM=^(GMSEL,0) S GMTSEG(GMI,GMSEL)=GMITEM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLOAD 3993 printed Nov 22, 2024@17:07:46 Page 2
GMTSLOAD ;SLC/JER - Loads Ad Hoc Summary Type ; 02/27/2002
+1 ;;2.7;Health Summary;**23,30,36,37,49**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10026 ^DIR
+5 ; DBIA 10141 BMES^XPDUTL
+6 ; DBIA 10141 MES^XPDUTL
+7 ;
MAIN ; Controls branching and execution
+1 NEW DIC,DIROUT,DIRUT,DIR,GMI,GMW,GMTJ,GMTNM,GMTSEG,GMTSFUNC,GMTSI,GMTSIFN,GMTSWHL,INCLUDE,S2,X,Y
+2 WRITE !!,"This option rebuilds the Ad Hoc Health Summary to include ALL components",!
+3 WRITE "alphabetized by name. If you wish, you may exclude DISABLED components.",!
+4 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="NO"
SET DIR("?")="Answer ""Y"" or ""N"", ""NO"" to exit this option."
+5 DO ^DIR
if Y=0
QUIT
WRITE !
+6 IF $SELECT($DATA(DIRUT):1,$DATA(DIROUT):1,1:0)
QUIT
+7 SET DIR("?")="Answer ""Y"" or ""N"", ""YES"" to include DISABLED components."
+8 SET DIR("A")="Should DISABLED components be included"
SET DIR("B")="YES"
+9 DO ^DIR
+10 IF $SELECT($DATA(DIRUT):1,$DATA(DIROUT):1,1:0)
QUIT
+11 SET INCLUDE=Y
ENPOST ; Entry point from Post-init
+1 ; Call with INCLUDE=0 to exclude DISABLED components
+2 ; Call with INCLUDE=1 to include DISABLED components
+3 NEW NEWREC,GMTSTYP,DLAYGO
+4 SET DLAYGO=142
+5 SET DIC=142
SET DIC(0)="LXF"
SET X="GMTS HS ADHOC OPTION"
SET Y=$$TYPE^GMTSULT
KILL DIC
+6 IF +Y'>0
DO NOFILE
QUIT
+7 SET (GMTSIFN,GMTSTYP)=+Y
SET NEWREC=+$PIECE(Y,U,3)
+8 if '$DATA(^GMT(142,GMTSIFN,1,0))
SET ^(0)="^142.01IA^0^0"
+9 SET GMTNM=""
FOR GMI=1:1
SET GMTNM=$ORDER(^GMT(142.1,"B",GMTNM))
if GMTNM']""
QUIT
SET GMTJ=$ORDER(^(GMTNM,0))
if GMTJ'>0
QUIT
DO LOAD
+10 SET GMTSI=0
IF 'NEWREC
FOR
SET GMTSI=$ORDER(^GMT(142,GMTSIFN,1,GMTSI))
if GMTSI'>0
QUIT
DO PURGE^GMTSRN
+11 DO BMES^XPDUTL(" Rebuilding Ad Hoc Summary")
+12 DO RNMBR^GMTSRN
+13 DO MES^XPDUTL(" Done")
+14 QUIT
NOFILE ; GMTS HS ADHOC OPTION Summary Type is missing
+1 DO MES^XPDUTL(" ")
+2 DO BMES^XPDUTL("** GMTS AD HOC OPTION Summary Type is missing **")
+3 QUIT
+4 ;
LOAD ; Loads GMTSEG(GMI)=Sequence ^ Component ^ Occurrence Limit ^
+1 ; Time Limit ^^ Hospital Location ^ ICD Text Displayed ^
+2 ; Provider Narratived Displayed ^ CPT Modifier Displayed
+3 ;
+4 ; Needs GMTJ Pointer to Component 142.1
+5 ; GMTSTYP Pointer to Type 142
+6 ; GMI Pointer to Structure 142.01 in GMTSEG(GMI)
+7 ;
+8 NEW COMP,TYPE,OCC,TIME,GMSEQ,HOSPLOC,ICDTEXT,PROVNARR,CPTMOD
+9 if '$DATA(^GMT(142.1,GMTJ,0))
QUIT
+10 SET GMSEQ=$ORDER(^GMT(142,"AE",GMTJ,GMTSTYP,0))
+11 IF GMSEQ>0
Begin DoDot:1
+12 SET COMP=$PIECE($GET(^GMT(142.1,GMTJ,0)),U,5)
SET TYPE=$PIECE($GET(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,3)
+13 SET OCC=$SELECT(COMP="Y":TYPE,1:"")
+14 SET COMP=$PIECE($GET(^GMT(142.1,GMTJ,0)),U,3)
SET TYPE=$PIECE($GET(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,4)
+15 SET TIME=$SELECT(COMP="Y":TYPE,1:"")
+16 SET COMP=$PIECE($GET(^GMT(142.1,GMTJ,0)),U,10)
SET TYPE=$PIECE($GET(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,6)
+17 SET HOSPLOC=$SELECT(COMP="Y":TYPE,1:"")
+18 SET COMP=$PIECE($GET(^GMT(142.1,GMTJ,0)),U,11)
SET TYPE=$PIECE($GET(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,7)
+19 SET ICDTEXT=$SELECT(COMP="Y":TYPE,1:"")
+20 SET COMP=$PIECE($GET(^GMT(142.1,GMTJ,0)),U,12)
SET TYPE=$PIECE($GET(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,8)
+21 SET PROVNARR=$SELECT(COMP="Y":TYPE,1:"")
+22 SET COMP=$PIECE($GET(^GMT(142.1,GMTJ,0)),U,14)
SET TYPE=$PIECE($GET(^GMT(142,GMTSTYP,1,GMSEQ,0)),U,9)
+23 SET CPTMOD=$SELECT((COMP="Y"&(TYPE'="N")):"Y",(COMP="Y"&(TYPE="N")):"N",1:"")
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 SET OCC=$SELECT($PIECE(^GMT(142.1,GMTJ,0),U,5)="Y":10,1:"")
+26 SET TIME=$SELECT($PIECE(^GMT(142.1,GMTJ,0),U,3)="Y":"1Y",1:"")
+27 SET HOSPLOC=$SELECT($PIECE(^GMT(142.1,GMTJ,0),U,10)="Y":"Y",1:"")
+28 SET ICDTEXT=$SELECT($PIECE(^GMT(142.1,GMTJ,0),U,11)="Y":"L",1:"")
+29 SET PROVNARR=$SELECT($PIECE(^GMT(142.1,GMTJ,0),U,12)="Y":"Y",1:"")
+30 SET CPTMOD=$SELECT($PIECE(^GMT(142.1,GMTJ,0),U,14)="Y":"Y",1:"")
End DoDot:1
+31 DO SETSEG
+32 QUIT
+33 ;
SETSEG ; Set Segment
+1 ; GMTSEG(GMI)
+2 SET GMI=+($GET(GMI))
if GMI=0
QUIT
NEW OFF
SET OFF=$SELECT($PIECE(^GMT(142.1,GMTJ,0),U,6)="P":1,$PIECE(^(0),U,6)="T":1,1:0)
+3 IF (+($GET(INCLUDE))=0)
IF (OFF=1)
QUIT
+4 SET GMTSEG(GMI)=(5*GMI)_U_GMTJ_U_OCC_U_TIME_U_U_HOSPLOC_U_ICDTEXT_U_PROVNARR_U_CPTMOD
+5 IF GMSEQ>0
DO SETSEL
+6 QUIT
SETSEL ; Sets up selection items
+1 ; GMTSEG(GMI,GMSEL)=Selection item
+2 NEW GMSEL,GMITEM,GMW,S2
+3 SET GMSEL=0
FOR
SET GMSEL=$ORDER(^GMT(142,GMTSTYP,1,+GMSEQ,1,GMSEL))
if GMSEL'>0
QUIT
SET GMITEM=^(GMSEL,0)
SET GMTSEG(GMI,GMSEL)=GMITEM
+4 QUIT
