IB20P395	;OAK/ELZ - POST INIT ROUTINE FOR IB*2*395 ;1/30/2008
	;;2.0;INTEGRATED BILLING;**395**;21-MAR-94;Build 3
	;;Per VHA Directive 10-93-142, this routine should not be modified.
	;
	;
POST	; Post init to edit 364.7 and update the Format Code
	;
	N IBL,IBM,IBX,IB353,IB3646,IB3645,IB3647
	;
	S IBL=0 D M(""),M("  IB*2*395 Post-Install Starting ....."),M(""),MES^XPDUTL(.IBM) K IBM S IBL=0
	;
	; ^IBE(353,"B","CMS-1500",0)
	;        BILL FORM: CMS-1500
	;        NATIONAL FORM: YES
	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
	I '$G(IB353) D M(""),M("          ***** Post-Install ERROR *****"),M("  -Cannot find National CMS-1500 form in file 353!!!"),M(""),MES^XPDUTL(.IBM) Q
	;
	;
	; ^IBA(364.6,"C","SERVICE FAC NPI (BX-32A)",0)
	;        BILL FORM: CMS-1500
	;        SECURITY LEVEL: NATIONAL,NO EDIT
	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
	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
	;
	;
	; ^IBA(364.5,"B","N-RENDERING INSTITUTION",0)
	;        SECURITY LEVEL: NATIONAL,NO EDIT
	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
	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
	;
	;
	; ^IBA(364.7,"B",364.6 entry
	;        SECURITY LEVEL: NATIONAL,NO EDIT
	;        DATA ELEMENT: N-RENDERING INSTITUTION
	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
	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
	;
	; set in format code
	S ^IBA(364.7,IB3647,1)=$P($T(CODE+1),";",3,99)
	;
	;
	D M("  Format code updated in 364.7 for National SERVICE FAC NPI (BX-32A)"),M(" ")
	D MES^XPDUTL(.IBM) K IBM S IBL=0
	;
	D M("  IB*2*395 Post-Install Done .....")
	D MES^XPDUTL(.IBM)
	;
	Q
	;
M(Y)	; sets up messages
	; Y = text to set up
	S IBL=IBL+1,IBM(IBL)=Y
	Q
	;
CODE	; new format code for 364.7 entry
	;;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
	;;