source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20P395.m@ 1154

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

initial load of WorldVistAEHR
File size: 2.5 KB
RevLine 
[613]1IB20P395 ;OAK/ELZ - POST INIT ROUTINE FOR IB*2*395 ;1/30/2008
2 ;;2.0;INTEGRATED BILLING;**395**;21-MAR-94;Build 3
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6POST ; Post init to edit 364.7 and update the Format Code
7 ;
8 N IBL,IBM,IBX,IB353,IB3646,IB3645,IB3647
9 ;
10 S IBL=0 D M(""),M(" IB*2*395 Post-Install Starting ....."),M(""),MES^XPDUTL(.IBM) K IBM S IBL=0
11 ;
12 ; ^IBE(353,"B","CMS-1500",0)
13 ; BILL FORM: CMS-1500
14 ; NATIONAL FORM: YES
15 S IBX=0 F S IBX=$O(^IBE(353,"B","CMS-1500",IBX)) Q:'IBX I $P($G(^IBE(353,IBX,2)),"^",4) S IB353=IBX Q
16 I '$G(IB353) D M(""),M(" ***** Post-Install ERROR *****"),M(" -Cannot find National CMS-1500 form in file 353!!!"),M(""),MES^XPDUTL(.IBM) Q
17 ;
18 ;
19 ; ^IBA(364.6,"C","SERVICE FAC NPI (BX-32A)",0)
20 ; BILL FORM: CMS-1500
21 ; SECURITY LEVEL: NATIONAL,NO EDIT
22 S IBX=0 F S IBX=$O(^IBA(364.6,"C","SERVICE FAC NPI (BX-32A)",IBX)) Q:'IBX I $P($G(^IBA(364.6,IBX,0)),"^",1,2)=(IB353_"^N") S IB3646=IBX Q
23 I '$G(IB3646) D M(""),M(" ***** Post-Install ERROR *****"),M(" -Cannot find National SERVICE FAC NPI (BX-32A) in file 364.6!!!"),M(""),MES^XPDUTL(.IBM) Q
24 ;
25 ;
26 ; ^IBA(364.5,"B","N-RENDERING INSTITUTION",0)
27 ; SECURITY LEVEL: NATIONAL,NO EDIT
28 S IBX=0 F S IBX=$O(^IBA(364.5,"B","N-RENDERING INSTITUTION",IBX)) Q:'IBX I $P($G(^IBA(364.5,IBX,0)),"^",2)="N" S IB3645=IBX Q
29 I '$G(IB3645) D M(""),M(" ***** Post-Install ERROR *****"),M(" -Cannot find National N-RENDERING INSTITUTION in file 364.5!!!"),M(""),MES^XPDUTL(.IBM) Q
30 ;
31 ;
32 ; ^IBA(364.7,"B",364.6 entry
33 ; SECURITY LEVEL: NATIONAL,NO EDIT
34 ; DATA ELEMENT: N-RENDERING INSTITUTION
35 S IBX=0 F S IBX=$O(^IBA(364.7,"B",IB3646,IBX)) Q:'IBX I $P($G(^IBA(364.7,IBX,0)),"^",2,3)=("N^"_IB3645) S IB3647=IBX Q
36 I '$G(IB3647) D M(""),M(" ***** Post-Install ERROR *****"),M(" -Cannot find National SERVICE FAC NPI (BX-32A) in file 364.7!!!"),M(""),MES^XPDUTL(.IBM) Q
37 ;
38 ; set in format code
39 S ^IBA(364.7,IB3647,1)=$P($T(CODE+1),";",3,99)
40 ;
41 ;
42 D M(" Format code updated in 364.7 for National SERVICE FAC NPI (BX-32A)"),M(" ")
43 D MES^XPDUTL(.IBM) K IBM S IBL=0
44 ;
45 D M(" IB*2*395 Post-Install Done .....")
46 D MES^XPDUTL(.IBM)
47 ;
48 Q
49 ;
50M(Y) ; sets up messages
51 ; Y = text to set up
52 S IBL=IBL+1,IBM(IBL)=Y
53 Q
54 ;
55CODE ; new format code for 364.7 entry
56 ;;N IBZ,IBZ1 S IBZ=$P(IBXDATA,U,2),IBZ1="" D F^IBCEF("N-ORGANIZATION NPI CODES","IBZ1",,IBXIEN) S IBXDATA=$S($$ISRX^IBCEF1(IBXIEN):$P(IBZ1,U,3),IBZ=1:$P(IBZ1,U,2),IBZ=0:$P(IBZ1,U),1:$P(IBZ1,U,3)),IBXSAVE("NPISVC")=IBXDATA
57 ;;
Note: See TracBrowser for help on using the repository browser.