GMTSOBL2 ; SLC/KER - HS Object - Lookup ; 01/06/2003
;;2.7;Health Summary;**58**;Oct 20, 1995
;
; External References
; DBIA 10006 ^DIC (file #142.5)
; DBIA 10013 ^DIK (file #142 and 142.5)
; DBIA 10016 ^DIM
; DBIA 10103 $$NOW^XLFDT
; DBIA 10103 $$FMADD^XLFDT
;
Q
N(X) ; Verify Name
N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTSNEW=+($P($G(X),"^",3))
I GMTSIEN'>0!('$L($P($G(^GMT(142.5,+($G(X)),0)),"^",1))) D
. S DA=GMTSIEN,DIK="^GMT(142.5,"
. W !," 'NAME' is a required field" Q:'GMTSNEW
. D:DA>0 ^DIK S X=-1
. W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
Q X
NN(GMTS) ; No Name Entered
N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
I +GMTSIEN>0 D
. Q:$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1))
. S DA=+GMTSIEN,DIK="^GMT(142.5,"
. W !," 'NAME' is a required field" Q:'GMTSNEW D:DA>0 ^DIK
. W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
. S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
Q
T(X) ; Type
N GMTST,GMTSB,GMTSC,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTST=+($P($G(^GMT(142.5,GMTSIEN,0)),"^",3)),GMTSNEW=+($P($G(X),"^",3))
I GMTST=0 D Q X
. S DA=GMTSIEN,DIK="^GMT(142.5,"
. W !," 'Health Summary Type' is a required field" Q:'GMTSNEW
. D:DA>0 ^DIK S X=-1
. W !," < Health Summary Object deleted >"
S GMTSB=+($D(^GMT(142,GMTST,1,"B"))),GMTSB=$S(GMTSB>0:1,1:0)
I GMTSB=0 D Q X
. S DA=GMTSIEN,DIK="^GMT(142.5,"
. W !," Selected Health Summary Type has no Components" Q:'GMTSNEW
. D:DA>0 ^DIK S X=-1
. W !," < Health Summary Object deleted >"
S GMTSC=$O(^GMT(142,GMTST,1,"C",0)),GMTSC=$S(GMTSC<9999&(GMTSC>0):1,1:0)
Q X
NT(GMTS) ; No Type Entered
N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
I +GMTSIEN>0 D
. Q:+($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))>0
. S DA=+GMTSIEN,DIK="^GMT(142.5,"
. W !," 'HEALTH SUMMARY TYPE' is a required field" Q:'GMTSNEW
. D:DA>0 ^DIK
. W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
. S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
Q
NEW(GMTS) ; New
S GMTS=+($G(GMTS))
I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
. N GMTSDT S GMTSDT=$$NOW^XLFDT
. S $P(^GMT(142.5,+GMTS,0),"^",18)=GMTSDT
. S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
. S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
. Q:+($G(DUZ))'>0 S $P(^GMT(142.5,+GMTS,0),"^",17)=+($G(DUZ))
Q
VER(X) ; Verify Object
N GMTSIEN,GMTSNAM,GMTSNEW S GMTSIEN=+($G(X)) Q:+GMTSIEN'>0 -1
S GMTSNAM=$P($G(X),"^",2),GMTSNEW=+($P($G(X),"^",3))
Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
I '$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1)) D Q -1
. S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'NAME' is a required field" D:DA>0 ^DIK
. W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
I +($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))'>0 D Q -1
. S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'HEALTH SUMMARY TYPE' is a required field" D:DA>0 ^DIK
. W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
Q X
MOD(GMTS) ; Modified
S GMTS=+($G(GMTS))
I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
. N GMTSDT S GMTSDT=$$NOW^XLFDT
. S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
. S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
Q
TRIM(X) ; Trim Spaces
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
B(X) ; Default "B"
Q:+($G(DUZ))=0 "" N Y,DIR,DIC,DTOUT,DUOUT,DIROUT,DLAYGO,DA,D,D0,D1,DI,DQ S U="^"
S DIC=142.5,DIC(0)="Z",X=" " D ^DIC S X=$S(+Y>0:Y,1:"") Q X
Q
NAH ; Name Help
W !," Enter the name of the Health Summary Object, 3 to 30 characters"
W !," in length. This Object is stored and then embedded in another"
W !," document as needed."
Q
DIM(X) ; Test DIC("S")
S X=$G(X) D ^DIM Q:'$D(X) ""
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBL2 4009 printed Dec 13, 2024@01:58:25 Page 2
GMTSOBL2 ; SLC/KER - HS Object - Lookup ; 01/06/2003
+1 ;;2.7;Health Summary;**58**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10006 ^DIC (file #142.5)
+5 ; DBIA 10013 ^DIK (file #142 and 142.5)
+6 ; DBIA 10016 ^DIM
+7 ; DBIA 10103 $$NOW^XLFDT
+8 ; DBIA 10103 $$FMADD^XLFDT
+9 ;
+10 QUIT
N(X) ; Verify Name
+1 NEW DA,DIK,GMTSIEN,GMTSNEW
SET GMTSIEN=+($GET(X))
SET GMTSNEW=+($PIECE($GET(X),"^",3))
+2 IF GMTSIEN'>0!('$LENGTH($PIECE($GET(^GMT(142.5,+($GET(X)),0)),"^",1)))
Begin DoDot:1
+3 SET DA=GMTSIEN
SET DIK="^GMT(142.5,"
+4 WRITE !," 'NAME' is a required field"
if 'GMTSNEW
QUIT
+5 if DA>0
DO ^DIK
SET X=-1
+6 if '$DATA(^GMT(142.5,+DA,0))
WRITE !," < Health Summary Object deleted >"
End DoDot:1
+7 QUIT X
NN(GMTS) ; No Name Entered
+1 NEW DA,DIK,GMTSIEN,GMTSNEW
SET GMTSIEN=+($GET(GMTS))
SET GMTSNEW=+($PIECE($GET(GMTS),"^",3))
+2 IF +GMTSIEN>0
Begin DoDot:1
+3 if $LENGTH($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",1))
QUIT
+4 SET DA=+GMTSIEN
SET DIK="^GMT(142.5,"
+5 WRITE !," 'NAME' is a required field"
if 'GMTSNEW
QUIT
if DA>0
DO ^DIK
+6 if '$DATA(^GMT(142.5,+DA,0))
WRITE !," < Health Summary Object deleted >"
+7 if '$DATA(^GMT(142.5,+DA,0))
SET (DA,X,Y)=-1
SET GMTSQ=1
End DoDot:1
+8 QUIT
T(X) ; Type
+1 NEW GMTST,GMTSB,GMTSC,GMTSIEN,GMTSNEW
SET GMTSIEN=+($GET(X))
SET GMTST=+($PIECE($GET(^GMT(142.5,GMTSIEN,0)),"^",3))
SET GMTSNEW=+($PIECE($GET(X),"^",3))
+2 IF GMTST=0
Begin DoDot:1
+3 SET DA=GMTSIEN
SET DIK="^GMT(142.5,"
+4 WRITE !," 'Health Summary Type' is a required field"
if 'GMTSNEW
QUIT
+5 if DA>0
DO ^DIK
SET X=-1
+6 WRITE !," < Health Summary Object deleted >"
End DoDot:1
QUIT X
+7 SET GMTSB=+($DATA(^GMT(142,GMTST,1,"B")))
SET GMTSB=$SELECT(GMTSB>0:1,1:0)
+8 IF GMTSB=0
Begin DoDot:1
+9 SET DA=GMTSIEN
SET DIK="^GMT(142.5,"
+10 WRITE !," Selected Health Summary Type has no Components"
if 'GMTSNEW
QUIT
+11 if DA>0
DO ^DIK
SET X=-1
+12 WRITE !," < Health Summary Object deleted >"
End DoDot:1
QUIT X
+13 SET GMTSC=$ORDER(^GMT(142,GMTST,1,"C",0))
SET GMTSC=$SELECT(GMTSC<9999&(GMTSC>0):1,1:0)
+14 QUIT X
NT(GMTS) ; No Type Entered
+1 NEW DA,DIK,GMTSIEN,GMTSNEW
SET GMTSIEN=+($GET(GMTS))
SET GMTSNEW=+($PIECE($GET(GMTS),"^",3))
+2 IF +GMTSIEN>0
Begin DoDot:1
+3 if +($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",3))>0
QUIT
+4 SET DA=+GMTSIEN
SET DIK="^GMT(142.5,"
+5 WRITE !," 'HEALTH SUMMARY TYPE' is a required field"
if 'GMTSNEW
QUIT
+6 if DA>0
DO ^DIK
+7 if '$DATA(^GMT(142.5,+DA,0))
WRITE !," < Health Summary Object deleted >"
+8 if '$DATA(^GMT(142.5,+DA,0))
SET (DA,X,Y)=-1
SET GMTSQ=1
End DoDot:1
+9 QUIT
NEW(GMTS) ; New
+1 SET GMTS=+($GET(GMTS))
+2 IF +GMTS>0
IF $DATA(^GMT(142.5,GMTS,0))
Begin DoDot:1
+3 NEW GMTSDT
SET GMTSDT=$$NOW^XLFDT
+4 SET $PIECE(^GMT(142.5,+GMTS,0),"^",18)=GMTSDT
+5 SET GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
+6 SET $PIECE(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
+7 if +($GET(DUZ))'>0
QUIT
SET $PIECE(^GMT(142.5,+GMTS,0),"^",17)=+($GET(DUZ))
End DoDot:1
+8 QUIT
VER(X) ; Verify Object
+1 NEW GMTSIEN,GMTSNAM,GMTSNEW
SET GMTSIEN=+($GET(X))
if +GMTSIEN'>0
QUIT -1
+2 SET GMTSNAM=$PIECE($GET(X),"^",2)
SET GMTSNEW=+($PIECE($GET(X),"^",3))
+3 if '$DATA(^GMT(142.5,+GMTSIEN,0))
QUIT -1
+4 IF '$LENGTH($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",1))
Begin DoDot:1
+5 SET DA=+GMTSIEN
SET DIK="^GMT(142.5,"
WRITE !," 'NAME' is a required field"
if DA>0
DO ^DIK
+6 if '$DATA(^GMT(142.5,+DA,0))
WRITE !," < Health Summary Object deleted >"
if '$DATA(^GMT(142.5,+DA,0))
SET (DA,X,Y)=-1
SET GMTSQ=1
End DoDot:1
QUIT -1
+7 if '$DATA(^GMT(142.5,+GMTSIEN,0))
QUIT -1
+8 IF +($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",3))'>0
Begin DoDot:1
+9 SET DA=+GMTSIEN
SET DIK="^GMT(142.5,"
WRITE !," 'HEALTH SUMMARY TYPE' is a required field"
if DA>0
DO ^DIK
+10 if '$DATA(^GMT(142.5,+DA,0))
WRITE !," < Health Summary Object deleted >"
if '$DATA(^GMT(142.5,+DA,0))
SET (DA,X,Y)=-1
SET GMTSQ=1
End DoDot:1
QUIT -1
+11 if '$DATA(^GMT(142.5,+GMTSIEN,0))
QUIT -1
+12 QUIT X
MOD(GMTS) ; Modified
+1 SET GMTS=+($GET(GMTS))
+2 IF +GMTS>0
IF $DATA(^GMT(142.5,GMTS,0))
Begin DoDot:1
+3 NEW GMTSDT
SET GMTSDT=$$NOW^XLFDT
+4 SET GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
+5 SET $PIECE(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
End DoDot:1
+6 QUIT
TRIM(X) ; Trim Spaces
+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
B(X) ; Default "B"
+1 if +($GET(DUZ))=0
QUIT ""
NEW Y,DIR,DIC,DTOUT,DUOUT,DIROUT,DLAYGO,DA,D,D0,D1,DI,DQ
SET U="^"
+2 SET DIC=142.5
SET DIC(0)="Z"
SET X=" "
DO ^DIC
SET X=$SELECT(+Y>0:Y,1:"")
QUIT X
+3 QUIT
NAH ; Name Help
+1 WRITE !," Enter the name of the Health Summary Object, 3 to 30 characters"
+2 WRITE !," in length. This Object is stored and then embedded in another"
+3 WRITE !," document as needed."
+4 QUIT
DIM(X) ; Test DIC("S")
+1 SET X=$GET(X)
DO ^DIM
if '$DATA(X)
QUIT ""
+2 QUIT X
