GMTSRM ; SLC/KER - Edit HS Type ; 01/06/2003
;;2.7;Health Summary;**30,35,29,47,56,58**;Oct 20, 1995
;
; External References
; DBIA 10076 ^XUSEC(
; DBIA 10076 ^XUSEC("GMTSMGR"
; DBIA 10018 ^DIE
; DBIA 10010 EN1^DIP
; DBIA 10026 ^DIR
;
MAIN ; Main loop to modify multiple health summary types
N %,DTOUT,DUOUT,DIRUT,EXISTS,GMTSFUNC,GMTSQIT,P
S GMTSQIT=0 F S EXISTS=0 D SELTYP Q:GMTSQIT
Q
SELTYP ; Select Health Summary Type to Edit
N CHANGE,DA,DIC,DIE,DLAYGO,DR,DUOUT,EXISTS,GMTSUM,GMTSNEW,GMTSMGR,GMTSEG,GMTSIFN,SELCNT,X,Y
W ! S U="^",DIC="^GMT(142,",DIC(0)="AEMQL"
S DIC("A")="Select Health Summary Type: "
S DIC("S")="I +($$AHST^GMTSULT(+($G(Y))))" S DLAYGO=142
S Y=$$TYPE^GMTSULT K DIC S:+Y'>0 GMTSQIT=1 Q:+Y'>0 S (GMTSIFN,DA)=+Y
S GMTSUM=$P(Y,U,2),GMTSNEW=+$P(Y,U,3),GMTSMGR=$S($D(^XUSEC("GMTSMGR",DUZ)):1,1:0)
I 'GMTSMGR,($P(^GMT(142,+DA,0),U,2)]"") D Q:'GMTSMGR
. S GMTSMGR=$D(^XUSEC($P(^(0),U,2),DUZ))
. W:'GMTSMGR !,$C(7),"This summary report is currently locked to prevent alteration.",!
I 'GMTSMGR,'GMTSNEW,($P(^GMT(142,+DA,0),U,3)'=DUZ) W !,$C(7),"Alteration of this summary report is restricted to its owner.",!,"See the Clinical Coordinator if you need additional help." Q
I $D(^GMT(142.5,"AC",+DA)) D Q:+DA'>0
. W !!,$C(7),"WARNING: You are about to edit a Health Summary Type that is being used"
. W !,"by a Health Summary Object. Changing the structure of this Health Summary"
. W !,"Type will alter how the Object will display.",! H 1
. N DIR,DTOUT,DUOUT,DIROUT,X,Y S DIR(0)="YAO",DIR("B")="NO"
. S DIR("A")="Do want to continue? " D ^DIR S:+Y'>0 DA=0
. I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S DA=0,GMTSQIT=1
S DIE="^GMT(142,",(GMTSIFN,DA)=+Y,DR="[GMTS EDIT HLTH SUM TYPE]" D ^DIE
I '$D(^GMT(142,+GMTSIFN,0))!$D(Y)!$D(DUOUT)!$D(DIROUT)!$D(DTOUT) D Q
. S GMTSQIT=1 D CHKDEL Q
I 'GMTSNEW,($O(^GMT(142,+GMTSIFN,1,0))) S EXISTS=1 D LIST,EXISTS Q
D SELCMP^GMTSRM5 Q:GMTSQIT D LIST:EXISTS,EXISTS D CHKDEL
Q
CHKDEL ; Check for Possible Deletion (New Type without Component)
Q:+($G(GMTSIFN))'>0 Q:'$D(^GMT(142,+($G(GMTSIFN)),0)) D:GMTSMGR!(GMTSNEW)!($P(^GMT(142,+GMTSIFN,0),U,3)'=$G(DUZ)) ADEL^GMTSRM2(+($G(GMTSIFN)))
Q
ENADHOC ; Entry point for AD HOC edit
N %,C,CHANGE,DA,DIC,DIE,DR,DUOUT,EXISTS,I,GMTSIFN,GMTSN,GMTSNCNT,GMTSNEW
N GMTSIFN,GMTSUM,P,SELCNT
N GMTSQIT,GMTSFUNC,X,Y
W !!,">>> EDITING the GMTS HS ADHOC OPTION Health Summary Type"
S (GMTSNEW,GMTSQIT)=0
S DIC=142,DIC(0)="XZF",X="GMTS HS ADHOC OPTION"
S Y=$$TYPE^GMTSULT I +Y'>0 D ^GMTSLOAD Q:$D(DIRUT)!$D(DIROUT) G ENADHOC
S GMTSIFN=+Y,GMTSUM=$P(Y,U,2),EXISTS=1
S DIE="^GMT(142,",DA=GMTSIFN,DR=".08T" D ^DIE
Q:$D(Y)
D LIST,EXISTS
Q
EXISTS ; Edit an existing health summary type
N CNT,NXTCMP Q:$D(DUOUT) S NXTCMP=0,NXTCMP(0)=0
F CNT=$$GETCNT(GMTSIFN):0 D NXTCMP^GMTSRM1,LIST:GMTSQIT Q:GMTSQIT!($D(DUOUT)) K GMTSQIT,GMTSNEW,TWEENER,SOACTION
I NXTCMP>0 W !,"Please hold on while I resequence the summary order" D COPY^GMTSRN,RNMBR^GMTSRN:CHANGE
Q
LIST ; Lists existing summary parameters
N B,DIC,DIR,IOP,Y,FR,TO,BY,DHD,FLDS,L
I GMTSQIT'=2 Q:($D(DUOUT)!(GMTSQIT=1))
I GMTSQIT=2,(NXTCMP=0) S GMTSQIT=0 Q
I 'GMTSNEW W ! S DIC=142,DIR(0)="Y",DIR("A")="Do you wish to review the Summary Type structure before continuing",DIR("B")="NO" D ^DIR K DIR I 'Y S:GMTSQIT=2 DUOUT="" S:GMTSQIT=2 GMTSQIT="D" S:$D(DUOUT) GMTSQIT=1 Q
I $D(GMTSQIT),GMTSQIT=2 S GMTSQIT=0
S IOP="HOME",DIC=142,(FR,TO)=GMTSUM,BY=".01",DHD="[GMTS TYPE INQ HEADER]-[GMTS TYPE INQ FOOTER]",FLDS="[GMTS TYPE INQ]",L=0 D EN1^DIP
Q
GETCNT(GMTSIFN) ; Determine default summary order for new component
N LI,LCNT S LI=0,LCNT=5 F S LI=$O(^GMT(142,+GMTSIFN,1,LI)) Q:+LI'>0 S LCNT=$P(LI,".")+5
Q LCNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRM 3824 printed Oct 16, 2024@18:00:52 Page 2
GMTSRM ; SLC/KER - Edit HS Type ; 01/06/2003
+1 ;;2.7;Health Summary;**30,35,29,47,56,58**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10076 ^XUSEC(
+5 ; DBIA 10076 ^XUSEC("GMTSMGR"
+6 ; DBIA 10018 ^DIE
+7 ; DBIA 10010 EN1^DIP
+8 ; DBIA 10026 ^DIR
+9 ;
MAIN ; Main loop to modify multiple health summary types
+1 NEW %,DTOUT,DUOUT,DIRUT,EXISTS,GMTSFUNC,GMTSQIT,P
+2 SET GMTSQIT=0
FOR
SET EXISTS=0
DO SELTYP
if GMTSQIT
QUIT
+3 QUIT
SELTYP ; Select Health Summary Type to Edit
+1 NEW CHANGE,DA,DIC,DIE,DLAYGO,DR,DUOUT,EXISTS,GMTSUM,GMTSNEW,GMTSMGR,GMTSEG,GMTSIFN,SELCNT,X,Y
+2 WRITE !
SET U="^"
SET DIC="^GMT(142,"
SET DIC(0)="AEMQL"
+3 SET DIC("A")="Select Health Summary Type: "
+4 SET DIC("S")="I +($$AHST^GMTSULT(+($G(Y))))"
SET DLAYGO=142
+5 SET Y=$$TYPE^GMTSULT
KILL DIC
if +Y'>0
SET GMTSQIT=1
if +Y'>0
QUIT
SET (GMTSIFN,DA)=+Y
+6 SET GMTSUM=$PIECE(Y,U,2)
SET GMTSNEW=+$PIECE(Y,U,3)
SET GMTSMGR=$SELECT($DATA(^XUSEC("GMTSMGR",DUZ)):1,1:0)
+7 IF 'GMTSMGR
IF ($PIECE(^GMT(142,+DA,0),U,2)]"")
Begin DoDot:1
+8 SET GMTSMGR=$DATA(^XUSEC($PIECE(^(0),U,2),DUZ))
+9 if 'GMTSMGR
WRITE !,$CHAR(7),"This summary report is currently locked to prevent alteration.",!
End DoDot:1
if 'GMTSMGR
QUIT
+10 IF 'GMTSMGR
IF 'GMTSNEW
IF ($PIECE(^GMT(142,+DA,0),U,3)'=DUZ)
WRITE !,$CHAR(7),"Alteration of this summary report is restricted to its owner.",!,"See the Clinical Coordinator if you need additional help."
QUIT
+11 IF $DATA(^GMT(142.5,"AC",+DA))
Begin DoDot:1
+12 WRITE !!,$CHAR(7),"WARNING: You are about to edit a Health Summary Type that is being used"
+13 WRITE !,"by a Health Summary Object. Changing the structure of this Health Summary"
+14 WRITE !,"Type will alter how the Object will display.",!
HANG 1
+15 NEW DIR,DTOUT,DUOUT,DIROUT,X,Y
SET DIR(0)="YAO"
SET DIR("B")="NO"
+16 SET DIR("A")="Do want to continue? "
DO ^DIR
if +Y'>0
SET DA=0
+17 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
SET DA=0
SET GMTSQIT=1
End DoDot:1
if +DA'>0
QUIT
+18 SET DIE="^GMT(142,"
SET (GMTSIFN,DA)=+Y
SET DR="[GMTS EDIT HLTH SUM TYPE]"
DO ^DIE
+19 IF '$DATA(^GMT(142,+GMTSIFN,0))!$DATA(Y)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DTOUT)
Begin DoDot:1
+20 SET GMTSQIT=1
DO CHKDEL
QUIT
End DoDot:1
QUIT
+21 IF 'GMTSNEW
IF ($ORDER(^GMT(142,+GMTSIFN,1,0)))
SET EXISTS=1
DO LIST
DO EXISTS
QUIT
+22 DO SELCMP^GMTSRM5
if GMTSQIT
QUIT
if EXISTS
DO LIST
DO EXISTS
DO CHKDEL
+23 QUIT
CHKDEL ; Check for Possible Deletion (New Type without Component)
+1 if +($GET(GMTSIFN))'>0
QUIT
if '$DATA(^GMT(142,+($GET(GMTSIFN)),0))
QUIT
if GMTSMGR!(GMTSNEW)!($PIECE(^GMT(142,+GMTSIFN,0),U,3)'=$GET(DUZ))
DO ADEL^GMTSRM2(+($GET(GMTSIFN)))
+2 QUIT
ENADHOC ; Entry point for AD HOC edit
+1 NEW %,C,CHANGE,DA,DIC,DIE,DR,DUOUT,EXISTS,I,GMTSIFN,GMTSN,GMTSNCNT,GMTSNEW
+2 NEW GMTSIFN,GMTSUM,P,SELCNT
+3 NEW GMTSQIT,GMTSFUNC,X,Y
+4 WRITE !!,">>> EDITING the GMTS HS ADHOC OPTION Health Summary Type"
+5 SET (GMTSNEW,GMTSQIT)=0
+6 SET DIC=142
SET DIC(0)="XZF"
SET X="GMTS HS ADHOC OPTION"
+7 SET Y=$$TYPE^GMTSULT
IF +Y'>0
DO ^GMTSLOAD
if $DATA(DIRUT)!$DATA(DIROUT)
QUIT
GOTO ENADHOC
+8 SET GMTSIFN=+Y
SET GMTSUM=$PIECE(Y,U,2)
SET EXISTS=1
+9 SET DIE="^GMT(142,"
SET DA=GMTSIFN
SET DR=".08T"
DO ^DIE
+10 if $DATA(Y)
QUIT
+11 DO LIST
DO EXISTS
+12 QUIT
EXISTS ; Edit an existing health summary type
+1 NEW CNT,NXTCMP
if $DATA(DUOUT)
QUIT
SET NXTCMP=0
SET NXTCMP(0)=0
+2 FOR CNT=$$GETCNT(GMTSIFN):0
DO NXTCMP^GMTSRM1
if GMTSQIT
DO LIST
if GMTSQIT!($DATA(DUOUT))
QUIT
KILL GMTSQIT,GMTSNEW,TWEENER,SOACTION
+3 IF NXTCMP>0
WRITE !,"Please hold on while I resequence the summary order"
DO COPY^GMTSRN
if CHANGE
DO RNMBR^GMTSRN
+4 QUIT
LIST ; Lists existing summary parameters
+1 NEW B,DIC,DIR,IOP,Y,FR,TO,BY,DHD,FLDS,L
+2 IF GMTSQIT'=2
if ($DATA(DUOUT)!(GMTSQIT=1))
QUIT
+3 IF GMTSQIT=2
IF (NXTCMP=0)
SET GMTSQIT=0
QUIT
+4 IF 'GMTSNEW
WRITE !
SET DIC=142
SET DIR(0)="Y"
SET DIR("A")="Do you wish to review the Summary Type structure before continuing"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF 'Y
if GMTSQIT=2
SET DUOUT=""
if GMTSQIT=2
SET GMTSQIT="D"
if $DATA(DUOUT)
SET GMTSQIT=1
QUIT
+5 IF $DATA(GMTSQIT)
IF GMTSQIT=2
SET GMTSQIT=0
+6 SET IOP="HOME"
SET DIC=142
SET (FR,TO)=GMTSUM
SET BY=".01"
SET DHD="[GMTS TYPE INQ HEADER]-[GMTS TYPE INQ FOOTER]"
SET FLDS="[GMTS TYPE INQ]"
SET L=0
DO EN1^DIP
+7 QUIT
GETCNT(GMTSIFN) ; Determine default summary order for new component
+1 NEW LI,LCNT
SET LI=0
SET LCNT=5
FOR
SET LI=$ORDER(^GMT(142,+GMTSIFN,1,LI))
if +LI'>0
QUIT
SET LCNT=$PIECE(LI,".")+5
+2 QUIT LCNT
