VistA-FOIAVistA/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFMO2.m

47 lines
1.7 KiB
Mathematica

PRCFFMO2 ;WISC/SJG-CONTINUATION OF OBLIGATION PROCESSING ;7/24/00 23:15
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
QUIT
; This routine handles Hold Functionality processing
ENSFO ; Entry point for original entry Supply Fund order documents
N DATEZ S DATEZ=PRCFA("OBLDATE")
D CURRENT^PRCFFUC
Q
ENO ; Entry point for original entry purchase order documents
N DATEZ
I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 S DATEZ=P("PODATE")
I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 S DATEZ=PRCFA("OBLDATE")
D CURRENT^PRCFFUC
ENO1 S EXIT1=0 D ACCPD^PRCFFUC Q:Y Q:EXIT Q:EXIT1
I 'Y D NACCPD^PRCFFUC,CHECK^PRCFFUC Q:EXIT W ! G ENO1
Q
RETRANO ; Get accounting period/obligation processing date from stack file
N RETRAN,ACCPD
S RETRAN=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
S ACCPD=$P(RETRAN,"/",5),PRCFA("OBLDATE")=$P(RETRAN,"/",6)
I PRCFA("OBLDATE")="" D NOW^%DTC S PRCFA("OBLDATE")=X
Q
;
ENSFM ; Entry point for modificattion entry Supply Fund order documents
N DATEZ S DATEZ=PRCFA("OBLDATE")
D CURRENT^PRCFFUC
Q
ENM ; Entry point for modification entry purchase order documents
N DATEZ
I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 D NOW^%DTC S DATEZ=X
I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 S DATEZ=PRCFA("OBLDATE")
D CURRENT^PRCFFUC
ENM1 S EXIT1=0 D ACCPD^PRCFFUC Q:Y Q:EXIT Q:EXIT1
I 'Y D NACCPD^PRCFFUC,CHECK^PRCFFUC Q:EXIT W ! G ENM1
Q
RETRANM ; Get accounting period/obligation processing date from stack file
N RETRAN,ACCPD
S RETRAN=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
S ACCPD=$P(RETRAN,"/",5),PRCFA("OBLDATE")=$P(RETRAN,"/",6)
I PRCFA("OBLDATE")="" D NOW^%DTC S PRCFA("OBLDATE")=X
Q
KILL ; Kill scratch variables
K CURDT,DATEZ,DEFDT,EXIT,EXIT1,PARTDT,X,Y,YY
Q