GMTSRM1A.m

GMTSRM1A ;SLC/JER,SBW - Create/Modify Health Summary (cont) ; 08/27/2002

 ;;2.7;Health Summary;**56**;Oct 20, 1995

 ;

 ; External References

 ;   DBIA 10026  ^DIR

 ;   DBIA 10018  ^DIE

 ;                    

CHKSO ; Checks for existence of Summary Order (SO).

 ;                    

 ;   Allows for overwrite or insertion prior

 ;   to existing "structure" records

 ;                    

 N SO,SOACTION,DIR

 S SO=+Y,CMP(0)=$G(CMP(0))

 I $D(OLDSO),OLDSO=SO S CMP(.01)=SO Q

 I $D(OLDSO),OLDSO'=SO S SOACTION="E" D DELCMP^GMTSRM4

 I '$D(^GMT(142,GMTSIFN,1,SO,0)) S CMP(.01)=+SO,GMTSNEW=1 Q

 W !,$P(^GMT(142.1,$P(^GMT(142,GMTSIFN,1,SO,0),U,2),0),U)," Already exists at SUMMARY ORDER ",SO

 S DIR(0)="SO^O:Overwrite;I:Insert Before;A:Append After",DIR("A")="Select Action" D ^DIR K DIR I $D(DIRUT) S GMTSQIT=1 Q

 I Y="O" S SOACTION="O",OLDSO=SO D DELCMP^GMTSRM4 S GMTSNEW=1,CMP(.01)=SO Q

 I Y="I" D INSRT^GMTSRM4 Q

 I Y="A" D APPND^GMTSRM4

 Q

LOADSEL ; Load Selection Item Multiple

 N DA,DC,DIC,DIE,DIEL,DK,DL,DM,DP,DR

 S:'$D(^GMT(142,GMTSIFN,1,CMP(.01),1,0)) ^(0)="^142.14V^^"

 S (DIC,DIE)="^GMT(142,"_GMTSIFN_",1,"_CMP(.01)_",1,",DA(2)=GMTSIFN,DA(1)=CMP(.01),DA=IEN S DR=".01////"_"^S X=CMP(142.14,IEN)" D ^DIE

 Q

 ;                    

GETSEL(CMP) ; Get Default Selection Items

 ;                    

 ;   Taken from Ad Hoc for Local Components

 N GMI,GMJ,GMK

 S GMI=$O(^GMT(142,"B","GMTS HS ADHOC OPTION",0)) Q:+GMI'>0

 S GMJ=$O(^GMT(142,+GMI,1,"C",+CMP,0)) Q:+GMJ'>0

 S GMK=0 F  S GMK=$O(^GMT(142,+GMI,1,+GMJ,1,GMK)) Q:+GMK'>0  D

 . S CMP(142.14,GMK)=$G(^GMT(142,+GMI,1,+GMJ,1,+GMK,0))

 Q

GMTSRM1A  ;SLC/JER,SBW - Create/Modify Health Summary (cont) ; 08/27/2002

 +1       ;;2.7;Health Summary;**56**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10026  ^DIR

 +5       ;   DBIA 10018  ^DIE

 +6       ;                    

CHKSO     ; Checks for existence of Summary Order (SO).

 +1       ;                    

 +2       ;   Allows for overwrite or insertion prior

 +3       ;   to existing "structure" records

 +4       ;                    

 +5        NEW SO,SOACTION,DIR

 +6        SET SO=+Y

           SET CMP(0)=$GET(CMP(0))

 +7        IF $DATA(OLDSO)

               IF OLDSO=SO

                   SET CMP(.01)=SO

                   QUIT 

 +8        IF $DATA(OLDSO)

               IF OLDSO'=SO

                   SET SOACTION="E"

                   DO DELCMP^GMTSRM4

 +9        IF '$DATA(^GMT(142,GMTSIFN,1,SO,0))

               SET CMP(.01)=+SO

               SET GMTSNEW=1

               QUIT 

 +10       WRITE !,$PIECE(^GMT(142.1,$PIECE(^GMT(142,GMTSIFN,1,SO,0),U,2),0),U)," Already exists at SUMMARY ORDER ",SO

 +11       SET DIR(0)="SO^O:Overwrite;I:Insert Before;A:Append After"

           SET DIR("A")="Select Action"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET GMTSQIT=1

               QUIT 

 +12       IF Y="O"

               SET SOACTION="O"

               SET OLDSO=SO

               DO DELCMP^GMTSRM4

               SET GMTSNEW=1

               SET CMP(.01)=SO

               QUIT 

 +13       IF Y="I"

               DO INSRT^GMTSRM4

               QUIT 

 +14       IF Y="A"

               DO APPND^GMTSRM4

 +15       QUIT 

LOADSEL   ; Load Selection Item Multiple

 +1        NEW DA,DC,DIC,DIE,DIEL,DK,DL,DM,DP,DR

 +2        IF '$DATA(^GMT(142,GMTSIFN,1,CMP(.01),1,0))

               SET ^(0)="^142.14V^^"

 +3        SET (DIC,DIE)="^GMT(142,"_GMTSIFN_",1,"_CMP(.01)_",1,"

           SET DA(2)=GMTSIFN

           SET DA(1)=CMP(.01)

           SET DA=IEN

           SET DR=".01////"_"^S X=CMP(142.14,IEN)"

           DO ^DIE

 +4        QUIT 

 +5       ;                    

GETSEL(CMP) ; Get Default Selection Items

 +1       ;                    

 +2       ;   Taken from Ad Hoc for Local Components

 +3        NEW GMI,GMJ,GMK

 +4        SET GMI=$ORDER(^GMT(142,"B","GMTS HS ADHOC OPTION",0))

           IF +GMI'>0

               QUIT 

 +5        SET GMJ=$ORDER(^GMT(142,+GMI,1,"C",+CMP,0))

           IF +GMJ'>0

               QUIT 

 +6        SET GMK=0

           FOR 

               SET GMK=$ORDER(^GMT(142,+GMI,1,+GMJ,1,GMK))

               IF +GMK'>0

                   QUIT 

               Begin DoDot:1

 +7                SET CMP(142.14,GMK)=$GET(^GMT(142,+GMI,1,+GMJ,1,+GMK,0))

               End DoDot:1

 +8        QUIT