FBAASL ;AISC/CMR-SUSPENSE LETTERS CONT. ;4/28/93 10:59
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;Allows selection of one/many/all Fee Programs and one/many/all
;letters to print.
S DIR(0)="Y",DIR("A")="Print Denials only",DIR("B")="No" D ^DIR K DIR G END:$D(DIRUT) I Y S FBDEN=1
S DIR(0)="Y",DIR("A")="Do you want to print letters for ALL Fee Basis programs",DIR("B")="No" D ^DIR K DIR G END:$D(DIRUT) I Y S FBPRG=1 D
.F J="I","O","P","C" S FBPRG(J)=""
SELP I 'FBPRG S DIR(0)="S^I:INPATIENT PAYMENT;O:OUTPATIENT PAYMENT;P:PHARMACY PAYMENT;C:CH NOTIFICATION/DENIAL",DIR("A")="Select PROGRAM to print letter for" D ^DIR K DIR G END:$D(DIRUT) S FBPRG(Y)=""
I 'FBPRG S DIR(0)="Y",DIR("A")="Do you want to choose another Program",DIR("B")="No" D ^DIR K DIR G END:$D(DIRUT),SELP:Y
S J="" F S J=$O(FBPRG(J)) Q:J="" S FBCTR=FBCTR+1
SELLT K FBERR I FBCTR>1 S DIR(0)="Y",DIR("A")="Do you want to choose a different letter for each of the PROGRAMS you have selected",DIR("B")="No" D ^DIR K DIR G END:$D(DIRUT) S FBY=Y
S DIC="^FBAA(161.3,",DIC(0)="AEQ",K=0
D LTR:FBCTR=1!'FBY G END:$G(FBLOUT),SELLT:$G(FBERR) F J=1:1:FBCTR S K=$O(FBPRG(K)) D MULT:FBCTR>1&(FBY) G END:$G(FBLOUT),SELLT:$G(FBERR) S FBPRG(K)=+Y
Q
END K FBPRG,FBCTR,J,K,FBLOUT,FBERR S FBAAOUT=1
Q
MULT S DIC("A")="Select letter to print for "_$S(K="I":"Inpatient Payments",K="O":"Outpatient Payments",K="P":"Pharmacy Payments",K="C":"CH Notification/Denials")_": " D LTR Q:$G(FBLOUT)!$G(FBERR)
Q
LTR D ^DIC K DIC("A") S:$D(DUOUT)!($D(DTOUT))!(X="") FBLOUT=1 S:Y<0 FBERR=1
Q
INDIV ;select pt and/or vendor to print suspension letters for
D DT^DICRW S DFN="",U="^" W !! S DIC="^FBAAA(",DIC(0)="AEQMZ",DIC("A")="Select Patient (or RETURN to select all):" D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT)) END1 I Y>0 S DFN=+Y
S DIC("A")="Select Vendor (or RETURN to select all):" D GETVEN^FBAAUTL1 K DIC,D0 G:$D(DTOUT)!($D(DUOUT)) END1
G ^FBAASLP
END1 ;
K DFN,FBV,DUOUT,DTOUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAASL 2026 printed Oct 16, 2024@17:57:30 Page 2
FBAASL ;AISC/CMR-SUSPENSE LETTERS CONT. ;4/28/93 10:59
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;Allows selection of one/many/all Fee Programs and one/many/all
+4 ;letters to print.
+5 SET DIR(0)="Y"
SET DIR("A")="Print Denials only"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
IF Y
SET FBDEN=1
+6 SET DIR(0)="Y"
SET DIR("A")="Do you want to print letters for ALL Fee Basis programs"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
IF Y
SET FBPRG=1
Begin DoDot:1
+7 FOR J="I","O","P","C"
SET FBPRG(J)=""
End DoDot:1
SELP IF 'FBPRG
SET DIR(0)="S^I:INPATIENT PAYMENT;O:OUTPATIENT PAYMENT;P:PHARMACY PAYMENT;C:CH NOTIFICATION/DENIAL"
SET DIR("A")="Select PROGRAM to print letter for"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET FBPRG(Y)=""
+1 IF 'FBPRG
SET DIR(0)="Y"
SET DIR("A")="Do you want to choose another Program"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
if Y
GOTO SELP
+2 SET J=""
FOR
SET J=$ORDER(FBPRG(J))
if J=""
QUIT
SET FBCTR=FBCTR+1
SELLT KILL FBERR
IF FBCTR>1
SET DIR(0)="Y"
SET DIR("A")="Do you want to choose a different letter for each of the PROGRAMS you have selected"
SET DIR("B")="No"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET FBY=Y
+1 SET DIC="^FBAA(161.3,"
SET DIC(0)="AEQ"
SET K=0
+2 if FBCTR=1!'FBY
DO LTR
if $GET(FBLOUT)
GOTO END
if $GET(FBERR)
GOTO SELLT
FOR J=1:1:FBCTR
SET K=$ORDER(FBPRG(K))
if FBCTR>1&(FBY)
DO MULT
if $GET(FBLOUT)
GOTO END
if $GET(FBERR)
GOTO SELLT
SET FBPRG(K)=+Y
+3 QUIT
END KILL FBPRG,FBCTR,J,K,FBLOUT,FBERR
SET FBAAOUT=1
+1 QUIT
MULT SET DIC("A")="Select letter to print for "_$SELECT(K="I":"Inpatient Payments",K="O":"Outpatient Payments",K="P":"Pharmacy Payments",K="C":"CH Notification/Denials")_": "
DO LTR
if $GET(FBLOUT)!$GET(FBERR)
QUIT
+1 QUIT
LTR DO ^DIC
KILL DIC("A")
if $DATA(DUOUT)!($DATA(DTOUT))!(X="")
SET FBLOUT=1
if Y<0
SET FBERR=1
+1 QUIT
INDIV ;select pt and/or vendor to print suspension letters for
+1 DO DT^DICRW
SET DFN=""
SET U="^"
WRITE !!
SET DIC="^FBAAA("
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Patient (or RETURN to select all):"
DO ^DIC
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO END1
IF Y>0
SET DFN=+Y
+2 SET DIC("A")="Select Vendor (or RETURN to select all):"
DO GETVEN^FBAAUTL1
KILL DIC,D0
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO END1
+3 GOTO ^FBAASLP
END1 ;
+1 KILL DFN,FBV,DUOUT,DTOUT
+2 QUIT
