183 lines
5.2 KiB
Mathematica
183 lines
5.2 KiB
Mathematica
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
|