FBNHPAMS ;AISC/GRR-PRINT AMIS ; 21JUN90
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
S FBUL="",$P(FBUL,"-",40)="-",(FBDV,FBPG)=0
W:$E(IOST,1,2)["C-" @IOF D HDR I $D(FBER) W ?30,">>>NOTICE<<<",!?5,">>>Incomplete patient movements affect the AMIS totals below<<<",!,?24,">>>Refer to last page for details<<<",!
W "G A I N S",!,$E(FBUL,1,9)
W !,?4,"ADMISSIONS"
W !!,?10,"01 AFTER REHOSP > 15 DAYS",?40,$J(FBG(1),5) D DV Q:$G(FBOUT) W !,?10,"02 ALL OTHER",?40,$J(FBG(2),5) D DV Q:$G(FBOUT)
W !!,?4,"TRANSFERS IN"
W !!,?10,"03 FROM OTHER CNH",?40,$J(FBG(3),5) D DV Q:$G(FBOUT) W !,?10,"04 FROM ASIH",?40,$J(FBG(4),5) D DV Q:$G(FBOUT)
D PGCK(9) Q:$G(FBOUT) W !!,"L O S S E S",!,$E(FBUL,1,11)
D PGCK(6) Q:$G(FBOUT) W !?4,"DISCHARGES & DEATHS",!!,?10,"05 DISCHARGES",?40,$J(FBL(1),5) D DV Q:$G(FBOUT) W !,?10,"06 DEATHS",?40,$J(FBL(2),5) D DV Q:$G(FBOUT)
D PGCK(7) Q:$G(FBOUT) W !!?4,"TRANSFERS OUT",!!,?10,"07 TO OTHER CNH",?40,$J(FBL(3),5) D DV Q:$G(FBOUT) W !,?10,"08 TO ASIH",?40,$J(FBL(4),5) D DV Q:$G(FBOUT)
D PGCK(8) Q:$G(FBOUT) W !!,"R E M A I N I N G",!,$E(FBUL,1,17),!
F I=1:1:3 W !,?10,$P($T(PR+I),";;",2),?40,$J(FBR(I),5) D DV Q:$G(FBOUT)
Q:$G(FBOUT)
W !,?10,"12 FEMALE BED OCCUPANTS",?40,$J(FBFEM,5) D DV Q:$G(FBOUT)
D PGCK(8) Q:$G(FBOUT) W !!,"L O S S E S F R O M A S I H",!,$E(FBUL,1,33)
W !!,?10,"13 DISCHARGES",?40,$J(FBASDIS,5) D DV Q:$G(FBOUT) W !,?10,"14 DEATHS",?40,$J(FBASDEAD,5) D DV Q:$G(FBOUT)
D PGCK(8) Q:$G(FBOUT) W !!,"M I S C T O T A L S",!,$E(FBUL,1,22),!!,?10,"15 PATIENT DAYS OF CARE",?40,$J(TOTDAYS,5) D DV Q:$G(FBOUT) W !,?10,"16 SC PLACEMENTS",?40,$J(FBSC,5) D DV Q:$G(FBOUT)
D PGCK(12) Q:$G(FBOUT) W !!,"AMIS BALANCING SEGMENT",!,$E(FBUL,1,22),!!?5,"PRIOR MONTH FIELDS 09 AND 10",?60,$J(FBPRIOR,6),!?5,"+ CURRENT MONTH FIELDS 01, 02, 03 AND 04",?60,$J("+"_(FBG(1)+FBG(2)+FBG(3)+FBG(4)),6)
W !?5,"- CURRENT MONTH FIELDS 05, 06, 07 AND 08",?60,$J("-"_(FBL(1)+FBL(2)+FBL(3)+FBL(4)),6),!?60,"------"
W !?5,"= CURRENT MONTH FIELDS 09 AND 10",?45,$J((FBR(1)+FBR(2)),5)," <======>" S FBCHK=FBPRIOR+FBG(1)+FBG(2)+FBG(3)+FBG(4)-FBL(1)-FBL(2)-FBL(3)-FBL(4) W ?60,$J(FBCHK,6)
W !,"**",$S(FBCHK=(FBR(1)+FBR(2)):"BALANCING SEGMENT OK",1:"PROBLEM FOUND IN BALANCING (see last page for details)")
I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR Q:'Y
D:$D(FBER) DISCR^FBNHAMIS
BAL I FBCHK'=(FBR(1)+FBR(2)),('$G(FBMOV)) D
.I '$D(FBER) W @IOF D HDR^FBNHPAMS
.W ! F I=1:1:22 D PGCK(3) Q:$G(FBOUT) W !,$P($T(TEXT+I),";;",2)
Q
HDR S FBPG=FBPG+1 I FBPG>1 W "Page ",FBPG
D PRPRDT^FBAAUTL2 W !,?15,"COMMUNITY NURSING HOME CARE ACTIVITY - AMIS 349",!,?21,$$DATX^FBAAUTL(+FBMONTH)," THRU ",$$DATX^FBAAUTL($P(FBMONTH,"^",2)),!!
Q
DV ;
I $G(FBVAL) D
.S FBIFN=0,FBDV=FBDV+1
.F S FBIFN=$O(^TMP($J,"FBAMIS",FBDV,FBIFN)) Q:'FBIFN D Q:$G(FBOUT)
..D PGCK(3) Q:$G(FBOUT)
..I (FBDV>8&(FBDV<13))!(FBDV=15) W !,?17,$$NAME^FBCHREQ2($P($G(^FB7078(FBIFN,0)),"^",3))
..I (FBDV<9)!(FBDV=13)!(FBDV=14)!(FBDV=16) W !,?17,$$NAME^FBCHREQ2($P($G(^FBAACNH(FBIFN,0)),"^",2)),?50,$$DATX^FBAAUTL(+$G(^FBAACNH(FBIFN,0)))
..I FBDV=15 W ?47,+^TMP($J,"FBAMIS",FBDV,FBIFN)
Q:$G(FBOUT)
D PGCK(3)
Q
PGCK(X) ;
I '$G(X) S X=1
I ($Y+X)>IOSL D
.I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBOUT=1 Q
.W @IOF D HDR
Q
PR ;;
;;09 BED OCCUPANTS
;;10 ABSENT BED OCCUPANTS
;;11 ABSENT SICK IN HOSP.
Q
TEXT ;;
;; Fixing AMIS BALANCING SEGMENT problems:
;;
;; 1) Obtain a listing of all patients in a CNH during the month.
;; Use either the Estimate Funds for Obligation option for the
;; month or the CNH Census Report for each day of the month.
;; 2) Verify all movements agree with those that preceed them
;; by running the Display Episode of Care option for each patient.
;; ***Transfers TO ASIH must be followed by one of the movement
;; types listed below. Any other movement types followed
;; by the types listed below will result in Segment Balancing
;; problems.
;; a) a transfer type of From ASIH < 15 days
;; b) a discharge type of ASIH
;; c) a discharge type of Death while ASIH
;;
;; 3) Use the Movement menu to edit the movement types for those found
;; to be inappropriate.
;; 4) Re-run the AMIS 349 once the movements have been updated.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBNHPAMS 4453 printed Oct 16, 2024@17:59:55 Page 2
FBNHPAMS ;AISC/GRR-PRINT AMIS ; 21JUN90
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 SET FBUL=""
SET $PIECE(FBUL,"-",40)="-"
SET (FBDV,FBPG)=0
+4 if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
DO HDR
IF $DATA(FBER)
WRITE ?30,">>>NOTICE<<<",!?5,">>>Incomplete patient movements affect the AMIS totals below<<<",!,?24,">>>Refer to last page for details<<<",!
+5 WRITE "G A I N S",!,$EXTRACT(FBUL,1,9)
+6 WRITE !,?4,"ADMISSIONS"
+7 WRITE !!,?10,"01 AFTER REHOSP > 15 DAYS",?40,$JUSTIFY(FBG(1),5)
DO DV
if $GET(FBOUT)
QUIT
WRITE !,?10,"02 ALL OTHER",?40,$JUSTIFY(FBG(2),5)
DO DV
if $GET(FBOUT)
QUIT
+8 WRITE !!,?4,"TRANSFERS IN"
+9 WRITE !!,?10,"03 FROM OTHER CNH",?40,$JUSTIFY(FBG(3),5)
DO DV
if $GET(FBOUT)
QUIT
WRITE !,?10,"04 FROM ASIH",?40,$JUSTIFY(FBG(4),5)
DO DV
if $GET(FBOUT)
QUIT
+10 DO PGCK(9)
if $GET(FBOUT)
QUIT
WRITE !!,"L O S S E S",!,$EXTRACT(FBUL,1,11)
+11 DO PGCK(6)
if $GET(FBOUT)
QUIT
WRITE !?4,"DISCHARGES & DEATHS",!!,?10,"05 DISCHARGES",?40,$JUSTIFY(FBL(1),5)
DO DV
if $GET(FBOUT)
QUIT
WRITE !,?10,"06 DEATHS",?40,$JUSTIFY(FBL(2),5)
DO DV
if $GET(FBOUT)
QUIT
+12 DO PGCK(7)
if $GET(FBOUT)
QUIT
WRITE !!?4,"TRANSFERS OUT",!!,?10,"07 TO OTHER CNH",?40,$JUSTIFY(FBL(3),5)
DO DV
if $GET(FBOUT)
QUIT
WRITE !,?10,"08 TO ASIH",?40,$JUSTIFY(FBL(4),5)
DO DV
if $GET(FBOUT)
QUIT
+13 DO PGCK(8)
if $GET(FBOUT)
QUIT
WRITE !!,"R E M A I N I N G",!,$EXTRACT(FBUL,1,17),!
+14 FOR I=1:1:3
WRITE !,?10,$PIECE($TEXT(PR+I),";;",2),?40,$JUSTIFY(FBR(I),5)
DO DV
if $GET(FBOUT)
QUIT
+15 if $GET(FBOUT)
QUIT
+16 WRITE !,?10,"12 FEMALE BED OCCUPANTS",?40,$JUSTIFY(FBFEM,5)
DO DV
if $GET(FBOUT)
QUIT
+17 DO PGCK(8)
if $GET(FBOUT)
QUIT
WRITE !!,"L O S S E S F R O M A S I H",!,$EXTRACT(FBUL,1,33)
+18 WRITE !!,?10,"13 DISCHARGES",?40,$JUSTIFY(FBASDIS,5)
DO DV
if $GET(FBOUT)
QUIT
WRITE !,?10,"14 DEATHS",?40,$JUSTIFY(FBASDEAD,5)
DO DV
if $GET(FBOUT)
QUIT
+19 DO PGCK(8)
if $GET(FBOUT)
QUIT
WRITE !!,"M I S C T O T A L S",!,$EXTRACT(FBUL,1,22),!!,?10,"15 PATIENT DAYS OF CARE",?40,$JUSTIFY(TOTDAYS,5)
DO DV
if $GET(FBOUT)
QUIT
WRITE !,?10,"16 SC PLACEMENTS",?40,$JUSTIFY(FBSC,5)
DO DV
if $GET(FBOUT)
QUIT
+20 DO PGCK(12)
if $GET(FBOUT)
QUIT
WRITE !!,"AMIS BALANCING SEGMENT",!,$EXTRACT(FBUL,1,22),!!?5,"PRIOR MONTH FIELDS 09 AND 10",?60,$JUSTIFY(FBPRIOR,6),!?5,"+ CURRENT MONTH FIELDS 01, 02, 03 AND 04",?60,$JUSTIFY("+"_(FBG(1)+FBG(2)+FBG(3)+FBG(4)),6)
+21 WRITE !?5,"- CURRENT MONTH FIELDS 05, 06, 07 AND 08",?60,$JUSTIFY("-"_(FBL(1)+FBL(2)+FBL(3)+FBL(4)),6),!?60,"------"
+22 WRITE !?5,"= CURRENT MONTH FIELDS 09 AND 10",?45,$JUSTIFY((FBR(1)+FBR(2)),5)," <======>"
SET FBCHK=FBPRIOR+FBG(1)+FBG(2)+FBG(3)+FBG(4)-FBL(1)-FBL(2)-FBL(3)-FBL(4)
WRITE ?60,$JUSTIFY(FBCHK,6)
+23 WRITE !,"**",$SELECT(FBCHK=(FBR(1)+FBR(2)):"BALANCING SEGMENT OK",1:"PROBLEM FOUND IN BALANCING (see last page for details)")
+24 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
QUIT
+25 if $DATA(FBER)
DO DISCR^FBNHAMIS
BAL IF FBCHK'=(FBR(1)+FBR(2))
IF ('$GET(FBMOV))
Begin DoDot:1
+1 IF '$DATA(FBER)
WRITE @IOF
DO HDR^FBNHPAMS
+2 WRITE !
FOR I=1:1:22
DO PGCK(3)
if $GET(FBOUT)
QUIT
WRITE !,$PIECE($TEXT(TEXT+I),";;",2)
End DoDot:1
+3 QUIT
HDR SET FBPG=FBPG+1
IF FBPG>1
WRITE "Page ",FBPG
+1 DO PRPRDT^FBAAUTL2
WRITE !,?15,"COMMUNITY NURSING HOME CARE ACTIVITY - AMIS 349",!,?21,$$DATX^FBAAUTL(+FBMONTH)," THRU ",$$DATX^FBAAUTL($PIECE(FBMONTH,"^",2)),!!
+2 QUIT
DV ;
+1 IF $GET(FBVAL)
Begin DoDot:1
+2 SET FBIFN=0
SET FBDV=FBDV+1
+3 FOR
SET FBIFN=$ORDER(^TMP($JOB,"FBAMIS",FBDV,FBIFN))
if 'FBIFN
QUIT
Begin DoDot:2
+4 DO PGCK(3)
if $GET(FBOUT)
QUIT
+5 IF (FBDV>8&(FBDV<13))!(FBDV=15)
WRITE !,?17,$$NAME^FBCHREQ2($PIECE($GET(^FB7078(FBIFN,0)),"^",3))
+6 IF (FBDV<9)!(FBDV=13)!(FBDV=14)!(FBDV=16)
WRITE !,?17,$$NAME^FBCHREQ2($PIECE($GET(^FBAACNH(FBIFN,0)),"^",2)),?50,$$DATX^FBAAUTL(+$GET(^FBAACNH(FBIFN,0)))
+7 IF FBDV=15
WRITE ?47,+^TMP($JOB,"FBAMIS",FBDV,FBIFN)
End DoDot:2
if $GET(FBOUT)
QUIT
End DoDot:1
+8 if $GET(FBOUT)
QUIT
+9 DO PGCK(3)
+10 QUIT
PGCK(X) ;
+1 IF '$GET(X)
SET X=1
+2 IF ($Y+X)>IOSL
Begin DoDot:1
+3 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBOUT=1
QUIT
+4 WRITE @IOF
DO HDR
End DoDot:1
+5 QUIT
PR ;;
+1 ;;09 BED OCCUPANTS
+2 ;;10 ABSENT BED OCCUPANTS
+3 ;;11 ABSENT SICK IN HOSP.
+4 QUIT
TEXT ;;
+1 ;; Fixing AMIS BALANCING SEGMENT problems:
+2 ;;
+3 ;; 1) Obtain a listing of all patients in a CNH during the month.
+4 ;; Use either the Estimate Funds for Obligation option for the
+5 ;; month or the CNH Census Report for each day of the month.
+6 ;; 2) Verify all movements agree with those that preceed them
+7 ;; by running the Display Episode of Care option for each patient.
+8 ;; ***Transfers TO ASIH must be followed by one of the movement
+9 ;; types listed below. Any other movement types followed
+10 ;; by the types listed below will result in Segment Balancing
+11 ;; problems.
+12 ;; a) a transfer type of From ASIH < 15 days
+13 ;; b) a discharge type of ASIH
+14 ;; c) a discharge type of Death while ASIH
+15 ;;
+16 ;; 3) Use the Movement menu to edit the movement types for those found
+17 ;; to be inappropriate.
+18 ;; 4) Re-run the AMIS 349 once the movements have been updated.
