source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSCM.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1GMTSCM ; 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 ;
12MAIN ; 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
48COPY(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
63ADHOC() ; 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
Note: See TracBrowser for help on using the repository browser.