| [613] | 1 | FBCHSTA ;AISC/DMK-DISPLAYS PENDING INPATIENT DISPOSITIONS ;13DEC88
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D HOME^%ZIS,^FBAASTA S DIR(0)="E" D ^DIR K DIR Q:'Y W @IOF
|
|---|
| 5 | EN D DT^DICRW S FBDT=DT,FBSW=1,CNT=0
|
|---|
| 6 | S Q="-",$P(Q,"-",80)="-" D HED
|
|---|
| 7 | F I=FBDT:0 S I=$O(^FB7078("AD",6,I)) Q:I'>0 F J=0:0 S J=$O(^FB7078("AD",6,I,J)) Q:J'>0 D TRANS
|
|---|
| 8 | STAT1 I $D(^FB7078("AC","I")) F I=0:0 S I=$O(^FB7078("AC","I",I)) Q:I'>0 F J=0:0 S J=$O(^FB7078("AC","I",I,J)) Q:J'>0 D TRANS
|
|---|
| 9 | END W:CNT'>0 !,$S($D(^XUSEC("FBAASUPERVISOR",DUZ)):"There are ",1:"You have "),"no inpatients pending disposition." K CNT,FBAD,FBDT,FBDUZ,FBTYPE,FBVEN,FBVET,I,J,POP,Q,Y,FBFLG Q
|
|---|
| 10 | TRANS S Y(0)=^FB7078(J,0) Q:$P(Y(0),"^",9)="DC"
|
|---|
| 11 | S FBVET=$P(Y(0),"^",3),FBVEN=$P(Y(0),"^",2),FBVEN=$P(FBVEN,";"),FBAD=$P(Y(0),"^",4),FBDUZ=$P(Y(0),"^",8),FBTYPE=$P(Y(0),"^",11)
|
|---|
| 12 | Q:FBTYPE'=6
|
|---|
| 13 | Q:DUZ'=FBDUZ&('$D(^XUSEC("FBAASUPERVISOR",DUZ)))
|
|---|
| 14 | S FBVET=$P(^DPT(FBVET,0),"^",1),FBVEN=$S($D(^FBAAV(FBVEN)):$P(^FBAAV(FBVEN,0),"^",1),1:"UNKNOWN")
|
|---|
| 15 | S X1=FBDT,X2=FBAD D D^%DTC
|
|---|
| 16 | S FBFLG=$S(X>10:"++",1:""),Y=FBAD D PDF^FBAAUTL S FBAD=Y
|
|---|
| 17 | W !,FBFLG,?5,FBVET,?35,FBVEN,?65,FBAD
|
|---|
| 18 | S CNT=CNT+1 Q
|
|---|
| 19 | HED ;S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP W @IOF
|
|---|
| 20 | W !,?29,"PENDING 7078's",!,?21,"('++' indicates LOS > 10 days)",!,"Veteran",?35,"Vendor",?65,"Admission Date",!,Q Q
|
|---|
