Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCORV1

PRCORV1.m

Go to the documentation of this file. 
  1. PRCORV1 ;WISC/DJM/BGJ/AS-IFCAP VRQ REVIEW ROUTINE, CONTINUED ;2/17/22  12:13
  1. V ;;5.1;IFCAP;**7,81,227**;Oct 20, 2000;Build 1
  1.  ;Per VHA Directive 6402, this routine should not be modified.
  1. REV ;COMPLETE REVIEW OF VENDOR ENTRY
  1.  N SPACE,VALMY,IEN,PRCOI,PRCOIN,DIC,DA,DR,DIQ,DIR,Y,X
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  S PRCOI=0
  1.  S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
  1.  S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
  1.  S IEN=+$P(PRCOIN,U,2)
  1.  D FULL^VALM1
  1.  W @IOF
  1.  K PRCORVP
  1.  S DIC="^PRC(440,",DA=IEN,DR=".01:55",DIQ="PRCORVP",DIQ(0)="E"
  1.  D EN^DIQ1
  1.  S $P(SPACE," ",24)=" "
  1.  W !!,"           Vendor Name: "_$$FIELD(IEN,.01)
  1.  W ?70,"PAGE: 1"
  1.  W !,"      Ordering Address: "_$$FIELD(IEN,1)
  1.  W:$$FIELD(IEN,2)]"" !,SPACE_$$FIELD(IEN,2)
  1.  S X=SPACE
  1.  S:$$FIELD(IEN,4.2)]"" X=X_$$FIELD(IEN,4.2)_", "
  1.  S:$$FIELD(IEN,4.4)]"" X=X_$$FIELD(IEN,4.4)_" "
  1.  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))
  1.  W !,X
  1.  W !!,"              FMS Name: "_$$FIELD(IEN,34.5)
  1.  W !!,"       Payment ADDRESS: "_$$FIELD(IEN,17.3)
  1.  W !,SPACE_$$FIELD(IEN,17.4)
  1.  W:$$FIELD(IEN,17.5)]"" !,SPACE_$$FIELD(IEN,17.5)
  1.  W:$$FIELD(IEN,17.6)]"" !,SPACE_$$FIELD(IEN,17.6)
  1.  S X=SPACE
  1.  S:$$FIELD(IEN,17.7)]"" X=X_$$FIELD(IEN,17.7)_", "
  1.  S:$$FIELD(IEN,17.8)]"" X=X_$$FIELD(IEN,17.8)_" "
  1.  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))
  1.  W !,X
  1.  W !!,"PAYMENT CONTACT PERSON: "_$$FIELD(IEN,17)
  1.  W !,"  PAYMENT PHONE NUMBER: "_$$FIELD(IEN,7.2)
  1.  W !
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  K DIR
  1.  W !
  1.  G:Y'=1 REVEXIT
  1.  W @IOF
  1.  W !!,"          VENDOR NAME: "_$$FIELD(IEN,.01)
  1.  W ?70,"PAGE: 2"
  1.  W !!,"      FMS VENDOR CODE: "_$$FIELD(IEN,34)
  1.  W !,"          ALT-ADDR-IND: "_$$FIELD(IEN,35)
  1.  W !,"            TAX ID/SSN: "_$$FIELD(IEN,38)
  1.  W !,"        SSN/TAX ID IND: "_$$FIELD(IEN,39)
  1.  W !!,"        NON-RECURRING/"
  1.  W !,"      RECURRUNG VENDOR: "_$$FIELD(IEN,36)
  1.  W !!,"1099 VENDOR INDICATOR: "_$$FIELD(IEN,41)
  1.  W !,"           VENDOR TYPE: "_$$FIELD(IEN,44)
  1.  W !,"      DUN & BRADSTREET: "_$$FIELD(IEN,18.3)
  1.  W !,"                   UEI: "_$$FIELD(IEN,55)
  1.  W !
  1.  S DIR(0)="E"
  1.  S DIR("A")="Enter RETURN to continue"
  1.  D ^DIR
  1.  K DIR
  1. REVEXIT S VALMBCK="R",VALMBG=1
  1. REVQ Q
  1.  ;
  1. EDIT ;EDIT THIS VENDOR
  1.  N PRCOI,PRCOIN,IEN,DIRUT,NAME,PRCFA
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  S PRCOI=0
  1.  S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
  1.  S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
  1.  S IEN=+$P(PRCOIN,U,2)
  1.  D FULL^VALM1
  1.  W @IOF
  1.  S NAME=$P($G(^PRC(440,IEN,0)),U)
  1.  W:NAME]"" !!,NAME
  1.  D HILO^PRCFQ
  1.  S (DA,PRCFA("VEND"))=IEN D INFO^PRCFAC3 K PRCTMP D DOIT
  1.  G:$D(DIRUT)!(Y'=1) EDITEX
  1.  D SCREEN
  1.  L +^PRC(440,DA):5 E  W !,$C(7),"Another user is editing this entry!" G EDITEX
  1.  ;K ^PRC(440.3,DA) S %X="^PRC(440,DA,",%Y="^PRC(440.3,DA," D %XY^%RCR
  1.  S DIE="^PRC(440,",DR="[PRCF FMS VENEDIT1B]"
  1.  D ^DIE K DIE,DR,ORDER
  1.  L -^PRC(440,PRCFA("VEND"))
  1. EDITEX S VALMBCK="R",VALMBG=1
  1.  ;   SEND VENDOR UPDATE INFORMATION TO DYNAMED   **81**
  1.  I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1)=1,$D(IEN) D ONECHK^PRCVNDR(PRCFA("VEND"))
  1.  Q
  1.  ;
  1. SEND ;SEND THIS VRQ TO AUSTIN
  1.  N PRCOI,PRCOIN,IEN
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  S PRCOI=0
  1.  S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
  1.  S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
  1.  S IEN=+$P(PRCOIN,U,2)
  1.  D SEND^PRCHE1(IEN)
  1.  D INIT^PRCORV
  1.  S VALMBCK="R",VALMBG=1
  1.  Q
  1.  ;
  1. DELETE ;DELETE THIS VENDOR REQUEST FROM THE LOCAL IFCAP SYSTEM
  1.  N PRCOI,PRCOIN,IEN,VRQ,COUNT
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  S PRCOI=0
  1.  S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
  1.  S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
  1.  S IEN=+$P(PRCOIN,U,2)
  1.  S NAME=$P($G(^PRC(440,IEN,0)),U)
  1.  S DIR("A")="Do you want to delete "_NAME_" (YES/NO)"
  1.  S DIR(0)="Y"
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  K DIR
  1.  G:Y'=1 NODELETE
  1.  S VRQ=$O(^PRCF(422.2,"B","123-VRQ-01",0))
  1.  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
  1.  K ^PRC(440.3,"AD",IEN,IEN)
  1.  K ^PRC(440.3,IEN)
  1.  D INIT^PRCORV
  1. NODELETE S VALMBCK="R",VALMBG=1
  1.  Q
  1.  ;
  1. FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD
  1.  ;FOR RECORD 'IEN' FROM FILE 440.3
  1.  S FIELD=$G(PRCORVP(440,IEN,FIELD,"E"))
  1.  Q FIELD
  1.  ;
  1. DOIT ;FIND OUT IF USER WANTS TO EDIT VENDOR RECORD
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Edit the payment information on Vendor record"
  1.  S DIR("B")="YES"
  1.  S DIR("?")="Enter 'NO' or 'N' or '^' to exit this edit session."
  1.  S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue."
  1.  D ^DIR
  1.  K DIR
  1.  W !
  1.  Q
  1.  ;
  1. SCREEN ; Control screen display
  1.  I $D(IOF) W @IOF
  1. HDR ; Write Option Header
  1.  I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM,!
  1.  Q