| 1 | DGANHD2 ;ALB/RMO - Balance and Save NHCU and DOM AMIS's 345-346 ; 31 AUG 90 3:34 pm
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;==============================================================
|
|---|
| 4 | ;When balancing NHCU and DOM AMIS segments the division statistics
|
|---|
| 5 | ;are combined.
|
|---|
| 6 | ;
|
|---|
| 7 | ;Input:
|
|---|
| 8 | ; DGMYR -Month/Year being calculated in internal date format
|
|---|
| 9 | ; DGPMYR -Prior Month/Year in internal date format
|
|---|
| 10 | ; DGCODFLG-Code Sheet flag if 1 -generate 0-do not generate
|
|---|
| 11 | ; ^UTILITY-Contains stats by Month/Year, Segment and Division
|
|---|
| 12 | ;==============================================================
|
|---|
| 13 | K DGNOB F DGSEG=0:0 S DGSEG=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG)) Q:'DGSEG D SET,BAL,SAVE
|
|---|
| 14 | I DGCODFLG,'$D(DGNOB) F DGSEG=0:0 S DGSEG=$O(^DGAM(345,DGMYR,"SE",DGSEG)) Q:'DGSEG D GEN
|
|---|
| 15 | ;
|
|---|
| 16 | Q K DGAM,DGAM0,DGBALFLG,DGDIV,DGEND,DGNOB,DGPAM,I,J,X
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | SET ;Add up Prior and Current Month AMIS(s) for All Divisions
|
|---|
| 20 | S DGEND=17 F I=1:1:DGEND S $P(DGPAM,"^",I)=0,$P(DGAM,"^",I)=0
|
|---|
| 21 | 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)
|
|---|
| 22 | 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)
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | BAL ;Balance AMIS Segment and Set Balance Flag to 1
|
|---|
| 26 | 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
|
|---|
| 27 | S:'DGBALFLG DGNOB(DGSEG)=""
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | SAVE ;Loop through Segments by Division to Save
|
|---|
| 31 | F DGDIV=0:0 S DGDIV=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG,DGDIV)) Q:'DGDIV S DGAM=^(DGDIV) D FILE
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | FILE ;Save AMIS Segment Statistics in File
|
|---|
| 35 | L ^DGAM(345,DGMYR):1 G:'$T FILE S:'$D(^DGAM(345,DGMYR,"SE",0)) ^(0)="^42.701SA^^"
|
|---|
| 36 | 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)
|
|---|
| 37 | S:'$D(^DGAM(345,DGMYR,"SE",DGSEG,"D",0)) ^(0)="^42.702PA^^"
|
|---|
| 38 | S DGAM0=DGDIV_"^"_$P(DGAM,"^",1,17)_"^^"_DT_"^"_DUZ_"^^"
|
|---|
| 39 | 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
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | GEN ;Generate AMIS Code Sheets
|
|---|
| 43 | S DGDIV=+$O(^DG(40.8,0)) D QUE^DGGECSA
|
|---|
| 44 | Q
|
|---|
