| [613] | 1 | PRCFFMO2 ;WISC/SJG-CONTINUATION OF OBLIGATION PROCESSING ;7/24/00  23:15
 | 
|---|
 | 2 | V ;;5.1;IFCAP;;Oct 20, 2000
 | 
|---|
 | 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 |  QUIT
 | 
|---|
 | 6 |  ; This routine handles Hold Functionality processing
 | 
|---|
 | 7 | ENSFO ; Entry point for original entry Supply Fund order documents
 | 
|---|
 | 8 |  N DATEZ S DATEZ=PRCFA("OBLDATE")
 | 
|---|
 | 9 |  D CURRENT^PRCFFUC
 | 
|---|
 | 10 |  Q
 | 
|---|
 | 11 | ENO ; Entry point for original entry purchase order documents
 | 
|---|
 | 12 |  N DATEZ
 | 
|---|
 | 13 |  I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 S DATEZ=P("PODATE")
 | 
|---|
 | 14 |  I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 S DATEZ=PRCFA("OBLDATE")
 | 
|---|
 | 15 |  D CURRENT^PRCFFUC
 | 
|---|
 | 16 | ENO1 S EXIT1=0 D ACCPD^PRCFFUC Q:Y  Q:EXIT  Q:EXIT1
 | 
|---|
 | 17 |  I 'Y D NACCPD^PRCFFUC,CHECK^PRCFFUC Q:EXIT  W ! G ENO1
 | 
|---|
 | 18 |  Q
 | 
|---|
 | 19 | RETRANO ; Get accounting period/obligation processing date from stack file
 | 
|---|
 | 20 |  N RETRAN,ACCPD
 | 
|---|
 | 21 |  S RETRAN=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
 | 
|---|
 | 22 |  S ACCPD=$P(RETRAN,"/",5),PRCFA("OBLDATE")=$P(RETRAN,"/",6)
 | 
|---|
 | 23 |  I PRCFA("OBLDATE")="" D NOW^%DTC S PRCFA("OBLDATE")=X
 | 
|---|
 | 24 |  Q
 | 
|---|
 | 25 |  ;
 | 
|---|
 | 26 | ENSFM ; Entry point for modificattion entry Supply Fund order documents
 | 
|---|
 | 27 |  N DATEZ S DATEZ=PRCFA("OBLDATE")
 | 
|---|
 | 28 |  D CURRENT^PRCFFUC
 | 
|---|
 | 29 |  Q
 | 
|---|
 | 30 | ENM ; Entry point for modification entry purchase order documents
 | 
|---|
 | 31 |  N DATEZ
 | 
|---|
 | 32 |  I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 D NOW^%DTC S DATEZ=X
 | 
|---|
 | 33 |  I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 S DATEZ=PRCFA("OBLDATE")
 | 
|---|
 | 34 |  D CURRENT^PRCFFUC
 | 
|---|
 | 35 | ENM1 S EXIT1=0 D ACCPD^PRCFFUC Q:Y  Q:EXIT  Q:EXIT1
 | 
|---|
 | 36 |  I 'Y D NACCPD^PRCFFUC,CHECK^PRCFFUC Q:EXIT  W ! G ENM1
 | 
|---|
 | 37 |  Q
 | 
|---|
 | 38 | RETRANM ; Get accounting period/obligation processing date from stack file
 | 
|---|
 | 39 |  N RETRAN,ACCPD
 | 
|---|
 | 40 |  S RETRAN=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
 | 
|---|
 | 41 |  S ACCPD=$P(RETRAN,"/",5),PRCFA("OBLDATE")=$P(RETRAN,"/",6)
 | 
|---|
 | 42 |  I PRCFA("OBLDATE")="" D NOW^%DTC S PRCFA("OBLDATE")=X
 | 
|---|
 | 43 |  Q
 | 
|---|
 | 44 | KILL ; Kill scratch variables
 | 
|---|
 | 45 |  K CURDT,DATEZ,DEFDT,EXIT,EXIT1,PARTDT,X,Y,YY
 | 
|---|
 | 46 |  Q
 | 
|---|