Routine: GMTSRN

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 !

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

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

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)

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

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

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

GMTSRN.m