source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAROC.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 987 bytes
RevLine 
[613]1FBAAROC ;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.
42 W !! S DIC="^DPT(",DIC(0)="QEAZM" D ^DIC G Q:Y<0!(X="")!(X="^") S FBDA=+Y
5ENT ;
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
12PRINT 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
15Q 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
Note: See TracBrowser for help on using the repository browser.