- BMCVDVA ; IHS/OIT/FCJ - 2/2 EDIT VENDOR INFORMATION - CALLED FROM BMCVDV ;
- ;;4.0;REFERRED CARE INFO SYSTEM;**5,7,8**;JAN 09, 2006;Build 101
- ;BMC*4.0*5 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDVA
- ;
- EDIT ;EP
- ;BMC*4.0*8 CHANGED NXT LINE TO 20
- S Y=+$$DIR^XBDIR("NO^1:20","Change Which Item","","","Enter the number corresponding to the field you need to edit","",2)
- G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT)!(Y<1)
- S $P(^AUTTVNDR(BMCPROV,11),U,11)=DT
- D @(Y)
- G A2^BMCVDV
- ;
- 1 ;
- D EDITVNDR(BMCPROV,.01)
- G A1^BMCVDV
- ;
- 2 ;
- D EDITVNDR(BMCPROV,"1101;1102")
- D ^BMCVDVD
- Q
- ;
- 3 ;
- D EDITVNDR(BMCPROV,.05)
- Q
- ;
- 4 ;
- S BMCACO="L",P=BMCPROV,A("DISPLAY")=0
- D L^BMCVDV1
- S:'$D(DA) DA=""
- Q:'$D(DA)!(DA="")
- S DIE("NO^")="",DIE="^AUTTVNDR("_BMCPROV_",""CN"",",DA(1)=BMCPROV,DR="1;2;4;3"
- D ^DIE
- K DIE,DA
- Q
- ;
- 5 ;
- D EDITVNDR(BMCPROV,1701)
- Q
- ;
- 6 ;
- S BMCAGTP="RQ"
- D AGRDSP^BMCVDV2
- Q:'$G(DA)
- S DIE="^AUTTVNDR("_BMCPROV_",18,",DA(1)=BMCPROV,DR=".02;.04;.03;.05;.07;.06;.08;.09"
- D ^DIE
- K DIE
- Q
- ;
- 7 ;
- D EDITVNDR(BMCPROV,1126)
- Q
- ;
- 8 ;
- S BMCAGTP="PA"
- D AGRDSP^BMCVDV2
- Q:'$G(DA)
- S DIE="^AUTTVNDR("_BMCPROV_",18,",DA(1)=BMCPROV,DR=".02;.04;.03;.05;.07;.06;.08;.09"
- D ^DIE
- K DIE
- Q
- ;
- 9 ;
- I $P($G(^AUTTVNDR(BMCPROV,23)),U)'="" D MP^BMCVDV1,EDITVNDR(BMCPROV,"2301;2302")
- I $P($G(^AUTTVNDR(BMCPROV,23)),U)="" D EDITVNDR(BMCPROV,"2301;2302"),MP^BMCVDV1
- Q
- ;
- 10 ;
- ;
- S BMCAGTP="BPA"
- D AGRDSP^BMCVDV2
- Q:'$G(DA)
- S DIE="^AUTTVNDR("_BMCPROV_",18,",DA(1)=BMCPROV,DR=".02;.04;.03;.05;.07;.06;.08;.09"
- D ^DIE
- K DIE
- Q
- ;BMC*4.0*7 IHS.OIT.FCJ ADDED EMAIL, FAX AND RENUMBERED
- 11 ;
- D EDITVNDR(BMCPROV,"2103")
- Q
- 12 ;
- D EDITVNDR(BMCPROV,".07;.08")
- Q
- ;BMC*4.0*8 IHS.OIT.FCJ ADDED DIRECT PARTICIPANT AND DIRECT EMAIL ADDRESS THEN RENUMBERED
- 13 ;DIRECT PARTICIPANT
- D EDITVNDR(BMCPROV,"2104")
- Q
- 14 ;DIRECT EMAIL ADDRESS
- D EDITVNDR(BMCPROV,"2105")
- Q
- 15 ;
- D EDITVNDR(BMCPROV,"1301:1302;1303;1304;1305;1109;1114") ;BMC*4.0*7 ADDED FIELD 1114 TO LINE
- Q
- ;
- 16 ;
- D EDITVNDR(BMCPROV,"1306;1307;1308;1309")
- Q
- ;
- 17 ;EP
- D EDITVNDR(BMCPROV,1103)
- Q
- ;
- 18 ;
- D EDITVNDR(BMCPROV,1110)
- Q
- ;
- 19 ;
- D EDITVNDR(BMCPROV,1103.01)
- Q
- ;
- 20 ;
- D EDITVNDR(BMCPROV,1125)
- Q
- ;
- EDITVNDR(DA,DR) ;EP - Edit fields in VENDOR.
- N DIE
- S DIE="^AUTTVNDR("
- D ^DIE
- Q
- ;
- BMCVDVA ; IHS/OIT/FCJ - 2/2 EDIT VENDOR INFORMATION - CALLED FROM BMCVDV ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;**5,7,8**;JAN 09, 2006;Build 101
- +2 ;BMC*4.0*5 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDVA
- +3 ;
- EDIT ;EP
- +1 ;BMC*4.0*8 CHANGED NXT LINE TO 20
- +2 SET Y=+$$DIR^XBDIR("NO^1:20","Change Which Item","","","Enter the number corresponding to the field you need to edit","",2)
- +3 IF $DATA(DTOUT)
- GOTO END^BMCVDV
- IF $DATA(DUOUT)!(Y<1)
- GOTO A1^BMCVDV
- +4 SET $PIECE(^AUTTVNDR(BMCPROV,11),U,11)=DT
- +5 DO @(Y)
- +6 GOTO A2^BMCVDV
- +7 ;
- 1 ;
- +1 DO EDITVNDR(BMCPROV,.01)
- +2 GOTO A1^BMCVDV
- +3 ;
- 2 ;
- +1 DO EDITVNDR(BMCPROV,"1101;1102")
- +2 DO ^BMCVDVD
- +3 QUIT
- +4 ;
- 3 ;
- +1 DO EDITVNDR(BMCPROV,.05)
- +2 QUIT
- +3 ;
- 4 ;
- +1 SET BMCACO="L"
- SET P=BMCPROV
- SET A("DISPLAY")=0
- +2 DO L^BMCVDV1
- +3 IF '$DATA(DA)
- SET DA=""
- +4 IF '$DATA(DA)!(DA="")
- QUIT
- +5 SET DIE("NO^")=""
- SET DIE="^AUTTVNDR("_BMCPROV_",""CN"","
- SET DA(1)=BMCPROV
- SET DR="1;2;4;3"
- +6 DO ^DIE
- +7 KILL DIE,DA
- +8 QUIT
- +9 ;
- 5 ;
- +1 DO EDITVNDR(BMCPROV,1701)
- +2 QUIT
- +3 ;
- 6 ;
- +1 SET BMCAGTP="RQ"
- +2 DO AGRDSP^BMCVDV2
- +3 IF '$GET(DA)
- QUIT
- +4 SET DIE="^AUTTVNDR("_BMCPROV_",18,"
- SET DA(1)=BMCPROV
- SET DR=".02;.04;.03;.05;.07;.06;.08;.09"
- +5 DO ^DIE
- +6 KILL DIE
- +7 QUIT
- +8 ;
- 7 ;
- +1 DO EDITVNDR(BMCPROV,1126)
- +2 QUIT
- +3 ;
- 8 ;
- +1 SET BMCAGTP="PA"
- +2 DO AGRDSP^BMCVDV2
- +3 IF '$GET(DA)
- QUIT
- +4 SET DIE="^AUTTVNDR("_BMCPROV_",18,"
- SET DA(1)=BMCPROV
- SET DR=".02;.04;.03;.05;.07;.06;.08;.09"
- +5 DO ^DIE
- +6 KILL DIE
- +7 QUIT
- +8 ;
- 9 ;
- +1 IF $PIECE($GET(^AUTTVNDR(BMCPROV,23)),U)'=""
- DO MP^BMCVDV1
- DO EDITVNDR(BMCPROV,"2301;2302")
- +2 IF $PIECE($GET(^AUTTVNDR(BMCPROV,23)),U)=""
- DO EDITVNDR(BMCPROV,"2301;2302")
- DO MP^BMCVDV1
- +3 QUIT
- +4 ;
- 10 ;
- +1 ;
- +2 SET BMCAGTP="BPA"
- +3 DO AGRDSP^BMCVDV2
- +4 IF '$GET(DA)
- QUIT
- +5 SET DIE="^AUTTVNDR("_BMCPROV_",18,"
- SET DA(1)=BMCPROV
- SET DR=".02;.04;.03;.05;.07;.06;.08;.09"
- +6 DO ^DIE
- +7 KILL DIE
- +8 QUIT
- +9 ;BMC*4.0*7 IHS.OIT.FCJ ADDED EMAIL, FAX AND RENUMBERED
- 11 ;
- +1 DO EDITVNDR(BMCPROV,"2103")
- +2 QUIT
- 12 ;
- +1 DO EDITVNDR(BMCPROV,".07;.08")
- +2 QUIT
- +3 ;BMC*4.0*8 IHS.OIT.FCJ ADDED DIRECT PARTICIPANT AND DIRECT EMAIL ADDRESS THEN RENUMBERED
- 13 ;DIRECT PARTICIPANT
- +1 DO EDITVNDR(BMCPROV,"2104")
- +2 QUIT
- 14 ;DIRECT EMAIL ADDRESS
- +1 DO EDITVNDR(BMCPROV,"2105")
- +2 QUIT
- 15 ;
- +1 ;BMC*4.0*7 ADDED FIELD 1114 TO LINE
- DO EDITVNDR(BMCPROV,"1301:1302;1303;1304;1305;1109;1114")
- +2 QUIT
- +3 ;
- 16 ;
- +1 DO EDITVNDR(BMCPROV,"1306;1307;1308;1309")
- +2 QUIT
- +3 ;
- 17 ;EP
- +1 DO EDITVNDR(BMCPROV,1103)
- +2 QUIT
- +3 ;
- 18 ;
- +1 DO EDITVNDR(BMCPROV,1110)
- +2 QUIT
- +3 ;
- 19 ;
- +1 DO EDITVNDR(BMCPROV,1103.01)
- +2 QUIT
- +3 ;
- 20 ;
- +1 DO EDITVNDR(BMCPROV,1125)
- +2 QUIT
- +3 ;
- EDITVNDR(DA,DR) ;EP - Edit fields in VENDOR.
- +1 NEW DIE
- +2 SET DIE="^AUTTVNDR("
- +3 DO ^DIE
- +4 QUIT
- +5 ;
