FBCH780 ;AISC/DMK-7078/AUTHORIZATION CON'T ;8/18/2004
;;3.5;FEE BASIS;**82**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
DISP D HOME^%ZIS W @IOF
W !! S DA=FBAA78,DR="0;1",DIC="^FB7078(" D EN^DIQ
ASK S DIR(0)="Y",DIR("A")="Is this Correct",DIR("B")="NO" D ^DIR K DIR S:$D(DIRUT) FBOUT=1 Q:$G(FBOUT) G EDIT:'Y
S DFN=+$P($G(^FB7078(+FBAA78,0)),"^",3)
W !,?2,"....Posting to 1358",! D WAIT^DICD,POST Q
END W ! Q
EDIT W ! S (DIC,DIE)="^FB7078(",DA=FBAA78,DR="[FBCH EDIT 7078]" D ^DIE
G DISP
HELP W !!,"Select one of the following: ",!,?18,"'00' FOR SURGICAL",!,?18,"'10' FOR MEDICAL",!,?18,"'86' FOR PSYCHIATRY",! Q
POST S PRCS("X")=FBCHOB,PRCS("TYPE")="FB" D EN3^PRCS58 I Y=-1 W !!,*7,"1358 not available for posting!",! Q
S FBCOMM=$S($D(FBNAME):FBNAME_" - "_FBSSN,1:"Estimated amount")
D NOW^%DTC S X=FBCHOB_"^"_%_"^"_FBEST_"^"_""_"^"_FBSEQ_"^"_FBCOMM_"^"_DFN_";"_+FBAA78_";"_$P(FBCHOB,"-",2),PRCS("TYPE")="FB"
D EN2^PRCS58 Q
NULL W !,*7,"Enter the reason for pending disposition or an '^' to exit",! G FBPDIS^FBCH78
NULL1 W !,*7,"This is a required response. Enter an '^' to exit.",! Q
;
DISCH(X) ;X = Pointer for 7078
;output = patient's Type of Discharge
N Y
S Y=$O(^FBAAI("E",X_";FB7078(",0))
I 'Y Q Y
S Y=+$P($G(^FBAAI(Y,0)),U,21)
Q $S($P($G(^FBAA(162.6,Y,0)),U)]"":$P(^(0),U),1:"")
;
PTF ;called to create a non-va ptf record at admission time for an
;authorized claim. Called from FBCH78.
;
; input
; DFN - ien of patient in file #2
; FBAA78 - ien of 7078 authorization in file #162.4
;
N FBDT
;
; obtain Authorization From Date from 7078 authorization to use
; as the admission date on the PTF record
S:$G(FBAA78) FBDT=$P($G(^FB7078(+FBAA78,0)),U,4)
;
; call utility to attempt creation of a Non-VA PTF record
D PTFC^FBUTL6($G(DFN),$G(FBDT))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCH780 1870 printed Dec 13, 2024@01:57:27 Page 2
FBCH780 ;AISC/DMK-7078/AUTHORIZATION CON'T ;8/18/2004
+1 ;;3.5;FEE BASIS;**82**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
DISP DO HOME^%ZIS
WRITE @IOF
+1 WRITE !!
SET DA=FBAA78
SET DR="0;1"
SET DIC="^FB7078("
DO EN^DIQ
ASK SET DIR(0)="Y"
SET DIR("A")="Is this Correct"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET FBOUT=1
if $GET(FBOUT)
QUIT
if 'Y
GOTO EDIT
+1 SET DFN=+$PIECE($GET(^FB7078(+FBAA78,0)),"^",3)
+2 WRITE !,?2,"....Posting to 1358",!
DO WAIT^DICD
DO POST
QUIT
END WRITE !
QUIT
EDIT WRITE !
SET (DIC,DIE)="^FB7078("
SET DA=FBAA78
SET DR="[FBCH EDIT 7078]"
DO ^DIE
+1 GOTO DISP
HELP WRITE !!,"Select one of the following: ",!,?18,"'00' FOR SURGICAL",!,?18,"'10' FOR MEDICAL",!,?18,"'86' FOR PSYCHIATRY",!
QUIT
POST SET PRCS("X")=FBCHOB
SET PRCS("TYPE")="FB"
DO EN3^PRCS58
IF Y=-1
WRITE !!,*7,"1358 not available for posting!",!
QUIT
+1 SET FBCOMM=$SELECT($DATA(FBNAME):FBNAME_" - "_FBSSN,1:"Estimated amount")
+2 DO NOW^%DTC
SET X=FBCHOB_"^"_%_"^"_FBEST_"^"_""_"^"_FBSEQ_"^"_FBCOMM_"^"_DFN_";"_+FBAA78_";"_$PIECE(FBCHOB,"-",2)
SET PRCS("TYPE")="FB"
+3 DO EN2^PRCS58
QUIT
NULL WRITE !,*7,"Enter the reason for pending disposition or an '^' to exit",!
GOTO FBPDIS^FBCH78
NULL1 WRITE !,*7,"This is a required response. Enter an '^' to exit.",!
QUIT
+1 ;
DISCH(X) ;X = Pointer for 7078
+1 ;output = patient's Type of Discharge
+2 NEW Y
+3 SET Y=$ORDER(^FBAAI("E",X_";FB7078(",0))
+4 IF 'Y
QUIT Y
+5 SET Y=+$PIECE($GET(^FBAAI(Y,0)),U,21)
+6 QUIT $SELECT($PIECE($GET(^FBAA(162.6,Y,0)),U)]"":$PIECE(^(0),U),1:"")
+7 ;
PTF ;called to create a non-va ptf record at admission time for an
+1 ;authorized claim. Called from FBCH78.
+2 ;
+3 ; input
+4 ; DFN - ien of patient in file #2
+5 ; FBAA78 - ien of 7078 authorization in file #162.4
+6 ;
+7 NEW FBDT
+8 ;
+9 ; obtain Authorization From Date from 7078 authorization to use
+10 ; as the admission date on the PTF record
+11 if $GET(FBAA78)
SET FBDT=$PIECE($GET(^FB7078(+FBAA78,0)),U,4)
+12 ;
+13 ; call utility to attempt creation of a Non-VA PTF record
+14 DO PTFC^FBUTL6($GET(DFN),$GET(FBDT))
+15 QUIT
