| 1 | FBCHROC ;AISC/DMK-REPORT OF CONTACT FOR CONTRACT HOSPITAL ;13AUG90
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | I '$D(FBDA),'$D(FBVD),'$D(FBDATE),'$D(DFN),'$D(DUZ),'$D(FBADDT),'$D(FBPHY),'$D(FBDIAG) Q
|
|---|
| 5 | W ! K DD,DO S DIC="^FBAA(161.5,",DIC(0)="L",DLAYGO=161.5,(X,DINUM)=FBDA D FILE^DICN K DLAYGO S DA=+Y,FBDATE=$E(FBDATE,1,12)
|
|---|
| 6 | I '$D(^FBAA(161.5,FBDA,2,0)) S ^FBAA(161.5,FBDA,2,0)="^161.517D^^"
|
|---|
| 7 | S DIE=DIC,DR="[FBCH ENTER ROC]" D ^DIE K DIC,DIE
|
|---|
| 8 | S DA(1)=FBDA,DIC="^FBAA(161.5,"_FBDA_",2,",DIC(0)="L",DLAYGO=161.5,X=FBDATE D ^DIC K DIC Q:Y<0 S DA=+Y,DA(1)=FBDA
|
|---|
| 9 | S DIE="^FBAA(161.5,"_DA(1)_",2,",DR=".01////^S X=FBDATE;2////^S X=DUZ;1" D ^DIE K DIE
|
|---|
| 10 | END K FBVD,FBDATE,FBADDT,FBPHY,FBDIAG,DIC,DIE,DR,DA Q
|
|---|
| 11 | ;
|
|---|
| 12 | ADD W !! S DIC="^FBAA(161.5,",DIC(0)="AEQM",D="D",DIC("A")="Select Veteran: " D IX^DIC K D,DIC("A") G END:X=""!(X="^")
|
|---|
| 13 | S FBDA=+Y
|
|---|
| 14 | S DIE="^FBAA(161.5,",DA=FBDA,DR="[FBCH ADD ROC]" D ^DIE
|
|---|
| 15 | K DIC,DIE,FBDA G ADD
|
|---|
| 16 | ;
|
|---|
| 17 | EDIT W !! S DIC="^FBAA(161.5,",DIC(0)="AEQM",D="D",DIC("A")="Select Veteran: " D IX^DIC K D,DIC("A") G END:X=""!(X="^") S DA=+Y
|
|---|
| 18 | EN S DIE=DIC,DR="[FBCH EDIT ROC]" D ^DIE
|
|---|
| 19 | Q:$D(FBREQED)
|
|---|
| 20 | K DIC,DIE,DA,X,Y G EDIT
|
|---|
