- IBYP584A ;ALB/CXW - IB*2.0*584 POST INIT: BILLING REGION UPDATE ;12-27-2016
- ;;2.0;INTEGRATED BILLING;**584**;21-MAR-94;Build 40
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- TYPE ; change facility type from 3-NPB to 2-PBO for primary division
- N IBA,IBARY,IBCNT,IBI,IBLN,IBLND,IBHDV,IBBDV,IBBIEN,DA,DIE,DR,X,Y S IBCNT=0
- D MSG("")
- D MSG(" >> Updating Billing Regions with Provider Based (Facility Type 2)")
- F IBI=1:1 S IBLN=$P($T(NPBTX+IBI),";;",2) Q:IBLN="" D
- . S IBHDV=$P(IBLN,U) Q:IBHDV=""
- . S ^TMP("IB584",$J,IBHDV,IBI)=""
- ;
- ; update type with 2 if not match
- S IBBIEN=0 F S IBBIEN=$O(^IBE(363.31,IBBIEN)) Q:'IBBIEN D
- . S IBLND=$G(^IBE(363.31,IBBIEN,0)) Q:IBLND=""
- . Q:$E(IBLND,1,3)'="RC "
- . S IBBDV=$P(IBLND," ",2) Q:IBBDV=""
- . Q:'$D(^TMP("IB584",$J,IBBDV))
- . Q:$P(IBLND,U,3)=2
- . ;
- . S DIE="^IBE(363.31,",DA=IBBIEN,DR=".03///2"
- . D ^DIE K DIE,DR,DA,X,Y
- . S IBCNT=IBCNT+1,IBARY($P(IBLND,U))=""
- ;
- ; display region name by order
- S IBBDV="" F S IBBDV=$O(IBARY(IBBDV)) Q:IBBDV="" D MSG(" "_IBBDV)
- D MSG(" Done. "_IBCNT_" facility type of billing regions changed")
- K ^TMP("IB584",$J)
- Q
- ;
- MSG(IBA) ;
- D MES^XPDUTL(IBA)
- Q
- ; 13 from Non-Provider Based (type 3) to Provider Based Outpt (type 2)
- NPBTX ; station^location^state^zip 3^VN
- ;;402QB^HOULTON VA CLINIC, ME^ME^047^1
- ;;436GJ^MILES CITY VA CLINIC, MT^MT^593^19
- ;;568HA^NEWCASTLE, WY^WY^827^23
- ;;573GN^PERRY VA CLINIC, FL^FL^323^8
- ;;573QJ^JACKSONVILLE 2 VA CLINIC, FL^FL^322^8
- ;;626GJ^HOPKINSVILLE VA CLINIC, KY^KY^422^9
- ;;626GN^ATHENS VA CLINIC, TN^TN^373^9
- ;;631QA^PLANTATION STREET VA CLINIC, MA^MA^016^1
- ;;652GB^FREDERICKSBURG 2 VA CLINIC, VA^VA^224^6
- ;;655QB^GRAND TRAVERSE VA CLINIC, MI^MI^496^10
- ;;658GA^TAZEWELL VA CLINIC, VA^VA^246^6
- ;;659BZ^SOUTH CAHRLOTTE VA CLINIC, NC^NC^282^6
- ;;671GC^DEL RIO VA CLINIC, TX^TX^788^17
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYP584A 1925 printed Jan 18, 2025@03:37:21 Page 2
- IBYP584A ;ALB/CXW - IB*2.0*584 POST INIT: BILLING REGION UPDATE ;12-27-2016
- +1 ;;2.0;INTEGRATED BILLING;**584**;21-MAR-94;Build 40
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- TYPE ; change facility type from 3-NPB to 2-PBO for primary division
- +1 NEW IBA,IBARY,IBCNT,IBI,IBLN,IBLND,IBHDV,IBBDV,IBBIEN,DA,DIE,DR,X,Y
- SET IBCNT=0
- +2 DO MSG("")
- +3 DO MSG(" >> Updating Billing Regions with Provider Based (Facility Type 2)")
- +4 FOR IBI=1:1
- SET IBLN=$PIECE($TEXT(NPBTX+IBI),";;",2)
- if IBLN=""
- QUIT
- Begin DoDot:1
- +5 SET IBHDV=$PIECE(IBLN,U)
- if IBHDV=""
- QUIT
- +6 SET ^TMP("IB584",$JOB,IBHDV,IBI)=""
- End DoDot:1
- +7 ;
- +8 ; update type with 2 if not match
- +9 SET IBBIEN=0
- FOR
- SET IBBIEN=$ORDER(^IBE(363.31,IBBIEN))
- if 'IBBIEN
- QUIT
- Begin DoDot:1
- +10 SET IBLND=$GET(^IBE(363.31,IBBIEN,0))
- if IBLND=""
- QUIT
- +11 if $EXTRACT(IBLND,1,3)'="RC "
- QUIT
- +12 SET IBBDV=$PIECE(IBLND," ",2)
- if IBBDV=""
- QUIT
- +13 if '$DATA(^TMP("IB584",$JOB,IBBDV))
- QUIT
- +14 if $PIECE(IBLND,U,3)=2
- QUIT
- +15 ;
- +16 SET DIE="^IBE(363.31,"
- SET DA=IBBIEN
- SET DR=".03///2"
- +17 DO ^DIE
- KILL DIE,DR,DA,X,Y
- +18 SET IBCNT=IBCNT+1
- SET IBARY($PIECE(IBLND,U))=""
- End DoDot:1
- +19 ;
- +20 ; display region name by order
- +21 SET IBBDV=""
- FOR
- SET IBBDV=$ORDER(IBARY(IBBDV))
- if IBBDV=""
- QUIT
- DO MSG(" "_IBBDV)
- +22 DO MSG(" Done. "_IBCNT_" facility type of billing regions changed")
- +23 KILL ^TMP("IB584",$JOB)
- +24 QUIT
- +25 ;
- MSG(IBA) ;
- +1 DO MES^XPDUTL(IBA)
- +2 QUIT
- +3 ; 13 from Non-Provider Based (type 3) to Provider Based Outpt (type 2)
- NPBTX ; station^location^state^zip 3^VN
- +1 ;;402QB^HOULTON VA CLINIC, ME^ME^047^1
- +2 ;;436GJ^MILES CITY VA CLINIC, MT^MT^593^19
- +3 ;;568HA^NEWCASTLE, WY^WY^827^23
- +4 ;;573GN^PERRY VA CLINIC, FL^FL^323^8
- +5 ;;573QJ^JACKSONVILLE 2 VA CLINIC, FL^FL^322^8
- +6 ;;626GJ^HOPKINSVILLE VA CLINIC, KY^KY^422^9
- +7 ;;626GN^ATHENS VA CLINIC, TN^TN^373^9
- +8 ;;631QA^PLANTATION STREET VA CLINIC, MA^MA^016^1
- +9 ;;652GB^FREDERICKSBURG 2 VA CLINIC, VA^VA^224^6
- +10 ;;655QB^GRAND TRAVERSE VA CLINIC, MI^MI^496^10
- +11 ;;658GA^TAZEWELL VA CLINIC, VA^VA^246^6
- +12 ;;659BZ^SOUTH CAHRLOTTE VA CLINIC, NC^NC^282^6
- +13 ;;671GC^DEL RIO VA CLINIC, TX^TX^788^17
- +14 ;
- +15 QUIT