BMCVDVD ; IHS/OIT/FCJ - CHECK FOR DUPLICATES WHEN ENTERING NEW VENDOR ; [ 10/31/2003 12:11 PM ]
;;4.0;REFERRED CARE INFO SYSTEM;**5**;JAN 09, 2006;Build 101
;BMC*4.0*5 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDVD
;
EP ;
I '$D(BMCPROV) G A1^BMCVDV
K BMCZEIN
I '$D(^AUTTVNDR(BMCPROV,11)) G END
S BMCEIN=$P(^AUTTVNDR(BMCPROV,11),U,1)
I BMCEIN="" G MESSAGE
;
;got this far, then we know we have an EIN
;now check the address
S BMCYAYA=$G(^AUTTVNDR(BMCPROV,13))
I $P(BMCYAYA,U,1)=""!($P(BMCYAYA,U,2)="")!($P(BMCYAYA,U,3)="") W !!,"Vendor address incomplete.",!,"Please make sure that at least street, city, and state are complete" H 3 D GETADDR Q:$D(DTOUT)!$D(DUOUT) G EP
;
;
S BMCSUFF=$P(^AUTTVNDR(BMCPROV,11),U,2)
I BMCSUFF'="" G GETD
I '$D(^AUTTVNDR("C",BMCEIN)) G GETD
S X=$O(^AUTTVNDR("C",BMCEIN,0))
I '$O(^AUTTVNDR("C",BMCEIN,X)) G GETD
S X=0
F S X=$O(^AUTTVNDR("C",BMCEIN,X)) G:X="" WRITE D
. S BMCUFF=$P($G(^AUTTVNDR(X,11)),U,2)
. I X'=BMCPROV,BMCSUFF="" S BMCZEIN(X)=BMCEIN
. I X'=BMCPROV,BMCUFF=BMCSUFF S BMCZEIN(X)=BMCEIN
.Q
GETD ;
S BMCEINS=BMCEIN_BMCSUFF,X=0
I '$D(^AUTTVNDR("E",BMCEINS)) G WRITE
S X=$O(^AUTTVNDR("E",BMCEINS,X))
I '$O(^AUTTVNDR("E",BMCEINS,X)) G WRITE
S X=0
F S X=$O(^AUTTVNDR("E",BMCEINS,X)) G WRITE:X="" S:X'=BMCPROV BMCZEIN(X)=BMCEINS
WRITE ;
I '$D(BMCZEIN),$D(BMCDFLG) Q
I '$D(BMCZEIN),'$D(BMCDFLG) G A1A^BMCVDV
W !!?12,*7,*7,"***** The EIN you have entered for this VENDOR is a *****",!?11,"***** duplicate of the EIN for the following VENDOR(S) *****",!!
S Z=0
F S Z=$O(BMCZEIN(Z)) Q:Z="" W !,$P(^AUTTVNDR(Z,0),U,1),?40,$P(BMCZEIN(Z),U)
CHECK ;
I '$D(^XUSEC("BMCZVEN",DUZ)) W !!?20,"** Duplicate EIN's are NOT ALLOWED! **",!?15,"Please copy this information and notify your supervisor.",!! G END:'$D(BMCDFLG) S Y=0 G EDIT0
EDIT ;
W !!?20,"** Duplicate EIN's are NOT ALLOWED! **",!?24,"You MUST enter a UNIQUE EIN or",!?25,"a SUFFIX to an existing EIN."
I $D(%(0)),'$D(BMCDFLG) G CHOOSE
K DIR
S DIR("A")="Do you wish to EDIT NOW",DIR(0)="Y",DIR("B")="NO"
W !!
D ^DIR
K DIR
G END:$D(DIRUT)&'$D(BMCDFLG)
;Check to see if vendor/provider edit option
I '$D(BMCDFLG),Y=0 G A1A^BMCVDV
;Check to see if initial document
EDIT0 ;
I $D(BMCDFLG),$D(DIRUT) K BMCPROV Q
I $D(BMCDFLG),Y=0 K BMCPROV Q
S Y="E"
G EDIT1
;
CHOOSE ;
W !!!,"Entry for "_$P(^AUTTVNDR(BMCPROV,0),U,1)_" "_$S($D(BMCEINS):BMCEINS,1:BMCEIN)
K DIR
S DIR(0)="S^E:Edit;D:Delete",DIR("B")="Delete"
D ^DIR
K DIR
G EDIT:$D(DUOUT),EDIT:$D(DIROUT),EDIT:$D(DIRUT)
I Y["D" G DELETE
EDIT1 ;
I Y["E" W !!,"Edit entry "_$P(^AUTTVNDR(BMCPROV,0),U)_" "_$S($D(BMCEINS):BMCEINS,1:BMCEIN) W !! S DR="1101;1102",DIE="^AUTTVNDR(",DA=BMCPROV D ^DIE K:$D(Y) BMCPROV
K BMCEIN,BMCZEIN,BMCSUFF,Z,X,DA,BMCEINS,DIR,DIC,DIE,DIK
G EP
;
DELETE ;
K DIR
S DIR(0)="Y",DIR("A")="DELETE entry "_$P(^AUTTVNDR(BMCPROV,0),U,1)_" "_$S($D(BMCEINS):BMCEINS,1:BMCEIN),DIR("B")="YES"
D ^DIR
K DIR
G:Y=0 EDIT
S DIK="^AUTTVNDR(",DA=BMCPROV
W " ...DELETING..."
D ^DIK
G END
MESSAGE ;EP
U IO
W !!,"There is no EIN on file for ",$P(^AUTTVNDR(BMCPROV,0),U,1),".",!,"Please edit to continue this process."
I IOST["C-" K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue..." W !!!! D ^DIR S Y="E" G EDIT1
END ;
K BMCEIN,BMCZEIN,BMCSUFF,Z,X,DA,BMCEINS,BMCPROV
G A1^BMCVDV
;
GETADDR ;
;prompt for and require an address for this provider
S Y=$$DIR^XBDIR("Y","Edit address now? ","NO","","","",2)
I Y=0 S DTOUT=1
;
I $D(DTOUT)!$D(DUOUT) Q
W !! S DR="1301:1304",DIE="^AUTTVNDR(",DA=BMCPROV D ^DIE
Q
;
VCHK ;
S BMCVFLG=""
S BMCTST=$P(Y,U,1)
F %=1102,1110,1116,1125,1302,1303,1304 D
. S VAL=$$GET1^DIQ(9999999.11,BMCTST,%,"I")
. I VAL="" D @(+%)
K BMCTST
Q
;
1102 W !,"Vendor EIN suffix incomplete",! S BMCVFLG=1 Q
;
1110 W !,"Vendor FED/NON-FED field incomplete",! S BMCVFLG=1 Q
;
1116 W "Vendor Congressional District incomplete",! S BMCVFLG=1 Q
;
1125 W "Vendor Geographical Location incomplete",! S BMCVFLG=1 Q
;
1302 W !,"Vendor mailing address city incomplete",! S BMCVFLG=1 Q
;
1303 W !,"Vendor mailing address state incomplete",! S BMCVFLG=1 Q
;
1304 W !,"Vendor mailing address zip incomplete",! S BMCVFLG=1 Q
BMCVDVD ; IHS/OIT/FCJ - CHECK FOR DUPLICATES WHEN ENTERING NEW VENDOR ; [ 10/31/2003 12:11 PM ]
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**5**;JAN 09, 2006;Build 101
+2 ;BMC*4.0*5 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDVD
+3 ;
EP ;
+1 IF '$DATA(BMCPROV)
GOTO A1^BMCVDV
+2 KILL BMCZEIN
+3 IF '$DATA(^AUTTVNDR(BMCPROV,11))
GOTO END
+4 SET BMCEIN=$PIECE(^AUTTVNDR(BMCPROV,11),U,1)
+5 IF BMCEIN=""
GOTO MESSAGE
+6 ;
+7 ;got this far, then we know we have an EIN
+8 ;now check the address
+9 SET BMCYAYA=$GET(^AUTTVNDR(BMCPROV,13))
+10 IF $PIECE(BMCYAYA,U,1)=""!($PIECE(BMCYAYA,U,2)="")!($PIECE(BMCYAYA,U,3)="")
WRITE !!,"Vendor address incomplete.",!,"Please make sure that at least street, city, and state are complete"
HANG 3
DO GETADDR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
GOTO EP
+11 ;
+12 ;
+13 SET BMCSUFF=$PIECE(^AUTTVNDR(BMCPROV,11),U,2)
+14 IF BMCSUFF'=""
GOTO GETD
+15 IF '$DATA(^AUTTVNDR("C",BMCEIN))
GOTO GETD
+16 SET X=$ORDER(^AUTTVNDR("C",BMCEIN,0))
+17 IF '$ORDER(^AUTTVNDR("C",BMCEIN,X))
GOTO GETD
+18 SET X=0
+19 FOR
SET X=$ORDER(^AUTTVNDR("C",BMCEIN,X))
IF X=""
GOTO WRITE
Begin DoDot:1
+20 SET BMCUFF=$PIECE($GET(^AUTTVNDR(X,11)),U,2)
+21 IF X'=BMCPROV
IF BMCSUFF=""
SET BMCZEIN(X)=BMCEIN
+22 IF X'=BMCPROV
IF BMCUFF=BMCSUFF
SET BMCZEIN(X)=BMCEIN
+23 QUIT
End DoDot:1
GETD ;
+1 SET BMCEINS=BMCEIN_BMCSUFF
SET X=0
+2 IF '$DATA(^AUTTVNDR("E",BMCEINS))
GOTO WRITE
+3 SET X=$ORDER(^AUTTVNDR("E",BMCEINS,X))
+4 IF '$ORDER(^AUTTVNDR("E",BMCEINS,X))
GOTO WRITE
+5 SET X=0
+6 FOR
SET X=$ORDER(^AUTTVNDR("E",BMCEINS,X))
IF X=""
GOTO WRITE
IF X'=BMCPROV
SET BMCZEIN(X)=BMCEINS
WRITE ;
+1 IF '$DATA(BMCZEIN)
IF $DATA(BMCDFLG)
QUIT
+2 IF '$DATA(BMCZEIN)
IF '$DATA(BMCDFLG)
GOTO A1A^BMCVDV
+3 WRITE !!?12,*7,*7,"***** The EIN you have entered for this VENDOR is a *****",!?11,"***** duplicate of the EIN for the following VENDOR(S) *****",!!
+4 SET Z=0
+5 FOR
SET Z=$ORDER(BMCZEIN(Z))
IF Z=""
QUIT
WRITE !,$PIECE(^AUTTVNDR(Z,0),U,1),?40,$PIECE(BMCZEIN(Z),U)
CHECK ;
+1 IF '$DATA(^XUSEC("BMCZVEN",DUZ))
WRITE !!?20,"** Duplicate EIN's are NOT ALLOWED! **",!?15,"Please copy this information and notify your supervisor.",!!
IF '$DATA(BMCDFLG)
GOTO END
SET Y=0
GOTO EDIT0
EDIT ;
+1 WRITE !!?20,"** Duplicate EIN's are NOT ALLOWED! **",!?24,"You MUST enter a UNIQUE EIN or",!?25,"a SUFFIX to an existing EIN."
+2 IF $DATA(%(0))
IF '$DATA(BMCDFLG)
GOTO CHOOSE
+3 KILL DIR
+4 SET DIR("A")="Do you wish to EDIT NOW"
SET DIR(0)="Y"
SET DIR("B")="NO"
+5 WRITE !!
+6 DO ^DIR
+7 KILL DIR
+8 IF $DATA(DIRUT)&'$DATA(BMCDFLG)
GOTO END
+9 ;Check to see if vendor/provider edit option
+10 IF '$DATA(BMCDFLG)
IF Y=0
GOTO A1A^BMCVDV
+11 ;Check to see if initial document
EDIT0 ;
+1 IF $DATA(BMCDFLG)
IF $DATA(DIRUT)
KILL BMCPROV
QUIT
+2 IF $DATA(BMCDFLG)
IF Y=0
KILL BMCPROV
QUIT
+3 SET Y="E"
+4 GOTO EDIT1
+5 ;
CHOOSE ;
+1 WRITE !!!,"Entry for "_$PIECE(^AUTTVNDR(BMCPROV,0),U,1)_" "_$SELECT($DATA(BMCEINS):BMCEINS,1:BMCEIN)
+2 KILL DIR
+3 SET DIR(0)="S^E:Edit;D:Delete"
SET DIR("B")="Delete"
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DUOUT)
GOTO EDIT
IF $DATA(DIROUT)
GOTO EDIT
IF $DATA(DIRUT)
GOTO EDIT
+7 IF Y["D"
GOTO DELETE
EDIT1 ;
+1 IF Y["E"
WRITE !!,"Edit entry "_$PIECE(^AUTTVNDR(BMCPROV,0),U)_" "_$SELECT($DATA(BMCEINS):BMCEINS,1:BMCEIN)
WRITE !!
SET DR="1101;1102"
SET DIE="^AUTTVNDR("
SET DA=BMCPROV
DO ^DIE
IF $DATA(Y)
KILL BMCPROV
+2 KILL BMCEIN,BMCZEIN,BMCSUFF,Z,X,DA,BMCEINS,DIR,DIC,DIE,DIK
+3 GOTO EP
+4 ;
DELETE ;
+1 KILL DIR
+2 SET DIR(0)="Y"
SET DIR("A")="DELETE entry "_$PIECE(^AUTTVNDR(BMCPROV,0),U,1)_" "_$SELECT($DATA(BMCEINS):BMCEINS,1:BMCEIN)
SET DIR("B")="YES"
+3 DO ^DIR
+4 KILL DIR
+5 IF Y=0
GOTO EDIT
+6 SET DIK="^AUTTVNDR("
SET DA=BMCPROV
+7 WRITE " ...DELETING..."
+8 DO ^DIK
+9 GOTO END
MESSAGE ;EP
+1 USE IO
+2 WRITE !!,"There is no EIN on file for ",$PIECE(^AUTTVNDR(BMCPROV,0),U,1),".",!,"Please edit to continue this process."
+3 IF IOST["C-"
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue..."
WRITE !!!!
DO ^DIR
SET Y="E"
GOTO EDIT1
END ;
+1 KILL BMCEIN,BMCZEIN,BMCSUFF,Z,X,DA,BMCEINS,BMCPROV
+2 GOTO A1^BMCVDV
+3 ;
GETADDR ;
+1 ;prompt for and require an address for this provider
+2 SET Y=$$DIR^XBDIR("Y","Edit address now? ","NO","","","",2)
+3 IF Y=0
SET DTOUT=1
+4 ;
+5 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 WRITE !!
SET DR="1301:1304"
SET DIE="^AUTTVNDR("
SET DA=BMCPROV
DO ^DIE
+7 QUIT
+8 ;
VCHK ;
+1 SET BMCVFLG=""
+2 SET BMCTST=$PIECE(Y,U,1)
+3 FOR %=1102,1110,1116,1125,1302,1303,1304
Begin DoDot:1
+4 SET VAL=$$GET1^DIQ(9999999.11,BMCTST,%,"I")
+5 IF VAL=""
DO @(+%)
End DoDot:1
+6 KILL BMCTST
+7 QUIT
+8 ;
1102 WRITE !,"Vendor EIN suffix incomplete",!
SET BMCVFLG=1
QUIT
+1 ;
1110 WRITE !,"Vendor FED/NON-FED field incomplete",!
SET BMCVFLG=1
QUIT
+1 ;
1116 WRITE "Vendor Congressional District incomplete",!
SET BMCVFLG=1
QUIT
+1 ;
1125 WRITE "Vendor Geographical Location incomplete",!
SET BMCVFLG=1
QUIT
+1 ;
1302 WRITE !,"Vendor mailing address city incomplete",!
SET BMCVFLG=1
QUIT
+1 ;
1303 WRITE !,"Vendor mailing address state incomplete",!
SET BMCVFLG=1
QUIT
+1 ;
1304 WRITE !,"Vendor mailing address zip incomplete",!
SET BMCVFLG=1
QUIT
