DGA4007 ;ALB/MAF - BALANCE AMIS - AMIS SEGMENTS 401 - 420 ; AUG 23, 1990@1200
;;5.3;Registration;;Aug 13, 1993
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGA4007 927 printed Oct 16, 2024@18:41:45 Page 2
DGA4007 ;ALB/MAF - BALANCE AMIS - AMIS SEGMENTS 401 - 420 ; AUG 23, 1990@1200
+1 ;;5.3;Registration;;Aug 13, 1993
+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
