- GMTSRN ;SLC/JER - Renumber Selected Health Summary Type ; 08/27/2002
- ;;2.7;Health Summary;**36,56**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10026 ^DIR
- ; DBIA 10076 ^XUSEC(
- ; DBIA 10076 ^XUSEC("GMTSMGR")
- ; DBIA 10013 ^DIK (file #142)
- ;
- MAIN ; Initializes Variables and Controls Branching
- N CHANGE,GMTSIFN,GMTSUM,GMTSEG,GMTSI,GMTSJ,GMTSQIT F D SELECT Q:$D(GMTSQIT) D COPY,RNMBR:CHANGE W !
- Q
- SELECT ; Select Health Summary Type
- N DIR,GMTSKEY,GMTSMGR,GMTSOWN,X,Y
- W ! S DIR(0)="PO^142:AEMQZ" D ^DIR K DIR I $D(DIRUT) S GMTSQIT="" Q
- S GMTSIFN=+Y,GMTSUM=$P(Y,U,2)
- S GMTSKEY=$S($P(^GMT(142,GMTSIFN,0),U,2)]"":$P(^(0),U,2),1:" ZZZ"),GMTSOWN=$S($P(^(0),U,3)>0:$P(^(0),U,3),1:DUZ)
- S GMTSMGR=$S($D(^XUSEC("GMTSMGR",DUZ)):1,$D(^XUSEC(GMTSKEY,DUZ)):1,GMTSOWN=DUZ:1,1:0)
- I GMTSMGR Q
- I '$D(^XUSEC(GMTSKEY,DUZ)) W !,$C(7),"This summary is currently locked to prevent alteration.",! S GMTSQIT="" Q
- I GMTSOWN'=DUZ W !,$C(7),"Alteration of this summary is restricted to its owner.",!,"See the Clinical Coordinator if you need additional help." S GMTSQIT=""
- Q
- COPY ; Copies Structure Multiple into GMTSEG(SEQ,
- N GMTSI,SEQ K GMTSEG S (CHANGE,GMTSI)=0 I '$D(^GMT(142,GMTSIFN,1,5)) S CHANGE=1
- F S GMTSI=$O(^GMT(142,GMTSIFN,1,GMTSI)) Q:GMTSI'>0 W "." I GMTSI#5'=0 S CHANGE=1
- I 'CHANGE Q
- S (SEQ,GMTSI)=0 F S GMTSI=$O(^GMT(142,GMTSIFN,1,GMTSI)) Q:GMTSI'>0 I $P(^(GMTSI,0),U,2) S SEQ=SEQ+1,GMTSEG(SEQ)=^(0) D GETSEL,PURGE W "."
- Q
- GETSEL ; Gets Selection Items from Multiple
- N SN S SN=0 F S SN=$O(^GMT(142,GMTSIFN,1,GMTSI,1,SN)) Q:SN'>0 S GMTSEG(SEQ,SN)=^(SN,0)
- Q
- PURGE ; Deletes Old Node from ^GMT(142,GMTSIFN,1,GMTSI, using ^DIK
- N DA,DIK S DA(1)=GMTSIFN,DA=GMTSI,DIK="^GMT(142,"_GMTSIFN_",1," D ^DIK
- Q
- RNMBR ; Traverses GMTSEG(SEQ) - Resets ^GMT(142,GMTSIFN,1,
- N DA,DR,DIE,ISEQ,SEQ,CCT S (CCT,SEQ)=0 F S SEQ=$O(GMTSEG(SEQ)) Q:SEQ'>0 K DA S DIE="^GMT(142,"_GMTSIFN_",1,",DA(1)=GMTSIFN D LOADCMP^GMTSRM5 S CCT=CCT+1 W:CCT#2=0 "."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRN 2018 printed Jan 18, 2025@03:01:24 Page 2
- GMTSRN ;SLC/JER - Renumber Selected Health Summary Type ; 08/27/2002
- +1 ;;2.7;Health Summary;**36,56**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10026 ^DIR
- +5 ; DBIA 10076 ^XUSEC(
- +6 ; DBIA 10076 ^XUSEC("GMTSMGR")
- +7 ; DBIA 10013 ^DIK (file #142)
- +8 ;
- MAIN ; Initializes Variables and Controls Branching
- +1 NEW CHANGE,GMTSIFN,GMTSUM,GMTSEG,GMTSI,GMTSJ,GMTSQIT
- FOR
- DO SELECT
- if $DATA(GMTSQIT)
- QUIT
- DO COPY
- if CHANGE
- DO RNMBR
- WRITE !
- +2 QUIT
- SELECT ; Select Health Summary Type
- +1 NEW DIR,GMTSKEY,GMTSMGR,GMTSOWN,X,Y
- +2 WRITE !
- SET DIR(0)="PO^142:AEMQZ"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET GMTSQIT=""
- QUIT
- +3 SET GMTSIFN=+Y
- SET GMTSUM=$PIECE(Y,U,2)
- +4 SET GMTSKEY=$SELECT($PIECE(^GMT(142,GMTSIFN,0),U,2)]"":$PIECE(^(0),U,2),1:" ZZZ")
- SET GMTSOWN=$SELECT($PIECE(^(0),U,3)>0:$PIECE(^(0),U,3),1:DUZ)
- +5 SET GMTSMGR=$SELECT($DATA(^XUSEC("GMTSMGR",DUZ)):1,$DATA(^XUSEC(GMTSKEY,DUZ)):1,GMTSOWN=DUZ:1,1:0)
- +6 IF GMTSMGR
- QUIT
- +7 IF '$DATA(^XUSEC(GMTSKEY,DUZ))
- WRITE !,$CHAR(7),"This summary is currently locked to prevent alteration.",!
- SET GMTSQIT=""
- QUIT
- +8 IF GMTSOWN'=DUZ
- WRITE !,$CHAR(7),"Alteration of this summary is restricted to its owner.",!,"See the Clinical Coordinator if you need additional help."
- SET GMTSQIT=""
- +9 QUIT
- COPY ; Copies Structure Multiple into GMTSEG(SEQ,
- +1 NEW GMTSI,SEQ
- KILL GMTSEG
- SET (CHANGE,GMTSI)=0
- IF '$DATA(^GMT(142,GMTSIFN,1,5))
- SET CHANGE=1
- +2 FOR
- SET GMTSI=$ORDER(^GMT(142,GMTSIFN,1,GMTSI))
- if GMTSI'>0
- QUIT
- WRITE "."
- IF GMTSI#5'=0
- SET CHANGE=1
- +3 IF 'CHANGE
- QUIT
- +4 SET (SEQ,GMTSI)=0
- FOR
- SET GMTSI=$ORDER(^GMT(142,GMTSIFN,1,GMTSI))
- if GMTSI'>0
- QUIT
- IF $PIECE(^(GMTSI,0),U,2)
- SET SEQ=SEQ+1
- SET GMTSEG(SEQ)=^(0)
- DO GETSEL
- DO PURGE
- WRITE "."
- +5 QUIT
- GETSEL ; Gets Selection Items from Multiple
- +1 NEW SN
- SET SN=0
- FOR
- SET SN=$ORDER(^GMT(142,GMTSIFN,1,GMTSI,1,SN))
- if SN'>0
- QUIT
- SET GMTSEG(SEQ,SN)=^(SN,0)
- +2 QUIT
- PURGE ; Deletes Old Node from ^GMT(142,GMTSIFN,1,GMTSI, using ^DIK
- +1 NEW DA,DIK
- SET DA(1)=GMTSIFN
- SET DA=GMTSI
- SET DIK="^GMT(142,"_GMTSIFN_",1,"
- DO ^DIK
- +2 QUIT
- RNMBR ; Traverses GMTSEG(SEQ) - Resets ^GMT(142,GMTSIFN,1,
- +1 NEW DA,DR,DIE,ISEQ,SEQ,CCT
- SET (CCT,SEQ)=0
- FOR
- SET SEQ=$ORDER(GMTSEG(SEQ))
- if SEQ'>0
- QUIT
- KILL DA
- SET DIE="^GMT(142,"_GMTSIFN_",1,"
- SET DA(1)=GMTSIFN
- DO LOADCMP^GMTSRM5
- SET CCT=CCT+1
- if CCT#2=0
- WRITE "."
- +2 QUIT