ENFAAV ;IRMFO/SAB-ADJUSTMENT VOUCHER ENTRY ;6.30.97
;;7.0;ENGINEERING;**39**;AUG 17, 1993
EN ; Entry point for option
; load table for converting FA Type to SGL
K ENFAPTY S ENDA=0 F S ENDA=$O(^ENG(6914.3,ENDA)) Q:'ENDA D
. S ENY0=$G(^ENG(6914.3,ENDA,0))
. I $P(ENY0,U,3)]"" S ENFAPTY($P(ENY0,U,3))=$P(ENY0,U)
ASKDOC ; ask FAP Document
W !
S DIR(0)="SBO^FA:FA DOCs;FB:FB DOCs;FC:FC DOCs;FD:FD DOCs;FR:FR DOCs"
S DIR("A")="Select Type of FAP Document"
S DIR("?",1)="Choose the type of FAP Document for which an Adjustment"
S DIR("?",2)="Voucher should be created. After the type is chosen, you"
S DIR("?",3)="will be asked to select the specific FAP Document."
S DIR("?")=" "
D ^DIR K DIR G:Y']""!$D(DIRUT) EXIT
S ENFILE="6915."_$F("ABCDR",$E(Y,2,2))
;
S DIC="^ENG("_ENFILE_",",DIC(0)="AQEM"
S DIC("A")="Select "_Y_" DOCUMENT (by Transaction Number or Equipment ENTRY #): "
D ^DIC G:Y'>0 EXIT
S ENDA("F?")=+Y
SHOWDOC ; show info for FAP Document/Adjustment Voucher
S ENDT=$$GET1^DIQ(ENFILE,ENDA("F?"),301,"I")
S ENY0=$G(^ENG(ENFILE,ENDA("F?"),0))
S ENY1=$G(^ENG(ENFILE,ENDA("F?"),1))
S ENDA=$P($G(^ENG(ENFILE,ENDA("F?"),0)),U)
S ENDA("FA")=$$AFA^ENFAR5A(ENFILE,ENDA("F?")) ; associated FA
S ENFAY3=$G(^ENG(6915.2,ENDA("FA"),3))
S ENSN=$TR($E($P(ENFAY3,U,5),1,5)," ","")
S:ENFILE=6915.2 ENFUND=$P(ENFAY3,U,10)
S:ENFILE'=6915.2 ENFUND=$$FUND^ENFAR5A(ENFILE,ENDA("F?"),ENDA("FA"))
S ENSGL=$S($P(ENFAY3,U,6)]"":$G(ENFAPTY($P(ENFAY3,U,6))),1:"")
S ENAMT=0
I ENFILE=6915.2 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,27)
I ENFILE=6915.3 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,4)
I ENFILE=6915.4 S ENX=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,6),ENAMT=$S(ENX="":0,1:ENX-$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,4))
I ENFILE=6915.5 S ENAMT="-"_$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,2)
I ENFILE=6915.6 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,8)
W @IOF,!,"ADJ. VOUCHER",?16,"TRANSACTION .............",?43,"STN"
W ?50,"FUND",?58,"SGL",?63,"NET AMOUNT"
W !,"DATE/TIME",?16,"CODE NUMBER DATE"
W !,"--------------",?16,"---- ----------- --------",?43,"-----"
W ?50,"------",?58,"----",?63,"----------------"
W !,$E($TR($$FMTE^XLFDT(ENDT,"2F")," ",0),1,14)
W ?16,$P(ENY1,U,6),?21,$P(ENY1,U,9)
W ?33,$TR($$FMTE^XLFDT($P(ENY0,U,2),"2DF")," ",0)
W ?43,ENSN,?50,ENFUND,?58,ENSGL
I ENFILE=6915.6 D ; check FR doc for FUND change
. S ENFUNDNW=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,9)
. I ENFUND=ENFUNDNW S ENAMT=0 Q ; fund didn't change
. S ENAMT=-ENAMT ; subtract from old fund
W ?63,$J($FN(ENAMT,",",2),16)
I ENFILE=6915.6,ENFUND'=ENFUNDNW D
. ; show addition to new fund
. W !,?43,ENSN,?50,ENFUNDNW,?58,ENSGL
. W ?63,$J($FN(-ENAMT,",",2),16)
W !,?5,"EQUIP #: ",ENDA,?26,$$GET1^DIQ(6914,ENDA,3)
S ENX=$$GET1^DIQ(ENFILE,ENDA("F?"),303)
I ENX]"" W !,?5,"REASON: ",ENX
I $O(^ENG(ENFILE,ENDA("F?"),301,0)) D G:$D(DIRUT) EXIT
. K ^UTILITY($J,"W") S DIWL=6,DIWR=(IOM-5),DIWF="W|"
. S X="COMMENTS: ",ENI=0
. F S ENI=$O(^ENG(ENFILE,ENDA("F?"),301,ENI)) Q:'ENI S X=X_^(ENI,0) D ^DIWP S X="" I $Y+4>IOSL S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)!'Y W @IOF
. D ^DIWW
CHECKAV ;
I $$GET1^DIQ(ENFILE,ENDA("F?"),301)]"" D G ASKDOC
. W $C(7),!,"This FAP Document already has an Adjustment Voucher!",!
EDITAV ;
W !
S ENAV=$$AVP(ENFILE,ENDA("F?"))
I 'ENAV W !,"Adjustment voucher was NOT created." I $G(ENUT) G EXIT
I ENAV D
. S DIE="^ENG("_ENFILE_",",DR="301///NOW",DA=ENDA("F?") D ^DIE
. W !,"Adjustment Voucher was created.",!
G ASKDOC
EXIT ;
K DA,DIC,DIE,DIR,DIRUT,DIROUT,DR,DTOUT,DUOUT,X,Y
K ENAMT,ENAV,ENDA,ENDT,ENFAPTY,ENFAY3,ENFILE,ENFUND,ENFUNDNW
K ENSGL,ENSN,ENUT,ENY0,ENY1
Q
;
AVP(ENF,ENDA) ; adjustment voucher preparation
; This program gathers all the information required for an adjustment
; voucher. The calling program must evaluate the return value and
; actually create the adjustment voucher at the appropriate time
; by storing NOW in the appropriate A.V. DATE field.
;
; Called by this routine for existing FAP Documents or by routines
; ENFAACQ, ENFABETR, ENFACHG, ENFADEL, ENFAXF during creation of
; new FAP Documents
;
; in
; ENF - # of file (e.g. 6915.2 for FA DOCUMENT LOG)
; ENDA - ien of entry in ENF to create adjustment voucher for
; out
; $D(ENUT) true if time-out or uparrow '^' during call
; returns 0 (cancelled) or 1 (fully prepared)
;
N DA,DIE,DIR,DR,ENAV,X,Y
K ENUT S ENAV=0
;
S DIR(0)="Y"
S DIR("A")="Should an Adjustment Voucher be created",DIR("B")="YES"
S DIR("?",1)="Adjustment Vouchers are used to inform Fiscal personnel"
S DIR("?",2)="of FAP transactions that Fiscal must take action on."
S DIR("?",3)=" "
S DIR("?")="Enter YES or NO"
D ^DIR K DIR S:$D(DIRUT) ENUT=1 G:'Y!$D(DIRUT) AVPX
;
AVPED S DIE="^ENG("_ENF_",",DR="303R;310R",DA=ENDA D ^DIE
S DIR(0)="Y",DIR("A")="Is adjustment voucher correct"
D ^DIR K DIR I $D(DIRUT) S ENUT=1 G AVPX
I 'Y D G:Y AVPED S Y=$$AVC(ENF,ENDA) G AVPX
. S DIR(0)="Y",DIR("A")="Do you want to re-edit it"
. D ^DIR K DIR I $D(DIRUT) S ENUT=1
I $P($G(^ENG(ENF,ENDA,300)),U,3)=""!'$O(^ENG(ENF,ENDA,301,0)) D G AVPED
. W $C(7),!,"Both Reason Code and Comments are required!"
S ENAV=1
;
AVPX ; exit
Q ENAV
;
AVC(ENF,ENDA) ; Adjustment Voucher Clean Up
; This code is used to clean up an aborted adjustment voucher.
; in
; ENF - file number (e.g. 6915.2)
; ENDA - ien
; returns 1 (done) or 0 (can't because a.v. completed)
;
I ENF'?1"6915."1N Q 0
I $$GET1^DIQ(ENF,ENDA,301)]"" Q 0
S DIE="^ENG("_ENF_",",DR="303///@;310///@",DA=ENDA D ^DIE Q 1
;
;ENFAAV
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAAV 5667 printed Oct 16, 2024@17:54:06 Page 2
ENFAAV ;IRMFO/SAB-ADJUSTMENT VOUCHER ENTRY ;6.30.97
+1 ;;7.0;ENGINEERING;**39**;AUG 17, 1993
EN ; Entry point for option
+1 ; load table for converting FA Type to SGL
+2 KILL ENFAPTY
SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6914.3,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+3 SET ENY0=$GET(^ENG(6914.3,ENDA,0))
+4 IF $PIECE(ENY0,U,3)]""
SET ENFAPTY($PIECE(ENY0,U,3))=$PIECE(ENY0,U)
End DoDot:1
ASKDOC ; ask FAP Document
+1 WRITE !
+2 SET DIR(0)="SBO^FA:FA DOCs;FB:FB DOCs;FC:FC DOCs;FD:FD DOCs;FR:FR DOCs"
+3 SET DIR("A")="Select Type of FAP Document"
+4 SET DIR("?",1)="Choose the type of FAP Document for which an Adjustment"
+5 SET DIR("?",2)="Voucher should be created. After the type is chosen, you"
+6 SET DIR("?",3)="will be asked to select the specific FAP Document."
+7 SET DIR("?")=" "
+8 DO ^DIR
KILL DIR
if Y']""!$DATA(DIRUT)
GOTO EXIT
+9 SET ENFILE="6915."_$FIND("ABCDR",$EXTRACT(Y,2,2))
+10 ;
+11 SET DIC="^ENG("_ENFILE_","
SET DIC(0)="AQEM"
+12 SET DIC("A")="Select "_Y_" DOCUMENT (by Transaction Number or Equipment ENTRY #): "
+13 DO ^DIC
if Y'>0
GOTO EXIT
+14 SET ENDA("F?")=+Y
SHOWDOC ; show info for FAP Document/Adjustment Voucher
+1 SET ENDT=$$GET1^DIQ(ENFILE,ENDA("F?"),301,"I")
+2 SET ENY0=$GET(^ENG(ENFILE,ENDA("F?"),0))
+3 SET ENY1=$GET(^ENG(ENFILE,ENDA("F?"),1))
+4 SET ENDA=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),0)),U)
+5 ; associated FA
SET ENDA("FA")=$$AFA^ENFAR5A(ENFILE,ENDA("F?"))
+6 SET ENFAY3=$GET(^ENG(6915.2,ENDA("FA"),3))
+7 SET ENSN=$TRANSLATE($EXTRACT($PIECE(ENFAY3,U,5),1,5)," ","")
+8 if ENFILE=6915.2
SET ENFUND=$PIECE(ENFAY3,U,10)
+9 if ENFILE'=6915.2
SET ENFUND=$$FUND^ENFAR5A(ENFILE,ENDA("F?"),ENDA("FA"))
+10 SET ENSGL=$SELECT($PIECE(ENFAY3,U,6)]"":$GET(ENFAPTY($PIECE(ENFAY3,U,6))),1:"")
+11 SET ENAMT=0
+12 IF ENFILE=6915.2
SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),3)),U,27)
+13 IF ENFILE=6915.3
SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),4)),U,4)
+14 IF ENFILE=6915.4
SET ENX=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),4)),U,6)
SET ENAMT=$SELECT(ENX="":0,1:ENX-$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,4))
+15 IF ENFILE=6915.5
SET ENAMT="-"_$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,2)
+16 IF ENFILE=6915.6
SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,8)
+17 WRITE @IOF,!,"ADJ. VOUCHER",?16,"TRANSACTION .............",?43,"STN"
+18 WRITE ?50,"FUND",?58,"SGL",?63,"NET AMOUNT"
+19 WRITE !,"DATE/TIME",?16,"CODE NUMBER DATE"
+20 WRITE !,"--------------",?16,"---- ----------- --------",?43,"-----"
+21 WRITE ?50,"------",?58,"----",?63,"----------------"
+22 WRITE !,$EXTRACT($TRANSLATE($$FMTE^XLFDT(ENDT,"2F")," ",0),1,14)
+23 WRITE ?16,$PIECE(ENY1,U,6),?21,$PIECE(ENY1,U,9)
+24 WRITE ?33,$TRANSLATE($$FMTE^XLFDT($PIECE(ENY0,U,2),"2DF")," ",0)
+25 WRITE ?43,ENSN,?50,ENFUND,?58,ENSGL
+26 ; check FR doc for FUND change
IF ENFILE=6915.6
Begin DoDot:1
+27 SET ENFUNDNW=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),3)),U,9)
+28 ; fund didn't change
IF ENFUND=ENFUNDNW
SET ENAMT=0
QUIT
+29 ; subtract from old fund
SET ENAMT=-ENAMT
End DoDot:1
+30 WRITE ?63,$JUSTIFY($FNUMBER(ENAMT,",",2),16)
+31 IF ENFILE=6915.6
IF ENFUND'=ENFUNDNW
Begin DoDot:1
+32 ; show addition to new fund
+33 WRITE !,?43,ENSN,?50,ENFUNDNW,?58,ENSGL
+34 WRITE ?63,$JUSTIFY($FNUMBER(-ENAMT,",",2),16)
End DoDot:1
+35 WRITE !,?5,"EQUIP #: ",ENDA,?26,$$GET1^DIQ(6914,ENDA,3)
+36 SET ENX=$$GET1^DIQ(ENFILE,ENDA("F?"),303)
+37 IF ENX]""
WRITE !,?5,"REASON: ",ENX
+38 IF $ORDER(^ENG(ENFILE,ENDA("F?"),301,0))
Begin DoDot:1
+39 KILL ^UTILITY($JOB,"W")
SET DIWL=6
SET DIWR=(IOM-5)
SET DIWF="W|"
+40 SET X="COMMENTS: "
SET ENI=0
+41 FOR
SET ENI=$ORDER(^ENG(ENFILE,ENDA("F?"),301,ENI))
if 'ENI
QUIT
SET X=X_^(ENI,0)
DO ^DIWP
SET X=""
IF $Y+4>IOSL
SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
QUIT
WRITE @IOF
+42 DO ^DIWW
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
CHECKAV ;
+1 IF $$GET1^DIQ(ENFILE,ENDA("F?"),301)]""
Begin DoDot:1
+2 WRITE $CHAR(7),!,"This FAP Document already has an Adjustment Voucher!",!
End DoDot:1
GOTO ASKDOC
EDITAV ;
+1 WRITE !
+2 SET ENAV=$$AVP(ENFILE,ENDA("F?"))
+3 IF 'ENAV
WRITE !,"Adjustment voucher was NOT created."
IF $GET(ENUT)
GOTO EXIT
+4 IF ENAV
Begin DoDot:1
+5 SET DIE="^ENG("_ENFILE_","
SET DR="301///NOW"
SET DA=ENDA("F?")
DO ^DIE
+6 WRITE !,"Adjustment Voucher was created.",!
End DoDot:1
+7 GOTO ASKDOC
EXIT ;
+1 KILL DA,DIC,DIE,DIR,DIRUT,DIROUT,DR,DTOUT,DUOUT,X,Y
+2 KILL ENAMT,ENAV,ENDA,ENDT,ENFAPTY,ENFAY3,ENFILE,ENFUND,ENFUNDNW
+3 KILL ENSGL,ENSN,ENUT,ENY0,ENY1
+4 QUIT
+5 ;
AVP(ENF,ENDA) ; adjustment voucher preparation
+1 ; This program gathers all the information required for an adjustment
+2 ; voucher. The calling program must evaluate the return value and
+3 ; actually create the adjustment voucher at the appropriate time
+4 ; by storing NOW in the appropriate A.V. DATE field.
+5 ;
+6 ; Called by this routine for existing FAP Documents or by routines
+7 ; ENFAACQ, ENFABETR, ENFACHG, ENFADEL, ENFAXF during creation of
+8 ; new FAP Documents
+9 ;
+10 ; in
+11 ; ENF - # of file (e.g. 6915.2 for FA DOCUMENT LOG)
+12 ; ENDA - ien of entry in ENF to create adjustment voucher for
+13 ; out
+14 ; $D(ENUT) true if time-out or uparrow '^' during call
+15 ; returns 0 (cancelled) or 1 (fully prepared)
+16 ;
+17 NEW DA,DIE,DIR,DR,ENAV,X,Y
+18 KILL ENUT
SET ENAV=0
+19 ;
+20 SET DIR(0)="Y"
+21 SET DIR("A")="Should an Adjustment Voucher be created"
SET DIR("B")="YES"
+22 SET DIR("?",1)="Adjustment Vouchers are used to inform Fiscal personnel"
+23 SET DIR("?",2)="of FAP transactions that Fiscal must take action on."
+24 SET DIR("?",3)=" "
+25 SET DIR("?")="Enter YES or NO"
+26 DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET ENUT=1
if 'Y!$DATA(DIRUT)
GOTO AVPX
+27 ;
AVPED SET DIE="^ENG("_ENF_","
SET DR="303R;310R"
SET DA=ENDA
DO ^DIE
+1 SET DIR(0)="Y"
SET DIR("A")="Is adjustment voucher correct"
+2 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ENUT=1
GOTO AVPX
+3 IF 'Y
Begin DoDot:1
+4 SET DIR(0)="Y"
SET DIR("A")="Do you want to re-edit it"
+5 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ENUT=1
End DoDot:1
if Y
GOTO AVPED
SET Y=$$AVC(ENF,ENDA)
GOTO AVPX
+6 IF $PIECE($GET(^ENG(ENF,ENDA,300)),U,3)=""!'$ORDER(^ENG(ENF,ENDA,301,0))
Begin DoDot:1
+7 WRITE $CHAR(7),!,"Both Reason Code and Comments are required!"
End DoDot:1
GOTO AVPED
+8 SET ENAV=1
+9 ;
AVPX ; exit
+1 QUIT ENAV
+2 ;
AVC(ENF,ENDA) ; Adjustment Voucher Clean Up
+1 ; This code is used to clean up an aborted adjustment voucher.
+2 ; in
+3 ; ENF - file number (e.g. 6915.2)
+4 ; ENDA - ien
+5 ; returns 1 (done) or 0 (can't because a.v. completed)
+6 ;
+7 IF ENF'?1"6915."1N
QUIT 0
+8 IF $$GET1^DIQ(ENF,ENDA,301)]""
QUIT 0
+9 SET DIE="^ENG("_ENF_","
SET DR="303///@;310///@"
SET DA=ENDA
DO ^DIE
QUIT 1
+10 ;
+11 ;ENFAAV
