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

PRCOVL.m

Go to the documentation of this file.
  1. PRCOVL ;WISC/DKM/BGJ-IFCAP AR VENDOR EDIT ROUTINE ;[10/19/98 2:36pm]
  1. V ;;5.1;IFCAP;**7**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point for PRCO VENDOR EDIT FOR AR
  1. ; FIRST LETS SEE IF THERE ARE ANY VENDOR RECORDS TO EDIT.
  1. S COUNT=$O(^PRCF(422.2,"B","AR-EDIT-01",0)) G:COUNT'>0 NONE
  1. S COUNT=$P($G(^PRCF(422.2,COUNT,0)),U,2) G:COUNT'>0 NONE
  1. K COUNT
  1. ;
  1. ; GET TERMINAL ATTRIBUTES.
  1. ;
  1. I '$D(IOF)!('$G(IOST(0))) S IOP="HOME" D ^%ZIS K IOP
  1. S X="IORVON;IORVOFF" D ENDR^%ZISS
  1. S PRCO("RV1")=$G(IORVON),PRCO("RV0")=$G(IORVOFF)
  1. S PRCO("XY")="N DX,DY S (DX,DY)=0 "_$G(^%ZOSF("XY"))
  1. D EN^VALM("PRCO VENDOR EDIT FOR AR")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="Edit vendor selected by AR user"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K ^TMP("PRCOVL",$J)
  1. S LOST=0
  1. S NAME=""
  1. I $O(^PRC(440.3,"AE",NAME))="" W !,"No Vendor records to edit." G NONE
  1. INITA D CLEAN^VALM10
  1. S COUNT=0
  1. S LINENO=0
  1. S NAME=""
  1. F S NAME=$O(^PRC(440.3,"AE",NAME)) Q:NAME="" D
  1. . S LIST=0
  1. . F S LIST=$O(^PRC(440.3,"AE",NAME,LIST)) Q:LIST="" D
  1. . . S NAME=$S($G(NAME)]"":NAME,1:$P($G(^PRC(440,LIST,0)),U)) Q:NAME=""
  1. . . I $G(^PRC(440.3,LIST,"AR"))']"" D Q
  1. . . . K ^PRC(440.3,LIST)
  1. . . . K ^PRC(440.3,"AD",NAME,LIST,LIST)
  1. . . . K ^PRC(440.3,"AE",NAME,LIST,LIST)
  1. . . . Q
  1. . . S VDA=0
  1. . . F S VDA=$O(^PRC(440.3,"AE",NAME,LIST,VDA)) Q:VDA="" D
  1. . . . S COUNT=COUNT+1
  1. . . . S SENT=$P($G(^PRC(440.3,VDA,"AR")),U,5)
  1. . . . S OK=$P($G(^PRC(440.3,VDA,"AR")),U,4)
  1. . . . S TAX=$P($G(^PRC(440,VDA,3)),U,8)
  1. . . . S X=$$SETFLD^VALM1(COUNT,"","NUMBER")
  1. . . . S X=$$SETFLD^VALM1(NAME,X,"VENDOR")
  1. . . . S X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
  1. . . . S X=$$SETFLD^VALM1(OK,X,"OK")
  1. . . . S X=$$SETFLD^VALM1(SENT,X,"SENT")
  1. . . . S LINENO=LINENO+1
  1. . . . D SET^VALM10(COUNT,X,LINENO)
  1. . . . S ^TMP("PRCOVL",$J,LINENO)=COUNT_"^"_LIST
  1. . . . Q
  1. . . Q
  1. . Q
  1. S VALMCNT=COUNT
  1. S LN=$O(^PRCF(422.2,"B","AR-EDIT-01",0))
  1. S $P(^PRCF(422.2,LN,0),U,2)=COUNT
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. NONE ; COME HERE IF THERE ARE NO VENDOR RECORDS TO EDIT.
  1. W !!,"There are no vendor records to edit at this time."
  1. NONE1 S DIR(0)="E"
  1. S DIR("A")="Enter RETURN to continue"
  1. D ^DIR
  1. K DIR
  1. Q
  1. ;
  1. REV ;COMPLETE REVIEW OF VENDOR ENTRY
  1. N SPACE,VALMY,IEN,PRCOI,PRCOIN,DIC,DA,DR,DIQ,DIR,Y
  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("PRCOVL",$J,PRCOI))
  1. S IEN=+$P(PRCOIN,U,2)
  1. D FULL^VALM1
  1. REV1 W @IOF
  1. K PRCORVP
  1. S DIC="^PRC(440,",DA=IEN,DR=".01:46",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=" City,State,ZIP: "
  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 !," "_$$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=" * City,State,ZIP: "
  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. W !," * = REQUIRED FIELD"
  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 !
  1. W !," * = REQUIRED FIELD"
  1. W !
  1. S DIR(0)="E"
  1. S DIR("A")="Enter RETURN to continue"
  1. D ^DIR
  1. K DIR
  1. REVEXIT I $G(RETURN)=961 G REVQ
  1. S VALMBCK="R",VALMBG=1
  1. REVQ 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. EDIT ;EDIT THIS VENDOR
  1. N PRCOI,PRCOIN,IEN,RETURN
  1. D EN^VALM2(XQORNOD(0),"OS")
  1. S PRCOI=0
  1. S PRCOI=$O(VALMY(PRCOI))
  1. G:'PRCOI REVQ
  1. S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
  1. S IEN=+$P(PRCOIN,U,2)
  1. S SENT=$P($G(^PRC(440.3,IEN,"AR")),U,5)
  1. I SENT]"" W !!,"This record has already been sent to Austin or FISCAL." D NONE1 G EDITEX
  1. D FULL^VALM1
  1. W @IOF
  1. S NAME=$P($G(^PRC(440,IEN,0)),U)
  1. W:NAME]"" !!?11,"Vendor Name: "_NAME
  1. D HILO^PRCFQ
  1. S (DA,PRCFA("VEND"))=IEN
  1. W !
  1. S DIR(0)="Y"
  1. S DIR("A")="Review the vendor selected"
  1. S DIR("B")="YES"
  1. D ^DIR
  1. K DIR
  1. W !
  1. G:$D(DIRUT) EDITEX
  1. I +Y=1 SET RETURN=961 D REV1 W @IOF
  1. K PRCTMP,RETURN
  1. 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. S DIE="^PRC(440,"
  1. S DR=$S(LOCAT="S":"[PRCHVENDOR]",1:"[PRCF FMS VENEDIT1B]")
  1. D ^DIE
  1. K DIE,DR,ORDER
  1. S ARFLG=$G(^PRC(440.3,PRCFA("VEND"),"AR"))
  1. S IEN=$P(ARFLG,U,2)
  1. S PRC("SITE")=$P(ARFLG,U,3)
  1. S FLAG=$P(ARFLG,U)
  1. S SAVE=$$CHECK^PRCOVTST(IEN,PRC("SITE"),FLAG)
  1. S SAVE1=$S(SAVE=0:"OK",SAVE=2:"GOOD",1:"")
  1. S TAX=$P($G(^PRC(440,IEN,3)),U,8)
  1. S DA=IEN
  1. S DIE="^PRC(440.3,"
  1. S DR=$S(SAVE=0:"53///^S X=SAVE1",SAVE=2:"53///^S X=SAVE1",1:"53///@")
  1. D ^DIE
  1. S X=@VALMAR@(PRCOI,0)
  1. S OK=$S(SAVE=0:"OK",1:"")
  1. S X=$$SETFLD^VALM1(OK,X,"OK")
  1. S X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
  1. S @VALMAR@(PRCOI,0)=X
  1. L -^PRC(440,PRCFA("VEND"))
  1. EDITEX S VALMBCK="R",VALMBG=1
  1. Q
  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 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. ; Write Option Header
  1. I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM,!
  1. Q