| 1 | GMTSCM ; SLC/JER,KER - Create/Modify Health Summary Comp ; 02/27/2002 | 
|---|
| 2 | ;;2.7;Health Summary;**7,30,49**;Oct 20, 1995 | 
|---|
| 3 | ; | 
|---|
| 4 | ; External References | 
|---|
| 5 | ;   DBIA 10112  $$SITE^VASITE | 
|---|
| 6 | ;   DBIA 10006  ^DIC | 
|---|
| 7 | ;   DBIA 10022  %XY^%RCR | 
|---|
| 8 | ;   DBIA 10018  ^DIE | 
|---|
| 9 | ;   DBIA 10026  ^DIR | 
|---|
| 10 | ;   DBIA    82  EN^XQORM | 
|---|
| 11 | ; | 
|---|
| 12 | MAIN ; Controls branching | 
|---|
| 13 | N %,C,D,D0,GMCMP,GMTSQIT,X,Y,DIRUT | 
|---|
| 14 | I +$G(DUZ(2))'>0 W !,"DUZ(2) must be set to your division.",! Q | 
|---|
| 15 | F  D  Q:$D(GMTSQIT) | 
|---|
| 16 | . N DA,DIC,DIE,DR,GMCMP,X,Y,GMDA,DLAYGO,DIDEL,GMSITE | 
|---|
| 17 | . S GMSITE=$P($$SITE^VASITE(),U,3) | 
|---|
| 18 | . S:GMSITE'>0 GMSITE=DUZ(2) | 
|---|
| 19 | . S:+$P($G(^GMT(142.1,0)),U,3)'>100000 $P(^GMT(142.1,0),U,3)=GMSITE_"000" | 
|---|
| 20 | . S DIC=142.1,DIC(0)="AEMQLZ",DIC("A")="Select COMPONENT: " | 
|---|
| 21 | . S DIC("S")="I $S(DUZ(2)=5000:1,(+$G(Y)'<100001)&(+$G(Y)'>9999999):1,1:0)" | 
|---|
| 22 | . S DLAYGO=142.1 | 
|---|
| 23 | . D ^DIC I +Y'>0 S GMTSQIT="" Q | 
|---|
| 24 | . S GMDA=+Y | 
|---|
| 25 | . I +$P(Y,U,3) S GMCMP(0)=$P(Y,U,2) D COPY(.GMCMP) | 
|---|
| 26 | . S DIDEL=142.1 | 
|---|
| 27 | . I $D(GMCMP)=11 S GMCMP=+GMDA D  Q | 
|---|
| 28 | . . I $D(GMCMP(3.5))>9 D | 
|---|
| 29 | . . . N %X,%Y | 
|---|
| 30 | . . . S %X="GMCMP(3.5,",%Y="^GMT(142.1,"_+GMDA_",3.5," D %XY^%RCR | 
|---|
| 31 | . . S DIE="^GMT(142.1,",DA=+GMDA | 
|---|
| 32 | . . 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) | 
|---|
| 33 | . . S DR=DR_";3;3.5;I X=""^""!(X=""^^"") S DIRUT=1,Y=""@1"";1;2;4;10;11;12;6;9;@1" | 
|---|
| 34 | . . D ^DIE I $D(Y)>9!($D(DIRUT))!'$D(DA) S GMTSQIT="" Q | 
|---|
| 35 | . . I $D(GMCMP("SEL")) D | 
|---|
| 36 | . . . 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 | 
|---|
| 37 | . . S DIE="^GMT(142.1,",(GMCMP,DA)=+GMDA,DR=7 | 
|---|
| 38 | . . D ^DIE I $D(Y)>9!($D(DIRUT)) S GMTSQIT="" Q | 
|---|
| 39 | . . I $D(DA) D  Q | 
|---|
| 40 | . . . W ! I $$ADHOC D ENADHOC^GMTSRM W !!,">>> Returning to Create/Modify Health Summary Component Option.",! | 
|---|
| 41 | . 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" | 
|---|
| 42 | . D ^DIE I $D(Y)>9!($D(DIRUT)) S GMTSQIT="" Q | 
|---|
| 43 | . I $D(DA) D  Q | 
|---|
| 44 | . . W ! I $$ADHOC,'$D(DIRUT) D ENADHOC^GMTSRM W !!,">>> Returning to Create/Modify Health Summary Component Option.",! | 
|---|
| 45 | . . I $D(DIRUT) S GMTSQIT="" Q | 
|---|
| 46 | . D CLEANUP^GMTSDD | 
|---|
| 47 | Q | 
|---|
| 48 | COPY(GMCMP) ; Duplicate existing Health Summary Component | 
|---|
| 49 | N %,DIC,DIR,GMI,I,X,XQORM,XQORSPEW,Y | 
|---|
| 50 | S DIR(0)="Y",DIR("A")="Do you wish to duplicate an existing COMPONENT" | 
|---|
| 51 | S DIR("B")="YES" D ^DIR Q:+Y'>0 | 
|---|
| 52 | S DIC=142,DIC(0)="XF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT Q:+Y'>0 | 
|---|
| 53 | S XQORM=+Y_";GMT(142,",XQORM(0)="1AD",XQORM("A")="Enter COMPONENT to Duplicate: " | 
|---|
| 54 | W ! D EN^XQORM Q:+Y'>0 | 
|---|
| 55 | S GMCMP=+$P($G(^GMT(142,+XQORM,1,+Y(1),0)),U,2) | 
|---|
| 56 | S GMCMP(0)=GMCMP(0)_U_$P($G(^GMT(142.1,+GMCMP,0)),U,2,12) | 
|---|
| 57 | I $O(^GMT(142.1,+GMCMP,3.5,0)) D | 
|---|
| 58 | . S GMCMP(3.5,0)=$G(^GMT(142.1,+GMCMP,3.5,0)) | 
|---|
| 59 | . S GMI=0 F  S GMI=$O(^GMT(142.1,+GMCMP,3.5,GMI)) Q:+GMI'>0  D | 
|---|
| 60 | . . S GMCMP(3.5,GMI,0)=$G(^(GMI,0)) | 
|---|
| 61 | I $O(^GMT(142.1,+GMCMP,1,0)) S GMCMP("SEL")=$G(^GMT(142.1,+GMCMP,1,$O(^(0)),0)) | 
|---|
| 62 | Q | 
|---|
| 63 | ADHOC() ; Ask user whether or not to ADD new component to AD HOC | 
|---|
| 64 | N %,DIR,X,Y | 
|---|
| 65 | S DIR(0)="Y",DIR("A")="ADD new Component to the AD HOC Health Summary" | 
|---|
| 66 | S DIR("B")="NO" D ^DIR | 
|---|
| 67 | Q Y | 
|---|