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