PRCESOE2.m

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 ---PRCESOE2   1361     printed  Apr 09, 2024@21:04:45                                                                                                                                                                                                    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