- FBNHDEC ;AISC/GRR-DISPLAY EPISODE OF CARE ;25AUG88
- ;;3.5;FEE BASIS;;JAN 30, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- D HED F J=0:0 S J=$O(^FBAACNH("AC",IFN,J)) Q:J'>0 I $D(^FBAACNH(J,0)) S Z=^(0) D:$Y>(IOSL+4) HED S Y=$P(Z,"^",1),FBAAAD=Y,FBTYPE=$P(Z,"^",3) D PDATE^FBAAUTL D ADD:FBTYPE="A",TRAN:FBTYPE="T",DIS:FBTYPE="D"
- K J,Z Q
- ADD S FBAT=$P(Z,"^",6) W !,FBPDT,?26,"Admission",?40,$P($T(ADDT+FBAT),";;",2) Q
- TRAN S FBAT=$P(Z,"^",7) W !,FBPDT,?26,"Transfer",?40,$P($T(TRANT+FBAT),";;",2) Q
- DIS S FBAT=$P(Z,"^",8) W !,FBPDT,?26,"Discharge",?40,$P($T(DIST+FBAT),";;",2) Q
- HED W @IOF,"Veteran: ",$P(^DPT(DFN,0),"^",1),?43,"SSN: ",$$SSN^FBAAUTL(DFN),!,?5,"Date/Time",?25,"Transaction",?42,"Type",!
- Q
- ADDT ;;
- ;;After Re-hospitalization > 15 Days
- ;;Transfer from Other CNH
- ;;From ASIH < 15 Days
- ;;All Other
- TRANT ;;
- ;;To Authorized Absence
- ;;To Un-authorized Absence
- ;;To ASIH
- ;;From Authorized Absence
- ;;From Un-authorized Absence
- ;;From ASIH
- DIST ;;
- ;;Regular
- ;;Death
- ;;Transfer to Other CNH
- ;;ASIH
- ;;Death While ASIH
- ;;Regular - Private Pay
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBNHDEC 1122 printed Feb 18, 2025@23:25:11 Page 2
- FBNHDEC ;AISC/GRR-DISPLAY EPISODE OF CARE ;25AUG88
- +1 ;;3.5;FEE BASIS;;JAN 30, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 DO HED
- FOR J=0:0
- SET J=$ORDER(^FBAACNH("AC",IFN,J))
- if J'>0
- QUIT
- IF $DATA(^FBAACNH(J,0))
- SET Z=^(0)
- if $Y>(IOSL+4)
- DO HED
- SET Y=$PIECE(Z,"^",1)
- SET FBAAAD=Y
- SET FBTYPE=$PIECE(Z,"^",3)
- DO PDATE^FBAAUTL
- if FBTYPE="A"
- DO ADD
- if FBTYPE="T"
- DO TRAN
- if FBTYPE="D"
- DO DIS
- +4 KILL J,Z
- QUIT
- ADD SET FBAT=$PIECE(Z,"^",6)
- WRITE !,FBPDT,?26,"Admission",?40,$PIECE($TEXT(ADDT+FBAT),";;",2)
- QUIT
- TRAN SET FBAT=$PIECE(Z,"^",7)
- WRITE !,FBPDT,?26,"Transfer",?40,$PIECE($TEXT(TRANT+FBAT),";;",2)
- QUIT
- DIS SET FBAT=$PIECE(Z,"^",8)
- WRITE !,FBPDT,?26,"Discharge",?40,$PIECE($TEXT(DIST+FBAT),";;",2)
- QUIT
- HED WRITE @IOF,"Veteran: ",$PIECE(^DPT(DFN,0),"^",1),?43,"SSN: ",$$SSN^FBAAUTL(DFN),!,?5,"Date/Time",?25,"Transaction",?42,"Type",!
- +1 QUIT
- ADDT ;;
- +1 ;;After Re-hospitalization > 15 Days
- +2 ;;Transfer from Other CNH
- +3 ;;From ASIH < 15 Days
- +4 ;;All Other
- TRANT ;;
- +1 ;;To Authorized Absence
- +2 ;;To Un-authorized Absence
- +3 ;;To ASIH
- +4 ;;From Authorized Absence
- +5 ;;From Un-authorized Absence
- +6 ;;From ASIH
- DIST ;;
- +1 ;;Regular
- +2 ;;Death
- +3 ;;Transfer to Other CNH
- +4 ;;ASIH
- +5 ;;Death While ASIH
- +6 ;;Regular - Private Pay