[613] | 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
|
---|