| [613] | 1 | IB20P395 ;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 | ;
|
|---|
| 6 | POST ; 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 | ;
|
|---|
| 50 | M(Y) ; sets up messages
|
|---|
| 51 | ; Y = text to set up
|
|---|
| 52 | S IBL=IBL+1,IBM(IBL)=Y
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | CODE ; 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 | ;;
|
|---|
