- GMTSOBV ; SLC/KER - HS Object - Verify ; 06/24/2009
- ;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61
- ;
- ; External References
- ; DBIA 10006 ^DIC (file #2 and 142.5)
- ; DBIA 10013 ^DIK (file #142.5)
- ; DBIA 10026 ^DIR
- ; DBIA 10104 $$UP^XLFSTR
- ; DBIA 10076 ^XUSEC(
- ; DBIA 10076 ^XUSEC("GMTSMGR"
- ; DBIA 3798 $$EXIST^TIUHSOBJ
- ; DBIA 10005 DT^DICRW
- ; DBIA 10103 $$DT^XLFDT
- ; DBIA 10061 DEM^VADPT
- ;
- Q
- VT(X) ; Verify Type Selection
- N GMTSHDR,GMTSNOQ,GMTSNOI,GMTSX,GMTSREDO S GMTSX=+($G(X)) Q:+GMTSX'>0 -1
- S GMTSHDR(1)="You have selected the following Health Summary Type to use as an Object:"
- S GMTSHDR(2)=" ",GMTSNOQ="",GMTSNOI="",GMTSREDO=0
- D DT^GMTSOBD(+GMTSX) I $D(^TMP("GMTSOBT",$J)) D
- . D NOQUE^GMTSOBD W ! N DIR,DTOUT,DUOUT S DIR(0)="YAO",DIR("A")="Is this correct? ",DIR("B")="Y"
- . D ^DIR S:$$UP^XLFSTR($E(X,1))="N" GMTSREDO=1 I +Y'>0 S GMTSX=-1
- I GMTSREDO>0!(GMTSX'>0) S X=-1
- Q X
- VTE(X) ; Verify Type Edit
- N GMTSX,GMTSOWN,GMTSNAT,GMTSLOCK,GMTSKEY,GMTSMGR S GMTSX=+($G(X)) Q:$D(GMTSDEV) X
- I +GMTSX'>0 W:'$D(GMTSQT) !!," Health Summary Type not found.",! Q -1
- I +($G(DUZ))'>0 W:'$D(GMTSQT) !!," User not defined.",! Q -1
- I +($$UACT^GMTSU2(+($G(DUZ))))'>0 W:'$D(GMTSQT) !!," User is not an active user.",! Q -1
- I '$D(^GMT(142,+GMTSX,0)) W:'$D(GMTSQT) !!," Health Summary Type not found.",! Q -1
- I '$L($P($G(^GMT(142,+GMTSX,0)),"^",1)) W:'$D(GMTSQT) !!," Invalid Health Summary Type.",! Q -1
- S GMTSMGR=$S($D(^XUSEC("GMTSMGR",+($G(DUZ)))):1,1:0),GMTSLOCK=$P($G(^GMT(142,+GMTSX,0)),"^",2)
- S GMTSKEY=1 S:$L(GMTSLOCK) GMTSKEY=$D(^XUSEC(GMTSLOCK,+($G(DUZ))))
- S GMTSOWN=$P($G(^GMT(142,+GMTSX,0)),"^",3),GMTSNAT=+($P($G(^GMT(142,+GMTSX,"VA")),"^",1))
- I GMTSNAT>0 W:'$D(GMTSQT) !!," You can not edit a Nationally exported Health Summary Type.",! Q -1
- I 'GMTSMGR,'GMTSKEY W:'$D(GMTSQT) !!," This Health Summary Type is currently locked to prevent alteration.",! Q -1
- I GMTSOWN>0,GMTSOWN'=+($G(DUZ)),'$D(^XUSEC("GMTSMGR",DUZ)) W:'$D(GMTSQT) !!," You can not edit a Health Summary Type you don't own.",! Q -1
- S X=GMTSX Q X
- VOE(X) ; Verify Object Edit
- N GMTSX,GMTSOWN,GMTSNAT,GMTSMGR S GMTSX=+($G(X)) Q:$D(GMTSDEV) X
- I +GMTSX'>0 W:'$D(GMTSQT) !!," Health Summary Object not found.",! Q -1
- I +($G(DUZ))'>0 W:'$D(GMTSQT) !!," User not defined.",! Q -1
- I +($$UACT^GMTSU2(+($G(DUZ))))'>0 W:'$D(GMTSQT) !!," User is not an active user.",! Q -1
- I '$D(^GMT(142.5,+GMTSX,0)) W:'$D(GMTSQT) !!," Health Summary Object not found.",! Q -1
- I '$L($P($G(^GMT(142.5,+GMTSX,0)),"^",1)) W:'$D(GMTSQT) !!," Invalid Health Summary Object.",! Q -1
- S GMTSMGR=$S($D(^XUSEC("GMTSMGR",+($G(DUZ)))):1,1:0)
- S GMTSOWN=$P($G(^GMT(142.5,+GMTSX,0)),"^",17),GMTSNAT=+($P($G(^GMT(142,+GMTSX,"VA")),"^",1))
- I GMTSNAT>0 W:'$D(GMTSQT) !!," You can not edit a Nationally exported Health Summary Object.",! Q -1
- I GMTSOWN>0,GMTSOWN'=+($G(DUZ)) W:'$D(GMTSQT) !!," You can not edit a Health Summary Object you don't own.",! Q -1
- S X=GMTSX Q X
- VO(X) ; Verify Object
- N GMTSHDR,GMTSNOQ,GMTSNOI,GMTSX,GMTSREDO S GMTSREDO=0,GMTSX=+($G(X)) Q:+GMTSX'>0 -1
- S GMTSHDR(1)="You have selected the following Health Summary Object:"
- S GMTSHDR(2)=" " D SO^GMTSOBS(+GMTSX) W ! N DIR,DTOUT,DUOUT S DIR(0)="YAO",DIR("A")="Is this correct? ",DIR("B")="Y"
- D ^DIR S:$$UP^XLFSTR($E(X,1))="N" GMTSREDO=1
- S X=1 I GMTSREDO>0!(+Y'>0) S X=-1
- Q X
- VOD(X) ; Verify Object Deletion
- N GMTS,GMTSIEN,GMTSOWN,GMTSOK,GMTSI,GMTSN,GMTST,GMTSS,GMTSNAT,DIR,DTOUT,DIROUT,DUOUT,Y
- S GMTSOK=0,GMTSIEN=+($G(X)) I +X'>0 D Q 0
- . W !!," Sorry, you can not delete this Health Summary Object.",!
- S GMTSN=$P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",1) I '$L(GMTSN) D Q 0
- . W !!," Sorry, you can not delete this Health Summary Object."
- . W !," There is a problem with the object's NAME field (#.01).",!
- S GMTSNAT=$P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",20),GMTSOWN=$P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",17)
- I +GMTSOWN>0,+GMTSOWN'=+($G(DUZ)) D Q 0
- . W !!," You can not delete a Health Summary Object you don't own.",!
- I +GMTSNAT>0,'$D(GMTSDEV) D Q 0
- . W !!," You can not delete a Nationally Exported Health Summary Object.",!
- S GMTST=" Object: "_GMTSN,GMTSS="",$P(GMTSS," ",(60-$L(GMTST))\2)=" ",GMTST=GMTSS_GMTST
- I '$L($T(EXIST^TIUHSOBJ)) D Q 0
- . W !!," Unable to determine if this Health Summary Object is linked"
- . W !," to a TIU Object. Nothing deleted.",!
- S X=$$EXIST^TIUHSOBJ(GMTSIEN) Q:+X'>0 1
- S DIR("A",1)=" WARNING -- You are about to delete a Health Summary Object "
- S DIR("A",2)=" currently in use by TIU. If you continue, then the associated"
- S DIR("A",3)=" TIU Object will not display correctly."
- S DIR("A",4)="",DIR("A",5)=GMTST,DIR("A",6)=""
- S DIR("A")=" Are you sure you want to delete this Health Summary Object? "
- S DIR(0)="YAO",DIR("B")="NO",(DIR("?"),DIR("??"))="^D VODH^GMTSOBV"
- D ^DIR S X=$S(+Y>0:+GMTSX,1:0) S:$D(DTOUT)!($D(DUOUT)) X=0
- Q X
- VODH ; VOD Help
- W !," Enter either 'Y' or 'N'."
- Q
- DEL(X) ; Verify Object Deletion
- N GMTSIEN S GMTSIEN=+($G(X)) Q:GMTSIEN'>0 0 Q:'$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1)) 0
- Q:+($P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",17))&(+($P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",17))'=+($G(DUZ))) 0
- Q:+($P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",20))&('$D(GMTSDEV)) 0
- I $L($T(EXIST^TIUHSOBJ)),+($$EXIST^TIUHSOBJ(GMTSIEN))>0,'$D(GMTSDEV) Q 0
- Q 1
- CRD(X) ; Create Delete
- N GMTSIEN S GMTSIEN=+($G(X)) Q:GMTSIEN'>0 N DA,DIK,GMTSC,GMTSE,GMTSN,GMTST,GMTSR S GMTSN=$P($G(^GMT(142.5,+GMTSIEN,0)),"^",1)
- S GMTSC=+($P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",17)) I +GMTSC>0,+GMTSC'=+($G(DUZ)) Q
- S GMTSE=+($P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",20)) I GMTSE>0&('$D(GMTSDEV)) Q
- I $L($T(EXIST^TIUHSOBJ)),+($$EXIST^TIUHSOBJ(GMTSIEN))>0 Q
- S GMTSN=+($P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",1)),GMTST=+($P($G(^GMT(142.5,+($G(GMTSIEN)),0)),"^",3))
- I $L(GMTSN),+($G(GMTST))>0,$D(^GMT(142,+($G(GMTST)),0)) Q
- S DA=GMTSIEN,DIK="^GMT(142.5," D ^DIK
- Q
- NAME(X) ; Verify Name for $$CRE^GMTSOBJ
- N GMTSN,GMTSE S GMTSN=$G(X),GMTSE=$$EXIST(GMTSN) S:$L(GMTSN)<3!($L(GMTSN)>60) GMTSN=""
- I $L(GMTSN)>2,$L(GMTSN)'>60,GMTSE'>0 Q X
- N X,Y,DIR,DIROUT,DTOUT,DUOUT
- S DIR(0)="FAO^3:60^N GMTS S GMTS=$$NIT^GMTSOBV(X) K:+GMTS'>0 X",GMTSN=""
- S DIR("A")=" Health Summary Object Name: "
- S (DIR("?"),DIR("??"))="^D NH^GMTSOBV"
- D ^DIR S:$L(Y)>2&($L(Y)'>60) GMTSN=Y S X=GMTSN W !
- Q X
- NIT(X) ; Name Input Transform
- N GMTSN S GMTSN=$$EXIST($G(X)) Q:+GMTSN<0 0
- I +GMTSN>0 D Q 0
- . W !!," A Health Summary Object of the same name exist"
- Q 1
- NH ; Name Help
- W !," Enter a name of a new Health Summary Object, "
- W !," 3 to 30 characters in length."
- Q
- EXIST(X) ; Name Exist
- ; Returns 0 Does not Exist
- ; 1 Exist
- ; -1 Error
- N GMTSN,GMTSO,GMTSC,GMTSI,GMTSE,GMTST S GMTSN=$$UP^XLFSTR($G(X))
- Q:$L(GMTSN)<3 -1 Q:$L(GMTSN)>60 -1
- S GMTSE=0,GMTSO=$E(GMTSN,1,28),GMTSO=$E(GMTSO,1,($L(GMTSO)-1))_$C($A($E(GMTSO,$L(GMTSO)))-1)_"~",GMTSC=$E(GMTSO,1,($L(GMTSO)-2))
- F S GMTSO=$O(^GMT(142.5,"C",GMTSO)) Q:GMTSO=""!(+GMTSE>0)!(GMTSO'[GMTSC) D
- . S GMTSI=0 F S GMTSI=$O(^GMT(142.5,"C",GMTSO,GMTSI)) Q:+GMTSI=0 D
- . . S GMTST=$$UP^XLFSTR($P($G(^GMT(142.5,GMTSI,0)),"^",1)) S:GMTSN=GMTST GMTSE=1
- S X=GMTSE
- Q X
- PAT ; Patient Lookup
- K DFN,GMP D DT^DICRW N DIC,DTOUT,DUOUT,DIROUT,GMTSNAM,GMTSLAS,VA,VADM
- S DIC=2,DIC("A")=" Select Patient: ",DIC(0)="AEQMZ",DT=$$DT^XLFDT,DTIME=300 D ^DIC I +Y>0 D
- . S DFN=+Y N GMTSNAM,GMTSLAS,VA,VADM D DEM^VADPT S GMTSNAM=$G(VADM(1)),GMTSLAS=+($G(VA("BID")))
- . S GMP=1,GMP(0)=1,GMP(1)=DFN_"^"_GMTSNAM_"^ "_GMTSNAM_" "_$S(+GMTSLAS>0:"(",1:0)_+GMTSLAS_$S(+GMTSLAS>0:")",1:0)_"^1"
- Q
- LKO(X) ; Lookup Object
- N DIC,DTOUT,DUOUT,DIROUT,DIR,GMTSX
- S DIC="^GMT(142.5,",DIC("A")=" Select HEALTH SUMMARY OBJECT: ",U="^"
- S DIC(0)="AEMQ" K DLAYGO D ^DIC S (X,GMTSX)=+Y Q:+Y'>0 -1 Q:$D(DTOUT)!($D(DUOUT)) -1
- I +Y>0 D Q X
- . N DIR,GMTSI,GMTSN S GMTSI=+Y,X=-1,GMTSN=$P($G(^GMT(142.5,+GMTSI,0)),"^",1) Q:'$L(GMTSN)
- . S DIR(0)="YAO",DIR("A")=" Is this correct? ",DIR("B")="Y"
- . W !!,"You have selected ",GMTSN,! D SO^GMTSOBS(GMTSX) W !
- . D ^DIR S X=$S(+Y>0:+GMTSX,1:-1) S:$D(DTOUT)!($D(DUOUT)) X=-1
- Q X
- TRIM(X) ; Trim Space Characters
- S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBV 8499 printed Mar 13, 2025@21:03:17 Page 2
- GMTSOBV ; SLC/KER - HS Object - Verify ; 06/24/2009
- +1 ;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61
- +2 ;
- +3 ; External References
- +4 ; DBIA 10006 ^DIC (file #2 and 142.5)
- +5 ; DBIA 10013 ^DIK (file #142.5)
- +6 ; DBIA 10026 ^DIR
- +7 ; DBIA 10104 $$UP^XLFSTR
- +8 ; DBIA 10076 ^XUSEC(
- +9 ; DBIA 10076 ^XUSEC("GMTSMGR"
- +10 ; DBIA 3798 $$EXIST^TIUHSOBJ
- +11 ; DBIA 10005 DT^DICRW
- +12 ; DBIA 10103 $$DT^XLFDT
- +13 ; DBIA 10061 DEM^VADPT
- +14 ;
- +15 QUIT
- VT(X) ; Verify Type Selection
- +1 NEW GMTSHDR,GMTSNOQ,GMTSNOI,GMTSX,GMTSREDO
- SET GMTSX=+($GET(X))
- if +GMTSX'>0
- QUIT -1
- +2 SET GMTSHDR(1)="You have selected the following Health Summary Type to use as an Object:"
- +3 SET GMTSHDR(2)=" "
- SET GMTSNOQ=""
- SET GMTSNOI=""
- SET GMTSREDO=0
- +4 DO DT^GMTSOBD(+GMTSX)
- IF $DATA(^TMP("GMTSOBT",$JOB))
- Begin DoDot:1
- +5 DO NOQUE^GMTSOBD
- WRITE !
- NEW DIR,DTOUT,DUOUT
- SET DIR(0)="YAO"
- SET DIR("A")="Is this correct? "
- SET DIR("B")="Y"
- +6 DO ^DIR
- if $$UP^XLFSTR($EXTRACT(X,1))="N"
- SET GMTSREDO=1
- IF +Y'>0
- SET GMTSX=-1
- End DoDot:1
- +7 IF GMTSREDO>0!(GMTSX'>0)
- SET X=-1
- +8 QUIT X
- VTE(X) ; Verify Type Edit
- +1 NEW GMTSX,GMTSOWN,GMTSNAT,GMTSLOCK,GMTSKEY,GMTSMGR
- SET GMTSX=+($GET(X))
- if $DATA(GMTSDEV)
- QUIT X
- +2 IF +GMTSX'>0
- if '$DATA(GMTSQT)
- WRITE !!," Health Summary Type not found.",!
- QUIT -1
- +3 IF +($GET(DUZ))'>0
- if '$DATA(GMTSQT)
- WRITE !!," User not defined.",!
- QUIT -1
- +4 IF +($$UACT^GMTSU2(+($GET(DUZ))))'>0
- if '$DATA(GMTSQT)
- WRITE !!," User is not an active user.",!
- QUIT -1
- +5 IF '$DATA(^GMT(142,+GMTSX,0))
- if '$DATA(GMTSQT)
- WRITE !!," Health Summary Type not found.",!
- QUIT -1
- +6 IF '$LENGTH($PIECE($GET(^GMT(142,+GMTSX,0)),"^",1))
- if '$DATA(GMTSQT)
- WRITE !!," Invalid Health Summary Type.",!
- QUIT -1
- +7 SET GMTSMGR=$SELECT($DATA(^XUSEC("GMTSMGR",+($GET(DUZ)))):1,1:0)
- SET GMTSLOCK=$PIECE($GET(^GMT(142,+GMTSX,0)),"^",2)
- +8 SET GMTSKEY=1
- if $LENGTH(GMTSLOCK)
- SET GMTSKEY=$DATA(^XUSEC(GMTSLOCK,+($GET(DUZ))))
- +9 SET GMTSOWN=$PIECE($GET(^GMT(142,+GMTSX,0)),"^",3)
- SET GMTSNAT=+($PIECE($GET(^GMT(142,+GMTSX,"VA")),"^",1))
- +10 IF GMTSNAT>0
- if '$DATA(GMTSQT)
- WRITE !!," You can not edit a Nationally exported Health Summary Type.",!
- QUIT -1
- +11 IF 'GMTSMGR
- IF 'GMTSKEY
- if '$DATA(GMTSQT)
- WRITE !!," This Health Summary Type is currently locked to prevent alteration.",!
- QUIT -1
- +12 IF GMTSOWN>0
- IF GMTSOWN'=+($GET(DUZ))
- IF '$DATA(^XUSEC("GMTSMGR",DUZ))
- if '$DATA(GMTSQT)
- WRITE !!," You can not edit a Health Summary Type you don't own.",!
- QUIT -1
- +13 SET X=GMTSX
- QUIT X
- VOE(X) ; Verify Object Edit
- +1 NEW GMTSX,GMTSOWN,GMTSNAT,GMTSMGR
- SET GMTSX=+($GET(X))
- if $DATA(GMTSDEV)
- QUIT X
- +2 IF +GMTSX'>0
- if '$DATA(GMTSQT)
- WRITE !!," Health Summary Object not found.",!
- QUIT -1
- +3 IF +($GET(DUZ))'>0
- if '$DATA(GMTSQT)
- WRITE !!," User not defined.",!
- QUIT -1
- +4 IF +($$UACT^GMTSU2(+($GET(DUZ))))'>0
- if '$DATA(GMTSQT)
- WRITE !!," User is not an active user.",!
- QUIT -1
- +5 IF '$DATA(^GMT(142.5,+GMTSX,0))
- if '$DATA(GMTSQT)
- WRITE !!," Health Summary Object not found.",!
- QUIT -1
- +6 IF '$LENGTH($PIECE($GET(^GMT(142.5,+GMTSX,0)),"^",1))
- if '$DATA(GMTSQT)
- WRITE !!," Invalid Health Summary Object.",!
- QUIT -1
- +7 SET GMTSMGR=$SELECT($DATA(^XUSEC("GMTSMGR",+($GET(DUZ)))):1,1:0)
- +8 SET GMTSOWN=$PIECE($GET(^GMT(142.5,+GMTSX,0)),"^",17)
- SET GMTSNAT=+($PIECE($GET(^GMT(142,+GMTSX,"VA")),"^",1))
- +9 IF GMTSNAT>0
- if '$DATA(GMTSQT)
- WRITE !!," You can not edit a Nationally exported Health Summary Object.",!
- QUIT -1
- +10 IF GMTSOWN>0
- IF GMTSOWN'=+($GET(DUZ))
- if '$DATA(GMTSQT)
- WRITE !!," You can not edit a Health Summary Object you don't own.",!
- QUIT -1
- +11 SET X=GMTSX
- QUIT X
- VO(X) ; Verify Object
- +1 NEW GMTSHDR,GMTSNOQ,GMTSNOI,GMTSX,GMTSREDO
- SET GMTSREDO=0
- SET GMTSX=+($GET(X))
- if +GMTSX'>0
- QUIT -1
- +2 SET GMTSHDR(1)="You have selected the following Health Summary Object:"
- +3 SET GMTSHDR(2)=" "
- DO SO^GMTSOBS(+GMTSX)
- WRITE !
- NEW DIR,DTOUT,DUOUT
- SET DIR(0)="YAO"
- SET DIR("A")="Is this correct? "
- SET DIR("B")="Y"
- +4 DO ^DIR
- if $$UP^XLFSTR($EXTRACT(X,1))="N"
- SET GMTSREDO=1
- +5 SET X=1
- IF GMTSREDO>0!(+Y'>0)
- SET X=-1
- +6 QUIT X
- VOD(X) ; Verify Object Deletion
- +1 NEW GMTS,GMTSIEN,GMTSOWN,GMTSOK,GMTSI,GMTSN,GMTST,GMTSS,GMTSNAT,DIR,DTOUT,DIROUT,DUOUT,Y
- +2 SET GMTSOK=0
- SET GMTSIEN=+($GET(X))
- IF +X'>0
- Begin DoDot:1
- +3 WRITE !!," Sorry, you can not delete this Health Summary Object.",!
- End DoDot:1
- QUIT 0
- +4 SET GMTSN=$PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",1)
- IF '$LENGTH(GMTSN)
- Begin DoDot:1
- +5 WRITE !!," Sorry, you can not delete this Health Summary Object."
- +6 WRITE !," There is a problem with the object's NAME field (#.01).",!
- End DoDot:1
- QUIT 0
- +7 SET GMTSNAT=$PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",20)
- SET GMTSOWN=$PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",17)
- +8 IF +GMTSOWN>0
- IF +GMTSOWN'=+($GET(DUZ))
- Begin DoDot:1
- +9 WRITE !!," You can not delete a Health Summary Object you don't own.",!
- End DoDot:1
- QUIT 0
- +10 IF +GMTSNAT>0
- IF '$DATA(GMTSDEV)
- Begin DoDot:1
- +11 WRITE !!," You can not delete a Nationally Exported Health Summary Object.",!
- End DoDot:1
- QUIT 0
- +12 SET GMTST=" Object: "_GMTSN
- SET GMTSS=""
- SET $PIECE(GMTSS," ",(60-$LENGTH(GMTST))\2)=" "
- SET GMTST=GMTSS_GMTST
- +13 IF '$LENGTH($TEXT(EXIST^TIUHSOBJ))
- Begin DoDot:1
- +14 WRITE !!," Unable to determine if this Health Summary Object is linked"
- +15 WRITE !," to a TIU Object. Nothing deleted.",!
- End DoDot:1
- QUIT 0
- +16 SET X=$$EXIST^TIUHSOBJ(GMTSIEN)
- if +X'>0
- QUIT 1
- +17 SET DIR("A",1)=" WARNING -- You are about to delete a Health Summary Object "
- +18 SET DIR("A",2)=" currently in use by TIU. If you continue, then the associated"
- +19 SET DIR("A",3)=" TIU Object will not display correctly."
- +20 SET DIR("A",4)=""
- SET DIR("A",5)=GMTST
- SET DIR("A",6)=""
- +21 SET DIR("A")=" Are you sure you want to delete this Health Summary Object? "
- +22 SET DIR(0)="YAO"
- SET DIR("B")="NO"
- SET (DIR("?"),DIR("??"))="^D VODH^GMTSOBV"
- +23 DO ^DIR
- SET X=$SELECT(+Y>0:+GMTSX,1:0)
- if $DATA(DTOUT)!($DATA(DUOUT))
- SET X=0
- +24 QUIT X
- VODH ; VOD Help
- +1 WRITE !," Enter either 'Y' or 'N'."
- +2 QUIT
- DEL(X) ; Verify Object Deletion
- +1 NEW GMTSIEN
- SET GMTSIEN=+($GET(X))
- if GMTSIEN'>0
- QUIT 0
- if '$LENGTH($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",1))
- QUIT 0
- +2 if +($PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",17))&(+($PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",17))'=+($GET(DUZ)))
- QUIT 0
- +3 if +($PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",20))&('$DATA(GMTSDEV))
- QUIT 0
- +4 IF $LENGTH($TEXT(EXIST^TIUHSOBJ))
- IF +($$EXIST^TIUHSOBJ(GMTSIEN))>0
- IF '$DATA(GMTSDEV)
- QUIT 0
- +5 QUIT 1
- CRD(X) ; Create Delete
- +1 NEW GMTSIEN
- SET GMTSIEN=+($GET(X))
- if GMTSIEN'>0
- QUIT
- NEW DA,DIK,GMTSC,GMTSE,GMTSN,GMTST,GMTSR
- SET GMTSN=$PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",1)
- +2 SET GMTSC=+($PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",17))
- IF +GMTSC>0
- IF +GMTSC'=+($GET(DUZ))
- QUIT
- +3 SET GMTSE=+($PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",20))
- IF GMTSE>0&('$DATA(GMTSDEV))
- QUIT
- +4 IF $LENGTH($TEXT(EXIST^TIUHSOBJ))
- IF +($$EXIST^TIUHSOBJ(GMTSIEN))>0
- QUIT
- +5 SET GMTSN=+($PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",1))
- SET GMTST=+($PIECE($GET(^GMT(142.5,+($GET(GMTSIEN)),0)),"^",3))
- +6 IF $LENGTH(GMTSN)
- IF +($GET(GMTST))>0
- IF $DATA(^GMT(142,+($GET(GMTST)),0))
- QUIT
- +7 SET DA=GMTSIEN
- SET DIK="^GMT(142.5,"
- DO ^DIK
- +8 QUIT
- NAME(X) ; Verify Name for $$CRE^GMTSOBJ
- +1 NEW GMTSN,GMTSE
- SET GMTSN=$GET(X)
- SET GMTSE=$$EXIST(GMTSN)
- if $LENGTH(GMTSN)<3!($LENGTH(GMTSN)>60)
- SET GMTSN=""
- +2 IF $LENGTH(GMTSN)>2
- IF $LENGTH(GMTSN)'>60
- IF GMTSE'>0
- QUIT X
- +3 NEW X,Y,DIR,DIROUT,DTOUT,DUOUT
- +4 SET DIR(0)="FAO^3:60^N GMTS S GMTS=$$NIT^GMTSOBV(X) K:+GMTS'>0 X"
- SET GMTSN=""
- +5 SET DIR("A")=" Health Summary Object Name: "
- +6 SET (DIR("?"),DIR("??"))="^D NH^GMTSOBV"
- +7 DO ^DIR
- if $LENGTH(Y)>2&($LENGTH(Y)'>60)
- SET GMTSN=Y
- SET X=GMTSN
- WRITE !
- +8 QUIT X
- NIT(X) ; Name Input Transform
- +1 NEW GMTSN
- SET GMTSN=$$EXIST($GET(X))
- if +GMTSN<0
- QUIT 0
- +2 IF +GMTSN>0
- Begin DoDot:1
- +3 WRITE !!," A Health Summary Object of the same name exist"
- End DoDot:1
- QUIT 0
- +4 QUIT 1
- NH ; Name Help
- +1 WRITE !," Enter a name of a new Health Summary Object, "
- +2 WRITE !," 3 to 30 characters in length."
- +3 QUIT
- EXIST(X) ; Name Exist
- +1 ; Returns 0 Does not Exist
- +2 ; 1 Exist
- +3 ; -1 Error
- +4 NEW GMTSN,GMTSO,GMTSC,GMTSI,GMTSE,GMTST
- SET GMTSN=$$UP^XLFSTR($GET(X))
- +5 if $LENGTH(GMTSN)<3
- QUIT -1
- if $LENGTH(GMTSN)>60
- QUIT -1
- +6 SET GMTSE=0
- SET GMTSO=$EXTRACT(GMTSN,1,28)
- SET GMTSO=$EXTRACT(GMTSO,1,($LENGTH(GMTSO)-1))_$CHAR($ASCII($EXTRACT(GMTSO,$LENGTH(GMTSO)))-1)_"~"
- SET GMTSC=$EXTRACT(GMTSO,1,($LENGTH(GMTSO)-2))
- +7 FOR
- SET GMTSO=$ORDER(^GMT(142.5,"C",GMTSO))
- if GMTSO=""!(+GMTSE>0)!(GMTSO'[GMTSC)
- QUIT
- Begin DoDot:1
- +8 SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^GMT(142.5,"C",GMTSO,GMTSI))
- if +GMTSI=0
- QUIT
- Begin DoDot:2
- +9 SET GMTST=$$UP^XLFSTR($PIECE($GET(^GMT(142.5,GMTSI,0)),"^",1))
- if GMTSN=GMTST
- SET GMTSE=1
- End DoDot:2
- End DoDot:1
- +10 SET X=GMTSE
- +11 QUIT X
- PAT ; Patient Lookup
- +1 KILL DFN,GMP
- DO DT^DICRW
- NEW DIC,DTOUT,DUOUT,DIROUT,GMTSNAM,GMTSLAS,VA,VADM
- +2 SET DIC=2
- SET DIC("A")=" Select Patient: "
- SET DIC(0)="AEQMZ"
- SET DT=$$DT^XLFDT
- SET DTIME=300
- DO ^DIC
- IF +Y>0
- Begin DoDot:1
- +3 SET DFN=+Y
- NEW GMTSNAM,GMTSLAS,VA,VADM
- DO DEM^VADPT
- SET GMTSNAM=$GET(VADM(1))
- SET GMTSLAS=+($GET(VA("BID")))
- +4 SET GMP=1
- SET GMP(0)=1
- SET GMP(1)=DFN_"^"_GMTSNAM_"^ "_GMTSNAM_" "_$SELECT(+GMTSLAS>0:"(",1:0)_+GMTSLAS_$SELECT(+GMTSLAS>0:")",1:0)_"^1"
- End DoDot:1
- +5 QUIT
- LKO(X) ; Lookup Object
- +1 NEW DIC,DTOUT,DUOUT,DIROUT,DIR,GMTSX
- +2 SET DIC="^GMT(142.5,"
- SET DIC("A")=" Select HEALTH SUMMARY OBJECT: "
- SET U="^"
- +3 SET DIC(0)="AEMQ"
- KILL DLAYGO
- DO ^DIC
- SET (X,GMTSX)=+Y
- if +Y'>0
- QUIT -1
- if $DATA(DTOUT)!($DATA(DUOUT))
- QUIT -1
- +4 IF +Y>0
- Begin DoDot:1
- +5 NEW DIR,GMTSI,GMTSN
- SET GMTSI=+Y
- SET X=-1
- SET GMTSN=$PIECE($GET(^GMT(142.5,+GMTSI,0)),"^",1)
- if '$LENGTH(GMTSN)
- QUIT
- +6 SET DIR(0)="YAO"
- SET DIR("A")=" Is this correct? "
- SET DIR("B")="Y"
- +7 WRITE !!,"You have selected ",GMTSN,!
- DO SO^GMTSOBS(GMTSX)
- WRITE !
- +8 DO ^DIR
- SET X=$SELECT(+Y>0:+GMTSX,1:-1)
- if $DATA(DTOUT)!($DATA(DUOUT))
- SET X=-1
- End DoDot:1
- QUIT X
- +9 QUIT X
- TRIM(X) ; Trim Space Characters
- +1 SET X=$GET(X)
- FOR
- if $EXTRACT(X,1)'=" "
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 FOR
- if $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +3 QUIT X
