source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBAAVD4.m@ 808

Last change on this file since 808 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1FBAAVD4 ;AISC/CLT, Special routine for entering/inactivating/deleting NPI in file 161.2; ; 19 Sep 2006 12:31 PM
2 ;;3.5;FEE BASIS;**98**;30-JAN-95;Build 54
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;This routine will ask for the NPI, check for proper format, check for duplicate entries
6 ;check for proper format using the double-add-double formula. If the NPI is being
7 ;deleted it will check if it is being deleted because of a valid NPI being removed for some
8 ;other reason. If it is being deleted because of an erroneous entry it will be completely deleted.
9 ; If it is a valid NPI being deleted because of a possible inappropriate usage it will be maintained
10 ; in the history cross reference to preclude anyone from using this NPI again.
11 ;
12EN ;Routine primary entry point
13 ;
14 N DIR,DUOUT,DTOUT,FBIEN,FBRTN,FBNPI,X,Y,FBCHECK,FBOLDNPI,FBRBNPI,DIE,DIC,DR
15 S FBIEN=DA,FBRTN=""
16 I $G(DA) S:$P($G(^FBAAV(DA,3)),U,2)'="" (DIR("B"),FBOLDNPI)=$P($G(^FBAAV(DA,3)),U,2)
17EN1 S DIR(0)="FO^10:10",DIR("A")="BILLING PROVIDER NPI",DIR("?")="Enter a 10 digit National Provider Identifier" S:'$G(DTIME) DIR("T")=600 S FBCHECK=0
18 D ^DIR G:$G(DUOUT)!$G(DTOUT) XIT G:X="@" DEL I X=""!(X=$P($G(^FBAAV(FBIEN,3)),U,2)) G XIT
19 I Y="" S:$G(FBOLDNPI) FBNPI=FBOLDNPI G XIT
20 S FBNPI=Y I '$$CHKDGT^XUSNPI(FBNPI) D BADCHK G EN1
21 I $$DUP^FBNPILK(FBNPI)'=""&(FBRTN'=DA) K DIR("A") G EN1
22 I $G(FBOLDNPI)'="" I FBNPI'=FBOLDNPI D INACT
23 D:FBNPI'="" ACTIVATE
24 G XIT
25 ;
26BADCHK ;BACK CHECK DIGIT ON THE NPI
27 W !,*7,"Not a valid NPI. Please try again."
28 Q
29 ;
30ACTIVATE ;CREATE AN ACTIVATED ENTRY IN MULTIPLE NPI FIELD
31 Q:$G(FBNPI)=""
32 S DA(1)=FBIEN,DIC="^FBAAV("_DA(1)_",""NPI"",",DIC(0)="L",X=$$NOW^XLFDT() H 1
33 S DIC("DR")=".02////^S X=1;.03////^S X=FBNPI;.04////^S X=DUZ"
34 D ^DIC
35 S $P(^FBAAV(FBIEN,3),U,2)=FBNPI,^FBAAV("NPI",FBNPI,FBIEN)="",^FBAAV("NPIHISTORY",FBNPI,FBIEN)=""
36 Q
37 ;
38DEL ;NPI HAS BEEN DELETED
39 ;If the user deletes the NPI this subroutine will determine why it was deleted and if it was because it was found
40 ;in a false identity situation will not allow it to be deleted, but removed to history to never be used again.
41 I $P($G(^FBAAV(DA,3)),U,2)="" W " ??",$C(7) Q
42 S FBNPI=DIR("B") K DIR S DIR(0)="Y",DIR("A")="Are you sure you wish to delete this NPI",DIR("?")="You have indicated you wish to delete the NPI. This is a second chance check."
43 D ^DIR
44 G:$G(Y)=0 XIT
45 S DIR(0)="S^E:ERROR;V:VALID",DIR("A")="Was this a Valid NPI or an NPI entered in Error",DIR("?",1)="An example of an NPI entered in error is if the entry person transposes numbers,"
46 S DIR("?",2)="or the NPI for one provider is accidentally assigned to a different provider."
47 S DIR("?")="Enter a 'E' for Error or a 'V' for Valid."
48 D ^DIR
49 D:$G(Y)="E" COMP I $G(Y)="V" S FBCHECK=3 D INACT
50 Q
51 ;
52COMP ;COMPLETELY DELETE THE NPI
53 ;This subroutine will delete the NPI from the NPI and NPIHISTORY cross references. It make an entry in the
54 ;NPI multiple field within a vendor record to indicate that the NPI has been deleted.
55 K ^FBAAV("NPI",FBNPI,DA),^FBAAV("NPIHISTORY",FBNPI,DA)
56 S DA(1)=FBIEN,DIC="^FBAAV("_DA(1)_",""NPI"",",DIC(0)="L",X=$$NOW^XLFDT()
57 S FBRB=0
58 D ; Find the most recent status '0' (inactive) NPI entry in the list that was not later made status '2' (deleted).
59 . N FBRBLST,FBRBTMP
60 . ; Don't want to roll back to the same number you are deleting.
61 . S FBRBLST(FBNPI)=""
62 . S FBRBTMP=$P(^FBAAV(FBIEN,"NPI",0),U,3)
63 . ; Go through each entry in reverse order
64 . F S FBRBTMP=$O(^FBAAV(FBIEN,"NPI",FBRBTMP),-1) Q:'FBRBTMP D Q:FBRB'=0
65 .. S FBRBLST=^FBAAV(FBIEN,"NPI",FBRBTMP,0)
66 .. ; If this is an 'active' entry then ignore it.
67 .. I $P(FBRBLST,U,2)=1 Q
68 .. ; If this is a 'deleted' entry then store the NPI for later comparison to any 'inactive' entries found.
69 .. I $P(FBRBLST,U,2)=2 S FBRBLST($P(FBRBLST,U,3))="" Q
70 .. ; If this is an 'inactive' entry and there is no 'deleted' entry then report it.
71 .. I $P(FBRBLST,U,2)=0,'$D(FBRBLST($P(FBRBLST,U,3))) S FBRB=FBRBTMP Q
72 .. Q
73 . Q
74 S DIC("DR")=".02////^S X=2;.03////^S X=FBOLDNPI;.04////^S X=DUZ"
75 D ^DIC S ^FBAAV(DA,3)="^"
76 W !,"This NPI has been deleted.",!
77 I FBRB>0 D ROLLBACK
78 Q
79 ;
80INACT ;INACTIVATE AN ENTRY
81 ;This subroutine makes two entries in the NPI multiple field. One for the activation of a new NPI and the second
82 ;is the deactivation of the old NPI.
83 S DA(1)=FBIEN,DIC="^FBAAV("_DA(1)_",""NPI"",",DIC(0)="L",X=$$NOW^XLFDT()
84 S DIC("DR")=".02////^S X=$S(FBCHECK=2:2,FBCHECK=3:0,1:0);.03////^S X=FBOLDNPI;.04////^S X=DUZ"
85 D ^DIC
86 S ^FBAAV("NPIHISTORY",FBOLDNPI,DA(1))="" K ^FBAAV("NPI",FBOLDNPI,DA(1))
87 S $P(^FBAAV(FBIEN,3),U,2)=""
88 I FBCHECK=0 D ACTIVATE
89 S ^FBAAV("NPIHISTORY",FBNPI,DA(1))=""
90 Q
91 ;
92ROLLBACK ;ROLL BACK TO THE PREVIOUS NPI AFTER AN NPI IS DELETED
93 S (FBNPI,FBRBNPI)=$P(^FBAAV(FBIEN,"NPI",FBRB,0),U,3)
94 S $P(^FBAAV(DA(1),3),U,2)=FBRBNPI,^FBAAV("NPI",FBRBNPI,DA(1))=""
95 H 1 D ACTIVATE
96 Q
97 ;
98XIT ;CLEAN AND EXIT
99 K FBRTN,FBRB,FBNPI,FBBT
100 Q
Note: See TracBrowser for help on using the repository browser.