| [613] | 1 | PRCFFU15 ;WISC/SJG-1358 & PO OBLIGATION UTILITY, CONT ;8/15/94 17:47
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; No top level entry
|
|---|
| 6 | QUIT
|
|---|
| 7 | ;
|
|---|
| 8 | VENCONO(IEN) ; Display vendor and contract information on org entry
|
|---|
| 9 | ; IEN - Internal entry number from 410
|
|---|
| 10 | K PRCTMP N VENDOR
|
|---|
| 11 | DISP S (VENDOR,CONT,CONTEND,VENCONT,CONTIEN)=""
|
|---|
| 12 | D GENDIQ^PRCFFU7(410,IEN,"11;12;13;52","IEN","")
|
|---|
| 13 | S VENDOR=$G(PRCTMP(410,IEN,11,"E"))
|
|---|
| 14 | I VENDOR]"" W !,IOINLOW,"VENDOR: ",IOINHI,VENDOR,IOINORM,!
|
|---|
| 15 | S CONT=$G(PRCTMP(410,IEN,13,"E")) Q:CONT=""
|
|---|
| 16 | I CONT]"" D CONTNUM Q:CONTEND=""
|
|---|
| 17 | I CONTEND]"" D
|
|---|
| 18 | .W IOINLOW,"CONTRACT: ",IOINHI,CONT,IOINORM,!
|
|---|
| 19 | .W IOINLOW,"CONTRACT ENDING DATE: ",IOINHI,CONTEND,IOINORM,!
|
|---|
| 20 | Q
|
|---|
| 21 | VENCONM(IEN) ; Display vendor and contract information on adjustment
|
|---|
| 22 | ; IEN - Internal entry number from 442
|
|---|
| 23 | K PRCTMP N VENDOR,PRRQST
|
|---|
| 24 | D GENDIQ^PRCFFU7(442,+PO,.07,"I","")
|
|---|
| 25 | S PRRQST=$G(PRCTMP(442,+IEN,.07,"I"))
|
|---|
| 26 | Q:PRRQST=""
|
|---|
| 27 | I PRRQST]"" S POIEN=IEN,IEN=PRRQST D DISP
|
|---|
| 28 | Q
|
|---|
| 29 | POVENO(IEN) ; Display vendor and contract information
|
|---|
| 30 | ; IEN - Internal entry number from 442
|
|---|
| 31 | K PRCTMP N VENNM,VENIEN
|
|---|
| 32 | D GENDIQ^PRCFFU7(442,IEN,5,"IEN","")
|
|---|
| 33 | S VENNM=$G(PRCTMP(442,IEN,5,"E")),VENIEN=$G(PRCTMP(442,IEN,5,"I"))
|
|---|
| 34 | I VENNM]"" W !,"VENDOR: ",VENNM,!
|
|---|
| 35 | I '$D(^PRC(442,+IEN,2,"AC")) W "CONTRACT: ** NONE ON THIS ORDER **",!
|
|---|
| 36 | PO1 I $D(^PRC(442,+IEN,2,"AC")) D W !
|
|---|
| 37 | .S (PRCFMOD,NEWADD)=0
|
|---|
| 38 | .W ! K MSG S MSG(1)="One or more of the following contracts are associated with the line items"
|
|---|
| 39 | .S MSG(2)="on this Purchase Order for Services for this Vendor: "
|
|---|
| 40 | .D EN^DDIOL(.MSG) K MSG
|
|---|
| 41 | .S CONT="" F S CONT=$O(^PRC(442,+IEN,2,"AC",CONT)) Q:CONT="" D ADDCONT
|
|---|
| 42 | .K PRCFMOD,NEWADD
|
|---|
| 43 | .Q
|
|---|
| 44 | PO2 I $D(^PRC(443.6,+IEN,2,"AC")),$P(PRCFA("MOD"),U)="M" D W !
|
|---|
| 45 | .S PRCFMOD=1,NEWADD=0
|
|---|
| 46 | .W ! K MSG S MSG(1)="The Amendment has added line items which contain one or more of the following"
|
|---|
| 47 | .S MSG(2)="contracts to this Purchase Order for Services:"
|
|---|
| 48 | .D EN^DDIOL(.MSG) K MSG
|
|---|
| 49 | .S CONT="" F S CONT=$O(^PRC(443.6,+IEN,2,"AC",CONT)) Q:CONT="" D ADDCONT
|
|---|
| 50 | .D:NEWADD=0 EN^DDIOL(" ** NO NEW CONTRACTS ADDED THROUGH THE AMENDMENT **")
|
|---|
| 51 | .K PRCFMOD,NEWADD
|
|---|
| 52 | .Q
|
|---|
| 53 | Q
|
|---|
| 54 | ADDCONT ;
|
|---|
| 55 | S DIC="^PRC(440,"_VENIEN_",4,",DIC(0)="MNZ",X=CONT D ^DIC K DIC Q:Y<0
|
|---|
| 56 | I Y>0 D
|
|---|
| 57 | .N DA,CONTIEN,CONTEND S CONTIEN=+Y
|
|---|
| 58 | .S DIC=440,DR=6,DA=VENIEN,DIQ="PRCTMP(",DIQ(0)="IEN",DR(440.03)=".5;1",DA(440.03)=CONTIEN D EN^DIQ1 K DIC,DIQ,DR
|
|---|
| 59 | .S CONTENDE=$G(PRCTMP(440.03,CONTIEN,1,"E")),CONTENDI=$G(PRCTMP(440.03,CONTIEN,1,"I"))
|
|---|
| 60 | .I PRCFMOD=1 Q:$D(CONTENDA(9999999-CONTENDI)) S NEWADD=1
|
|---|
| 61 | .S CONTENDA(9999999-CONTENDI)=CONTENDE_U_CONTENDI
|
|---|
| 62 | .W !?2,"CONTRACT: ",CONT,?33,"END DATE: ",CONTENDE,?56,"START DATE: ",$G(PRCTMP(440.03,CONTIEN,.5,"E")) W:$G(PRCTMP(440.03,CONTIEN,.5,"E"))="" "NONE LISTED"
|
|---|
| 63 | .Q
|
|---|
| 64 | Q
|
|---|
| 65 | MSG1 ; Display current auto accrual information for PO
|
|---|
| 66 | K MSG W ! N FIL S FIL=$$FILE^PRCFFU16
|
|---|
| 67 | S MSG(1)="CURRENT VALUES FOR AUTO ACCRUAL FOR P.O. SERVICE ORDER:"
|
|---|
| 68 | S MSG(2)=" ENDING DATE FOR SERVICE: "_$G(PRCTMP(FIL,+OB,29,"E"))
|
|---|
| 69 | S MSG(3)=" AUTO ACCRUAL FLAG: "_$G(PRCTMP(FIL,+OB,30,"E"))
|
|---|
| 70 | D EN^DDIOL(.MSG) K MSG
|
|---|
| 71 | Q
|
|---|
| 72 | MSG2 ; Prompt for change if needed
|
|---|
| 73 | N TAG S TAG=$$LABEL
|
|---|
| 74 | K MSG W !! S MSG(1)="The Ending Date and the Auto Accrual Flag must now be entered for"
|
|---|
| 75 | S MSG(2)="this obligation. The system will default to the Ending Date on the Vendor"
|
|---|
| 76 | S MSG(3)="Contract from the "_TAG_", if available. Otherwise, the default Ending"
|
|---|
| 77 | S MSG(4)="Date is the last date of the current month.",MSG(5)=" "
|
|---|
| 78 | S MSG(6)="The Auto Accrual Flag tells FMS whether the "_TAG_" should be accrued."
|
|---|
| 79 | S MSG(7)="The default value will be 'NO' if the Ending Date is within the same month."
|
|---|
| 80 | S MSG(8)="To accrue the "_TAG_", change the flag to 'YES'."
|
|---|
| 81 | D EN^DDIOL(.MSG) K MSG
|
|---|
| 82 | Q
|
|---|
| 83 | CONTNUM ; Determine contract number
|
|---|
| 84 | I $G(PRCTMP(410,IEN,11,"E"))="" Q
|
|---|
| 85 | I $G(PRCTMP(410,IEN,13,"I"))]"" D
|
|---|
| 86 | .S VENID=$G(PRCTMP(410,IEN,12,"I")) Q:VENID=""
|
|---|
| 87 | .S VENCONT=$G(PRCTMP(410,IEN,13,"I"))
|
|---|
| 88 | .S DIC="^PRC(440,"_VENID_",4,",DIC(0)="MNZ",X=VENCONT D ^DIC K DIC
|
|---|
| 89 | .Q:Y<0 I Y>0 D
|
|---|
| 90 | ..N DA S CONTIEN=+Y
|
|---|
| 91 | ..S DIC=440,DR=6,DA=+VENID,DIQ="PRCTMP(",DIQ(0)="IEN",DR(440.03)=".5;1",DA(440.03)=CONTIEN D EN^DIQ1 K DIC,DIQ,DR
|
|---|
| 92 | ..S CONTEND=$G(PRCTMP(440.03,CONTIEN,1,"E"))
|
|---|
| 93 | ..Q
|
|---|
| 94 | .Q
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | MSG5 ; Exit message
|
|---|
| 98 | W ! D EN^DDIOL("Returning to Obligation processing...") W !
|
|---|
| 99 | Q
|
|---|
| 100 | LABEL() ; Determine label for messages
|
|---|
| 101 | S LABEL=""
|
|---|
| 102 | I '$D(PRCFA("MP")) S LABEL=""
|
|---|
| 103 | I $D(TRNODE(0)) I $P(TRNODE(0),U,2)="O"!($P(TRNODE(0),U,2)="A") S LABEL="1358"
|
|---|
| 104 | I $D(PRCFA("MP")),PRCFA("MP")=21 S LABEL="1358"
|
|---|
| 105 | I $D(PRCFA("MP")),PRCFA("MP")=2 S LABEL="Purchase Order"
|
|---|
| 106 | Q LABEL
|
|---|
