PRCESOE2 ;WISC/SJG-CONTINUATION OF 1358 OBLIGATION ;7/24/00 23:23
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
; No Top Level Entry
QUIT
ENO ; Entry point for original entry 1358 documents
N DATEZ 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,OBLDT
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
ENM ; Entry point for modification entry 1358 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
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[HPRCESOE2 1361 printed Dec 13, 2024@02:01:35 Page 2
PRCESOE2 ;WISC/SJG-CONTINUATION OF 1358 OBLIGATION ;7/24/00 23:23
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ; No Top Level Entry
+4 QUIT
ENO ; Entry point for original entry 1358 documents
+1 NEW DATEZ
SET DATEZ=PRCFA("OBLDATE")
+2 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,OBLDT
+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
ENM ; Entry point for modification entry 1358 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
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
