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 Dec 13, 2024@01:58:29 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
