source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGAINP2.m@ 1166

Last change on this file since 1166 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1DGAINP2 ;ALB/RMO - Balance and Save Inpatient AMIS's 334-341 ; 08 MAY 90 2:20 pm
2 ;;5.3;Registration;;Aug 13, 1993
3 ;==============================================================
4 ;When balancing inpatient 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,"DGAINP",DGMYR,DGSEG)) Q:'DGSEG D SET,BAL,SAVE
14 I DGCODFLG,'$D(DGNOB) F DGSEG=0:0 S DGSEG=$O(^DGAM(334,DGMYR,"SE",DGSEG)) Q:'DGSEG D GEN
15 ;
16Q K DGAM,DGAM0,DGBALFLG,DGDIV,DGEND,DGNOB,DGPAM,I,J,X
17 Q
18 ;
19SET ;Add up Prior and Current Month AMIS(s) for All Divisions
20 S DGEND=$S(DGSEG=334!(DGSEG=336):15,1:14) F I=1:1:DGEND S $P(DGPAM,"^",I)=0,$P(DGAM,"^",I)=0
21 I DGSEG=334 F J=0:0 S J=$O(^DGAM(334,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)+$S(I=12:+$P(X,"^",24),I=13:+$P(X,"^",I),I>13:+$P(X,"^",I+4),1:+$P(X,"^",I+1))
22 I DGSEG>334,DGSEG<342 F J=0:0 S J=$O(^DGAM(334,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)+$S(I<13:+$P(X,"^",I+1),I=15:0,1:+$P(X,"^",I+5))
23 F J=0:0 S J=$O(^UTILITY($J,"DGAINP",DGMYR,DGSEG,J)) Q:'J S X=^(J) F I=1:1:DGEND S $P(DGAM,"^",I)=$P(DGAM,"^",I)+$P(X,"^",I)
24 Q
25 ;
26BAL ;Balance AMIS Segment and Set Balance Flag to 1
27 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
28 S:'DGBALFLG DGNOB(DGSEG)=""
29 Q
30 ;
31SAVE ;Loop through Segments by Division to Save
32 F DGDIV=0:0 S DGDIV=$O(^UTILITY($J,"DGAINP",DGMYR,DGSEG,DGDIV)) Q:'DGDIV S DGAM=^(DGDIV) D FILE
33 Q
34 ;
35FILE ;Save AMIS Segment Statistics in File
36 L +^DGAM(334,DGMYR):1 G:'$T FILE S:'$D(^DGAM(334,DGMYR,"SE",0)) ^(0)="^42.6001SA^^"
37 I '$D(^DGAM(334,DGMYR,"SE",DGSEG,0)) S ^(0)=DGSEG_"^"_DGBALFLG,$P(^(0),"^",3,4)=DGSEG_"^"_($P(^DGAM(334,DGMYR,"SE",0),"^",4)+1)
38 S:'$D(^DGAM(334,DGMYR,"SE",DGSEG,"D",0)) ^(0)="^42.61PA^^"
39 S DGAM0=DGDIV_"^"_$P(DGAM,"^",1,11)_"^"_$S(DGSEG>334:$P(DGAM,"^",12),1:$P(DGAM,"^",13))_"^^^^^"_$S(DGSEG>334:$P(DGAM,"^",13,14),1:$P(DGAM,"^",14,15))_"^^^"_DT_"^"_DUZ_"^"_$S(DGSEG>334:"",1:$P(DGAM,"^",12))
40 S ^DGAM(334,DGMYR,"SE",DGSEG,"D",DGDIV,0)=DGAM0 S $P(^(0),"^",3,4)=DGDIV_"^"_($P(^DGAM(334,DGMYR,"SE",DGSEG,"D",0),"^",4)+1) L -^DGAM(334,DGMYR)
41 Q
42 ;
43GEN ;Generate AMIS Code Sheets
44 S DGDIV=+$O(^DG(40.8,0)) D QUE^DGGECSA
45 Q
Note: See TracBrowser for help on using the repository browser.