PRCOVL1 ;WISC/DJM/BGJ-IFCAP AR VENDOR EDIT ROUTINE CONTINUED ;[10/19/98 12:05pm]
V ;;5.1;IFCAP;**7**;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
PRINT ;PRINTING A COMPLETE REVIEW OF VENDOR ENTRY
 ;
 N %ZIS,AA,POP
 D EN^VALM2(XQORNOD(0),"O")
 Q:'$D(VALMY)
 D FULL^VALM1
 W @IOF
 K IO("Q")
 S %ZIS="MQ",%ZIS("A")="Select a printer: ",%ZIS("B")=""
 S %ZIS("S")="S AA=$G(^%ZIS(1,Y,""SUBTYPE"")) I AA>0,$E($G(^%ZIS(2,AA,0)),1)=""P"""
 D ^%ZIS
 I POP W !!," No printer selected -- quitting." G PRINTQ
 I $D(IO("Q")) K IO("Q") D  G PRINTQ
 .  S ZTRTN="PRINT1^PRCOVL1"
 .  S ZTSAVE("VALMY(")=""
 .  S ZTSAVE("^TMP(""PRCOVL1"",$J,")=""
 .  S ZTDESC="Complete review of vender entry"
 .  D ^%ZTLOAD
 .  Q
 ;
PRINT1 ;ENTER HERE TO PRINT THE REPORT
 N DIC,DA,DIQ,SPACE,%,%H,%I,X,Y,FIELD,PN,PRCOI,PRCOIN,IEN
 S (PRCOI,PN)=0
 ;GET THE IEN FOR EACH ENTRY SELECTED
 F  S PRCOI=$O(VALMY(PRCOI)) Q:PRCOI'>0  D
 .  S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
 .  S IEN=+$P(PRCOIN,U,2)
 .  S PN=PN+1
 .  D PRINT2
 G PRINTQ
 ;
PRINT2 ;PRINT EACH ENTRY SELECTED HERE
 K PRCOVL1
 S DIC="^PRC(440,",DA=IEN,DR=".01:46",DIQ="PRCOVL1",DIQ(0)="E"
 D EN^DIQ1
 S $P(SPACE," ",24)=" "
 U IO
 W:$Y>0 @IOF
 I $D(ZTQUEUED) W:PN>1 !
 W !!,?9,"VENDOR Review"
 W ?38
 D NOW^%DTC
 D YX^%DTC
 W Y
 W ?70,"PAGE: "_PN
 W !!,?11,"Vendor Name: "_$$FIELD(IEN,.01)
 W !,?6,"Ordering Address: "_$$FIELD(IEN,1)
 W:$$FIELD(IEN,2)]"" !,SPACE_$$FIELD(IEN,2)
 S X="        City,State,ZIP: "
 S:$$FIELD(IEN,4.2)]"" X=X_$$FIELD(IEN,4.2)_", "
 S:$$FIELD(IEN,4.4)]"" X=X_$$FIELD(IEN,4.4)_" "
 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))
 W !,X
 W !!,"              FMS Name: "_$$FIELD(IEN,34.5)
 W !!," *     Payment ADDRESS: "_$$FIELD(IEN,17.3)
 W !,SPACE,$$FIELD(IEN,17.4)
 W:$$FIELD(IEN,17.5)]"" !,SPACE_$$FIELD(IEN,17.5)
 W:$$FIELD(IEN,17.6)]"" !,SPACE_$$FIELD(IEN,17.6)
 S X=" *      City,State,ZIP: "
 S:$$FIELD(IEN,17.7)]"" X=X_$$FIELD(IEN,17.7)_", "
 S:$$FIELD(IEN,17.8)]"" X=X_$$FIELD(IEN,17.8)_" "
 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))
 W !,X
 W !!,"PAYMENT CONTACT PERSON: "_$$FIELD(IEN,17)
 W !,"  PAYMENT PHONE NUMBER: "_$$FIELD(IEN,7.2)
 W !!,?7,"FMS VENDOR CODE: "_$$FIELD(IEN,34)
 W !,?10,"ALT-ADDR-IND: "_$$FIELD(IEN,35)
 W !," *          TAX ID/SSN: "_$$FIELD(IEN,38)
 W !," *      SSN/TAX ID IND: "_$$FIELD(IEN,39)
 W !!,?8,"NON-RECURRING/"
 W !,?6,"RECURRING VENDOR: "_$$FIELD(IEN,36)
 W !!," 1099 VENDOR INDICATOR: "_$$FIELD(IEN,41)
 W !," *         VENDOR TYPE: "_$$FIELD(IEN,44)
 W !,?6,"DUN & BRADSTREET: "_$$FIELD(IEN,18.3)
 W !!,"    * = REQUIRED FIELD"
 Q
 ;
