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