FBCHROC ;AISC/DMK-REPORT OF CONTACT FOR CONTRACT HOSPITAL ;13AUG90
 ;;3.5;FEE BASIS;;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 I '$D(FBDA),'$D(FBVD),'$D(FBDATE),'$D(DFN),'$D(DUZ),'$D(FBADDT),'$D(FBPHY),'$D(FBDIAG) Q
 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)
 I '$D(^FBAA(161.5,FBDA,2,0)) S ^FBAA(161.5,FBDA,2,0)="^161.517D^^"
 S DIE=DIC,DR="[FBCH ENTER ROC]" D ^DIE K DIC,DIE
 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
 S DIE="^FBAA(161.5,"_DA(1)_",2,",DR=".01////^S X=FBDATE;2////^S X=DUZ;1" D ^DIE K DIE
END K FBVD,FBDATE,FBADDT,FBPHY,FBDIAG,DIC,DIE,DR,DA Q
 ;
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="^")
 S FBDA=+Y
 S DIE="^FBAA(161.5,",DA=FBDA,DR="[FBCH ADD ROC]" D ^DIE
 K DIC,DIE,FBDA G ADD
 ;
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
EN S DIE=DIC,DR="[FBCH EDIT ROC]" D ^DIE
 Q:$D(FBREQED)
 K DIC,DIE,DA,X,Y G EDIT