GMTSCM ; SLC/JER,KER - Create/Modify Health Summary Comp ; 02/27/2002
;;2.7;Health Summary;**7,30,49**;Oct 20, 1995
;
; External References
; DBIA 10112 $$SITE^VASITE
; DBIA 10006 ^DIC
; DBIA 10022 %XY^%RCR
; DBIA 10018 ^DIE
; DBIA 10026 ^DIR
; DBIA 82 EN^XQORM
;
MAIN ; Controls branching
N %,C,D,D0,GMCMP,GMTSQIT,X,Y,DIRUT
I +$G(DUZ(2))'>0 W !,"DUZ(2) must be set to your division.",! Q
F D Q:$D(GMTSQIT)
. N DA,DIC,DIE,DR,GMCMP,X,Y,GMDA,DLAYGO,DIDEL,GMSITE
. S GMSITE=$P($$SITE^VASITE(),U,3)
. S:GMSITE'>0 GMSITE=DUZ(2)
. S:+$P($G(^GMT(142.1,0)),U,3)'>100000 $P(^GMT(142.1,0),U,3)=GMSITE_"000"
. S DIC=142.1,DIC(0)="AEMQLZ",DIC("A")="Select COMPONENT: "
. S DIC("S")="I $S(DUZ(2)=5000:1,(+$G(Y)'<100001)&(+$G(Y)'>9999999):1,1:0)"
. S DLAYGO=142.1
. D ^DIC I +Y'>0 S GMTSQIT="" Q
. S GMDA=+Y
. I +$P(Y,U,3) S GMCMP(0)=$P(Y,U,2) D COPY(.GMCMP)
. S DIDEL=142.1
. I $D(GMCMP)=11 S GMCMP=+GMDA D Q
. . I $D(GMCMP(3.5))>9 D
. . . N %X,%Y
. . . S %X="GMCMP(3.5,",%Y="^GMT(142.1,"_+GMDA_",3.5," D %XY^%RCR
. . S DIE="^GMT(142.1,",DA=+GMDA
. . S DR=".01;1///^S X=$P(GMCMP(0),U,2);2///"_$P(GMCMP(0),U,3)_";4///"_$P(GMCMP(0),U,5)_";6///"_$P(GMCMP(0),U,7)_";10///"_$P(GMCMP(0),U,10)_";11///"_$P(GMCMP(0),U,11)_";12///"_$P(GMCMP(0),U,12)
. . S DR=DR_";3;3.5;I X=""^""!(X=""^^"") S DIRUT=1,Y=""@1"";1;2;4;10;11;12;6;9;@1"
. . D ^DIE I $D(Y)>9!($D(DIRUT))!'$D(DA) S GMTSQIT="" Q
. . I $D(GMCMP("SEL")) D
. . . S DIE="^GMT(142.1,"_+DA_",1,",DA(1)=DA,DA=1,DR=".01///"_$P(GMCMP("SEL"),U)_";1///"_$P(GMCMP("SEL"),U,2) S:'$D(@(DIE_"0)")) ^(0)="^142.17P^^" D ^DIE I $D(Y)>9 S GMTSQIT="" Q
. . S DIE="^GMT(142.1,",(GMCMP,DA)=+GMDA,DR=7
. . D ^DIE I $D(Y)>9!($D(DIRUT)) S GMTSQIT="" Q
. . I $D(DA) D Q
. . . W ! I $$ADHOC D ENADHOC^GMTSRM W !!,">>> Returning to Create/Modify Health Summary Component Option.",!
. S DIE="^GMT(142.1,",(GMCMP,DA)=+GMDA,DR=".01;1;3;3.5;I X=""^""!(X=""^^"") S DIRUT=1,Y=""@1"";2;4;10;11;12;6;9;7;@1"
. D ^DIE I $D(Y)>9!($D(DIRUT)) S GMTSQIT="" Q
. I $D(DA) D Q
. . W ! I $$ADHOC,'$D(DIRUT) D ENADHOC^GMTSRM W !!,">>> Returning to Create/Modify Health Summary Component Option.",!
. . I $D(DIRUT) S GMTSQIT="" Q
. D CLEANUP^GMTSDD
Q
COPY(GMCMP) ; Duplicate existing Health Summary Component
N %,DIC,DIR,GMI,I,X,XQORM,XQORSPEW,Y
S DIR(0)="Y",DIR("A")="Do you wish to duplicate an existing COMPONENT"
S DIR("B")="YES" D ^DIR Q:+Y'>0
S DIC=142,DIC(0)="XF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT Q:+Y'>0
S XQORM=+Y_";GMT(142,",XQORM(0)="1AD",XQORM("A")="Enter COMPONENT to Duplicate: "
W ! D EN^XQORM Q:+Y'>0
S GMCMP=+$P($G(^GMT(142,+XQORM,1,+Y(1),0)),U,2)
S GMCMP(0)=GMCMP(0)_U_$P($G(^GMT(142.1,+GMCMP,0)),U,2,12)
I $O(^GMT(142.1,+GMCMP,3.5,0)) D
. S GMCMP(3.5,0)=$G(^GMT(142.1,+GMCMP,3.5,0))
. S GMI=0 F S GMI=$O(^GMT(142.1,+GMCMP,3.5,GMI)) Q:+GMI'>0 D
. . S GMCMP(3.5,GMI,0)=$G(^(GMI,0))
I $O(^GMT(142.1,+GMCMP,1,0)) S GMCMP("SEL")=$G(^GMT(142.1,+GMCMP,1,$O(^(0)),0))
Q
ADHOC() ; Ask user whether or not to ADD new component to AD HOC
N %,DIR,X,Y
S DIR(0)="Y",DIR("A")="ADD new Component to the AD HOC Health Summary"
S DIR("B")="NO" D ^DIR
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSCM 3234 printed Oct 16, 2024@17:57:55 Page 2
GMTSCM ; SLC/JER,KER - Create/Modify Health Summary Comp ; 02/27/2002
+1 ;;2.7;Health Summary;**7,30,49**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10112 $$SITE^VASITE
+5 ; DBIA 10006 ^DIC
+6 ; DBIA 10022 %XY^%RCR
+7 ; DBIA 10018 ^DIE
+8 ; DBIA 10026 ^DIR
+9 ; DBIA 82 EN^XQORM
+10 ;
MAIN ; Controls branching
+1 NEW %,C,D,D0,GMCMP,GMTSQIT,X,Y,DIRUT
+2 IF +$GET(DUZ(2))'>0
WRITE !,"DUZ(2) must be set to your division.",!
QUIT
+3 FOR
Begin DoDot:1
+4 NEW DA,DIC,DIE,DR,GMCMP,X,Y,GMDA,DLAYGO,DIDEL,GMSITE
+5 SET GMSITE=$PIECE($$SITE^VASITE(),U,3)
+6 if GMSITE'>0
SET GMSITE=DUZ(2)
+7 if +$PIECE($GET(^GMT(142.1,0)),U,3)'>100000
SET $PIECE(^GMT(142.1,0),U,3)=GMSITE_"000"
+8 SET DIC=142.1
SET DIC(0)="AEMQLZ"
SET DIC("A")="Select COMPONENT: "
+9 SET DIC("S")="I $S(DUZ(2)=5000:1,(+$G(Y)'<100001)&(+$G(Y)'>9999999):1,1:0)"
+10 SET DLAYGO=142.1
+11 DO ^DIC
IF +Y'>0
SET GMTSQIT=""
QUIT
+12 SET GMDA=+Y
+13 IF +$PIECE(Y,U,3)
SET GMCMP(0)=$PIECE(Y,U,2)
DO COPY(.GMCMP)
+14 SET DIDEL=142.1
+15 IF $DATA(GMCMP)=11
SET GMCMP=+GMDA
Begin DoDot:2
+16 IF $DATA(GMCMP(3.5))>9
Begin DoDot:3
+17 NEW %X,%Y
+18 SET %X="GMCMP(3.5,"
SET %Y="^GMT(142.1,"_+GMDA_",3.5,"
DO %XY^%RCR
End DoDot:3
+19 SET DIE="^GMT(142.1,"
SET DA=+GMDA
+20 SET DR=".01;1///^S X=$P(GMCMP(0),U,2);2///"_$PIECE(GMCMP(0),U,3)_";4///"_$PIECE(GMCMP(0),U,5)_";6///"_$PIECE(GMCMP(0),U,7)_";10///"_$PIECE(GMCMP(0),U,10)_";11///"_$PIECE(GMCMP(0),U,11)_";12///"_$PIECE(GMCMP(0),U,12)
+21 SET DR=DR_";3;3.5;I X=""^""!(X=""^^"") S DIRUT=1,Y=""@1"";1;2;4;10;11;12;6;9;@1"
+22 DO ^DIE
IF $DATA(Y)>9!($DATA(DIRUT))!'$DATA(DA)
SET GMTSQIT=""
QUIT
+23 IF $DATA(GMCMP("SEL"))
Begin DoDot:3
+24 SET DIE="^GMT(142.1,"_+DA_",1,"
SET DA(1)=DA
SET DA=1
SET DR=".01///"_$PIECE(GMCMP("SEL"),U)_";1///"_$PIECE(GMCMP("SEL"),U,2)
if '$DATA(@(DIE_"0)"))
SET ^(0)="^142.17P^^"
DO ^DIE
IF $DATA(Y)>9
SET GMTSQIT=""
QUIT
End DoDot:3
+25 SET DIE="^GMT(142.1,"
SET (GMCMP,DA)=+GMDA
SET DR=7
+26 DO ^DIE
IF $DATA(Y)>9!($DATA(DIRUT))
SET GMTSQIT=""
QUIT
+27 IF $DATA(DA)
Begin DoDot:3
+28 WRITE !
IF $$ADHOC
DO ENADHOC^GMTSRM
WRITE !!,">>> Returning to Create/Modify Health Summary Component Option.",!
End DoDot:3
QUIT
End DoDot:2
QUIT
+29 SET DIE="^GMT(142.1,"
SET (GMCMP,DA)=+GMDA
SET DR=".01;1;3;3.5;I X=""^""!(X=""^^"") S DIRUT=1,Y=""@1"";2;4;10;11;12;6;9;7;@1"
+30 DO ^DIE
IF $DATA(Y)>9!($DATA(DIRUT))
SET GMTSQIT=""
QUIT
+31 IF $DATA(DA)
Begin DoDot:2
+32 WRITE !
IF $$ADHOC
IF '$DATA(DIRUT)
DO ENADHOC^GMTSRM
WRITE !!,">>> Returning to Create/Modify Health Summary Component Option.",!
+33 IF $DATA(DIRUT)
SET GMTSQIT=""
QUIT
End DoDot:2
QUIT
+34 DO CLEANUP^GMTSDD
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+35 QUIT
COPY(GMCMP) ; Duplicate existing Health Summary Component
+1 NEW %,DIC,DIR,GMI,I,X,XQORM,XQORSPEW,Y
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to duplicate an existing COMPONENT"
+3 SET DIR("B")="YES"
DO ^DIR
if +Y'>0
QUIT
+4 SET DIC=142
SET DIC(0)="XF"
SET X="GMTS HS ADHOC OPTION"
SET Y=$$TYPE^GMTSULT
if +Y'>0
QUIT
+5 SET XQORM=+Y_";GMT(142,"
SET XQORM(0)="1AD"
SET XQORM("A")="Enter COMPONENT to Duplicate: "
+6 WRITE !
DO EN^XQORM
if +Y'>0
QUIT
+7 SET GMCMP=+$PIECE($GET(^GMT(142,+XQORM,1,+Y(1),0)),U,2)
+8 SET GMCMP(0)=GMCMP(0)_U_$PIECE($GET(^GMT(142.1,+GMCMP,0)),U,2,12)
+9 IF $ORDER(^GMT(142.1,+GMCMP,3.5,0))
Begin DoDot:1
+10 SET GMCMP(3.5,0)=$GET(^GMT(142.1,+GMCMP,3.5,0))
+11 SET GMI=0
FOR
SET GMI=$ORDER(^GMT(142.1,+GMCMP,3.5,GMI))
if +GMI'>0
QUIT
Begin DoDot:2
+12 SET GMCMP(3.5,GMI,0)=$GET(^(GMI,0))
End DoDot:2
End DoDot:1
+13 IF $ORDER(^GMT(142.1,+GMCMP,1,0))
SET GMCMP("SEL")=$GET(^GMT(142.1,+GMCMP,1,$ORDER(^(0)),0))
+14 QUIT
ADHOC() ; Ask user whether or not to ADD new component to AD HOC
+1 NEW %,DIR,X,Y
+2 SET DIR(0)="Y"
SET DIR("A")="ADD new Component to the AD HOC Health Summary"
+3 SET DIR("B")="NO"
DO ^DIR
+4 QUIT Y
