| 1 | PRCORV1 ;WISC/DJM/BGJ/AS-IFCAP VRQ REVIEW ROUTINE, CONTINUED ;3/8/05 | 
|---|
| 2 | V ;;5.1;IFCAP;**7,81**;Oct 20, 2000 | 
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | REV ;COMPLETE REVIEW OF VENDOR ENTRY | 
|---|
| 5 | N SPACE,VALMY,IEN,PRCOI,PRCOIN,DIC,DA,DR,DIQ,DIR,Y | 
|---|
| 6 | D EN^VALM2(XQORNOD(0),"OS") | 
|---|
| 7 | S PRCOI=0 | 
|---|
| 8 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ | 
|---|
| 9 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI)) | 
|---|
| 10 | S IEN=+$P(PRCOIN,U,2) | 
|---|
| 11 | D FULL^VALM1 | 
|---|
| 12 | W @IOF | 
|---|
| 13 | K PRCORVP | 
|---|
| 14 | S DIC="^PRC(440,",DA=IEN,DR=".01:46",DIQ="PRCORVP",DIQ(0)="E" | 
|---|
| 15 | D EN^DIQ1 | 
|---|
| 16 | S $P(SPACE," ",24)=" " | 
|---|
| 17 | W !!,"           Vendor Name: "_$$FIELD(IEN,.01) | 
|---|
| 18 | W ?70,"PAGE: 1" | 
|---|
| 19 | W !,"      Ordering Address: "_$$FIELD(IEN,1) | 
|---|
| 20 | W:$$FIELD(IEN,2)]"" !,SPACE_$$FIELD(IEN,2) | 
|---|
| 21 | S X=SPACE | 
|---|
| 22 | S:$$FIELD(IEN,4.2)]"" X=X_$$FIELD(IEN,4.2)_", " | 
|---|
| 23 | S:$$FIELD(IEN,4.4)]"" X=X_$$FIELD(IEN,4.4)_" " | 
|---|
| 24 | S X=X_$S($L($$FIELD(IEN,4.6))=9:$E($$FIELD(IEN,4.6),1,5)_"-"_$E($$FIELD(IEN,4.6),6,9),1:$$FIELD(IEN,4.6)) | 
|---|
| 25 | W !,X | 
|---|
| 26 | W !!,"              FMS Name: "_$$FIELD(IEN,34.5) | 
|---|
| 27 | W !!,"       Payment ADDRESS: "_$$FIELD(IEN,17.3) | 
|---|
| 28 | W !,SPACE_$$FIELD(IEN,17.4) | 
|---|
| 29 | W:$$FIELD(IEN,17.5)]"" !,SPACE_$$FIELD(IEN,17.5) | 
|---|
| 30 | W:$$FIELD(IEN,17.6)]"" !,SPACE_$$FIELD(IEN,17.6) | 
|---|
| 31 | S X=SPACE | 
|---|
| 32 | S:$$FIELD(IEN,17.7)]"" X=X_$$FIELD(IEN,17.7)_", " | 
|---|
| 33 | S:$$FIELD(IEN,17.8)]"" X=X_$$FIELD(IEN,17.8)_" " | 
|---|
| 34 | S X=X_$S($L($$FIELD(IEN,17.9))=9:$E($$FIELD(IEN,17.9),1,5)_"-"_$E($$FIELD(IEN,17.9),6,9),1:$$FIELD(IEN,17.9)) | 
|---|
| 35 | W !,X | 
|---|
| 36 | W !!,"PAYMENT CONTACT PERSON: "_$$FIELD(IEN,17) | 
|---|
| 37 | W !,"  PAYMENT PHONE NUMBER: "_$$FIELD(IEN,7.2) | 
|---|
| 38 | W ! | 
|---|
| 39 | S DIR(0)="E" | 
|---|
| 40 | D ^DIR | 
|---|
| 41 | K DIR | 
|---|
| 42 | W ! | 
|---|
| 43 | G:Y'=1 REVEXIT | 
|---|
| 44 | W @IOF | 
|---|
| 45 | W !!,"           VENDOR NAME: "_$$FIELD(IEN,.01) | 
|---|
| 46 | W ?70,"PAGE: 2" | 
|---|
| 47 | W !!,"       FMS VENDOR CODE: "_$$FIELD(IEN,34) | 
|---|
| 48 | W !,"          ALT-ADDR-IND: "_$$FIELD(IEN,35) | 
|---|
| 49 | W !,"            TAX ID/SSN: "_$$FIELD(IEN,38) | 
|---|
| 50 | W !,"        SSN/TAX ID IND: "_$$FIELD(IEN,39) | 
|---|
| 51 | W !!,"        NON-RECURRING/" | 
|---|
| 52 | W !,"      RECURRUNG VENDOR: "_$$FIELD(IEN,36) | 
|---|
| 53 | W !!," 1099 VENDOR INDICATOR: "_$$FIELD(IEN,41) | 
|---|
| 54 | W !,"           VENDOR TYPE: "_$$FIELD(IEN,44) | 
|---|
| 55 | W !,"      DUN & BRADSTREET: "_$$FIELD(IEN,18.3) | 
|---|
| 56 | W ! | 
|---|
| 57 | S DIR(0)="E" | 
|---|
| 58 | S DIR("A")="Enter RETURN to continue" | 
|---|
| 59 | D ^DIR | 
|---|
| 60 | K DIR | 
|---|
| 61 | REVEXIT S VALMBCK="R",VALMBG=1 | 
|---|
| 62 | REVQ Q | 
|---|
| 63 | ; | 
|---|
| 64 | EDIT ;EDIT THIS VENDOR | 
|---|
| 65 | N PRCOI,PRCOIN,IEN | 
|---|
| 66 | D EN^VALM2(XQORNOD(0),"OS") | 
|---|
| 67 | S PRCOI=0 | 
|---|
| 68 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ | 
|---|
| 69 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI)) | 
|---|
| 70 | S IEN=+$P(PRCOIN,U,2) | 
|---|
| 71 | D FULL^VALM1 | 
|---|
| 72 | W @IOF | 
|---|
| 73 | S NAME=$P($G(^PRC(440,IEN,0)),U) | 
|---|
| 74 | W:NAME]"" !!,NAME | 
|---|
| 75 | D HILO^PRCFQ | 
|---|
| 76 | S (DA,PRCFA("VEND"))=IEN D INFO^PRCFAC3 K PRCTMP D DOIT | 
|---|
| 77 | G:$D(DIRUT)!(Y'=1) EDITEX | 
|---|
| 78 | D SCREEN | 
|---|
| 79 | L +^PRC(440,DA):5 E  W !,$C(7),"Another user is editing this entry!" G EDITEX | 
|---|
| 80 | ;K ^PRC(440.3,DA) S %X="^PRC(440,DA,",%Y="^PRC(440.3,DA," D %XY^%RCR | 
|---|
| 81 | S DIE="^PRC(440,",DR="[PRCF FMS VENEDIT1B]" | 
|---|
| 82 | D ^DIE K DIE,DR,ORDER | 
|---|
| 83 | L -^PRC(440,PRCFA("VEND")) | 
|---|
| 84 | EDITEX S VALMBCK="R",VALMBG=1 | 
|---|
| 85 | ;   SEND VENDOR UPDATE INFORMATION TO DYNAMED   **81** | 
|---|
| 86 | I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1)=1,$D(IEN) D ONECHK^PRCVNDR(PRCFA("VEND")) | 
|---|
| 87 | Q | 
|---|
| 88 | ; | 
|---|
| 89 | SEND ;SEND THIS VRQ TO AUSTIN | 
|---|
| 90 | N PRCOI,PRCOIN,IEN | 
|---|
| 91 | D EN^VALM2(XQORNOD(0),"OS") | 
|---|
| 92 | S PRCOI=0 | 
|---|
| 93 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ | 
|---|
| 94 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI)) | 
|---|
| 95 | S IEN=+$P(PRCOIN,U,2) | 
|---|
| 96 | D SEND^PRCHE1(IEN) | 
|---|
| 97 | D INIT^PRCORV | 
|---|
| 98 | S VALMBCK="R",VALMBG=1 | 
|---|
| 99 | Q | 
|---|
| 100 | ; | 
|---|
| 101 | DELETE ;DELETE THIS VENDOR REQUEST FROM THE LOCAL IFCAP SYSTEM | 
|---|
| 102 | N PRCOI,PRCOIN,IEN,VRQ,COUNT | 
|---|
| 103 | D EN^VALM2(XQORNOD(0),"OS") | 
|---|
| 104 | S PRCOI=0 | 
|---|
| 105 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ | 
|---|
| 106 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI)) | 
|---|
| 107 | S IEN=+$P(PRCOIN,U,2) | 
|---|
| 108 | S NAME=$P($G(^PRC(440,IEN,0)),U) | 
|---|
| 109 | S DIR("A")="Do you want to delete "_NAME_" (YES/NO)" | 
|---|
| 110 | S DIR(0)="Y" | 
|---|
| 111 | S DIR("B")="NO" | 
|---|
| 112 | D ^DIR | 
|---|
| 113 | K DIR | 
|---|
| 114 | G:Y'=1 NODELETE | 
|---|
| 115 | S VRQ=$O(^PRCF(422.2,"B","123-VRQ-01",0)) | 
|---|
| 116 | S COUNT=$P(^PRCF(422.2,VRQ,0),U,2),COUNT=$S(COUNT-1>0:COUNT-1,1:0),$P(^PRCF(422.2,VRQ,0),U,2)=COUNT | 
|---|
| 117 | K ^PRC(440.3,"AD",IEN,IEN) | 
|---|
| 118 | K ^PRC(440.3,IEN) | 
|---|
| 119 | D INIT^PRCORV | 
|---|
| 120 | NODELETE S VALMBCK="R",VALMBG=1 | 
|---|
| 121 | Q | 
|---|
| 122 | ; | 
|---|
| 123 | FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD | 
|---|
| 124 | ;FOR RECORD 'IEN' FROM FILE 440.3 | 
|---|
| 125 | S FIELD=$G(PRCORVP(440,IEN,FIELD,"E")) | 
|---|
| 126 | Q FIELD | 
|---|
| 127 | ; | 
|---|
| 128 | DOIT ;FIND OUT IF USER WANTS TO EDIT VENDOR RECORD | 
|---|
| 129 | W ! | 
|---|
| 130 | S DIR(0)="Y" | 
|---|
| 131 | S DIR("A")="Edit the payment information on Vendor record" | 
|---|
| 132 | S DIR("B")="YES" | 
|---|
| 133 | S DIR("?")="Enter 'NO' or 'N' or '^' to exit this edit session." | 
|---|
| 134 | S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue." | 
|---|
| 135 | D ^DIR | 
|---|
| 136 | K DIR | 
|---|
| 137 | W ! | 
|---|
| 138 | Q | 
|---|
| 139 | ; | 
|---|
| 140 | SCREEN ; Control screen display | 
|---|
| 141 | I $D(IOF) W @IOF | 
|---|
| 142 | HDR ; Write Option Header | 
|---|
| 143 | I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM,! | 
|---|
| 144 | Q | 
|---|