- 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 Dec 13, 2024@02:41:04 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