Routine: DGANHD2

DGANHD2 ;ALB/RMO - Balance and Save NHCU and DOM AMIS's 345-346 ; 31 AUG 90 3:34 pm

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

 ;==============================================================

 ;When balancing NHCU and DOM AMIS segments the division statistics

 ;are combined.

 ;Input:

 ; DGMYR   -Month/Year being calculated in internal date format

 ; DGPMYR  -Prior Month/Year in internal date format

 ; DGCODFLG-Code Sheet flag if  1 -generate  0-do not generate

 ; ^UTILITY-Contains stats by Month/Year, Segment and Division

 ;==============================================================

 K DGNOB F DGSEG=0:0 S DGSEG=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG)) Q:'DGSEG  D SET,BAL,SAVE

 I DGCODFLG,'$D(DGNOB) F DGSEG=0:0 S DGSEG=$O(^DGAM(345,DGMYR,"SE",DGSEG)) Q:'DGSEG  D GEN

Q K DGAM,DGAM0,DGBALFLG,DGDIV,DGEND,DGNOB,DGPAM,I,J,X

SET ;Add up Prior and Current Month AMIS(s) for All Divisions

 S DGEND=17 F I=1:1:DGEND S $P(DGPAM,"^",I)=0,$P(DGAM,"^",I)=0

 F J=0:0 S J=$O(^DGAM(345,DGPMYR,"SE",DGSEG,"D",J)) Q:'J  I $D(^(J,0)) S X=^(0) F I=1:1:DGEND S $P(DGPAM,"^",I)=$P(DGPAM,"^",I)+$P(X,"^",I+1)

 F J=0:0 S J=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG,J)) Q:'J  S X=^(J) F I=1:1:DGEND S $P(DGAM,"^",I)=$P(DGAM,"^",I)+$P(X,"^",I)

BAL ;Balance AMIS Segment and Set Balance Flag to 1

 S DGBALFLG=0 I ($P(DGPAM,"^",9)+$P(DGPAM,"^",10)+$P(DGAM,"^",1)+$P(DGAM,"^",2)+$P(DGAM,"^",3)+$P(DGAM,"^",4))-(+$P(DGAM,"^",5)+$P(DGAM,"^",6)+$P(DGAM,"^",7)+$P(DGAM,"^",8))=($P(DGAM,"^",9)+$P(DGAM,"^",10)) S DGBALFLG=1

 S:'DGBALFLG DGNOB(DGSEG)=""

SAVE ;Loop through Segments by Division to Save

 F DGDIV=0:0 S DGDIV=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG,DGDIV)) Q:'DGDIV  S DGAM=^(DGDIV) D FILE

FILE ;Save AMIS Segment Statistics in File

 L ^DGAM(345,DGMYR):1 G:'$T FILE S:'$D(^DGAM(345,DGMYR,"SE",0)) ^(0)="^42.701SA^^"

 I '$D(^DGAM(345,DGMYR,"SE",DGSEG,0)) S ^(0)=DGSEG_"^"_DGBALFLG,$P(^(0),"^",3,4)=DGSEG_"^"_($P(^DGAM(345,DGMYR,"SE",0),"^",4)+1)

 S:'$D(^DGAM(345,DGMYR,"SE",DGSEG,"D",0)) ^(0)="^42.702PA^^"

 S DGAM0=DGDIV_"^"_$P(DGAM,"^",1,17)_"^^"_DT_"^"_DUZ_"^^"

 S ^DGAM(345,DGMYR,"SE",DGSEG,"D",DGDIV,0)=DGAM0 S $P(^(0),"^",3,4)=DGDIV_"^"_($P(^DGAM(345,DGMYR,"SE",DGSEG,"D",0),"^",4)+1) L

GEN ;Generate AMIS Code Sheets

 S DGDIV=+$O(^DG(40.8,0)) D QUE^DGGECSA

DGANHD2   ;ALB/RMO - Balance and Save NHCU and DOM AMIS's 345-346 ; 31 AUG 90 3:34 pm

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

 +2       ;==============================================================

 +3       ;When balancing NHCU and DOM AMIS segments the division statistics

 +4       ;are combined.

 +5       ;

 +6       ;Input:

 +7       ; DGMYR   -Month/Year being calculated in internal date format

 +8       ; DGPMYR  -Prior Month/Year in internal date format

 +9       ; DGCODFLG-Code Sheet flag if  1 -generate  0-do not generate

 +10      ; ^UTILITY-Contains stats by Month/Year, Segment and Division

 +11      ;==============================================================

 +12       KILL DGNOB

           FOR DGSEG=0:0

               SET DGSEG=$ORDER(^UTILITY($JOB,"DGANHD",DGMYR,DGSEG))

               IF 'DGSEG

                   QUIT

               DO SET

               DO BAL

               DO SAVE

 +13       IF DGCODFLG

               IF '$DATA(DGNOB)

                   FOR DGSEG=0:0

                       SET DGSEG=$ORDER(^DGAM(345,DGMYR,"SE",DGSEG))

                       IF 'DGSEG

                           QUIT

                       DO GEN

 +14      ;

