FBNHDEC.m

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 ---FBNHDEC   1122     printed  Apr 09, 2024@21:03                                                                                                                                                                                                        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