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

PRCFFU.m

Go to the documentation of this file.
  1. PRCFFU ;WISC/SJG-CONTINUATION OF OBLIGATION PROCESSING ;7/21/93 13:51
  1. V ;;5.1;IFCAP;**196**;Oct 20, 2000;Build 15
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRC*5.1*196 Send order obligation date to GECS for creation
  1. ; of the SO document CTL segment with correct date
  1. QUIT
  1. ; No top level entry point
  1. OKAY ;
  1. S DIR(0)="Y",DIR("A",1)="The information listed above is recorded on this "_PRCFA("IDES")_"."
  1. S DIR("A")="Is the above information correct",DIR("B")="YES"
  1. S DIR("?")="Enter 'NO' or 'N' to edit the Cost Center or BOC."
  1. S DIR("?",1)="Enter '^' to exit this option."
  1. S DIR("?",2)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this obligation."
  1. D ^DIR K DIR
  1. QUIT
  1. ;
  1. OKAY2 ;
  1. S DIR(0)="Y",DIR("A")="OK to Continue",DIR("B")="YES"
  1. S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
  1. S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this obligation."
  1. D ^DIR K DIR
  1. QUIT
  1. ;
  1. EDIT ; Set up PRCFMO array to indicate required FMS fields
  1. S PARAM1="^"_PRC("SITE")_"^"_+$P(PO(0),U,3)_"^"_PRC("FY")_"^"_PRCFA("BBFY")
  1. ; build PRCFMO array to use when creating LIN string of FMS transaction
  1. ; PARAM1=^STATION^FCP^FY^BBFY
  1. ; SPE means spending documents
  1. D DOCREQ^PRC0C(PARAM1,"SPE","PRCFMO")
  1. S PRCFMO("G/N")=$P(PRCFMO,U,12)
  1. QUIT
  1. ;
  1. GO ; Prompt user for final go-ahead for the document creation
  1. S PRCFA("FDES")=$S(PRCFA("TT")="MO":"Miscellaneous Order (MO)",PRCFA("TT")="SO":"Service (SO) Order",PRCFA("TT")="AR":"Receiver Accrual (AR)")
  1. N POSIT S POSIT=$F(PRCFA("FDES"),"(")
  1. S PRCFA("TYPE")=$E(PRCFA("FDES"),POSIT,POSIT+1)
  1. S DIR(0)="Y"
  1. S DIR("A")="Transmit this Document to FMS"
  1. S DIR("B")="YES"
  1. S DIR("A",1)=" "
  1. S DIR("A",2)="This "_PRCFA("IDES")_" will now generate the "
  1. S DIR("A",3)=$P(PRCFA("MOD"),U,3)_" "_PRCFA("FDES")_" Document. The "_PRCFA("TYPE")_" Document"
  1. S DIR("A",4)="will be marked for transmission to FMS."
  1. S DIR("A",5)=" "
  1. S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
  1. S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to transmit this Document."
  1. D ^DIR K DIR
  1. QUIT
  1. ;
  1. STACK(MOD) ; Create entry in GECS Stack File
  1. I $D(PRCFA("CONVS")),PRCFA("CONVS")=1 G STACK1
  1. I $D(PRCFA("CONVG")),PRCFA("CONVG")=1 G STACK1
  1. W !!,"...now generating the FMS "
  1. W $S(PRCFA("TT")="MO":"Miscellaneous Order (MO) Document",PRCFA("TT")="SO":"Service Order (SO) Document",PRCFA("TT")="AR":"Receiver Accrual (AR) Document",1:"Document")
  1. W "...",! D WAIT^DICD
  1. STACK1 N FMSSYS,FMSSTA,FMSDOC,FMSTRA,FMSSEC,FMSMOD,FMSFCP,FMSDES,FMSCOMDT
  1. I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 Q
  1. K GECSUFMS("DA") ; delete current ien to get new ien
  1. S FMSDES=PRCFA("IDES")
  1. S FMSDOC=PRCFA("REF")
  1. S FMSMOD=MOD
  1. I PRCFA("TT")="AR" D
  1. . S FMSDOC=FMSDOC_12
  1. . S FMSMOD=1
  1. S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
  1. S FMSSTA=PRC("SITE")
  1. S FMSSYS="I"
  1. S FMSTRA=PRCFA("TT")
  1. S FMSCOMDT=PRCFA("OBLDATE") ;PRC*5.1*196
  1. D CONTROL^GECSUFMS(FMSSYS,FMSSTA,FMSDOC,FMSTRA,FMSSEC,FMSMOD,"Y",FMSDES,FMSCOMDT)
  1. QUIT
  1. ;
  1. OKAM ; Reader for prompt to approve amendment
  1. S DIR(0)="Y"
  1. S DIR("A",1)="The information listed above is recorded on this Purchase Order amendment."
  1. S DIR("A")="Are you ready to approve and obligate this amendment"
  1. S DIR("B")="YES"
  1. S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
  1. S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this amendment obligation."
  1. D ^DIR K DIR
  1. QUIT
  1. ;
  1. OKAPP ; Reader for prompt that amendment has already been approved
  1. S DIR(0)="Y"
  1. S DIR("A",1)="This amendment has already been approved by Fiscal."
  1. S DIR("A")="Are you sure that you wish to continue"
  1. S DIR("B")="NO"
  1. S DIR("?")="Enter 'YES' or 'Y' to continue."
  1. S DIR("?",1)="Enter 'NO' or 'N' or '^' or 'RETURN' to exit this option."
  1. D ^DIR K DIR
  1. QUIT
  1. ;
  1. OKPRT ; Reader to prompt user to print the amendment
  1. S DIR(0)="Y"
  1. S DIR("A")="Would you like to print this amendment"
  1. S DIR("B")="YES"
  1. S DIR("?")="Enter 'YES' or 'Y' or 'RETURN' to print this amendment."
  1. S DIR("?",1)="Enter 'NO' or 'N' or '^' if printing in not desired."
  1. D ^DIR K DIR
  1. QUIT
  1. ;
  1. REVIEW ; Reader to prompt user to review the PO before obligation
  1. N LABEL S LABEL=$S((PRCFA("MP")=1)!(PRCFA("MP")=2):"Purchase Order",PRCFA("MP")=8:"Requisition",1:"Purchase Order")
  1. S DIR(0)="Y"
  1. S DIR("A")="Would you like to review the entire "_LABEL
  1. S DIR("B")="YES"
  1. S DIR("?")="Enter 'NO' or 'N' or '^' if the "_LABEL_" review is not necessary."
  1. S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to display the "_LABEL_"."
  1. D ^DIR K DIR
  1. Q
  1. ;
  1. ; PO is the ien of the 443.6 file
  1. ; AMNUM is the amendment number
  1. CHKAMEN(PO,AMNUM) ; checks PO completeness, looks for missing data
  1. N CNT,J,INUM,CHNG,STARTFLG,TYPAM,MSG,PRPAYFLG
  1. S CNT=0
  1. S STARTFLG=0
  1. S PRPAYFLG=0
  1. F CHNG=0:0 S CHNG=$O(^PRC(443.6,+PO,6,AMNUM,3,CHNG)) Q:CHNG'>0 D
  1. . S CHNG=^(CHNG,0)
  1. . ;
  1. . ;Has the data in any of the following fields been deleted?
  1. . ;Ship To Address, Inv. Address, Prompt Pay. Terms, or F.O.B.Point.
  1. . S TYPAM=$P($G(CHNG),U,2)
  1. . I TYPAM=20,$P(^PRC(443.6,+PO,1),U,3)="" D
  1. . . S MSG="Ship To Address."
  1. . . S $P(^PRC(443.6,+PO,1),U,3)=$P(^PRC(442,+PO,1),U,3)
  1. . I TYPAM=25,$P(^PRC(443.6,+PO,12),U,6)="" D
  1. . . S MSG="Invoice Address."
  1. . . S $P(^PRC(443.6,+PO,12),U,6)=$P(^PRC(442,+PO,12),U,6)
  1. . I TYPAM=33,^PRC(443.6,+PO,5,0)="" D
  1. . . S MSG="Prompt Payment Terms."
  1. . . S ^PRC(443.6,+PO,5,0)=^PRC(442,+PO,5,0)
  1. . . S I=0 F J=0:0 S I=$O(^PRC(443.6,+PO,5,I)) Q:I="" S ^PRC(443.6,+PO,5,I,0)=^PRC(442,+PO,5,I,0)
  1. . . Q
  1. . I TYPAM=35,$P(^PRC(443.6,+PO,1),U,6)="" D
  1. . . S MSG="F.O.B. Point."
  1. . . S $P(^PRC(443.6,+PO,1),U,6)=$P(^PRC(442,+PO,1),U,6)
  1. . I $G(MSG)]"" D
  1. . . I TYPAM=33&'PRPAYFLG!(TYPAM'=33) W !?10,"This amendment is missing it's ",MSG,"!" K MSG
  1. . . I TYPAM=33 S PRPAYFLG=1
  1. . . S STARTFLG=1
  1. . Q
  1. . ;
  1. . I $P($P(CHNG,U,3),":",2)=40,($P($P(CHNG,U,3),";"))=1 S INUM=$P(CHNG,U,4) I $G(INUM)]"" D
  1. . . ; for each item , check description
  1. . . S J=0 S J=$O(^PRC(443.6,+PO,2,INUM,1,J)) I J>0&(^(J,0)="") D
  1. . . . I CNT>22 N DIR S DIR(0)="E" D ^DIR S CNT=0
  1. . . . W !,?10,"Line item ",INUM," is missing it's description!"
  1. . . . S CNT=CNT+2,STARTFLG=1
  1. . . . Q
  1. . . Q
  1. . Q
  1. Q STARTFLG