21 lines
1.2 KiB
Mathematica
21 lines
1.2 KiB
Mathematica
|
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
|