PRCOVL ;WISC/DKM/BGJ-IFCAP AR VENDOR EDIT ROUTINE ;[10/19/98 2:36pm]
V ;;5.1;IFCAP;**7**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- main entry point for PRCO VENDOR EDIT FOR AR
; FIRST LETS SEE IF THERE ARE ANY VENDOR RECORDS TO EDIT.
S COUNT=$O(^PRCF(422.2,"B","AR-EDIT-01",0)) G:COUNT'>0 NONE
S COUNT=$P($G(^PRCF(422.2,COUNT,0)),U,2) G:COUNT'>0 NONE
K COUNT
;
; GET TERMINAL ATTRIBUTES.
;
I '$D(IOF)!('$G(IOST(0))) S IOP="HOME" D ^%ZIS K IOP
S X="IORVON;IORVOFF" D ENDR^%ZISS
S PRCO("RV1")=$G(IORVON),PRCO("RV0")=$G(IORVOFF)
S PRCO("XY")="N DX,DY S (DX,DY)=0 "_$G(^%ZOSF("XY"))
D EN^VALM("PRCO VENDOR EDIT FOR AR")
Q
;
HDR ; -- header code
S VALMHDR(1)="Edit vendor selected by AR user"
Q
;
INIT ; -- init variables and list array
K ^TMP("PRCOVL",$J)
S LOST=0
S NAME=""
I $O(^PRC(440.3,"AE",NAME))="" W !,"No Vendor records to edit." G NONE
INITA D CLEAN^VALM10
S COUNT=0
S LINENO=0
S NAME=""
F S NAME=$O(^PRC(440.3,"AE",NAME)) Q:NAME="" D
. S LIST=0
. F S LIST=$O(^PRC(440.3,"AE",NAME,LIST)) Q:LIST="" D
. . S NAME=$S($G(NAME)]"":NAME,1:$P($G(^PRC(440,LIST,0)),U)) Q:NAME=""
. . I $G(^PRC(440.3,LIST,"AR"))']"" D Q
. . . K ^PRC(440.3,LIST)
. . . K ^PRC(440.3,"AD",NAME,LIST,LIST)
. . . K ^PRC(440.3,"AE",NAME,LIST,LIST)
. . . Q
. . S VDA=0
. . F S VDA=$O(^PRC(440.3,"AE",NAME,LIST,VDA)) Q:VDA="" D
. . . S COUNT=COUNT+1
. . . S SENT=$P($G(^PRC(440.3,VDA,"AR")),U,5)
. . . S OK=$P($G(^PRC(440.3,VDA,"AR")),U,4)
. . . S TAX=$P($G(^PRC(440,VDA,3)),U,8)
. . . S X=$$SETFLD^VALM1(COUNT,"","NUMBER")
. . . S X=$$SETFLD^VALM1(NAME,X,"VENDOR")
. . . S X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
. . . S X=$$SETFLD^VALM1(OK,X,"OK")
. . . S X=$$SETFLD^VALM1(SENT,X,"SENT")
. . . S LINENO=LINENO+1
. . . D SET^VALM10(COUNT,X,LINENO)
. . . S ^TMP("PRCOVL",$J,LINENO)=COUNT_"^"_LIST
. . . Q
. . Q
. Q
S VALMCNT=COUNT
S LN=$O(^PRCF(422.2,"B","AR-EDIT-01",0))
S $P(^PRCF(422.2,LN,0),U,2)=COUNT
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
NONE ; COME HERE IF THERE ARE NO VENDOR RECORDS TO EDIT.
W !!,"There are no vendor records to edit at this time."
NONE1 S DIR(0)="E"
S DIR("A")="Enter RETURN to continue"
D ^DIR
K DIR
Q
;
REV ;COMPLETE REVIEW OF VENDOR ENTRY
N SPACE,VALMY,IEN,PRCOI,PRCOIN,DIC,DA,DR,DIQ,DIR,Y
D EN^VALM2(XQORNOD(0),"OS")
S PRCOI=0
S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
S IEN=+$P(PRCOIN,U,2)
D FULL^VALM1
REV1 W @IOF
K PRCORVP
S DIC="^PRC(440,",DA=IEN,DR=".01:46",DIQ="PRCORVP",DIQ(0)="E"
D EN^DIQ1
S $P(SPACE," ",24)=" "
W !!," Vendor Name: "_$$FIELD(IEN,.01)
W ?70,"PAGE: 1"
W !," 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 !," "_$$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 !
W !," * = REQUIRED FIELD"
W !
S DIR(0)="E"
D ^DIR
K DIR
W !
G:Y'=1 REVEXIT
W @IOF
W !!," Vendor Name: "_$$FIELD(IEN,.01)
W ?70,"PAGE: 2"
W !!," FMS VENDOR CODE: "_$$FIELD(IEN,34)
W !," ALT-ADDR-IND: "_$$FIELD(IEN,35)
W !," * TAX ID/SSN: "_$$FIELD(IEN,38)
W !," * SSN/TAX ID IND: "_$$FIELD(IEN,39)
W !!," NON-RECURRING/"
W !," RECURRUNG VENDOR: "_$$FIELD(IEN,36)
W !!," 1099 VENDOR INDICATOR: "_$$FIELD(IEN,41)
W !," * VENDOR TYPE: "_$$FIELD(IEN,44)
W !," DUN & BRADSTREET: "_$$FIELD(IEN,18.3)
W !
W !," * = REQUIRED FIELD"
W !
S DIR(0)="E"
S DIR("A")="Enter RETURN to continue"
D ^DIR
K DIR
REVEXIT I $G(RETURN)=961 G REVQ
S VALMBCK="R",VALMBG=1
REVQ Q
;
FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD
;FOR RECORD 'IEN' FROM FILE 440.3
S FIELD=$G(PRCORVP(440,IEN,FIELD,"E"))
Q FIELD
;
EDIT ;EDIT THIS VENDOR
N PRCOI,PRCOIN,IEN,RETURN
D EN^VALM2(XQORNOD(0),"OS")
S PRCOI=0
S PRCOI=$O(VALMY(PRCOI))
G:'PRCOI REVQ
S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
S IEN=+$P(PRCOIN,U,2)
S SENT=$P($G(^PRC(440.3,IEN,"AR")),U,5)
I SENT]"" W !!,"This record has already been sent to Austin or FISCAL." D NONE1 G EDITEX
D FULL^VALM1
W @IOF
S NAME=$P($G(^PRC(440,IEN,0)),U)
W:NAME]"" !!?11,"Vendor Name: "_NAME
D HILO^PRCFQ
S (DA,PRCFA("VEND"))=IEN
W !
S DIR(0)="Y"
S DIR("A")="Review the vendor selected"
S DIR("B")="YES"
D ^DIR
K DIR
W !
G:$D(DIRUT) EDITEX
I +Y=1 SET RETURN=961 D REV1 W @IOF
K PRCTMP,RETURN
D DOIT
G:$D(DIRUT)!(Y'=1) EDITEX
D SCREEN
L +^PRC(440,DA):5 E W !,$C(7),"Another user is editing this entry!" G EDITEX
S DIE="^PRC(440,"
S DR=$S(LOCAT="S":"[PRCHVENDOR]",1:"[PRCF FMS VENEDIT1B]")
D ^DIE
K DIE,DR,ORDER
S ARFLG=$G(^PRC(440.3,PRCFA("VEND"),"AR"))
S IEN=$P(ARFLG,U,2)
S PRC("SITE")=$P(ARFLG,U,3)
S FLAG=$P(ARFLG,U)
S SAVE=$$CHECK^PRCOVTST(IEN,PRC("SITE"),FLAG)
S SAVE1=$S(SAVE=0:"OK",SAVE=2:"GOOD",1:"")
S TAX=$P($G(^PRC(440,IEN,3)),U,8)
S DA=IEN
S DIE="^PRC(440.3,"
S DR=$S(SAVE=0:"53///^S X=SAVE1",SAVE=2:"53///^S X=SAVE1",1:"53///@")
D ^DIE
S X=@VALMAR@(PRCOI,0)
S OK=$S(SAVE=0:"OK",1:"")
S X=$$SETFLD^VALM1(OK,X,"OK")
S X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
S @VALMAR@(PRCOI,0)=X
L -^PRC(440,PRCFA("VEND"))
EDITEX S VALMBCK="R",VALMBG=1
Q
;
DOIT ;FIND OUT IF USER WANTS TO EDIT VENDOR RECORD
W !
S DIR(0)="Y"
S DIR("A")="Edit the Vendor record"
S DIR("B")="YES"
S DIR("?")="Enter 'NO' or 'N' or '^' to exit this edit session."
S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue."
D ^DIR
K DIR
W !
Q
;
SCREEN ; Control screen display
I $D(IOF) W @IOF
; Write Option Header
I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOVL 6653 printed Apr 09, 2024@21:11:50 Page 2
PRCOVL ;WISC/DKM/BGJ-IFCAP AR VENDOR EDIT ROUTINE ;[10/19/98 2:36pm]
V ;;5.1;IFCAP;**7**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
EN ; -- main entry point for PRCO VENDOR EDIT FOR AR
+1 ; FIRST LETS SEE IF THERE ARE ANY VENDOR RECORDS TO EDIT.
+2 SET COUNT=$ORDER(^PRCF(422.2,"B","AR-EDIT-01",0))
if COUNT'>0
GOTO NONE
+3 SET COUNT=$PIECE($GET(^PRCF(422.2,COUNT,0)),U,2)
if COUNT'>0
GOTO NONE
+4 KILL COUNT
+5 ;
+6 ; GET TERMINAL ATTRIBUTES.
+7 ;
+8 IF '$DATA(IOF)!('$GET(IOST(0)))
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+9 SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
+10 SET PRCO("RV1")=$GET(IORVON)
SET PRCO("RV0")=$GET(IORVOFF)
+11 SET PRCO("XY")="N DX,DY S (DX,DY)=0 "_$GET(^%ZOSF("XY"))
+12 DO EN^VALM("PRCO VENDOR EDIT FOR AR")
+13 QUIT
+14 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Edit vendor selected by AR user"
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("PRCOVL",$JOB)
+2 SET LOST=0
+3 SET NAME=""
+4 IF $ORDER(^PRC(440.3,"AE",NAME))=""
WRITE !,"No Vendor records to edit."
GOTO NONE
INITA DO CLEAN^VALM10
+1 SET COUNT=0
+2 SET LINENO=0
+3 SET NAME=""
+4 FOR
SET NAME=$ORDER(^PRC(440.3,"AE",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET LIST=0
+6 FOR
SET LIST=$ORDER(^PRC(440.3,"AE",NAME,LIST))
if LIST=""
QUIT
Begin DoDot:2
+7 SET NAME=$SELECT($GET(NAME)]"":NAME,1:$PIECE($GET(^PRC(440,LIST,0)),U))
if NAME=""
QUIT
+8 IF $GET(^PRC(440.3,LIST,"AR"))']""
Begin DoDot:3
+9 KILL ^PRC(440.3,LIST)
+10 KILL ^PRC(440.3,"AD",NAME,LIST,LIST)
+11 KILL ^PRC(440.3,"AE",NAME,LIST,LIST)
+12 QUIT
End DoDot:3
QUIT
+13 SET VDA=0
+14 FOR
SET VDA=$ORDER(^PRC(440.3,"AE",NAME,LIST,VDA))
if VDA=""
QUIT
Begin DoDot:3
+15 SET COUNT=COUNT+1
+16 SET SENT=$PIECE($GET(^PRC(440.3,VDA,"AR")),U,5)
+17 SET OK=$PIECE($GET(^PRC(440.3,VDA,"AR")),U,4)
+18 SET TAX=$PIECE($GET(^PRC(440,VDA,3)),U,8)
+19 SET X=$$SETFLD^VALM1(COUNT,"","NUMBER")
+20 SET X=$$SETFLD^VALM1(NAME,X,"VENDOR")
+21 SET X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
+22 SET X=$$SETFLD^VALM1(OK,X,"OK")
+23 SET X=$$SETFLD^VALM1(SENT,X,"SENT")
+24 SET LINENO=LINENO+1
+25 DO SET^VALM10(COUNT,X,LINENO)
+26 SET ^TMP("PRCOVL",$JOB,LINENO)=COUNT_"^"_LIST
+27 QUIT
End DoDot:3
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 SET VALMCNT=COUNT
+31 SET LN=$ORDER(^PRCF(422.2,"B","AR-EDIT-01",0))
+32 SET $PIECE(^PRCF(422.2,LN,0),U,2)=COUNT
+33 QUIT
+34 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
NONE ; COME HERE IF THERE ARE NO VENDOR RECORDS TO EDIT.
+1 WRITE !!,"There are no vendor records to edit at this time."
NONE1 SET DIR(0)="E"
+1 SET DIR("A")="Enter RETURN to continue"
+2 DO ^DIR
+3 KILL DIR
+4 QUIT
+5 ;
REV ;COMPLETE REVIEW OF VENDOR ENTRY
+1 NEW SPACE,VALMY,IEN,PRCOI,PRCOIN,DIC,DA,DR,DIQ,DIR,Y
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 SET PRCOI=0
+4 SET PRCOI=$ORDER(VALMY(PRCOI))
if 'PRCOI
GOTO REVQ
+5 SET PRCOIN=$GET(^TMP("PRCOVL",$JOB,PRCOI))
+6 SET IEN=+$PIECE(PRCOIN,U,2)
+7 DO FULL^VALM1
REV1 WRITE @IOF
+1 KILL PRCORVP
+2 SET DIC="^PRC(440,"
SET DA=IEN
SET DR=".01:46"
SET DIQ="PRCORVP"
SET DIQ(0)="E"
+3 DO EN^DIQ1
+4 SET $PIECE(SPACE," ",24)=" "
+5 WRITE !!," Vendor Name: "_$$FIELD(IEN,.01)
+6 WRITE ?70,"PAGE: 1"
+7 WRITE !," Ordering Address: "_$$FIELD(IEN,1)
+8 if $$FIELD(IEN,2)]""
WRITE !,SPACE_$$FIELD(IEN,2)
+9 SET X=" City,State,ZIP: "
+10 if $$FIELD(IEN,4.2)]""
SET X=X_$$FIELD(IEN,4.2)_", "
+11 if $$FIELD(IEN,4.4)]""
SET X=X_$$FIELD(IEN,4.4)_" "
+12 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))
+13 WRITE !,X
+14 WRITE !!," FMS Name: "_$$FIELD(IEN,34.5)
+15 WRITE !!," * Payment ADDRESS: "_$$FIELD(IEN,17.3)
+16 WRITE !," "_$$FIELD(IEN,17.4)
+17 if $$FIELD(IEN,17.5)]""
WRITE !,SPACE_$$FIELD(IEN,17.5)
+18 if $$FIELD(IEN,17.6)]""
WRITE !,SPACE_$$FIELD(IEN,17.6)
+19 SET X=" * City,State,ZIP: "
+20 if $$FIELD(IEN,17.7)]""
SET X=X_$$FIELD(IEN,17.7)_", "
+21 if $$FIELD(IEN,17.8)]""
SET X=X_$$FIELD(IEN,17.8)_" "
+22 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))
+23 WRITE !,X
+24 WRITE !!,"PAYMENT CONTACT PERSON: "_$$FIELD(IEN,17)
+25 WRITE !," PAYMENT PHONE NUMBER: "_$$FIELD(IEN,7.2)
+26 WRITE !
+27 WRITE !," * = REQUIRED FIELD"
+28 WRITE !
+29 SET DIR(0)="E"
+30 DO ^DIR
+31 KILL DIR
+32 WRITE !
+33 if Y'=1
GOTO REVEXIT
+34 WRITE @IOF
+35 WRITE !!," Vendor Name: "_$$FIELD(IEN,.01)
+36 WRITE ?70,"PAGE: 2"
+37 WRITE !!," FMS VENDOR CODE: "_$$FIELD(IEN,34)
+38 WRITE !," ALT-ADDR-IND: "_$$FIELD(IEN,35)
+39 WRITE !," * TAX ID/SSN: "_$$FIELD(IEN,38)
+40 WRITE !," * SSN/TAX ID IND: "_$$FIELD(IEN,39)
+41 WRITE !!," NON-RECURRING/"
+42 WRITE !," RECURRUNG VENDOR: "_$$FIELD(IEN,36)
+43 WRITE !!," 1099 VENDOR INDICATOR: "_$$FIELD(IEN,41)
+44 WRITE !," * VENDOR TYPE: "_$$FIELD(IEN,44)
+45 WRITE !," DUN & BRADSTREET: "_$$FIELD(IEN,18.3)
+46 WRITE !
+47 WRITE !," * = REQUIRED FIELD"
+48 WRITE !
+49 SET DIR(0)="E"
+50 SET DIR("A")="Enter RETURN to continue"
+51 DO ^DIR
+52 KILL DIR
REVEXIT IF $GET(RETURN)=961
GOTO REVQ
+1 SET VALMBCK="R"
SET VALMBG=1
REVQ QUIT
+1 ;
FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD
+1 ;FOR RECORD 'IEN' FROM FILE 440.3
+2 SET FIELD=$GET(PRCORVP(440,IEN,FIELD,"E"))
+3 QUIT FIELD
+4 ;
EDIT ;EDIT THIS VENDOR
+1 NEW PRCOI,PRCOIN,IEN,RETURN
+2 DO EN^VALM2(XQORNOD(0),"OS")
+3 SET PRCOI=0
+4 SET PRCOI=$ORDER(VALMY(PRCOI))
+5 if 'PRCOI
GOTO REVQ
+6 SET PRCOIN=$GET(^TMP("PRCOVL",$JOB,PRCOI))
+7 SET IEN=+$PIECE(PRCOIN,U,2)
+8 SET SENT=$PIECE($GET(^PRC(440.3,IEN,"AR")),U,5)
+9 IF SENT]""
WRITE !!,"This record has already been sent to Austin or FISCAL."
DO NONE1
GOTO EDITEX
+10 DO FULL^VALM1
+11 WRITE @IOF
+12 SET NAME=$PIECE($GET(^PRC(440,IEN,0)),U)
+13 if NAME]""
WRITE !!?11,"Vendor Name: "_NAME
+14 DO HILO^PRCFQ
+15 SET (DA,PRCFA("VEND"))=IEN
+16 WRITE !
+17 SET DIR(0)="Y"
+18 SET DIR("A")="Review the vendor selected"
+19 SET DIR("B")="YES"
+20 DO ^DIR
+21 KILL DIR
+22 WRITE !
+23 if $DATA(DIRUT)
GOTO EDITEX
+24 IF +Y=1
SET RETURN=961
DO REV1
WRITE @IOF
+25 KILL PRCTMP,RETURN
+26 DO DOIT
+27 if $DATA(DIRUT)!(Y'=1)
GOTO EDITEX
+28 DO SCREEN
+29 LOCK +^PRC(440,DA):5
IF '$TEST
WRITE !,$CHAR(7),"Another user is editing this entry!"
GOTO EDITEX
+30 SET DIE="^PRC(440,"
+31 SET DR=$SELECT(LOCAT="S":"[PRCHVENDOR]",1:"[PRCF FMS VENEDIT1B]")
+32 DO ^DIE
+33 KILL DIE,DR,ORDER
+34 SET ARFLG=$GET(^PRC(440.3,PRCFA("VEND"),"AR"))
+35 SET IEN=$PIECE(ARFLG,U,2)
+36 SET PRC("SITE")=$PIECE(ARFLG,U,3)
+37 SET FLAG=$PIECE(ARFLG,U)
+38 SET SAVE=$$CHECK^PRCOVTST(IEN,PRC("SITE"),FLAG)
+39 SET SAVE1=$SELECT(SAVE=0:"OK",SAVE=2:"GOOD",1:"")
+40 SET TAX=$PIECE($GET(^PRC(440,IEN,3)),U,8)
+41 SET DA=IEN
+42 SET DIE="^PRC(440.3,"
+43 SET DR=$SELECT(SAVE=0:"53///^S X=SAVE1",SAVE=2:"53///^S X=SAVE1",1:"53///@")
+44 DO ^DIE
+45 SET X=@VALMAR@(PRCOI,0)
+46 SET OK=$SELECT(SAVE=0:"OK",1:"")
+47 SET X=$$SETFLD^VALM1(OK,X,"OK")
+48 SET X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
+49 SET @VALMAR@(PRCOI,0)=X
+50 LOCK -^PRC(440,PRCFA("VEND"))
EDITEX SET VALMBCK="R"
SET VALMBG=1
+1 QUIT
+2 ;
DOIT ;FIND OUT IF USER WANTS TO EDIT VENDOR RECORD
+1 WRITE !
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Edit the Vendor record"
+4 SET DIR("B")="YES"
+5 SET DIR("?")="Enter 'NO' or 'N' or '^' to exit this edit session."
+6 SET DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue."
+7 DO ^DIR
+8 KILL DIR
+9 WRITE !
+10 QUIT
+11 ;
SCREEN ; Control screen display
+1 IF $DATA(IOF)
WRITE @IOF
+2 ; Write Option Header
+3 IF $DATA(XQY0)
WRITE IOINHI,$PIECE(XQY0,U,2),IOINORM,!
+4 QUIT