Q          KILL DGAM,DGAM0,DGBALFLG,DGDIV,DGEND,DGNOB,DGPAM,I,J,X

 +1        QUIT

 +2       ;

SET       ;Add up Prior and Current Month AMIS(s) for All Divisions

 +1        SET DGEND=17

           FOR I=1:1:DGEND

               SET $PIECE(DGPAM,"^",I)=0

               SET $PIECE(DGAM,"^",I)=0

 +2        FOR J=0:0

               SET J=$ORDER(^DGAM(345,DGPMYR,"SE",DGSEG,"D",J))

               IF 'J

                   QUIT

               IF $DATA(^(J,0))

                   SET X=^(0)

                   FOR I=1:1:DGEND

                       SET $PIECE(DGPAM,"^",I)=$PIECE(DGPAM,"^",I)+$PIECE(X,"^",I+1)

 +3        FOR J=0:0

               SET J=$ORDER(^UTILITY($JOB,"DGANHD",DGMYR,DGSEG,J))

               IF 'J

                   QUIT

               SET X=^(J)

               FOR I=1:1:DGEND

                   SET $PIECE(DGAM,"^",I)=$PIECE(DGAM,"^",I)+$PIECE(X,"^",I)

 +4        QUIT

 +5       ;

BAL       ;Balance AMIS Segment and Set Balance Flag to 1

 +1        SET DGBALFLG=0

           IF ($PIECE(DGPAM,"^",9)+$PIECE(DGPAM,"^",10)+$PIECE(DGAM,"^",1)+$PIECE(DGAM,"^",2)+$PIECE(DGAM,"^",3)+$PIECE(DGAM,"^",4))-(+$PIECE(DGAM,"^",5)+$PIECE(DGAM,"^",6)+$PIECE(DGAM,"^",7)+$PIECE(DGAM,"^",8))=($PIECE(DGAM,"^",9)+$PIECE(DGAM,"^",10))

               SET DGBALFLG=1

 +2        IF 'DGBALFLG

               SET DGNOB(DGSEG)=""

 +3        QUIT

 +4       ;

SAVE      ;Loop through Segments by Division to Save

 +1        FOR DGDIV=0:0

               SET DGDIV=$ORDER(^UTILITY($JOB,"DGANHD",DGMYR,DGSEG,DGDIV))

               IF 'DGDIV

                   QUIT

               SET DGAM=^(DGDIV)

               DO FILE

 +2        QUIT

 +3       ;

FILE      ;Save AMIS Segment Statistics in File

 +1        LOCK ^DGAM(345,DGMYR):1

           IF '$TEST

               GOTO FILE

           IF '$DATA(^DGAM(345,DGMYR,"SE",0))

               SET ^(0)="^42.701SA^^"

 +2        IF '$DATA(^DGAM(345,DGMYR,"SE",DGSEG,0))

               SET ^(0)=DGSEG_"^"_DGBALFLG

               SET $PIECE(^(0),"^",3,4)=DGSEG_"^"_($PIECE(^DGAM(345,DGMYR,"SE",0),"^",4)+1)

 +3        IF '$DATA(^DGAM(345,DGMYR,"SE",DGSEG,"D",0))

               SET ^(0)="^42.702PA^^"

 +4        SET DGAM0=DGDIV_"^"_$PIECE(DGAM,"^",1,17)_"^^"_DT_"^"_DUZ_"^^"

 +5        SET ^DGAM(345,DGMYR,"SE",DGSEG,"D",DGDIV,0)=DGAM0

           SET $PIECE(^(0),"^",3,4)=DGDIV_"^"_($PIECE(^DGAM(345,DGMYR,"SE",DGSEG,"D",0),"^",4)+1)

           LOCK

 +6        QUIT

 +7       ;

GEN       ;Generate AMIS Code Sheets

 +1        SET DGDIV=+$ORDER(^DG(40.8,0))

           DO QUE^DGGECSA

 +2        QUIT

DGANHD2.m