| [623] | 1 | FBAAAUT ;AISC/DMK-ENTER/EDIT AUTHORIZATION ;3/11/1999
|
|---|
| 2 | ;;3.5;FEE BASIS;**13,95**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D SITEP^FBAAUTL G Q:FBPOP S FBAADDYS=+$P(FBSITE(0),"^",13),FBAAASKV=$P(FBSITE(1),"^",1),FBPROG=$S($P(FBSITE(1),"^",6)="":"I 1",1:"I $P(^(0),U,3)=2")
|
|---|
| 5 | W ! S DIC="^DPT(",DIC(0)="QEAZM" D ^DIC G Q:Y<0 S DFN=+Y
|
|---|
| 6 | I $P($G(^DPT(DFN,.361)),"^")="" W !!,"ELIGIBILITY HAS NOT BEEN DETERMINED NOR PENDING, CANNOT ENTER AN AUTHORIZATION." G FBAAAUT
|
|---|
| 7 | CONT I $P($G(^DPT(DFN,.32)),"^",4)=2 W !!?4,"VETERAN HAS A DISHONORABLE DISCHARGE, " S X=$P($G(^(.321)),"^") W $S(X="Y":"ONLY ELIGIBLE FOR AGENT ORANGE EXAM.",1:"NOT ELIGIBLE FOR BENEFITS.")
|
|---|
| 8 | W ! S DIR("A")="Do you want to continue",DIR(0)="Y",DIR("B")="Yes" D ^DIR K DIR G FBAAAUT:$S($D(DIRUT):1,'Y:1,1:0)
|
|---|
| 9 | 1 S DA=DFN I '$D(^FBAAA(DA,0)) L +^FBAAA(DA) K DD,DO S (X,DINUM)=DA,DIC="^FBAAA(",DIC(0)="LM",DLAYGO=161 D FILE^DICN L -^FBAAA(DFN) K DIC G:Y<0 Q
|
|---|
| 10 | S:'$D(^FBAAA(DFN,1,0)) ^(0)="^161.01D^^"
|
|---|
| 11 | D ^FBAADEM K DIRUT,DIROUT,DTOUT,DUOUT
|
|---|
| 12 | 2 W ! S (HID,NID,FBAAP79,FBANEW)="",DA=DFN,DIE="^FBAAA(",DIE("NO^")="",DR="[FBAA AUTHORIZATION]" D ^DIE I $D(FBD1) S FBANEW=$G(^FBAAA(DFN,1,FBD1,0))
|
|---|
| 13 | D:'$D(Y)&(HID'="")&(HID'=NID) TRIG K HID,NID,NIDR,TIME G FBAAAUT:FBANEW']"" S X=FBANEW,K=FBD1,J=DT
|
|---|
| 14 | I FBAAP79="Y" S $P(^FBAAA(DFN,1,FBD1,1),"^",2)="",FBDFN=DFN D CHEKP79 S DFN=FBDFN
|
|---|
| 15 | I $D(FBAOLD),FBAOLD'=FBANEW,$D(FBAALT),FBAALT="Y" S FBTTYPE="A",FBMST=$S($P(FBANEW,"^",13)=1:"Y",1:""),FBFDC=$S($P(FBAOLD,"^")'=$P(FBANEW,"^"):1,1:"") D MORE
|
|---|
| 16 | I '$D(^FBAAC(DFN,0)) K DD,DO S (X,DINUM)=DFN,DIC(0)="L",DLAYGO=162,DIC="^FBAAC(" D FILE^DICN K DIC,DLAYGO
|
|---|
| 17 | G FBAAAUT
|
|---|
| 18 | TRIG ;Add an entry in Fee Basis ID Card Audit file
|
|---|
| 19 | I '$D(^FBAA(161.83,DFN)) K DD,DO S (X,DINUM)=DFN,DIC="^FBAA(161.83,",DIC(0)="L",DLAYGO=161.83 D FILE^DICN Q:Y<0
|
|---|
| 20 | S:'$D(^FBAA(161.83,DFN,1,0)) ^(0)="^161.831DA^^"
|
|---|
| 21 | S %DT="XT",X="NOW" D ^%DT K %DT S TIME=Y
|
|---|
| 22 | L +^FBAA(161.83,DFN) S DIC="^FBAA(161.83,"_DFN_",1,",DIC(0)="LM",DINUM=9999999.9999-TIME,X=TIME,DIC("DR")="1////^S X=HID;2////^S X=NIDR;3////^S X=DUZ",DA(1)=DFN K DD,DO D FILE^DICN I Y<0 L -^FBAA(161.83,DFN) Q
|
|---|
| 23 | K DIE,DIC,DA,DLAYGO L -^FBAA(161.83,DFN)
|
|---|
| 24 | Q
|
|---|
| 25 | ENT ;ENTRY POINT FROM ^FBAAPM TO CREATE MRA TRANSACTION
|
|---|
| 26 | MORE ;
|
|---|
| 27 | S DIC="^FBAA(161.26,",DIC(0)="L",DLAYGO=161.26,X=DFN
|
|---|
| 28 | S DIC("DR")="1///^S X=""P"";2///^S X=FBD1;3///^S X=FBTTYPE;5////^S X=FBFDC;6////^S X=FBMST"
|
|---|
| 29 | K DD,DO D FILE^DICN K DIC,DLAYGO S DA=+Y
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | CHEKP79 W ! S DIR("A")="Want to Print 7079 for this patient now",DIR(0)="Y",DIR("B")="No" D ^DIR K DIR I Y S FBK=FBD1 D EN1^FBAAS79
|
|---|
| 33 | Q
|
|---|
| 34 | Q K DA,DAT,DFN,DR,F,FBAASKV,FBAADDYS,FBAALT,FBAAP79,FBAATT,FBANEW,FBAOLD,FBCOUNTY,FBDX,FBI,FBRR,FBSITE,FBTYPE,FBXX,I,J,K,PI,S,T,Z,ZZ,FBAAASKV,FBPROG,DIC,DIE,FBAAX,X,Y,PTYPE,FBPRG,FBAAOUT,FBDFN
|
|---|
| 35 | K FBAUT,FBD1,FBPOP
|
|---|
| 36 | Q
|
|---|
