- 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
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P395 2648 printed Mar 13, 2025@21:07:22 Page 2
- IB20P395 ;OAK/ELZ - POST INIT ROUTINE FOR IB*2*395 ;1/30/2008
- +1 ;;2.0;INTEGRATED BILLING;**395**;21-MAR-94;Build 3
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;
- POST ; Post init to edit 364.7 and update the Format Code
- +1 ;
- +2 NEW IBL,IBM,IBX,IB353,IB3646,IB3645,IB3647
- +3 ;
- +4 SET IBL=0
- DO M("")
- DO M(" IB*2*395 Post-Install Starting .....")
- DO M("")
- DO MES^XPDUTL(.IBM)
- KILL IBM
- SET IBL=0
- +5 ;
- +6 ; ^IBE(353,"B","CMS-1500",0)
- +7 ; BILL FORM: CMS-1500
- +8 ; NATIONAL FORM: YES
- +9 SET IBX=0
- FOR
- SET IBX=$ORDER(^IBE(353,"B","CMS-1500",IBX))
- if 'IBX
- QUIT
- IF $PIECE($GET(^IBE(353,IBX,2)),"^",4)
- SET IB353=IBX
- QUIT
- +10 IF '$GET(IB353)
- DO M("")
- DO M(" ***** Post-Install ERROR *****")
- DO M(" -Cannot find National CMS-1500 form in file 353!!!")
- DO M("")
- DO MES^XPDUTL(.IBM)
- QUIT
- +11 ;
- +12 ;
- +13 ; ^IBA(364.6,"C","SERVICE FAC NPI (BX-32A)",0)
- +14 ; BILL FORM: CMS-1500
- +15 ; SECURITY LEVEL: NATIONAL,NO EDIT
- +16 SET IBX=0
- FOR
- SET IBX=$ORDER(^IBA(364.6,"C","SERVICE FAC NPI (BX-32A)",IBX))
- if 'IBX
- QUIT
- IF $PIECE($GET(^IBA(364.6,IBX,0)),"^",1,2)=(IB353_"^N")
- SET IB3646=IBX
- QUIT
- +17 IF '$GET(IB3646)
- DO M("")
- DO M(" ***** Post-Install ERROR *****")
- DO M(" -Cannot find National SERVICE FAC NPI (BX-32A) in file 364.6!!!")
- DO M("")
- DO MES^XPDUTL(.IBM)
- QUIT
- +18 ;
- +19 ;
- +20 ; ^IBA(364.5,"B","N-RENDERING INSTITUTION",0)
- +21 ; SECURITY LEVEL: NATIONAL,NO EDIT
- +22 SET IBX=0
- FOR
- SET IBX=$ORDER(^IBA(364.5,"B","N-RENDERING INSTITUTION",IBX))
- if 'IBX
- QUIT
- IF $PIECE($GET(^IBA(364.5,IBX,0)),"^",2)="N"
- SET IB3645=IBX
- QUIT
- +23 IF '$GET(IB3645)
- DO M("")
- DO M(" ***** Post-Install ERROR *****")
- DO M(" -Cannot find National N-RENDERING INSTITUTION in file 364.5!!!")
- DO M("")
- DO MES^XPDUTL(.IBM)
- QUIT
- +24 ;
- +25 ;
- +26 ; ^IBA(364.7,"B",364.6 entry
- +27 ; SECURITY LEVEL: NATIONAL,NO EDIT
- +28 ; DATA ELEMENT: N-RENDERING INSTITUTION
- +29 SET IBX=0
- FOR
- SET IBX=$ORDER(^IBA(364.7,"B",IB3646,IBX))
- if 'IBX
- QUIT
- IF $PIECE($GET(^IBA(364.7,IBX,0)),"^",2,3)=("N^"_IB3645)
- SET IB3647=IBX
- QUIT
- +30 IF '$GET(IB3647)
- DO M("")
- DO M(" ***** Post-Install ERROR *****")
- DO M(" -Cannot find National SERVICE FAC NPI (BX-32A) in file 364.7!!!")
- DO M("")
- DO MES^XPDUTL(.IBM)
- QUIT
- +31 ;
- +32 ; set in format code
- +33 SET ^IBA(364.7,IB3647,1)=$PIECE($TEXT(CODE+1),";",3,99)
- +34 ;
- +35 ;
- +36 DO M(" Format code updated in 364.7 for National SERVICE FAC NPI (BX-32A)")
- DO M(" ")
- +37 DO MES^XPDUTL(.IBM)
- KILL IBM
- SET IBL=0
- +38 ;
- +39 DO M(" IB*2*395 Post-Install Done .....")
- +40 DO MES^XPDUTL(.IBM)
- +41 ;
- +42 QUIT
- +43 ;
- M(Y) ; sets up messages
- +1 ; Y = text to set up
- +2 SET IBL=IBL+1
- SET IBM(IBL)=Y
- +3 QUIT
- +4 ;
- CODE ; new format code for 364.7 entry
- +1 ;;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
- +2 ;;
