- PRCEFIS ;WISC/CTB/CLH-FISCAL UTILITIES ;09/28/93 4:22 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- CLOSE ;Close/complete 1358
- N DIR,Y,X,PRC,PRCF,PRCFA,PO,ER,ZX,DIC,DA,Z,%,STATUS,LOOK
- S LOOK="",DIR("A",1)="This option will mark a 1358 as complete. No further authorizations",DIR("A",2)="or liquidations may be made while the document is closed.",DIR("A")="Ok to continue",DIR(0)="YO",DIR("B")="Yes" D ^DIR K DIR
- I Y["^"!(Y=0) Q
- D LOOKUP I '% S X="Unable to find this document. Contact application coordinator.*" D MSG^PRCFQ Q
- I STATUS=40 S X="This 1358 has already been marked as closed." D MSG^PRCFQ Q
- I STATUS'=100 S X="Only status of 'Obligated - 1358' documents may be closed.*" D MSG^PRCFQ Q
- S DA=PRCFA("PODA")
- S PO=$$BAL^PRCH58(DA) W !!,?3,"Obligation Blanace: $ ",$J($FN($P(PO(8),U),",",2),12),?48,"Service Balance: $ ",$J($FN($P(PO(8),U,3),",",2),12),!,?49,"Fiscal Balance: $ ",$J($FN($P(PO(8),U,2),",",2),12),!!
- S DIR("A")="Okay to continue",DIR("B")="Yes",DIR(0)="YO",DIR("?")="Enter yes or <RETURN> to complete this 1358" D ^DIR K DIR
- I Y=0!(Y["^") Q
- W !! S X=40 D ENF^PRCHSTAT S X="Status changed to 'TRANSACTION COMPLETE'.*" D MSG^PRCFQ Q
- ;
- REOPEN ;reopen 1358 document
- N DIR,Y,X,PRC,PRCF,PRCFA,PO,ER,ZX,DIC,DA,Z,%,STATUS,LOOK
- S LOOK="",DIR("A",1)="This option will reopen a 1358 and make it available for posting authorizations",DIR("A",2)="and liquidations.",DIR("A")="Okay to continue",DIR(0)="YO",DIR("B")="Yes" D ^DIR K DIR
- I Y["^"!(Y=0) Q
- D LOOKUP Q:'%
- I STATUS'=40 S X="Only 1358 with status of 'Transaction Complete' may be reopened" D MSG^PRCFQ Q
- S DA=PRCFA("PODA")
- S PO=$$BAL^PRCH58(DA) W !!,?3,"Obligation Blanace: $ ",$J($FN($P(PO(8),U),",",2),12),?48,"Service Balance: $ ",$J($FN($P(PO(8),U,3),",",2),12),!,?49,"Fiscal Balance: $ ",$J($FN($P(PO(8),U,2),",",2),12),!!
- S DIR("A")="Okay to continue",DIR("B")="Yes",DIR(0)="YO",DIR("?")="Enter yes or <RETURN> to REOPEN this 1358" D ^DIR K DIR
- I Y=0!(Y["^") Q
- W !! S X=100 D ENF^PRCHSTAT S X="Status changed to 'Obligated - 1358'.*" D MSG^PRCFQ
- Q
- ;
- LOOKUP ;lookup obligation
- S PRCF("X")="AS" D ^PRCFSITE Q:'%
- D LIQ^PRCH58LQ(.PRCFA,.Y,.ER,.PO) I 'ER S %=0 Q
- W ! S STATUS="" I $G(PO(7))]"",$D(^PRCD(442.3,$P(PO(7),U),0)) S STATUS=$P(PO(7),U,4)
- I STATUS="" S X="Invalid status - no action taken*" D MSG^PRCFQ S %=0
- I STATUS=105 S X="1358 has been cancelled. No action taken.*" D MSG^PRCFQ S %=0 Q
- S %=1 Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCEFIS 2501 printed Feb 18, 2025@23:27:48 Page 2
- PRCEFIS ;WISC/CTB/CLH-FISCAL UTILITIES ;09/28/93 4:22 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- CLOSE ;Close/complete 1358
- +1 NEW DIR,Y,X,PRC,PRCF,PRCFA,PO,ER,ZX,DIC,DA,Z,%,STATUS,LOOK
- +2 SET LOOK=""
- SET DIR("A",1)="This option will mark a 1358 as complete. No further authorizations"
- SET DIR("A",2)="or liquidations may be made while the document is closed."
- SET DIR("A")="Ok to continue"
- SET DIR(0)="YO"
- SET DIR("B")="Yes"
- DO ^DIR
- KILL DIR
- +3 IF Y["^"!(Y=0)
- QUIT
- +4 DO LOOKUP
- IF '%
- SET X="Unable to find this document. Contact application coordinator.*"
- DO MSG^PRCFQ
- QUIT
- +5 IF STATUS=40
- SET X="This 1358 has already been marked as closed."
- DO MSG^PRCFQ
- QUIT
- +6 IF STATUS'=100
- SET X="Only status of 'Obligated - 1358' documents may be closed.*"
- DO MSG^PRCFQ
- QUIT
- +7 SET DA=PRCFA("PODA")
- +8 SET PO=$$BAL^PRCH58(DA)
- WRITE !!,?3,"Obligation Blanace: $ ",$JUSTIFY($FNUMBER($PIECE(PO(8),U),",",2),12),?48,"Service Balance: $ ",$JUSTIFY($FNUMBER($PIECE(PO(8),U,3),",",2),12),!,?49,"Fiscal Balance: $ ",$JUSTIFY($FNUMBER($PIECE(PO(8),U,2),",",2),12),!!
- +9 SET DIR("A")="Okay to continue"
- SET DIR("B")="Yes"
- SET DIR(0)="YO"
- SET DIR("?")="Enter yes or <RETURN> to complete this 1358"
- DO ^DIR
- KILL DIR
- +10 IF Y=0!(Y["^")
- QUIT
- +11 WRITE !!
- SET X=40
- DO ENF^PRCHSTAT
- SET X="Status changed to 'TRANSACTION COMPLETE'.*"
- DO MSG^PRCFQ
- QUIT
- +12 ;
- REOPEN ;reopen 1358 document
- +1 NEW DIR,Y,X,PRC,PRCF,PRCFA,PO,ER,ZX,DIC,DA,Z,%,STATUS,LOOK
- +2 SET LOOK=""
- SET DIR("A",1)="This option will reopen a 1358 and make it available for posting authorizations"
- SET DIR("A",2)="and liquidations."
- SET DIR("A")="Okay to continue"
- SET DIR(0)="YO"
- SET DIR("B")="Yes"
- DO ^DIR
- KILL DIR
- +3 IF Y["^"!(Y=0)
- QUIT
- +4 DO LOOKUP
- if '%
- QUIT
- +5 IF STATUS'=40
- SET X="Only 1358 with status of 'Transaction Complete' may be reopened"
- DO MSG^PRCFQ
- QUIT
- +6 SET DA=PRCFA("PODA")
- +7 SET PO=$$BAL^PRCH58(DA)
- WRITE !!,?3,"Obligation Blanace: $ ",$JUSTIFY($FNUMBER($PIECE(PO(8),U),",",2),12),?48,"Service Balance: $ ",$JUSTIFY($FNUMBER($PIECE(PO(8),U,3),",",2),12),!,?49,"Fiscal Balance: $ ",$JUSTIFY($FNUMBER($PIECE(PO(8),U,2),",",2),12),!!
- +8 SET DIR("A")="Okay to continue"
- SET DIR("B")="Yes"
- SET DIR(0)="YO"
- SET DIR("?")="Enter yes or <RETURN> to REOPEN this 1358"
- DO ^DIR
- KILL DIR
- +9 IF Y=0!(Y["^")
- QUIT
- +10 WRITE !!
- SET X=100
- DO ENF^PRCHSTAT
- SET X="Status changed to 'Obligated - 1358'.*"
- DO MSG^PRCFQ
- +11 QUIT
- +12 ;
- LOOKUP ;lookup obligation
- +1 SET PRCF("X")="AS"
- DO ^PRCFSITE
- if '%
- QUIT
- +2 DO LIQ^PRCH58LQ(.PRCFA,.Y,.ER,.PO)
- IF 'ER
- SET %=0
- QUIT
- +3 WRITE !
- SET STATUS=""
- IF $GET(PO(7))]""
- IF $DATA(^PRCD(442.3,$PIECE(PO(7),U),0))
- SET STATUS=$PIECE(PO(7),U,4)
- +4 IF STATUS=""
- SET X="Invalid status - no action taken*"
- DO MSG^PRCFQ
- SET %=0
- +5 IF STATUS=105
- SET X="1358 has been cancelled. No action taken.*"
- DO MSG^PRCFQ
- SET %=0
- QUIT
- +6 SET %=1
- QUIT
- +7 ;