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

ACHSVDVD.m

Go to the documentation of this file. 
  1. 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
  1.  ;ITS/SET/JVK ACHS*3.1*6 TEST FOR COMPLETE VENDOR INFO 4/14/2003
  1.  ;
  1. EP ;
  1.  K ACHSZEIN,ACHSEIN,ACHSSUFF,ACHSUFF,X,ACHSEINS,Z
  1.  I '$D(ACHSPROV) G A1^ACHSVDV
  1.  K ACHSZEIN
  1.  I '$D(^AUTTVNDR(ACHSPROV,11)) G END
  1.  S ACHSEIN=$P(^AUTTVNDR(ACHSPROV,11),U,1)
  1.  I ACHSEIN="" G MESSAGE
  1.  ;
  1.  ;got this far, then we know we have an EIN
  1.  ;now check the address
  1.  S ACHSYAYA=$G(^AUTTVNDR(ACHSPROV,13))
  1.  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
  1.  ;
  1.  ;
  1.  S ACHSSUFF=$P(^AUTTVNDR(ACHSPROV,11),U,2)
  1.  I ACHSSUFF'="" G GETD
  1.  I '$D(^AUTTVNDR("C",ACHSEIN)) G GETD
  1.  S X=$O(^AUTTVNDR("C",ACHSEIN,0))
  1.  I '$O(^AUTTVNDR("C",ACHSEIN,X)) G GETD
  1.  S X=0
  1.  F  S X=$O(^AUTTVNDR("C",ACHSEIN,X)) G:X="" WRITE D
  1.  . S ACHSUFF=$P($G(^AUTTVNDR(X,11)),U,2)
  1.  . I X'=ACHSPROV,ACHSSUFF="" S ACHSZEIN(X)=ACHSEIN
  1.  . I X'=ACHSPROV,ACHSUFF=ACHSSUFF S ACHSZEIN(X)=ACHSEIN
  1.  .Q
  1. GETD ;
  1.  S ACHSEINS=ACHSEIN_ACHSSUFF,X=0
  1.  I '$D(^AUTTVNDR("E",ACHSEINS)) G WRITE
  1.  S X=$O(^AUTTVNDR("E",ACHSEINS,X))
  1.  I '$O(^AUTTVNDR("E",ACHSEINS,X)) G WRITE
  1.  S X=0
  1.  F  S X=$O(^AUTTVNDR("E",ACHSEINS,X)) G WRITE:X="" S:X'=ACHSPROV ACHSZEIN(X)=ACHSEINS
  1. WRITE ;
  1.  I '$D(ACHSZEIN),$D(ACHSDFLG) Q
  1.  I '$D(ACHSZEIN),'$D(ACHSDFLG) G A1A^ACHSVDV
  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(ACHSZEIN(Z)) Q:Z=""  W !,$P(^AUTTVNDR(Z,0),U,1),?40,$P(ACHSZEIN(Z),U)
  1. CHECK ;
  1.  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
  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(ACHSDFLG) 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(ACHSDFLG)
  1.  ;Check to see if vendor/provider edit option
  1.  I '$D(ACHSDFLG),Y=0 G A1A^ACHSVDV
  1.  ;Check to see if initial document
  1. EDIT0 ;
  1.  I $D(ACHSDFLG),$D(DIRUT) K ACHSPROV Q
  1.  I $D(ACHSDFLG),Y=0 K ACHSPROV Q
  1.  S Y="E"
  1.  G EDIT1
  1.  ;
  1. CHOOSE ;
  1.  W !!!,"Entry for "_$P(^AUTTVNDR(ACHSPROV,0),U,1)_"  "_$S($D(ACHSEINS):ACHSEINS,1:ACHSEIN)
  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(ACHSPROV,0),U)_"  "_$S($D(ACHSEINS):ACHSEINS,1:ACHSEIN) W !! S DR="1101;1102",DIE="^AUTTVNDR(",DA=ACHSPROV D ^DIE K:$D(Y) ACHSPROV
  1.  K ACHSEIN,ACHSZEIN,ACHSSUFF,Z,X,DA,ACHSEINS,DIR,DIC,DIE,DIK
  1.  G EP
  1.  ;
  1. DELETE ;
  1.  K DIR
  1.  S DIR(0)="Y",DIR("A")="DELETE entry "_$P(^AUTTVNDR(ACHSPROV,0),U,1)_"  "_$S($D(ACHSEINS):ACHSEINS,1:ACHSEIN),DIR("B")="YES"
  1.  D ^DIR
  1.  K DIR
  1.  G:Y=0 EDIT
  1.  S DIK="^AUTTVNDR(",DA=ACHSPROV
  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(ACHSPROV,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 ACHSEIN,ACHSZEIN,ACHSSUFF,Z,X,DA,ACHSEINS,ACHSPROV
  1.  G A1^ACHSVDV
  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=ACHSPROV D ^DIE
  1.  Q
  1.  ;
  1. VCHK ;
  1.  ;IHS/SET/JVK ACHS*3.1*6 4/14/2003
  1.  ;ENTRY POINT FROM ACHSA1
  1.  ;ADDED THIS SECTION AS TEST FOR COMPLETE VENDOR EIN INFO
  1.  S ACHSVFLG=""
  1.  S ACHSTST=$P(Y,U,1)
  1.  F %=1102,1110,1116,1125,1302,1303,1304  D
  1.  . S VAL=$$GET1^DIQ(9999999.11,ACHSTST,%,"I")
  1.  . I VAL="" D @(+%)
  1.  . Q
  1.  K ACHSTST
  1.  Q
  1.  ;
  1. 1102 W !,"Vendor EIN suffix incomplete",! S ACHSVFLG=1 Q
  1.  ;
  1. 1110 W !,"Vendor FED/NON-FED field incomplete",! S ACHSVFLG=1 Q
  1.  ;
  1. 1116 W "Vendor Congressional District incomplete",! S ACHSVFLG=1 Q
  1.  ;
  1. 1125 W "Vendor Geographical Location incomplete",! S ACHSVFLG=1 Q
  1.  ;
  1. 1302 W !,"Vendor mailing address city incomplete",! S ACHSVFLG=1 Q
  1.  ;
  1. 1303 W !,"Vendor mailing address state incomplete",! S ACHSVFLG=1 Q
  1.  ;
  1. 1304 W !,"Vendor mailing address zip incomplete",! S ACHSVFLG=1 Q
  1.  ;IHS/SET/JVK ACHS*3.1*6 END NEW CODE