Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMCVDVD

BMCVDVD.m

Go to the documentation of this file. 
  1. 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
  1.  ;BMC*4.0*5 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDVD
  1.  ;
  1. EP ;
  1.  I '$D(BMCPROV) G A1^BMCVDV
  1.  K BMCZEIN
  1.  I '$D(^AUTTVNDR(BMCPROV,11)) G END
  1.  S BMCEIN=$P(^AUTTVNDR(BMCPROV,11),U,1)
  1.  I BMCEIN="" G MESSAGE
  1.  ;
  1.  ;got this far, then we know we have an EIN
  1.  ;now check the address
  1.  S BMCYAYA=$G(^AUTTVNDR(BMCPROV,13))
  1.  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
  1.  ;
  1.  ;
  1.  S BMCSUFF=$P(^AUTTVNDR(BMCPROV,11),U,2)
  1.  I BMCSUFF'="" G GETD
  1.  I '$D(^AUTTVNDR("C",BMCEIN)) G GETD
  1.  S X=$O(^AUTTVNDR("C",BMCEIN,0))
  1.  I '$O(^AUTTVNDR("C",BMCEIN,X)) G GETD
  1.  S X=0
  1.  F  S X=$O(^AUTTVNDR("C",BMCEIN,X)) G:X="" WRITE D
  1.  . S BMCUFF=$P($G(^AUTTVNDR(X,11)),U,2)
  1.  . I X'=BMCPROV,BMCSUFF="" S BMCZEIN(X)=BMCEIN
  1.  . I X'=BMCPROV,BMCUFF=BMCSUFF S BMCZEIN(X)=BMCEIN
  1.  .Q
  1. GETD ;
  1.  S BMCEINS=BMCEIN_BMCSUFF,X=0
  1.  I '$D(^AUTTVNDR("E",BMCEINS)) G WRITE
  1.  S X=$O(^AUTTVNDR("E",BMCEINS,X))
  1.  I '$O(^AUTTVNDR("E",BMCEINS,X)) G WRITE
  1.  S X=0
  1.  F  S X=$O(^AUTTVNDR("E",BMCEINS,X)) G WRITE:X="" S:X'=BMCPROV BMCZEIN(X)=BMCEINS
  1. WRITE ;
  1.  I '$D(BMCZEIN),$D(BMCDFLG) Q
  1.  I '$D(BMCZEIN),'$D(BMCDFLG) G A1A^BMCVDV
  1.  W !!?12,*7,*7,"***** The EIN you have entered for this VENDOR is a *****",!?11,"***** duplicate of the EIN for the following VENDOR(S) *****",!!
  1.  S Z=0
  1.  F  S Z=$O(BMCZEIN(Z)) Q:Z=""  W !,$P(^AUTTVNDR(Z,0),U,1),?40,$P(BMCZEIN(Z),U)
  1. CHECK ;
  1.  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
  1. EDIT ;
  1.  W !!?20,"** Duplicate EIN's are NOT ALLOWED! **",!?24,"You MUST enter a UNIQUE EIN or",!?25,"a SUFFIX to an existing EIN."
  1.  I $D(%(0)),'$D(BMCDFLG) G CHOOSE
  1.  K DIR
  1.  S DIR("A")="Do you wish to EDIT NOW",DIR(0)="Y",DIR("B")="NO"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  G END:$D(DIRUT)&'$D(BMCDFLG)
  1.  ;Check to see if vendor/provider edit option
  1.  I '$D(BMCDFLG),Y=0 G A1A^BMCVDV
  1.  ;Check to see if initial document
  1. EDIT0 ;
  1.  I $D(BMCDFLG),$D(DIRUT) K BMCPROV Q
  1.  I $D(BMCDFLG),Y=0 K BMCPROV Q
  1.  S Y="E"
  1.  G EDIT1
  1.  ;
  1. CHOOSE ;
  1.  W !!!,"Entry for "_$P(^AUTTVNDR(BMCPROV,0),U,1)_"  "_$S($D(BMCEINS):BMCEINS,1:BMCEIN)
  1.  K DIR
  1.  S DIR(0)="S^E:Edit;D:Delete",DIR("B")="Delete"
  1.  D ^DIR
  1.  K DIR
  1.  G EDIT:$D(DUOUT),EDIT:$D(DIROUT),EDIT:$D(DIRUT)
  1.  I Y["D" G DELETE
  1. EDIT1 ;
  1.  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
  1.  K BMCEIN,BMCZEIN,BMCSUFF,Z,X,DA,BMCEINS,DIR,DIC,DIE,DIK
  1.  G EP
  1.  ;
  1. DELETE ;
  1.  K DIR
  1.  S DIR(0)="Y",DIR("A")="DELETE entry "_$P(^AUTTVNDR(BMCPROV,0),U,1)_"  "_$S($D(BMCEINS):BMCEINS,1:BMCEIN),DIR("B")="YES"
  1.  D ^DIR
  1.  K DIR
  1.  G:Y=0 EDIT
  1.  S DIK="^AUTTVNDR(",DA=BMCPROV
  1.  W "   ...DELETING..."
  1.  D ^DIK
  1.  G END
  1. MESSAGE ;EP
  1.  U IO
  1.  W !!,"There is no EIN on file for ",$P(^AUTTVNDR(BMCPROV,0),U,1),".",!,"Please edit to continue this process."
  1.  I IOST["C-" K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue..." W !!!! D ^DIR S Y="E" G EDIT1
  1. END ;
  1.  K BMCEIN,BMCZEIN,BMCSUFF,Z,X,DA,BMCEINS,BMCPROV
  1.  G A1^BMCVDV
  1.  ;
  1. GETADDR ;
  1.  ;prompt for and require an address for this provider
  1.  S Y=$$DIR^XBDIR("Y","Edit address now?  ","NO","","","",2)
  1.  I Y=0 S DTOUT=1
  1.  ;
  1.  I $D(DTOUT)!$D(DUOUT) Q
  1.  W !! S DR="1301:1304",DIE="^AUTTVNDR(",DA=BMCPROV D ^DIE
  1.  Q
  1.  ;
  1. VCHK ;
  1.  S BMCVFLG=""
  1.  S BMCTST=$P(Y,U,1)
  1.  F %=1102,1110,1116,1125,1302,1303,1304  D
  1.  . S VAL=$$GET1^DIQ(9999999.11,BMCTST,%,"I")
  1.  . I VAL="" D @(+%)
  1.  K BMCTST
  1.  Q
  1.  ;
  1. 1102 W !,"Vendor EIN suffix incomplete",! S BMCVFLG=1 Q
  1.  ;
  1. 1110 W !,"Vendor FED/NON-FED field incomplete",! S BMCVFLG=1 Q
  1.  ;
  1. 1116 W "Vendor Congressional District incomplete",! S BMCVFLG=1 Q
  1.  ;
  1. 1125 W "Vendor Geographical Location incomplete",! S BMCVFLG=1 Q
  1.  ;
  1. 1302 W !,"Vendor mailing address city incomplete",! S BMCVFLG=1 Q
  1.  ;
  1. 1303 W !,"Vendor mailing address state incomplete",! S BMCVFLG=1 Q
  1.  ;
  1. 1304 W !,"Vendor mailing address zip incomplete",! S BMCVFLG=1 Q