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