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 Oct 16, 2024@18:00:59 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
