| 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
 | 
|---|