Routine: PRCOVL1

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"

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

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

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

PAUSE ; LET USER READ MESSAGE, THEN CONTINUE.

 S DIR(0)="E"

 S DIR("A")="Enter RETURN to continue"

 D ^DIR

 K DIR

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  Feb 18, 2025@23:38:43                                                                                                                                                                                                     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

PRCOVL1.m