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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCHROC 1201 printed Oct 16, 2024@17:58:46 Page 2
FBCHROC ;AISC/DMK-REPORT OF CONTACT FOR CONTRACT HOSPITAL ;13AUG90
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 IF '$DATA(FBDA)
IF '$DATA(FBVD)
IF '$DATA(FBDATE)
IF '$DATA(DFN)
IF '$DATA(DUZ)
IF '$DATA(FBADDT)
IF '$DATA(FBPHY)
IF '$DATA(FBDIAG)
QUIT
+4 WRITE !
KILL DD,DO
SET DIC="^FBAA(161.5,"
SET DIC(0)="L"
SET DLAYGO=161.5
SET (X,DINUM)=FBDA
DO FILE^DICN
KILL DLAYGO
SET DA=+Y
SET FBDATE=$EXTRACT(FBDATE,1,12)
+5 IF '$DATA(^FBAA(161.5,FBDA,2,0))
SET ^FBAA(161.5,FBDA,2,0)="^161.517D^^"
+6 SET DIE=DIC
SET DR="[FBCH ENTER ROC]"
DO ^DIE
KILL DIC,DIE
+7 SET DA(1)=FBDA
SET DIC="^FBAA(161.5,"_FBDA_",2,"
SET DIC(0)="L"
SET DLAYGO=161.5
SET X=FBDATE
DO ^DIC
KILL DIC
if Y<0
QUIT
SET DA=+Y
SET DA(1)=FBDA
+8 SET DIE="^FBAA(161.5,"_DA(1)_",2,"
SET DR=".01////^S X=FBDATE;2////^S X=DUZ;1"
DO ^DIE
KILL DIE
END KILL FBVD,FBDATE,FBADDT,FBPHY,FBDIAG,DIC,DIE,DR,DA
QUIT
+1 ;
ADD WRITE !!
SET DIC="^FBAA(161.5,"
SET DIC(0)="AEQM"
SET D="D"
SET DIC("A")="Select Veteran: "
DO IX^DIC
KILL D,DIC("A")
if X=""!(X="^")
GOTO END
+1 SET FBDA=+Y
+2 SET DIE="^FBAA(161.5,"
SET DA=FBDA
SET DR="[FBCH ADD ROC]"
DO ^DIE
+3 KILL DIC,DIE,FBDA
GOTO ADD
+4 ;
EDIT WRITE !!
SET DIC="^FBAA(161.5,"
SET DIC(0)="AEQM"
SET D="D"
SET DIC("A")="Select Veteran: "
DO IX^DIC
KILL D,DIC("A")
if X=""!(X="^")
GOTO END
SET DA=+Y
EN SET DIE=DIC
SET DR="[FBCH EDIT ROC]"
DO ^DIE
+1 if $DATA(FBREQED)
QUIT
+2 KILL DIC,DIE,DA,X,Y
GOTO EDIT
