FBAAROC.m

FBAAROC ;AISC/GRR-ENTER/EDIT REPORT OF CONTACT ;06JUL86

 ;;3.5;FEE BASIS;;JAN 30, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

2 W !! S DIC="^DPT(",DIC(0)="QEAZM" D ^DIC G Q:Y<0!(X="")!(X="^") S FBDA=+Y

ENT ;

 I '$D(^FBAAA(FBDA)) K DD,DO S DIC="^FBAAA(",DIC(0)="LQ",DLAYGO=161,(X,DINUM)=FBDA D FILE^DICN S FBDA=+Y

 I '$D(^FBAAA(FBDA,2,0)) S ^FBAAA(FBDA,2,0)="^161.02D^^"

 S DA=FBDA

 I $D(DA) S DIE="^FBAAA(",DR="[FBAA REPORT OF CONTACT]" D ^DIE G 2:'$D(FBD1),2:$D(Y)'=0

 I '$D(^FBAAA(FBDA,2,FBD1,0)) K DIE,DR G 2

 D SITEP^FBAAUTL G:FBPOP Q S SITE=$P(FBSITE(0),"^",1),ROC=FBD1,DFN=FBDA

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

 S VAR="DFN^ROC^SITE",VAL=DFN_"^"_ROC_"^"_SITE,PGM="START^FBAAPRC" D ZIS^FBAAUTL G 2:FBPOP

 D START^FBAAPRC G 2

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

 D CLOSE^FBAAUTL Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAAROC   1003     printed  Apr 09, 2024@21:00:41                                                                                                                                                                                                     Page 2

FBAAROC   ;AISC/GRR-ENTER/EDIT REPORT OF CONTACT ;06JUL86

 +1       ;;3.5;FEE BASIS;;JAN 30, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

2          WRITE !!

           SET DIC="^DPT("

           SET DIC(0)="QEAZM"

           DO ^DIC

           if Y<0!(X="")!(X="^")

               GOTO Q

           SET FBDA=+Y

ENT       ;

 +1        IF '$DATA(^FBAAA(FBDA))

               KILL DD,DO

               SET DIC="^FBAAA("

               SET DIC(0)="LQ"

               SET DLAYGO=161

               SET (X,DINUM)=FBDA

               DO FILE^DICN

               SET FBDA=+Y

 +2        IF '$DATA(^FBAAA(FBDA,2,0))

               SET ^FBAAA(FBDA,2,0)="^161.02D^^"

 +3        SET DA=FBDA

 +4        IF $DATA(DA)

               SET DIE="^FBAAA("

               SET DR="[FBAA REPORT OF CONTACT]"

               DO ^DIE

               if '$DATA(FBD1)

                   GOTO 2

               if $DATA(Y)'=0

                   GOTO 2

 +5        IF '$DATA(^FBAAA(FBDA,2,FBD1,0))

               KILL DIE,DR

               GOTO 2

 +6        DO SITEP^FBAAUTL

           if FBPOP

               GOTO Q

           SET SITE=$PIECE(FBSITE(0),"^",1)

           SET ROC=FBD1

           SET DFN=FBDA

PRINT      SET DIR(0)="Y"

           SET DIR("A")="Want to print this Report of Contact"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!'Y

               GOTO 2

 +1        SET VAR="DFN^ROC^SITE"

           SET VAL=DFN_"^"_ROC_"^"_SITE

           SET PGM="START^FBAAPRC"

           DO ZIS^FBAAUTL

           if FBPOP

               GOTO 2

 +2        DO START^FBAAPRC

           GOTO 2

Q          KILL 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

 +1        DO CLOSE^FBAAUTL

           QUIT