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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFMO2 1784 printed Oct 16, 2024@18:04:16 Page 2
PRCFFMO2 ;WISC/SJG-CONTINUATION OF OBLIGATION PROCESSING ;7/24/00 23:15
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 QUIT
+4 ; This routine handles Hold Functionality processing
ENSFO ; Entry point for original entry Supply Fund order documents
+1 NEW DATEZ
SET DATEZ=PRCFA("OBLDATE")
+2 DO CURRENT^PRCFFUC
+3 QUIT
ENO ; Entry point for original entry purchase order documents
+1 NEW DATEZ
+2 IF $DATA(PRCFA("RETRAN"))
IF PRCFA("RETRAN")=0
SET DATEZ=P("PODATE")
+3 IF $DATA(PRCFA("RETRAN"))
IF PRCFA("RETRAN")=1
SET DATEZ=PRCFA("OBLDATE")
+4 DO CURRENT^PRCFFUC
ENO1 SET EXIT1=0
DO ACCPD^PRCFFUC
if Y
QUIT
if EXIT
QUIT
if EXIT1
QUIT
+1 IF 'Y
DO NACCPD^PRCFFUC
DO CHECK^PRCFFUC
if EXIT
QUIT
WRITE !
GOTO ENO1
+2 QUIT
RETRANO ; Get accounting period/obligation processing date from stack file
+1 NEW RETRAN,ACCPD
+2 SET RETRAN=$GET(GECSDATA(2100.1,GECSDATA,26,"E"))
+3 SET ACCPD=$PIECE(RETRAN,"/",5)
SET PRCFA("OBLDATE")=$PIECE(RETRAN,"/",6)
+4 IF PRCFA("OBLDATE")=""
DO NOW^%DTC
SET PRCFA("OBLDATE")=X
+5 QUIT
+6 ;
ENSFM ; Entry point for modificattion entry Supply Fund order documents
+1 NEW DATEZ
SET DATEZ=PRCFA("OBLDATE")
+2 DO CURRENT^PRCFFUC
+3 QUIT
ENM ; Entry point for modification entry purchase order documents
+1 NEW DATEZ
+2 IF $DATA(PRCFA("RETRAN"))
IF PRCFA("RETRAN")=0
DO NOW^%DTC
SET DATEZ=X
+3 IF $DATA(PRCFA("RETRAN"))
IF PRCFA("RETRAN")=1
SET DATEZ=PRCFA("OBLDATE")
+4 DO CURRENT^PRCFFUC
ENM1 SET EXIT1=0
DO ACCPD^PRCFFUC
if Y
QUIT
if EXIT
QUIT
if EXIT1
QUIT
+1 IF 'Y
DO NACCPD^PRCFFUC
DO CHECK^PRCFFUC
if EXIT
QUIT
WRITE !
GOTO ENM1
+2 QUIT
RETRANM ; Get accounting period/obligation processing date from stack file
+1 NEW RETRAN,ACCPD
+2 SET RETRAN=$GET(GECSDATA(2100.1,GECSDATA,26,"E"))
+3 SET ACCPD=$PIECE(RETRAN,"/",5)
SET PRCFA("OBLDATE")=$PIECE(RETRAN,"/",6)
+4 IF PRCFA("OBLDATE")=""
DO NOW^%DTC
SET PRCFA("OBLDATE")=X
+5 QUIT
KILL ; Kill scratch variables
+1 KILL CURDT,DATEZ,DEFDT,EXIT,EXIT1,PARTDT,X,Y,YY
+2 QUIT
