ACHSVDVD ; IHS/ITSC/PMF - CHECK FOR DUPLICATES WHEN ENTERING NEW VENDOR ; [ 10/31/2003 12:11 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6**;JUN 11, 2001
;ITS/SET/JVK ACHS*3.1*6 TEST FOR COMPLETE VENDOR INFO 4/14/2003
;
EP ;
K ACHSZEIN,ACHSEIN,ACHSSUFF,ACHSUFF,X,ACHSEINS,Z
I '$D(ACHSPROV) G A1^ACHSVDV
K ACHSZEIN
I '$D(^AUTTVNDR(ACHSPROV,11)) G END
S ACHSEIN=$P(^AUTTVNDR(ACHSPROV,11),U,1)
I ACHSEIN="" G MESSAGE
;
;got this far, then we know we have an EIN
;now check the address
S ACHSYAYA=$G(^AUTTVNDR(ACHSPROV,13))
I $P(ACHSYAYA,U,1)=""!($P(ACHSYAYA,U,2)="")!($P(ACHSYAYA,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 ACHSSUFF=$P(^AUTTVNDR(ACHSPROV,11),U,2)
I ACHSSUFF'="" G GETD
I '$D(^AUTTVNDR("C",ACHSEIN)) G GETD
S X=$O(^AUTTVNDR("C",ACHSEIN,0))
I '$O(^AUTTVNDR("C",ACHSEIN,X)) G GETD
S X=0
F S X=$O(^AUTTVNDR("C",ACHSEIN,X)) G:X="" WRITE D
. S ACHSUFF=$P($G(^AUTTVNDR(X,11)),U,2)
. I X'=ACHSPROV,ACHSSUFF="" S ACHSZEIN(X)=ACHSEIN
. I X'=ACHSPROV,ACHSUFF=ACHSSUFF S ACHSZEIN(X)=ACHSEIN
.Q
GETD ;
S ACHSEINS=ACHSEIN_ACHSSUFF,X=0
I '$D(^AUTTVNDR("E",ACHSEINS)) G WRITE
S X=$O(^AUTTVNDR("E",ACHSEINS,X))
I '$O(^AUTTVNDR("E",ACHSEINS,X)) G WRITE
S X=0
F S X=$O(^AUTTVNDR("E",ACHSEINS,X)) G WRITE:X="" S:X'=ACHSPROV ACHSZEIN(X)=ACHSEINS
WRITE ;
I '$D(ACHSZEIN),$D(ACHSDFLG) Q
I '$D(ACHSZEIN),'$D(ACHSDFLG) G A1A^ACHSVDV
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(ACHSZEIN(Z)) Q:Z="" W !,$P(^AUTTVNDR(Z,0),U,1),?40,$P(ACHSZEIN(Z),U)
CHECK ;
I '$D(^XUSEC("ACHSZMGR",DUZ)) W !!?20,"** Duplicate EIN's are NOT ALLOWED! **",!?15,"Please copy this information and notify your supervisor.",!! G END:'$D(ACHSDFLG) 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(ACHSDFLG) 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(ACHSDFLG)
;Check to see if vendor/provider edit option
I '$D(ACHSDFLG),Y=0 G A1A^ACHSVDV
;Check to see if initial document
EDIT0 ;
I $D(ACHSDFLG),$D(DIRUT) K ACHSPROV Q
I $D(ACHSDFLG),Y=0 K ACHSPROV Q
S Y="E"
G EDIT1
;
CHOOSE ;
W !!!,"Entry for "_$P(^AUTTVNDR(ACHSPROV,0),U,1)_" "_$S($D(ACHSEINS):ACHSEINS,1:ACHSEIN)
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(ACHSPROV,0),U)_" "_$S($D(ACHSEINS):ACHSEINS,1:ACHSEIN) W !! S DR="1101;1102",DIE="^AUTTVNDR(",DA=ACHSPROV D ^DIE K:$D(Y) ACHSPROV
K ACHSEIN,ACHSZEIN,ACHSSUFF,Z,X,DA,ACHSEINS,DIR,DIC,DIE,DIK
G EP
;
DELETE ;
K DIR
S DIR(0)="Y",DIR("A")="DELETE entry "_$P(^AUTTVNDR(ACHSPROV,0),U,1)_" "_$S($D(ACHSEINS):ACHSEINS,1:ACHSEIN),DIR("B")="YES"
D ^DIR
K DIR
G:Y=0 EDIT
S DIK="^AUTTVNDR(",DA=ACHSPROV
W " ...DELETING..."
D ^DIK
G END
MESSAGE ;EP
U IO
W !!,"There is no EIN on file for ",$P(^AUTTVNDR(ACHSPROV,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 ACHSEIN,ACHSZEIN,ACHSSUFF,Z,X,DA,ACHSEINS,ACHSPROV
G A1^ACHSVDV
;
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=ACHSPROV D ^DIE
Q
;
VCHK ;
;IHS/SET/JVK ACHS*3.1*6 4/14/2003
;ENTRY POINT FROM ACHSA1
;ADDED THIS SECTION AS TEST FOR COMPLETE VENDOR EIN INFO
S ACHSVFLG=""
S ACHSTST=$P(Y,U,1)
F %=1102,1110,1116,1125,1302,1303,1304 D
. S VAL=$$GET1^DIQ(9999999.11,ACHSTST,%,"I")
. I VAL="" D @(+%)
. Q
K ACHSTST
Q
;
1102 W !,"Vendor EIN suffix incomplete",! S ACHSVFLG=1 Q
;
1110 W !,"Vendor FED/NON-FED field incomplete",! S ACHSVFLG=1 Q
;
1116 W "Vendor Congressional District incomplete",! S ACHSVFLG=1 Q
;
1125 W "Vendor Geographical Location incomplete",! S ACHSVFLG=1 Q
;
1302 W !,"Vendor mailing address city incomplete",! S ACHSVFLG=1 Q
;
1303 W !,"Vendor mailing address state incomplete",! S ACHSVFLG=1 Q
;
1304 W !,"Vendor mailing address zip incomplete",! S ACHSVFLG=1 Q
;IHS/SET/JVK ACHS*3.1*6 END NEW CODE
ACHSVDVD ; IHS/ITSC/PMF - CHECK FOR DUPLICATES WHEN ENTERING NEW VENDOR ; [ 10/31/2003 12:11 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6**;JUN 11, 2001
+2 ;ITS/SET/JVK ACHS*3.1*6 TEST FOR COMPLETE VENDOR INFO 4/14/2003
+3 ;
EP ;
+1 KILL ACHSZEIN,ACHSEIN,ACHSSUFF,ACHSUFF,X,ACHSEINS,Z
+2 IF '$DATA(ACHSPROV)
GOTO A1^ACHSVDV
+3 KILL ACHSZEIN
+4 IF '$DATA(^AUTTVNDR(ACHSPROV,11))
GOTO END
+5 SET ACHSEIN=$PIECE(^AUTTVNDR(ACHSPROV,11),U,1)
+6 IF ACHSEIN=""
GOTO MESSAGE
+7 ;
+8 ;got this far, then we know we have an EIN
+9 ;now check the address
+10 SET ACHSYAYA=$GET(^AUTTVNDR(ACHSPROV,13))
+11 IF $PIECE(ACHSYAYA,U,1)=""!($PIECE(ACHSYAYA,U,2)="")!($PIECE(ACHSYAYA,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
+12 ;
+13 ;
+14 SET ACHSSUFF=$PIECE(^AUTTVNDR(ACHSPROV,11),U,2)
+15 IF ACHSSUFF'=""
GOTO GETD
+16 IF '$DATA(^AUTTVNDR("C",ACHSEIN))
GOTO GETD
+17 SET X=$ORDER(^AUTTVNDR("C",ACHSEIN,0))
+18 IF '$ORDER(^AUTTVNDR("C",ACHSEIN,X))
GOTO GETD
+19 SET X=0
+20 FOR
SET X=$ORDER(^AUTTVNDR("C",ACHSEIN,X))
IF X=""
GOTO WRITE
Begin DoDot:1
+21 SET ACHSUFF=$PIECE($GET(^AUTTVNDR(X,11)),U,2)
+22 IF X'=ACHSPROV
IF ACHSSUFF=""
SET ACHSZEIN(X)=ACHSEIN
+23 IF X'=ACHSPROV
IF ACHSUFF=ACHSSUFF
SET ACHSZEIN(X)=ACHSEIN
+24 QUIT
End DoDot:1
GETD ;
+1 SET ACHSEINS=ACHSEIN_ACHSSUFF
SET X=0
+2 IF '$DATA(^AUTTVNDR("E",ACHSEINS))
GOTO WRITE
+3 SET X=$ORDER(^AUTTVNDR("E",ACHSEINS,X))
+4 IF '$ORDER(^AUTTVNDR("E",ACHSEINS,X))
GOTO WRITE
+5 SET X=0
+6 FOR
SET X=$ORDER(^AUTTVNDR("E",ACHSEINS,X))
IF X=""
GOTO WRITE
IF X'=ACHSPROV
SET ACHSZEIN(X)=ACHSEINS
WRITE ;
+1 IF '$DATA(ACHSZEIN)
IF $DATA(ACHSDFLG)
QUIT
+2 IF '$DATA(ACHSZEIN)
IF '$DATA(ACHSDFLG)
GOTO A1A^ACHSVDV
+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(ACHSZEIN(Z))
IF Z=""
QUIT
WRITE !,$PIECE(^AUTTVNDR(Z,0),U,1),?40,$PIECE(ACHSZEIN(Z),U)
CHECK ;
+1 IF '$DATA(^XUSEC("ACHSZMGR",DUZ))
WRITE !!?20,"** Duplicate EIN's are NOT ALLOWED! **",!?15,"Please copy this information and notify your supervisor.",!!
IF '$DATA(ACHSDFLG)
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(ACHSDFLG)
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(ACHSDFLG)
GOTO END
+9 ;Check to see if vendor/provider edit option
+10 IF '$DATA(ACHSDFLG)
IF Y=0
GOTO A1A^ACHSVDV
+11 ;Check to see if initial document
EDIT0 ;
+1 IF $DATA(ACHSDFLG)
IF $DATA(DIRUT)
KILL ACHSPROV
QUIT
+2 IF $DATA(ACHSDFLG)
IF Y=0
KILL ACHSPROV
QUIT
+3 SET Y="E"
+4 GOTO EDIT1
+5 ;
CHOOSE ;
+1 WRITE !!!,"Entry for "_$PIECE(^AUTTVNDR(ACHSPROV,0),U,1)_" "_$SELECT($DATA(ACHSEINS):ACHSEINS,1:ACHSEIN)
+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(ACHSPROV,0),U)_" "_$SELECT($DATA(ACHSEINS):ACHSEINS,1:ACHSEIN)
WRITE !!
SET DR="1101;1102"
SET DIE="^AUTTVNDR("
SET DA=ACHSPROV
DO ^DIE
IF $DATA(Y)
KILL ACHSPROV
+2 KILL ACHSEIN,ACHSZEIN,ACHSSUFF,Z,X,DA,ACHSEINS,DIR,DIC,DIE,DIK
+3 GOTO EP
+4 ;
DELETE ;
+1 KILL DIR
+2 SET DIR(0)="Y"
SET DIR("A")="DELETE entry "_$PIECE(^AUTTVNDR(ACHSPROV,0),U,1)_" "_$SELECT($DATA(ACHSEINS):ACHSEINS,1:ACHSEIN)
SET DIR("B")="YES"
+3 DO ^DIR
+4 KILL DIR
+5 IF Y=0
GOTO EDIT
+6 SET DIK="^AUTTVNDR("
SET DA=ACHSPROV
+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(ACHSPROV,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 ACHSEIN,ACHSZEIN,ACHSSUFF,Z,X,DA,ACHSEINS,ACHSPROV
+2 GOTO A1^ACHSVDV
+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=ACHSPROV
DO ^DIE
+7 QUIT
+8 ;
VCHK ;
+1 ;IHS/SET/JVK ACHS*3.1*6 4/14/2003
+2 ;ENTRY POINT FROM ACHSA1
+3 ;ADDED THIS SECTION AS TEST FOR COMPLETE VENDOR EIN INFO
+4 SET ACHSVFLG=""
+5 SET ACHSTST=$PIECE(Y,U,1)
+6 FOR %=1102,1110,1116,1125,1302,1303,1304
Begin DoDot:1
+7 SET VAL=$$GET1^DIQ(9999999.11,ACHSTST,%,"I")
+8 IF VAL=""
DO @(+%)
+9 QUIT
End DoDot:1
+10 KILL ACHSTST
+11 QUIT
+12 ;
1102 WRITE !,"Vendor EIN suffix incomplete",!
SET ACHSVFLG=1
QUIT
+1 ;
1110 WRITE !,"Vendor FED/NON-FED field incomplete",!
SET ACHSVFLG=1
QUIT
+1 ;
1116 WRITE "Vendor Congressional District incomplete",!
SET ACHSVFLG=1
QUIT
+1 ;
1125 WRITE "Vendor Geographical Location incomplete",!
SET ACHSVFLG=1
QUIT
+1 ;
1302 WRITE !,"Vendor mailing address city incomplete",!
SET ACHSVFLG=1
QUIT
+1 ;
1303 WRITE !,"Vendor mailing address state incomplete",!
SET ACHSVFLG=1
QUIT
+1 ;
1304 WRITE !,"Vendor mailing address zip incomplete",!
SET ACHSVFLG=1
QUIT
+1 ;IHS/SET/JVK ACHS*3.1*6 END NEW CODE
