Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCFFMO1

PRCFFMO1.m

Go to the documentation of this file.
  1. PRCFFMO1 ;WISC/SJG-CONTINUATION OF OBLIGATION PROCESSING ;4/24/96 8:54 AM
  1. V ;;5.1;IFCAP;**58,79,220**;Oct 20, 2000;Build 23
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRC*5.1*220 Comment out line related to FPDS message generation
  1. ;
  1. ;DISPLAY CONTROL POINT OFFICIALS BALANCES
  1. W !!,"Net Cost of Order: ",?30,"$",$J($P(PO(0),U,16),10,2)
  1. D CPBAL
  1. I $D(PRCF("NOBAL")) K PRCF("NOBAL")
  1. V1 I $P(PRC("PARAM"),"^",17)="Y" D
  1. . W !!,"Fiscal Status of Funds for Control Point"
  1. . W !!,"Status of Funds Balance: "
  1. . W ?30,"$",$J($P(^PRC(420,PRC("SITE"),1,+$P(PO(0),U,3),0),U,7),10,2)
  1. . W !,"Estimated Balance:"
  1. . W ?30,"$",$J($P(^(0),U,8),10,2)
  1. I $G(PRCRGS)<1 D OVCOM^PRCFFU10 I PRCFA("OVCOM")=1!(PRCFA("OVCOM")=2) D POFAIL^PRCFFU10,MSG H 3 G OUT3
  1. S PRCFA("IDES")="Purchase Order Obligation"
  1. W ! D OKAY2^PRCFFU ; ask 'OK to continue?'
  1. I 'Y!($D(DIRUT)) D MSG H 3 G OUT3
  1. VAR S P("DELDATE")=$P(PO(0),U,10)
  1. S P("PODATE")=DT
  1. I $P(^PRC(442,PRCFA("PODA"),1),"^",15)'="" S P("PODATE")=$P(^(1),"^",15)
  1. S PRCFA("MOD")="E^0^Original Entry"
  1. S PRCFA("MP")=$P(PO(0),U,2)
  1. S PRCFA("REF")=$P(PO(0),"^")
  1. S PRCFA("SFC")=$P(PO(0),U,19)
  1. S PRCFA("SYS")="FMS"
  1. S PRCFA("TT")=$S(PRCFA("MP")=2:"SO",1:"MO")
  1. W !
  1. I $D(PRCFA("RETRAN")),'PRCFA("RETRAN") D REVIEW^PRCFFU I Y N D0 S D0=PRCFA("PODA") D ^PRCHDP1
  1. VAR1 I PRCFA("MP")=2,PRCFA("TT")'="MO" D G:ACCEDIT=1 VAR1
  1. . W !
  1. . D EN^PRCFFU16(+PO)
  1. . D MSG6^PRCFFU16
  1. VAR11 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 D G VAR2
  1. . D RETRANO^PRCFFMO2 S Y=PRCFA("OBLDATE")
  1. S Y=$$DTOBL^PRCFFUD1(PRC("RBDT"),PRC("PODT"))
  1. VAR2 D D^PRCFQ
  1. S %DT="AEX"
  1. S %DT("A")="Select Obligation Processing Date: "
  1. S %DT("B")=Y
  1. W ! D ^%DT K %DT
  1. I Y<0 D MSG H 3 D OUT3 Q
  1. S PRCFA("OBLDATE")=Y
  1. S EXIT=0
  1. D ENO^PRCFFMO2
  1. I EXIT D MSG,KILL^PRCFFMO2 H 3 D OUT3 Q
  1. I PRC("RBDT")'<$P(^PRC(420,PRC("SITE"),0),"^",9),$P($$DATE^PRC0C(PRCFA("OBLDATE"),"I"),U,1,2)'=$P($$DATE^PRC0C(PRC("RBDT"),"I"),U,1,2) D MSG1^PRCFFUD G VAR11
  1. S PRCFA("SC")=""
  1. Q:'$D(^PRC(442,+PO,1))
  1. S PRCFA("SC")=$S($D(^PRC(440,$P(^PRC(442,+PO,1),U,1),2)):$P(^(2),U,4),1:"")
  1. I PRCFA("SC")="",$P(^PRC(442,PRCFA("PODA"),1),"^",7)'="" S PRCFA("SC")=$P(^PRCD(420.8,$P(^PRC(442,PRCFA("PODA"),1),"^",7),0),"^",3)
  1. S PRCFA("BBFY")=$$BBFY^PRCFFU5(PRCFA("PODA"))
  1. D GENDIQ^PRCFFU7(442,PRCFA("PODA"),".1;.07;.03;17","IEN","")
  1. ;
  1. EDIT ; Check fund/year dictionary for required FMS fields
  1. D EDIT^PRCFFU ; sets up PRCFMO array based upon required fields
  1. ;
  1. GO ; Prompt user for final go-ahead for the document creation
  1. D GO^PRCFFU I 'Y!($D(DIRUT)) D MSG,OUT3 H 3 Q
  1. ;
  1. ESIG ; Enter the Electronic Signature and away it goes!
  1. W !,"The Electronic Signature must now be entered to generate the "_PRCFA("TYPE")_" Document.",!
  1. D SIG^PRCFFU4
  1. I $D(PRCFA("SIGFAIL")) K PRCFA("SIGFAIL") D MSG1(ESIGMSG),OUT3 H 3 Q
  1. ;
  1. I $G(PRCTMP(442,+PO,.07,"I"))="" D NEW410^PRCFFUD
  1. D PO^PRCFFUD
  1. S IDFLAG="I" ; flag to indicate $ increase to FMS
  1. I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 D
  1. . D SETPO^PRCFFERT ; rebuild txn
  1. ;
  1. STACK ; Create entry in GECS Stack File
  1. D STACK^PRCFFU(0) ; build CTL,DOC segs, (0) means generate no batch#
  1. ;
  1. SEGS ; Create entry into TMP($J, for remaining segments
  1. K ^TMP($J,"PRCMO")
  1. N FMSINT S FMSINT=+PO,FMSMOD=$P(PRCFA("MOD"),U,1)
  1. D NEW^PRCFFU1(FMSINT,PRCFA("TT"),FMSMOD) ; create remaining segs
  1. ;
  1. ; Transfer nodes from TMP($J, into GECS stack file
  1. N LOOP S LOOP=0 F S LOOP=$O(^TMP($J,"PRCMO",GECSFMS("DA"),LOOP)) Q:'LOOP D SETCS^GECSSTAA(GECSFMS("DA"),^(LOOP))
  1. K ^TMP($J,"PRCMO")
  1. ;
  1. TRANS ; Mark the document as queued for transmission
  1. D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
  1. N P2 S P2=+PO,$P(P2,"/",5)=$P($G(PRCFA("ACCPD")),U),$P(P2,"/",6)=PRCFA("OBLDATE")
  1. D SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
  1. ;
  1. POOBL ; Enter Obligation Data into Purchase Order record
  1. I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
  1. N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2)
  1. D EN7^PRCFFU41(PRCFA("TT"),FMSMOD,PRCFA("OBLDATE"),FMSDOCT) ; log txn
  1. ;
  1. ; continue processing if this is not a rebuild
  1. I $D(PRCFA("RETRAN")),PRCFA("RETRAN") D OUT3 Q
  1. ;
  1. FISCST ; Post to Fiscal Status of Funds Tracker
  1. I $P(PRC("PARAM"),U,17)["Y" D FISC^PRCFFU4
  1. ;
  1. PHA ; Generate PHA transaction
  1. S PRCOPODA=PRCFA("PODA") W ! D WAIT^DICD W !!,"...now generating the PHA transaction"
  1. S FILE=442 S PRCHPO=PRCFA("PODA") D CHECK^PRCHSWCH K FILE
  1. D:'$G(PRCHOBL) NEW^PRCOEDI W !
  1. ; PRC*5.1*79: let the user know that a message is going out, except for
  1. ; Requisitions.
  1. ;D:$D(^PRC(442,PRCHPO,25)) EN^DDIOL("...now generating the FPDS message for the AAC","","!"),EN^DDIOL(" ") ;PRC*5.1*220
  1. ;
  1. K PRCOPODA,IO("Q")
  1. ;
  1. NC I $D(PRCFA("PODA")) D ^PRCFAC02
  1. ; Generate FPDS HL7 message for the AAC, PRC*5.1*79
  1. I $P(^PRC(442,PRCHPO,0),U,15)>0,$D(^PRC(442,PRCHPO,25)) D AAC^PRCHAAC
  1. ; End of changes for PRC*5.1*79
  1. Q
  1. ;
  1. OUT3 K %,AMT,C1,C,CSDA,D0,DA,DI,DIC,DEL,E,I,J,K,N1,N2,PCP,PO,PODA,PRCQ,PTYPE,T,T1,TIME,TRDA,Y,Z,Z5,ZX
  1. Q
  1. MSG W !! S X="No further processing is being taken on this obligation." D EN^DDIOL(X) Q
  1. Q
  1. MSG1(MSG) S:'$D(ROUTINE) ROUTINE="PRCUESIG"
  1. W !!,$$ERROR^PRCFFU13(ROUTINE,MSG)
  1. D MSG Q
  1. OUT W !,"No data posted to Control Point Files",$C(7) R X:3 Q
  1. Q
  1. CPBAL N A,B
  1. ;
  1. ; **Add call to OBLDAT^PRCFFUD1 as part of PRC*5.1*58
  1. S A=$$DATE^PRC0C($$OBLDAT^PRCFFUD1(PRC("RBDT"),$G(PRC("AMENDT"))),"I")
  1. K OBLDAT
  1. ; **End PRC*5.1*58
  1. ;
  1. S B=$P(A,"^",2)
  1. S A=$E(A,3,4)
  1. S:'$D(PQT) PQT=PRC("QTR")
  1. S X=$G(^PRC(420,PRC("SITE"),1,+PCP,4,A,0))
  1. I X="" W !! S X="No Control Point balances available at this time." D EN^DDIOL(X) S PRCF("NOBAL")="" Q
  1. S PRCS("C")=$P(X,"^",B+1)
  1. S PRCS("O")=$P(X,"^",B+5)
  1. W !!,"Control Point Balances"
  1. W !!,"Uncommitted Balance: "
  1. W ?30,"$"_$J(PRCS("C"),10,2)
  1. W !,"Unobligated Balance: "
  1. W ?30,"$"_$J(PRCS("O"),10,2)
  1. W !,"Committed, Not Obligated: "
  1. W ?30,"$"_$J((PRCS("O")-PRCS("C")),10,2)
  1. K PRCS
  1. Q