- 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 Jan 18, 2025@03:01:17 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