1 | FBAAROC ;AISC/GRR-ENTER/EDIT REPORT OF CONTACT ;06JUL86
|
---|
2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | 2 W !! S DIC="^DPT(",DIC(0)="QEAZM" D ^DIC G Q:Y<0!(X="")!(X="^") S FBDA=+Y
|
---|
5 | ENT ;
|
---|
6 | I '$D(^FBAAA(FBDA)) K DD,DO S DIC="^FBAAA(",DIC(0)="LQ",DLAYGO=161,(X,DINUM)=FBDA D FILE^DICN S FBDA=+Y
|
---|
7 | I '$D(^FBAAA(FBDA,2,0)) S ^FBAAA(FBDA,2,0)="^161.02D^^"
|
---|
8 | S DA=FBDA
|
---|
9 | I $D(DA) S DIE="^FBAAA(",DR="[FBAA REPORT OF CONTACT]" D ^DIE G 2:'$D(FBD1),2:$D(Y)'=0
|
---|
10 | I '$D(^FBAAA(FBDA,2,FBD1,0)) K DIE,DR G 2
|
---|
11 | D SITEP^FBAAUTL G:FBPOP Q S SITE=$P(FBSITE(0),"^",1),ROC=FBD1,DFN=FBDA
|
---|
12 | PRINT S DIR(0)="Y",DIR("A")="Want to print this Report of Contact",DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y 2
|
---|
13 | S VAR="DFN^ROC^SITE",VAL=DFN_"^"_ROC_"^"_SITE,PGM="START^FBAAPRC" D ZIS^FBAAUTL G 2:FBPOP
|
---|
14 | D START^FBAAPRC G 2
|
---|
15 | Q K DAT,FBDA,FBD1,D0,D1,DA,DFN,DI,DIC,DIE,DIRUT,DR,DQ,DWLW,J,X,Y,F,FBCOUNTY,FBDX,I,PGM,PI,T,VAL,VAR,Z,ZZ,ROC,SITE,DFN,FBSITE,FBDAT
|
---|
16 | D CLOSE^FBAAUTL Q
|
---|