DGA4007.m

DGA4007 ;ALB/MAF - BALANCE AMIS - AMIS SEGMENTS 401 - 420 ; AUG 23, 1990@1200

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 S (DGCT,DGCT(1),DGCT(2),DGCT(3),DGCT(4),DGCT(5),DGCT(6),DGCT(7),DGCTEOM)=0

 F X=2:1:15,22:1:25,30:1:33,38:1:40 S DGCT=DGCT+$P(DGN,"^",X)

 S X1=DGA,X2=-31 D C^%DTC S X=$E(X,1,5)_"00" I $D(^DG(391.1,DGI,"D",1,"MY",X,"A1")) S DGCTEOM=$S($P(^DG(391.1,DGI,"D",1,"MY",X,"A1"),"^",38)]"":$P(^("A1"),"^",38),1:0) S DGCT=DGCT+DGCTEOM

 F X=11:1:15 S DGCT(1)=DGCT(1)+$P(DGN,"^",X)

 F X=16:1:19 S DGCT(2)=DGCT(2)+$P(DGN,"^",X)

 F X=20:1:21 S DGCT(3)=DGCT(3)+$P(DGN,"^",X)

 F X=22:1:25 S DGCT(4)=DGCT(4)+$P(DGN,"^",X)

 F X=26:1:29 S DGCT(5)=DGCT(5)+$P(DGN,"^",X)

 F X=30:1:33 S DGCT(6)=DGCT(6)+$P(DGN,"^",X)

 F X=34:1:37 S DGCT(7)=DGCT(7)+$P(DGN,"^",X)

 I DGCT=$P(DGN,"^",1)+DGCTEOM,DGCT(1)=DGCT(2),DGCT(1)=DGCT(3),DGCT(4)=DGCT(5),DGCT(6)=DGCT(7) S DGFLG=1 Q

 S DGUB(DGI)="" Q

 K ^UTILITY($J,"DGSEG",DGI,DGI1) Q

DGA4007   ;ALB/MAF - BALANCE AMIS - AMIS SEGMENTS 401 - 420 ; AUG 23, 1990@1200

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2        SET (DGCT,DGCT(1),DGCT(2),DGCT(3),DGCT(4),DGCT(5),DGCT(6),DGCT(7),DGCTEOM)=0

 +3        FOR X=2:1:15,22:1:25,30:1:33,38:1:40

               SET DGCT=DGCT+$PIECE(DGN,"^",X)

 +4        SET X1=DGA

           SET X2=-31

           DO C^%DTC

           SET X=$EXTRACT(X,1,5)_"00"

           IF $DATA(^DG(391.1,DGI,"D",1,"MY",X,"A1"))

               SET DGCTEOM=$SELECT($PIECE(^DG(391.1,DGI,"D",1,"MY",X,"A1"),"^",38)]"":$PIECE(^("A1"),"^",38),1:0)

               SET DGCT=DGCT+DGCTEOM

 +5        FOR X=11:1:15

               SET DGCT(1)=DGCT(1)+$PIECE(DGN,"^",X)

 +6        FOR X=16:1:19

               SET DGCT(2)=DGCT(2)+$PIECE(DGN,"^",X)

 +7        FOR X=20:1:21

               SET DGCT(3)=DGCT(3)+$PIECE(DGN,"^",X)

 +8        FOR X=22:1:25

               SET DGCT(4)=DGCT(4)+$PIECE(DGN,"^",X)

 +9        FOR X=26:1:29

               SET DGCT(5)=DGCT(5)+$PIECE(DGN,"^",X)

 +10       FOR X=30:1:33

               SET DGCT(6)=DGCT(6)+$PIECE(DGN,"^",X)

 +11       FOR X=34:1:37

               SET DGCT(7)=DGCT(7)+$PIECE(DGN,"^",X)

 +12       IF DGCT=$PIECE(DGN,"^",1)+DGCTEOM

               IF DGCT(1)=DGCT(2)

                   IF DGCT(1)=DGCT(3)

                       IF DGCT(4)=DGCT(5)

                           IF DGCT(6)=DGCT(7)

                               SET DGFLG=1

                               QUIT 

 +13       SET DGUB(DGI)=""

           QUIT 

 +14       KILL ^UTILITY($JOB,"DGSEG",DGI,DGI1)

           QUIT