| 1 | DGANHD4 ;ALB/RMO - Print NHCU and DOM AMIS's 345-346 ; 01 SEP 90 10:47 am
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;==============================================================
|
|---|
| 4 | ;Print NHCU and DOM AMIS segment fields for each division.
|
|---|
| 5 | ;
|
|---|
| 6 | ;Input:
|
|---|
| 7 | ; DGMYR -Month/Year being printed in internal date format
|
|---|
| 8 | ; ^UTILITY-Contains stats by Month/Year, Segment and Division
|
|---|
| 9 | ;==============================================================
|
|---|
| 10 | S DGPGE=0,DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))="",DGX="",DGMAR=DGIOM-38
|
|---|
| 11 | F DGSEG=0:0 S DGSEG=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG)) Q:'DGSEG!(DGX["^") D SET,PRT
|
|---|
| 12 | ;
|
|---|
| 13 | Q K DGDIVNB,DGFLD,DGIOM,DGFLD,DGLNE,DGMAR,DGPGE,DGSEG,DGTAB,DGX,I,X,Y
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | SET ;Set Tab Variable for Print
|
|---|
| 17 | K DGFLD S DGDIVNB=0 F I=0:0 S I=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG,I)) Q:'I S DGDIVNB=DGDIVNB+1
|
|---|
| 18 | S DGTAB=$S(DGMAR\DGDIVNB>20:20,1:DGMAR\DGDIVNB)
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | PRT ;Print AMIS Segment
|
|---|
| 22 | D HD Q:DGX["^"
|
|---|
| 23 | S DGFLD="001^ADMIS AFTER REHOSP >30 DAYS" D FLD Q:DGX["^"
|
|---|
| 24 | S DGFLD="002^ADMISSIONS - ALL OTHER" D FLD Q:DGX["^"
|
|---|
| 25 | S DGFLD="003^TRANSFERS IN SIMAL FACIL" D FLD Q:DGX["^"
|
|---|
| 26 | S DGFLD="004^FROM ASIH" D FLD Q:DGX["^"
|
|---|
| 27 | S DGFLD="005^DISCHARGES" D FLD Q:DGX["^"
|
|---|
| 28 | S DGFLD="006^DEATHS,BO AND ABO" D FLD Q:DGX["^"
|
|---|
| 29 | S DGFLD="007^TRANSFERS OUT-SIMILAR FACIL" D FLD Q:DGX["^"
|
|---|
| 30 | S DGFLD="008^TO ASIH" D FLD Q:DGX["^"
|
|---|
| 31 | S DGFLD="009^BED OCCUPANTS EOM" D FLD Q:DGX["^"
|
|---|
| 32 | S DGFLD="010^ABSENT BED OCCUPANTS EOM" D FLD Q:DGX["^"
|
|---|
| 33 | S DGFLD="011^ASIH" D FLD Q:DGX["^"
|
|---|
| 34 | S DGFLD="012^FEMALE PATIENTS REMAINING EOM" D FLD Q:DGX["^"
|
|---|
| 35 | S DGFLD="013^DISCHARGES-ASIH" D FLD Q:DGX["^"
|
|---|
| 36 | S DGFLD="014^DIED-ASIH" D FLD Q:DGX["^"
|
|---|
| 37 | S DGFLD="015^PATIENT DAYS OF CARE" D FLD Q:DGX["^"
|
|---|
| 38 | S DGFLD="016^DAYS OF AUTH ABS <96 HRS" D FLD Q:DGX["^"
|
|---|
| 39 | S DGFLD="017^OPERATING BEDS EOM" D FLD Q:DGX["^"
|
|---|
| 40 | D LEG
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | FLD ;Print Field for AMIS Segment
|
|---|
| 44 | D HD:($Y+7)>IOSL Q:DGX["^" W !,"(",$P(DGFLD,"^"),") ",$P(DGFLD,"^",2),?38
|
|---|
| 45 | F I=0:0 S I=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG,I)) Q:'I W $J(+$P(^(I),"^",+DGFLD),DGTAB-2)
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | HD D CRCHK Q:DGX["^" W @IOF,!?30,"AMIS ",DGSEG," REPORT" S DGPGE=DGPGE+1 S Y=DT X ^DD("DD") W ?60,"DATE: ",Y
|
|---|
| 49 | W !?30,$S(DGSEG=345:"NURSING HOME",DGSEG=346:"DOMICILIARY",1:"UNKNOWN")
|
|---|
| 50 | S Y=DGMYR X ^DD("DD") W !?32,"for ",Y
|
|---|
| 51 | W !!?38 F I=0:0 S I=$O(^UTILITY($J,"DGANHD",DGMYR,DGSEG,I)) Q:'I W $J($E($S($D(^DG(40.8,I,0)):$P(^(0),"^"),1:"UNKNOWN"),1,DGTAB-2),DGTAB)
|
|---|
| 52 | W !,DGLNE
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | LEG D CRCHK:($Y+7)>IOSL Q:DGX["^" W !,DGLNE,!,"FOR THIS SEGMENT FIELDS SHOULD BALANCE AS FOLLOWS:"
|
|---|
| 56 | W !!,?3,"Fields 009 and 010 prior period plus 001,002,003,004 current period"
|
|---|
| 57 | W !,?3,"less fields 005 thru 008 current period must equal fields",!?3,"009 and 010 current period."
|
|---|
| 58 | I $D(^DGAM(345,DGMYR,"SE",DGSEG,0)),'$P(^(0),"^",2) W !!,"*** This segment ",$S($P(^(0),"^",2)="":"has Not been Balanced",1:"is Out of Balance"),". ***"
|
|---|
| 59 | W !,DGLNE
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | CRCHK I DGPGE,$E(IOST,1)="C" W !!,*7,"Press RETURN to continue or '^' to stop " R X:DTIME S:'$T X="^" S DGX=X
|
|---|
| 63 | Q
|
|---|