PRINTQ S VALMBCK="R",VALMBG=1
 S:$D(ZTQUEUED) ZTREQ="@"
 D ^%ZISC
PRINTQ1 Q
 ;
FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD
 ;FOR RECORD 'IEN' FROM FILE 440
 S FIELD=$G(PRCOVL1(440,IEN,FIELD,"E"))
 Q FIELD
 Q
 ;
VRQ ; SEND THIS ENTRY TO VRQ REVIEW OR AUSTIN, AS NEEDED.
 ; DO THIS ONLY FOR THOSE RECORDS IN THE "AR" NODE THAT ARE SET
 ; TO "OK" IN THE OK FIELD (#53).
 D EN^VALM2(XQORNOD(0),"OS")
 S PRCOI=0
 S PRCOI=$O(VALMY(PRCOI))
 G:'PRCOI VRQEX
 S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
 S IEN=+$P(PRCOIN,U,2)
 K PRCORVP
 S DIC="^PRC(440.3,"
 S DA=IEN
 S DR="50:54"
 S DIQ="PRCORVP"
 S DIQ(0)="E"
 D EN^DIQ1
 S OK=$$FIELD1(IEN,53)
 I OK="GOOD" W !!,"This record in now properly vendorized.  You may delete it." D PAUSE G VRQEX
 S SENT=$$FIELD1(IEN,54)
 I SENT]"" W !!,"This record is sent.  It needs to be removed." D PAUSE G VRQEX
 I OK'="OK" W !,"This entry can not become a VRQ yet.  Re-edit it." D PAUSE G VRQEX
 S SITE=$$FIELD1(IEN,52)
 S FISCAL=$G(^PRC(411,SITE,9))
 I $P(FISCAL,U,3)="Y" D  D ADD G VRQEX
 .  S FLAG=1
 .  S DIE="^PRC(440.3,"
 .  S SENT="SENT"
 .  S DR="47///^S X=FLAG;48///^S X=IEN;49///^S X=SITE;54///^S X=SENT"
 .  D ^DIE
 .  Q
 ;
 ; SINCE THIS VENDOR WON'T BE REVIEWED BY FISCAL LETS SEND THE VRQ
 ; TO AUSTIN.
 ;
 D VRQS^PRCOVTST(IEN,SITE)
 S DIE="^PRC(440.3,"
 S SENT="SENT"
 S DR="54///^S X=SENT"
 D ^DIE
 D ADD
 ;
VRQEX ; NOW THAT THE VRQ IS SENT LETS EXIT THIS PROTOCOL
 S VALMBCK="R",VALMBG=1
 Q
 ;
ADD ; UPDATE LIST MANAGER LINE NOTEING THAT THIS RECORD WAS SENT.
 ;
 S X=@VALMAR@(PRCOI,0)
 S SENT="SENT"
 S X=$$SETFLD^VALM1(SENT,X,"SENT")
 S @VALMAR@(PRCOI,0)=X
 Q
 ;
PAUSE ; LET USER READ MESSAGE, THEN CONTINUE.
 S DIR(0)="E"
 S DIR("A")="Enter RETURN to continue"
 D ^DIR
 K DIR
 Q
 ;
FIELD1(IEN,FIELD) ;
 ; FETCH EXTERNAL VALUE OF FIELD.
 ; FOR RECORD 'IEN' FROM FILE 440.3.
 S FIELD=$G(PRCORVP(440.3,IEN,FIELD,"E"))
 Q FIELD
 ;
OUT ; REMOVE ONE RECORD FROM THE 'AR EDIT LIST'.
 D EN^VALM2(XQORNOD(0),"OS")
 S PRCOI=0
 S PRCOI=$O(VALMY(PRCOI))
 G:'PRCOI VRQEX
 S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
 S IEN=+$P(PRCOIN,U,2)
 S OK=$P($G(^PRC(440.3,IEN,"AR")),U,4)
 G:OK="GOOD" OUT1
 I OK="" W !!,"This record needs to be edited first." D PAUSE G VRQEX
 S SENT=$P($G(^PRC(440.3,IEN,"AR")),U,5)
 I SENT="" W !!,"This record needs to be sent first." D PAUSE G VRQEX
OUT1 S FLAG=1
 S DIE="^PRC(440.3,"
 S DA=IEN
 S DR="50///@;51///@;52///@;53///@;54///@"
 D ^DIE
 S OUT=$O(^PRCF(422.2,"B","AR-EDIT-01",0))
 S COUNT=$P(^PRCF(422.2,OUT,0),U,2)
 S COUNT=$S(COUNT-1>0:COUNT-1,1:0)
 S $P(^PRCF(422.2,OUT,0),U,2)=COUNT
 I OK="GOOD" K ^PRC(440.3,IEN)
 D INITA^PRCOVL
 G VRQEX