- 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 Mar 13, 2025@21:03:09 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
