PRCFFMO2.m

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 ---PRCFFMO2   1784     printed  Feb 18, 2025@23:29:53                                                                                                                                                                                                    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