Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBYP584A

IBYP584A.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. TYPE ; change facility type from 3-NPB to 2-PBO for primary division
  1. N IBA,IBARY,IBCNT,IBI,IBLN,IBLND,IBHDV,IBBDV,IBBIEN,DA,DIE,DR,X,Y S IBCNT=0
  1. D MSG("")
  1. D MSG(" >> Updating Billing Regions with Provider Based (Facility Type 2)")
  1. F IBI=1:1 S IBLN=$P($T(NPBTX+IBI),";;",2) Q:IBLN="" D
  1. . S IBHDV=$P(IBLN,U) Q:IBHDV=""
  1. . S ^TMP("IB584",$J,IBHDV,IBI)=""
  1. ;
  1. ; update type with 2 if not match
  1. S IBBIEN=0 F S IBBIEN=$O(^IBE(363.31,IBBIEN)) Q:'IBBIEN D
  1. . S IBLND=$G(^IBE(363.31,IBBIEN,0)) Q:IBLND=""
  1. . Q:$E(IBLND,1,3)'="RC "
  1. . S IBBDV=$P(IBLND," ",2) Q:IBBDV=""
  1. . Q:'$D(^TMP("IB584",$J,IBBDV))
  1. . Q:$P(IBLND,U,3)=2
  1. . ;
  1. . S DIE="^IBE(363.31,",DA=IBBIEN,DR=".03///2"
  1. . D ^DIE K DIE,DR,DA,X,Y
  1. . S IBCNT=IBCNT+1,IBARY($P(IBLND,U))=""
  1. ;
  1. ; display region name by order
  1. S IBBDV="" F S IBBDV=$O(IBARY(IBBDV)) Q:IBBDV="" D MSG(" "_IBBDV)
  1. D MSG(" Done. "_IBCNT_" facility type of billing regions changed")
  1. K ^TMP("IB584",$J)
  1. Q
  1. ;
  1. MSG(IBA) ;
  1. D MES^XPDUTL(IBA)
  1. Q
  1. ; 13 from Non-Provider Based (type 3) to Provider Based Outpt (type 2)
  1. NPBTX ; station^location^state^zip 3^VN
  1. ;;402QB^HOULTON VA CLINIC, ME^ME^047^1
  1. ;;436GJ^MILES CITY VA CLINIC, MT^MT^593^19
  1. ;;568HA^NEWCASTLE, WY^WY^827^23
  1. ;;573GN^PERRY VA CLINIC, FL^FL^323^8
  1. ;;573QJ^JACKSONVILLE 2 VA CLINIC, FL^FL^322^8
  1. ;;626GJ^HOPKINSVILLE VA CLINIC, KY^KY^422^9
  1. ;;626GN^ATHENS VA CLINIC, TN^TN^373^9
  1. ;;631QA^PLANTATION STREET VA CLINIC, MA^MA^016^1
  1. ;;652GB^FREDERICKSBURG 2 VA CLINIC, VA^VA^224^6
  1. ;;655QB^GRAND TRAVERSE VA CLINIC, MI^MI^496^10
  1. ;;658GA^TAZEWELL VA CLINIC, VA^VA^246^6
  1. ;;659BZ^SOUTH CAHRLOTTE VA CLINIC, NC^NC^282^6
  1. ;;671GC^DEL RIO VA CLINIC, TX^TX^788^17
  1. ;
  1. Q