GMTSOBI ; SLC/KER - HS Object - Import/Install ; 01/06/2003
;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61
;
; External References
; DBIA 10096 ^%ZOSF("DEL"
; DBIA 10013 IX1^DIK
; DBIA 10112 $$SITE^VASITE
; DBIA 2055 $$FLDNUM^DILFD (file 142.5)
; DBIA 10103 $$NOW^XLFDT
; DBIA 10013 ^DIK
;
EN ; Install Object from Routine GMTSOBX
N DA,DIK,GMTS3,GMTS4,GMTSC,GMTSEDAT,GMTSETYP,GMTSETTL,GMTSDAO
N GMTSDAT,GMTSDR,GMTSEX,GMTSFAC,GMTSFRM,GMTSI,GMTSIEN,GMTSIT
N GMTSL,GMTSLN,GMTSNDD,GMTSOBJ,GMTSOBX,GMTSON,GMTSQIT,GMTSR
N GMTSROK,GMTSRT,GMTSRTN,GMTST,GMTSTE,GMTSTN,GMTSTMP,GMTSTR
N GMTSTTL,GMTSTXT,GMTSTYP,GMTSUSR,X
I +($$FLDNUM^DILFD(142.5,"NAME"))'>0!('$D(^GMT(142.5))) D Q
. W !," Unable to find HEALTH SUMMARY OBJECTS file #142.5"
S GMTSEDAT=0,GMTSRTN="GMTSOBX",GMTSQIT=0,GMTSUSR=+($G(DUZ)) I +GMTSUSR=0 W !!," User not defined" Q
I +($$ROK^GMTSOBU(GMTSRTN))'>0 W !," Error:",!," Object not Found (routine GMTSOBX)" Q
F GMTSI=1:1:7 D
. S GMTST=$$TX^GMTSOBU(GMTSRTN,GMTSRTN,(GMTSI-1)) S:GMTST["Object: " GMTSOBJ=$P(GMTST,"Object: ",2)
. S:GMTST["From: " GMTSFRM=$P(GMTST,"From: ",2) S:GMTST["Sender: " GMTSDR=$P(GMTST,"Sender: ",2)
S (GMTSON,GMTSOBJ)=$P($$TX^GMTSOBU(GMTSRTN,"OBJ",1),";",2)
S (GMTSTN,GMTSTYP)=$P($$TX^GMTSOBU(GMTSRTN,"TYPE",1),";",2)
I GMTSOBJ=""!(GMTSFRM="")!(GMTSDR="") W !," Error:",!," Can not install object from ",GMTSRTN Q
W !," Installing Health Summary Object: ",GMTSOBJ
I $L(GMTSTYP) D
. W !," Using Health Summary Type: ",GMTSTYP
W !," From: ",GMTSFRM
W !," Sender: ",GMTSDR
S GMTSTTL=$P($$TX^GMTSOBU(GMTSRTN,"TYPE",2),";",2)
; Check Facility
S GMTSFAC=+($P($$SITE^VASITE,"^",3)) I +GMTSFAC=0 W !," Error:",!," Facility not defined" Q
; Check Object
W !!," Checking Health Summary Object file #142.5"
I $L(GMTSOBJ) D Q:GMTSQIT
. N GMTSTMP S GMTSTMP=$$BOX^GMTSOBU(GMTSOBJ) I +($G(GMTSTMP))>0 W ! D ER1^GMTSOBU S GMTSQIT=1
; Check Type
W !," Check Health Summary Type file #142"
I $L(GMTSTYP) D Q:GMTSQIT
. S GMTSQIT=1 N GMTSTMP S GMTSTMP=$$NWX^GMTSOBU(GMTSTYP)
. S:+($G(GMTSTMP))'>0 GMTSQIT=0 I +($G(GMTSTMP))>0 D
. . S GMTSEDAT=$$EHST^GMTSOBU I GMTSEDAT>0 D Q
. . . S GMTSDAT=GMTSEDAT,GMTSQIT=0 I $L($G(GMTSETYP)),$L($G(GMTSETTL)) D
. . . . S GMTSTYP=GMTSETYP,GMTSTTL=GMTSETTL
; Check Title
W !," Checking for Duplicate Title"
I $L(GMTSTTL) D Q:GMTSQIT
. N GMTSTMP S GMTSTMP=$$TWX^GMTSOBU(GMTSTTL) I +GMTSTMP>0 W ! D ER3^GMTSOBU S GMTSQIT=1
S GMTSDAT=$$TIEN^GMTSOBU S:+($G(GMTSEDAT))>0 GMTSDAT=+($G(GMTSEDAT))
S:GMTSDAT'>0 GMTSQIT=1
I GMTSQIT W !," Unable to add Health Summary Type" Q
S GMTSDAO=$$OIEN^GMTSOBU(GMTSFAC) S:GMTSDAO'>0 GMTSQIT=1
I GMTSQIT W !," Unable to add Health Summary Object" Q
L +^GMT(142,+GMTSDAT):0 S:'$T GMTSQIT=1
L +^GMT(142.5,+GMTSDAO):0 S:'$T GMTSQIT=1
I +($G(GMTSQIT))>0 L -^GMT(142,+GMTSDAT) L -^GMT(142,+GMTSDAO) D Q
. W !," Unable to add Health Summary Type and Object"
I GMTSDAT>0,GMTSDAO>0,GMTSQIT'>0 D HST,HSO
D DELERR L -^GMT(142,+GMTSDAT) L -^GMT(142,+GMTSDAO)
D DONE W !
Q
HST ; Install Health Summary Type
; Needs GMTSRTN, GMTSDAT, GMTSUSR, GMTSTYP, GMTSTTL
Q:+($G(GMTSTE))>0 N GMTSROK,GMTSI,GMTSTXT,GMTSTR,GMTSNDD,GMTSR,GMTSC,GMTSRT,GMTS3,GMTS4,DA,DIK
Q:+($G(GMTSQIT))>0 S GMTSQIT=0,GMTSROK=$$ROK^GMTSOBU(GMTSRTN) Q:GMTSROK'>0
; Save Type
I '$L(GMTSTYP)!('$L(GMTSTTL)) S GMTSQIT=1 Q
F GMTSI=3:1 Q:GMTSQIT D Q:GMTSQIT
. S GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"TYPE",GMTSI),GMTSTXT=$P(GMTSTXT," ;",2,299)
. I '$L(GMTSTXT) S GMTSQIT=1 Q
. S GMTSTR=$P(GMTSTXT,";",1),GMTSNDD=$P(GMTSTXT,";",2)
. S GMTSR=$P(GMTSTR,",",2),GMTSC=$P(GMTSNDD,"^",2)
. Q:GMTSR>0&(GMTSC>0)&('$D(^GMT(142.1,+GMTSC))) Q:(GMTSR>0)&(GMTSC>0)&(GMTSC>999)
. S:GMTSTR="0" $P(GMTSNDD,"^",3)=GMTSUSR
. S:GMTSTR="0"&($L(GMTSTYP)) $P(GMTSNDD,"^",1)=GMTSTYP
. S:GMTSTR="""T"""&($L(GMTSTTL)) $P(GMTSNDD,"^",1)=GMTSTTL
. S GMTSNDD=$TR(GMTSNDD,"""","") S:'$L(GMTSNDD) GMTSNDD=""""""
. S GMTSRT="^GMT(142,DA,"_GMTSTR_")"
. S DA=GMTSDAT S @GMTSRT=GMTSNDD
; Check Indexes
S GMTSQIT=0 F GMTSI="B","C" S GMTSR=0 F S GMTSR=$O(^GMT(142,GMTSDAT,1,GMTSI,GMTSR)) Q:+GMTSR=0 D
. S GMTSC=0 F S GMTSC=$O(^GMT(142,GMTSDAT,1,GMTSI,GMTSR,GMTSC)) Q:+GMTSC=0 D
. . I '$D(^GMT(142,GMTSDAT,1,GMTSC)) K ^GMT(142,GMTSDAT,1,GMTSI,GMTSR,GMTSC)
; Re-Index
S DA=GMTSDAT,DIK="^GMT(142," D IX1^DIK
; Check Structure (sub-file 142.01)
S (GMTSI,GMTS3,GMTS4)=0 F S GMTSI=$O(^GMT(142,GMTSDAT,1,GMTSI)) Q:+GMTSI=0 D
. S GMTS3=GMTSI,GMTS4=GMTS4+1
S:GMTS3>0&(GMTS4>0)&($D(^GMT(142,GMTSDAT,1,0))) ^GMT(142,+GMTSDAT,1,0)="^142.01IA^"_GMTS3_"^"_GMTS4
Q
HSO ; Install Health Summary Object
; Needs GMTSRTN, GMTSDAO,GMTSUSR
Q:+($G(GMTSQIT))>0 N GMTSQIT,GMTSROK,GMTSTXT,GMTSOBJ,GMTSNDD,GMTSTR,GMTSRT,DA,DIK
S GMTSQIT=0,GMTSROK=$$ROK^GMTSOBU(GMTSRTN) Q:GMTSROK'>0
S GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",1),GMTSOBJ=$P(GMTSTXT,";",2,299)
S GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",2),$P(GMTSTXT,"^",17)=GMTSUSR,GMTSNDD=GMTSTXT
S GMTSTR=$P(GMTSNDD,";",2),GMTSNDD=$P(GMTSNDD,";",3,299)
S GMTSRT="^GMT(142.5,DA,"_GMTSTR_")",DA=GMTSDAO,DIK="^GMT(142.5,"
S $P(GMTSNDD,"^",3)=+($G(GMTSDAT)),$P(GMTSNDD,"^",17)=+($G(GMTSUSR))
S $P(GMTSNDD,"^",18)=$$NOW^XLFDT H 1 S $P(GMTSNDD,"^",19)=$$NOW^XLFDT
S $P(GMTSNDD,"^",20)=0,@GMTSRT=GMTSNDD
;AGP CHANGE FOR NEW SUBSCRIPT
S GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",3),GMTSNDD=GMTSTXT
S GMTSTR=$P(GMTSNDD,";",2),GMTSNDD=$P(GMTSNDD,";",3,299)
S GMTSRT="^GMT(142.5,DA,"_GMTSTR_")"
S @GMTSRT=GMTSNDD
D IX1^DIK
Q
DELERR ; Delete on Error
I +($G(GMTSDAT))>0,+($G(GMTSDAO))'>0 D
. D DI(+($G(GMTSDAT)),"^GMT(142,")
. W !," An error has occurred while installing Health Summary Object"
. W !," Deleting the associated Health Summary Type"
I +($G(GMTSDAT))'>0,+($G(GMTSDAO))>0 D
. D DI(+($G(GMTSDAO)),"^GMT(142.5,")
. W !," An error has occurred while installing Health Summary Type"
. W !," Deleting the associated Health Summary Object"
I +($G(GMTSDAT))>0&('$D(^GMT(142,+GMTSDAT))) D
. D DI(+($G(GMTSDAT)),"^GMT(142,"),DEL(+($G(GMTSDAO)),"^GMT(142.5,")
. W !," An error has occurred while installing Health Summary Type"
. W !," Deleting the associated Health Summary Object"
I +($G(GMTSDAO))>0&('$D(^GMT(142.5,+GMTSDAO))) D
. D DI(+($G(GMTSDAT)),"^GMT(142,"),DEL(+($G(GMTSDAO)),"^GMT(142.5,")
. W !," An error has occurred while installing Health Summary Object"
. W !," Deleting the associated Health Summary Type"
Q
DI(X,Y) ; Delete Item
N DA,DIK S DA=+($G(X)),DIK=$G(Y) D:$L(DIK) ^DIK
Q
DONE ; Completed
I +($G(GMTSDAT))>0,+($G(GMTSDAO))>0 D
. I $D(^GMT(142,+GMTSDAT,0)),$D(^GMT(142.5,+GMTSDAO,0)) D
. . H 1 I $L(GMTSTN),$L(GMTSON) D Q
. . . W !!," Object '",GMTSON,"' installed using Health Summary Type '",GMTSTN,"'"
. . W !," Object Installed"
;AGP ADDED TO CLEAN-UP ROUTINE GMTSOBX
D DEL(GMTSRTN)
Q
DEL(X) ; Delete Routine X
S X=$G(X) Q:'$L(X) Q:$L(X)>8 Q:$$ROK^GMTSOBU(X)=0 X ^%ZOSF("DEL") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBI 7164 printed Nov 22, 2024@17:08:29 Page 2
GMTSOBI ; SLC/KER - HS Object - Import/Install ; 01/06/2003
+1 ;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61
+2 ;
+3 ; External References
+4 ; DBIA 10096 ^%ZOSF("DEL"
+5 ; DBIA 10013 IX1^DIK
+6 ; DBIA 10112 $$SITE^VASITE
+7 ; DBIA 2055 $$FLDNUM^DILFD (file 142.5)
+8 ; DBIA 10103 $$NOW^XLFDT
+9 ; DBIA 10013 ^DIK
+10 ;
EN ; Install Object from Routine GMTSOBX
+1 NEW DA,DIK,GMTS3,GMTS4,GMTSC,GMTSEDAT,GMTSETYP,GMTSETTL,GMTSDAO
+2 NEW GMTSDAT,GMTSDR,GMTSEX,GMTSFAC,GMTSFRM,GMTSI,GMTSIEN,GMTSIT
+3 NEW GMTSL,GMTSLN,GMTSNDD,GMTSOBJ,GMTSOBX,GMTSON,GMTSQIT,GMTSR
+4 NEW GMTSROK,GMTSRT,GMTSRTN,GMTST,GMTSTE,GMTSTN,GMTSTMP,GMTSTR
+5 NEW GMTSTTL,GMTSTXT,GMTSTYP,GMTSUSR,X
+6 IF +($$FLDNUM^DILFD(142.5,"NAME"))'>0!('$DATA(^GMT(142.5)))
Begin DoDot:1
+7 WRITE !," Unable to find HEALTH SUMMARY OBJECTS file #142.5"
End DoDot:1
QUIT
+8 SET GMTSEDAT=0
SET GMTSRTN="GMTSOBX"
SET GMTSQIT=0
SET GMTSUSR=+($GET(DUZ))
IF +GMTSUSR=0
WRITE !!," User not defined"
QUIT
+9 IF +($$ROK^GMTSOBU(GMTSRTN))'>0
WRITE !," Error:",!," Object not Found (routine GMTSOBX)"
QUIT
+10 FOR GMTSI=1:1:7
Begin DoDot:1
+11 SET GMTST=$$TX^GMTSOBU(GMTSRTN,GMTSRTN,(GMTSI-1))
if GMTST["Object
SET GMTSOBJ=$PIECE(GMTST,"Object: ",2)
+12 if GMTST["From
SET GMTSFRM=$PIECE(GMTST,"From: ",2)
if GMTST["Sender
SET GMTSDR=$PIECE(GMTST,"Sender: ",2)
End DoDot:1
+13 SET (GMTSON,GMTSOBJ)=$PIECE($$TX^GMTSOBU(GMTSRTN,"OBJ",1),";",2)
+14 SET (GMTSTN,GMTSTYP)=$PIECE($$TX^GMTSOBU(GMTSRTN,"TYPE",1),";",2)
+15 IF GMTSOBJ=""!(GMTSFRM="")!(GMTSDR="")
WRITE !," Error:",!," Can not install object from ",GMTSRTN
QUIT
+16 WRITE !," Installing Health Summary Object: ",GMTSOBJ
+17 IF $LENGTH(GMTSTYP)
Begin DoDot:1
+18 WRITE !," Using Health Summary Type: ",GMTSTYP
End DoDot:1
+19 WRITE !," From: ",GMTSFRM
+20 WRITE !," Sender: ",GMTSDR
+21 SET GMTSTTL=$PIECE($$TX^GMTSOBU(GMTSRTN,"TYPE",2),";",2)
+22 ; Check Facility
+23 SET GMTSFAC=+($PIECE($$SITE^VASITE,"^",3))
IF +GMTSFAC=0
WRITE !," Error:",!," Facility not defined"
QUIT
+24 ; Check Object
+25 WRITE !!," Checking Health Summary Object file #142.5"
+26 IF $LENGTH(GMTSOBJ)
Begin DoDot:1
+27 NEW GMTSTMP
SET GMTSTMP=$$BOX^GMTSOBU(GMTSOBJ)
IF +($GET(GMTSTMP))>0
WRITE !
DO ER1^GMTSOBU
SET GMTSQIT=1
End DoDot:1
if GMTSQIT
QUIT
+28 ; Check Type
+29 WRITE !," Check Health Summary Type file #142"
+30 IF $LENGTH(GMTSTYP)
Begin DoDot:1
+31 SET GMTSQIT=1
NEW GMTSTMP
SET GMTSTMP=$$NWX^GMTSOBU(GMTSTYP)
+32 if +($GET(GMTSTMP))'>0
SET GMTSQIT=0
IF +($GET(GMTSTMP))>0
Begin DoDot:2
+33 SET GMTSEDAT=$$EHST^GMTSOBU
IF GMTSEDAT>0
Begin DoDot:3
+34 SET GMTSDAT=GMTSEDAT
SET GMTSQIT=0
IF $LENGTH($GET(GMTSETYP))
IF $LENGTH($GET(GMTSETTL))
Begin DoDot:4
+35 SET GMTSTYP=GMTSETYP
SET GMTSTTL=GMTSETTL
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
if GMTSQIT
QUIT
+36 ; Check Title
+37 WRITE !," Checking for Duplicate Title"
+38 IF $LENGTH(GMTSTTL)
Begin DoDot:1
+39 NEW GMTSTMP
SET GMTSTMP=$$TWX^GMTSOBU(GMTSTTL)
IF +GMTSTMP>0
WRITE !
DO ER3^GMTSOBU
SET GMTSQIT=1
End DoDot:1
if GMTSQIT
QUIT
+40 SET GMTSDAT=$$TIEN^GMTSOBU
if +($GET(GMTSEDAT))>0
SET GMTSDAT=+($GET(GMTSEDAT))
+41 if GMTSDAT'>0
SET GMTSQIT=1
+42 IF GMTSQIT
WRITE !," Unable to add Health Summary Type"
QUIT
+43 SET GMTSDAO=$$OIEN^GMTSOBU(GMTSFAC)
if GMTSDAO'>0
SET GMTSQIT=1
+44 IF GMTSQIT
WRITE !," Unable to add Health Summary Object"
QUIT
+45 LOCK +^GMT(142,+GMTSDAT):0
if '$TEST
SET GMTSQIT=1
+46 LOCK +^GMT(142.5,+GMTSDAO):0
if '$TEST
SET GMTSQIT=1
+47 IF +($GET(GMTSQIT))>0
LOCK -^GMT(142,+GMTSDAT)
LOCK -^GMT(142,+GMTSDAO)
Begin DoDot:1
+48 WRITE !," Unable to add Health Summary Type and Object"
End DoDot:1
QUIT
+49 IF GMTSDAT>0
IF GMTSDAO>0
IF GMTSQIT'>0
DO HST
DO HSO
+50 DO DELERR
LOCK -^GMT(142,+GMTSDAT)
LOCK -^GMT(142,+GMTSDAO)
+51 DO DONE
WRITE !
+52 QUIT
HST ; Install Health Summary Type
+1 ; Needs GMTSRTN, GMTSDAT, GMTSUSR, GMTSTYP, GMTSTTL
+2 if +($GET(GMTSTE))>0
QUIT
NEW GMTSROK,GMTSI,GMTSTXT,GMTSTR,GMTSNDD,GMTSR,GMTSC,GMTSRT,GMTS3,GMTS4,DA,DIK
+3 if +($GET(GMTSQIT))>0
QUIT
SET GMTSQIT=0
SET GMTSROK=$$ROK^GMTSOBU(GMTSRTN)
if GMTSROK'>0
QUIT
+4 ; Save Type
+5 IF '$LENGTH(GMTSTYP)!('$LENGTH(GMTSTTL))
SET GMTSQIT=1
QUIT
+6 FOR GMTSI=3:1
if GMTSQIT
QUIT
Begin DoDot:1
+7 SET GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"TYPE",GMTSI)
SET GMTSTXT=$PIECE(GMTSTXT," ;",2,299)
+8 IF '$LENGTH(GMTSTXT)
SET GMTSQIT=1
QUIT
+9 SET GMTSTR=$PIECE(GMTSTXT,";",1)
SET GMTSNDD=$PIECE(GMTSTXT,";",2)
+10 SET GMTSR=$PIECE(GMTSTR,",",2)
SET GMTSC=$PIECE(GMTSNDD,"^",2)
+11 if GMTSR>0&(GMTSC>0)&('$DATA(^GMT(142.1,+GMTSC)))
QUIT
if (GMTSR>0)&(GMTSC>0)&(GMTSC>999)
QUIT
+12 if GMTSTR="0"
SET $PIECE(GMTSNDD,"^",3)=GMTSUSR
+13 if GMTSTR="0"&($LENGTH(GMTSTYP))
SET $PIECE(GMTSNDD,"^",1)=GMTSTYP
+14 if GMTSTR="""T"""&($LENGTH(GMTSTTL))
SET $PIECE(GMTSNDD,"^",1)=GMTSTTL
+15 SET GMTSNDD=$TRANSLATE(GMTSNDD,"""","")
if '$LENGTH(GMTSNDD)
SET GMTSNDD=""""""
+16 SET GMTSRT="^GMT(142,DA,"_GMTSTR_")"
+17 SET DA=GMTSDAT
SET @GMTSRT=GMTSNDD
End DoDot:1
if GMTSQIT
QUIT
+18 ; Check Indexes
+19 SET GMTSQIT=0
FOR GMTSI="B","C"
SET GMTSR=0
FOR
SET GMTSR=$ORDER(^GMT(142,GMTSDAT,1,GMTSI,GMTSR))
if +GMTSR=0
QUIT
Begin DoDot:1
+20 SET GMTSC=0
FOR
SET GMTSC=$ORDER(^GMT(142,GMTSDAT,1,GMTSI,GMTSR,GMTSC))
if +GMTSC=0
QUIT
Begin DoDot:2
+21 IF '$DATA(^GMT(142,GMTSDAT,1,GMTSC))
KILL ^GMT(142,GMTSDAT,1,GMTSI,GMTSR,GMTSC)
End DoDot:2
End DoDot:1
+22 ; Re-Index
+23 SET DA=GMTSDAT
SET DIK="^GMT(142,"
DO IX1^DIK
+24 ; Check Structure (sub-file 142.01)
+25 SET (GMTSI,GMTS3,GMTS4)=0
FOR
SET GMTSI=$ORDER(^GMT(142,GMTSDAT,1,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+26 SET GMTS3=GMTSI
SET GMTS4=GMTS4+1
End DoDot:1
+27 if GMTS3>0&(GMTS4>0)&($DATA(^GMT(142,GMTSDAT,1,0)))
SET ^GMT(142,+GMTSDAT,1,0)="^142.01IA^"_GMTS3_"^"_GMTS4
+28 QUIT
HSO ; Install Health Summary Object
+1 ; Needs GMTSRTN, GMTSDAO,GMTSUSR
+2 if +($GET(GMTSQIT))>0
QUIT
NEW GMTSQIT,GMTSROK,GMTSTXT,GMTSOBJ,GMTSNDD,GMTSTR,GMTSRT,DA,DIK
+3 SET GMTSQIT=0
SET GMTSROK=$$ROK^GMTSOBU(GMTSRTN)
if GMTSROK'>0
QUIT
+4 SET GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",1)
SET GMTSOBJ=$PIECE(GMTSTXT,";",2,299)
+5 SET GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",2)
SET $PIECE(GMTSTXT,"^",17)=GMTSUSR
SET GMTSNDD=GMTSTXT
+6 SET GMTSTR=$PIECE(GMTSNDD,";",2)
SET GMTSNDD=$PIECE(GMTSNDD,";",3,299)
+7 SET GMTSRT="^GMT(142.5,DA,"_GMTSTR_")"
SET DA=GMTSDAO
SET DIK="^GMT(142.5,"
+8 SET $PIECE(GMTSNDD,"^",3)=+($GET(GMTSDAT))
SET $PIECE(GMTSNDD,"^",17)=+($GET(GMTSUSR))
+9 SET $PIECE(GMTSNDD,"^",18)=$$NOW^XLFDT
HANG 1
SET $PIECE(GMTSNDD,"^",19)=$$NOW^XLFDT
+10 SET $PIECE(GMTSNDD,"^",20)=0
SET @GMTSRT=GMTSNDD
+11 ;AGP CHANGE FOR NEW SUBSCRIPT
+12 SET GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",3)
SET GMTSNDD=GMTSTXT
+13 SET GMTSTR=$PIECE(GMTSNDD,";",2)
SET GMTSNDD=$PIECE(GMTSNDD,";",3,299)
+14 SET GMTSRT="^GMT(142.5,DA,"_GMTSTR_")"
+15 SET @GMTSRT=GMTSNDD
+16 DO IX1^DIK
+17 QUIT
DELERR ; Delete on Error
+1 IF +($GET(GMTSDAT))>0
IF +($GET(GMTSDAO))'>0
Begin DoDot:1
+2 DO DI(+($GET(GMTSDAT)),"^GMT(142,")
+3 WRITE !," An error has occurred while installing Health Summary Object"
+4 WRITE !," Deleting the associated Health Summary Type"
End DoDot:1
+5 IF +($GET(GMTSDAT))'>0
IF +($GET(GMTSDAO))>0
Begin DoDot:1
+6 DO DI(+($GET(GMTSDAO)),"^GMT(142.5,")
+7 WRITE !," An error has occurred while installing Health Summary Type"
+8 WRITE !," Deleting the associated Health Summary Object"
End DoDot:1
+9 IF +($GET(GMTSDAT))>0&('$DATA(^GMT(142,+GMTSDAT)))
Begin DoDot:1
+10 DO DI(+($GET(GMTSDAT)),"^GMT(142,")
DO DEL(+($GET(GMTSDAO)),"^GMT(142.5,")
+11 WRITE !," An error has occurred while installing Health Summary Type"
+12 WRITE !," Deleting the associated Health Summary Object"
End DoDot:1
+13 IF +($GET(GMTSDAO))>0&('$DATA(^GMT(142.5,+GMTSDAO)))
Begin DoDot:1
+14 DO DI(+($GET(GMTSDAT)),"^GMT(142,")
DO DEL(+($GET(GMTSDAO)),"^GMT(142.5,")
+15 WRITE !," An error has occurred while installing Health Summary Object"
+16 WRITE !," Deleting the associated Health Summary Type"
End DoDot:1
+17 QUIT
DI(X,Y) ; Delete Item
+1 NEW DA,DIK
SET DA=+($GET(X))
SET DIK=$GET(Y)
if $LENGTH(DIK)
DO ^DIK
+2 QUIT
DONE ; Completed
+1 IF +($GET(GMTSDAT))>0
IF +($GET(GMTSDAO))>0
Begin DoDot:1
+2 IF $DATA(^GMT(142,+GMTSDAT,0))
IF $DATA(^GMT(142.5,+GMTSDAO,0))
Begin DoDot:2
+3 HANG 1
IF $LENGTH(GMTSTN)
IF $LENGTH(GMTSON)
Begin DoDot:3
+4 WRITE !!," Object '",GMTSON,"' installed using Health Summary Type '",GMTSTN,"'"
End DoDot:3
QUIT
+5 WRITE !," Object Installed"
End DoDot:2
End DoDot:1
+6 ;AGP ADDED TO CLEAN-UP ROUTINE GMTSOBX
+7 DO DEL(GMTSRTN)
+8 QUIT
DEL(X) ; Delete Routine X
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT
if $LENGTH(X)>8
QUIT
if $$ROK^GMTSOBU(X)=0
QUIT
XECUTE ^%ZOSF("DEL")
QUIT
