FBAACFE.m

FBAACFE ;WOIFO/SAB - CONTRACT FILE ENTER/EDIT ;9/24/2009

 ;;3.5;FEE BASIS;**108,163**;JAN 30, 1995;Build 21

 ;Per VA Directive 6402, this routine should not be modified.

 ;

 N DA,DIC,DIDEL,DR,DLAYGO,DTOUT,DUOUT,X,Y

 N FBCNTRN,FBDA,FBNEW,FBX

 ;

SEL ; add/select

 S DIC="^FBAA(161.43,",DIC(0)="AQELM",DLAYGO=161.43

 S DIC("A")="Select FEE BASIS CONTRACT NUMBER: "

 D ^DIC K DIC

 I Y<0 G END

 S (DA,FBDA)=+Y

 S FBCNTRN=$P(Y,"^",2)

 S FBNEW=+$P(Y,"^",3)

 ;

 ; lock

 L +^FBAA(161.43,FBDA):$S($D(DILOCKTM):DILOCKTM,1:5) I '$T D  G SEL

 . W $C(7),!,"Record being edited by someone else. Try later.",!

 ;

 ; edit

 S DIE="^FBAA(161.43,"

 I 'FBNEW,$$CNTRPTR^FBUTL7(DA) D

 . S FBX="CONTRACT NUMBER: "_FBCNTRN_" (referenced, no editing)"

 . S DR="W !,FBX;1:5"

 E  S DR=".01:5"  ; FB*3.5*163 - Added fields 4 and 5 for CHOICE Program Indicator

 S DIDEL=161.43

 S DIE("NO^")="BACK"

 D ^DIE K DIE,DIDEL,DR

 I $D(DTOUT) G END

 ;

 ; unlock

 L -^FBAA(161.43,FBDA)

 ;

 ; repeat

 W !

 G SEL

 ;

END ; exit

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAACFE   1028     printed  Mar 13, 2025@20:59:46                                                                                                                                                                                                     Page 2

FBAACFE   ;WOIFO/SAB - CONTRACT FILE ENTER/EDIT ;9/24/2009

 +1       ;;3.5;FEE BASIS;**108,163**;JAN 30, 1995;Build 21

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4        NEW DA,DIC,DIDEL,DR,DLAYGO,DTOUT,DUOUT,X,Y

 +5        NEW FBCNTRN,FBDA,FBNEW,FBX

 +6       ;

SEL       ; add/select

 +1        SET DIC="^FBAA(161.43,"

           SET DIC(0)="AQELM"

           SET DLAYGO=161.43

 +2        SET DIC("A")="Select FEE BASIS CONTRACT NUMBER: "

 +3        DO ^DIC

           KILL DIC

 +4        IF Y<0

               GOTO END

 +5        SET (DA,FBDA)=+Y

 +6        SET FBCNTRN=$PIECE(Y,"^",2)

 +7        SET FBNEW=+$PIECE(Y,"^",3)

 +8       ;

 +9       ; lock

 +10       LOCK +^FBAA(161.43,FBDA):$SELECT($DATA(DILOCKTM):DILOCKTM,1:5)

           IF '$TEST

               Begin DoDot:1

 +11               WRITE $CHAR(7),!,"Record being edited by someone else. Try later.",!

               End DoDot:1

               GOTO SEL

 +12      ;

 +13      ; edit

 +14       SET DIE="^FBAA(161.43,"

 +15       IF 'FBNEW

               IF $$CNTRPTR^FBUTL7(DA)

                   Begin DoDot:1

 +16                   SET FBX="CONTRACT NUMBER: "_FBCNTRN_" (referenced, no editing)"

 +17                   SET DR="W !,FBX;1:5"

                   End DoDot:1

 +18      ; FB*3.5*163 - Added fields 4 and 5 for CHOICE Program Indicator

          IF '$TEST

               SET DR=".01:5"

 +19       SET DIDEL=161.43

 +20       SET DIE("NO^")="BACK"

 +21       DO ^DIE

           KILL DIE,DIDEL,DR

 +22       IF $DATA(DTOUT)

               GOTO END

 +23      ;

 +24      ; unlock

 +25       LOCK -^FBAA(161.43,FBDA)

 +26      ;

 +27      ; repeat

 +28       WRITE !

 +29       GOTO SEL

 +30      ;

END       ; exit

 +1        QUIT