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

IBCEP0A.m

Go to the documentation of this file. 
  1. IBCEP0A ;ALB/TMP - EDI UTILITIES for insurance assigned provider ID ;01-NOV-00
  1.  ;;2.0;INTEGRATED BILLING;**137,232,320,377**;21-MAR-94;Build 23
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. NEW(IBINS,IBPRV,IBPTYP,IBDEF) ; Add new insurance co assigned id
  1.  ; IBDEF = flag sent as 1 if only insurance co defaults are being added
  1.  N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IBQ,IBIEN,IBCUND,DTOUT,DUOUT
  1.  D FULL^VALM1
  1.  S IBQ=0
  1.  I $G(IBDEF)="D" W !!,"YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",!
  1.  I '$G(IBPRV),$G(IBDEF)'="D" D  G:IBQ NEWQ
  1.  . N DA,IBO
  1.  . S IBO=($G(IBDSP)'="I")
  1.  . S DIR(0)="355.9,.01A"_$S(IBO:"O",1:""),DIR("A")="Select PROVIDER"_$S(IBO:" (optional)",1:"")_": "
  1.  . S DIR("?")="Select the PROVIDER to be assigned a provider ID"
  1.  . I IBO S DIR("?",1)=DIR("?"),DIR("?")="Or    Press ENTER to add an insurance co level default id (all providers)"
  1.  . W ! D ^DIR K DIR W !
  1.  . I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
  1.  . S IBPRV=$S(Y>0:$P(Y,U),1:"")
  1.  . Q:IBPRV
  1.  . S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",DIR("A")="IS THIS OK?: "
  1.  . W ! D ^DIR K DIR W !
  1.  . I $D(DTOUT)!$D(DUOUT)!(Y'=1) S IBQ=1
  1.  . Q
  1.  ;
  1.  I '$G(IBPTYP) D  G:IBQ NEWQ
  1.  . S DIR(0)="PAr^355.97:AEMQ",DIR("A")="Select Provider ID Qualifier: "
  1.  . S DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
  1.  . S DIR("S")="I $$RAINS^IBCEPU(Y)"   ; Rendering/Attending IDs provided by ins
  1.  . S DA=0
  1.  . W ! D ^DIR K DIR W !
  1.  . I $D(DTOUT)!$D(DUOUT)!'Y S IBQ=1 Q
  1.  . S IBPTYP=+Y
  1.  ;
  1.  S IBQ=$$ADDID(IBINS,IBPRV,IBPTYP)
  1.  ;
  1. NEWQ D:'$G(IBQ) BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. DEL1 ; Delete Insurance Co assigned provider ID's
  1.  ; IBPRV = vp ien of provider if editing entry in file 355.9
  1.  ;         otherwise, null
  1.  N IB1,IBDA,IBFILE
  1.  D FULL^VALM1
  1.  D SEL^IBCEP0(.IBDA)
  1.  G:'$O(IBDA(0)) DEL1Q
  1.  S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
  1.  G:'IBDA DEL1Q
  1.  S IB1=$P(IBDA,U,2),IBDA=+IBDA
  1.  S IBFILE=$S(IB1:355.9,1:355.91)
  1.  I IBDA>0 D DEL^IBCEP5B(IBFILE,IBDA,1),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
  1.  ;
  1. DEL1Q S VALMBCK="R"
  1.  Q
  1.  ;
  1. CHG1 ; Edit Provider ID's
  1.  N IBDA,IB1,IBFILE
  1.  D FULL^VALM1
  1.  D SEL^IBCEP0(.IBDA)
  1.  G:'$O(IBDA(0)) CHG1Q
  1.  S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
  1.  G:'IBDA CHG1Q
  1.  S IB1=$P(IBDA,U,2),IBDA=+IBDA
  1.  S IBFILE=$S(IB1:355.9,1:355.91)
  1.  I IBDA>0 D
  1.  . I IBFILE=355.9 W !!,"PROVIDER: ",$$EXPAND^IBTRE(355.9,.01,IB1)
  1.  . I IBFILE'=355.9 W !!,"  <<INS CO DEFAULT>>"
  1.  . D CHG^IBCEP5B(IBFILE,IBDA),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
  1.  ;
  1. CHG1Q S VALMBCK="R"
  1.  Q
  1.  ;
  1. PRVJMP(IBDSP) ; Navigate to a specific sort level in current LM list
  1.  ;   (from insurance co option)
  1.  ; IBDSP = 'I', 'A' or 'D' to indicate format selected for display
  1.  ;        ([P]ROVIDER, PROVIDER [T]YPE OR [I]NSURANCE DEFAULT)
  1.  ; Sets VALMBG = LINE # if a provider in list selected
  1.  ;
  1.  I $G(IBDSP)="I" D PRVNJMP(.VALMBG)
  1.  I $G(IBDSP)="D"!($G(IBDSP)="A") D PRVTJMP(.VALMBG)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. PRVNJMP(VALMBG) ; Navigate to a specific provider name (from insurance co
  1.  ;  option)
  1.  ;
  1.  N DIR,X,Y,DA
  1.  D FULL^VALM1
  1.  S DIR(0)="355.9,.01AO^^I '$D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Y)_U_$P(Y,U))) K X"
  1.  S DIR("?",1)="*** YOU MAY ONLY SELECT PROVIDERS INCLUDED IN THE CURRENT LIST ***",DIR("?",2)=" ",DIR("?",3)="SELECTING A PROVIDER WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR THAT",DIR("?")="   PROVIDER"
  1.  S DIR("A")="SELECT PROVIDER: "
  1.  S DIR("S")="N Z S Z=$P(^(0),U) I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Z)_U_Z))"
  1.  W ! D ^DIR K DIR W !
  1.  I Y>0,'$D(DTOUT),'$D(DUOUT) D
  1.  . N Z
  1.  . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPRV",U_$$EXPAND^IBTRE(355.9,.01,$P(Y,U))_U_$P(Y,U)))
  1.  . I Z S VALMBG=Z Q
  1.  . S DIR(0)="EA",DIR("A",1)="THIS PROVIDER DOES NOT EXIST IN THE CURRENT DISPLAY",DIR("A")="PRESS THE ENTER KEY TO CONTINUE"
  1.  . W ! D ^DIR K DIR W !
  1.  Q
  1.  ;
  1. PRVTJMP(VALMBG) ; Navigate to a specific type of ID qualifier (from ins co option)
  1.  ;
  1.  N DIR,X,Y
  1.  D FULL^VALM1
  1.  S DIR(0)="PAO^355.97:AEMQ",DIR("A")="Select type of ID Qualifier: "
  1.  S DIR("?")="Select a type of ID Qualifier to display the IDs of that type."
  1.  S DIR("S")="I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPTYP"",+Y))"
  1.  W ! D ^DIR K DIR W !
  1.  I Y>0,'$D(DTOUT),'$D(DUOUT) D
  1.  . N Z
  1.  . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPTYP",+Y))
  1.  . I Z S VALMBG=Z Q
  1.  . S DIR(0)="EA",DIR("A",1)="This type of ID Qualifier does not exist in the current display",DIR("A")="Press the Enter key to continue"
  1.  . W ! D ^DIR K DIR W !
  1.  Q
  1.  ;
  1. CHGINS ; Change insurance co being displayed, using the same or new params
  1.  ; Assumes IBINS exists = IEN of insurance co (file 36)
  1.  N IBINEW,IBSAVE,DIC,DA,Y,X,DIR
  1.  D FULL^VALM1
  1.  S DIC="^DIC(36,",DIC(0)="AEMQ" D ^DIC
  1.  S IBINEW=+Y
  1.  ;
  1.  I IBINEW>0,IBINS'=IBINEW D
  1.  . D COPYPROV^IBCEP5A(IBINS)
  1.  . S DIR(0)="YA",DIR("?")="IF YOU WANT TO CHANGE THE FORMAT OF THE DISPLAY, RESPOND NO HERE"
  1.  . S DIR("A")="DO YOU WANT TO DISPLAY THE NEW INS. CO IDS USING THE CURRENT DISPLAY FORMAT?: ",DIR("B")="YES" W ! D ^DIR W ! K DIR
  1.  . Q:Y'=1
  1.  . S IBSAVE("IBINS")=IBINS
  1.  . K ^TMP("IBPRV_INS_ID",$J),VALMHDR S VALMBG=1,IBINS=IBINEW
  1.  . I Y=1 D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT)) Q
  1.  . D INIT^IBCEP0
  1.  . I '$G(VALMQUIT) Q
  1.  . S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. CHGFMT ; Change format parameters for display
  1.  N IBSAVE
  1.  S IBSAVE("IBINS")=$G(IBINS)
  1.  D INIT^IBCEP0
  1.  I '$G(VALMQUIT) G CHGFMTQ
  1.  S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
  1. CHGFMTQ S VALMBCK="R"
  1.  Q
  1.  ;
  1. IPARAM ; Display Insurance co parameters and care unit requirements
  1.  ; Assumes IBINS exists = IEN of insurance co
  1.  N IBDSP,IBSORT,IBHOLD
  1.  D FULL^VALM1
  1.  S IBHOLD("IBINS")=$G(IBINS)
  1.  D EN^VALM("IBCE PRVINS PARAM DISPLAY")
  1.  S:$G(IBHOLD("IBINS"))'="" IBINS=IBHOLD("IBINS")
  1.  K VALMQUIT
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. ADDID(IBINS,IBPRV,IBPTYP) ; Adds a new ID for the provider and/or ins co
  1.  ; IBINS = ien of file 36
  1.  ; IBPRV = vp ien of file 355.9
  1.  ; IBPTYP = ien of file 355.97
  1.  ; FUNCTION returns 1 if record not added, 0 if filed OK
  1.  N IBIEN,IBQ,DIC,DA,DO,DD,DLAYGO,X,Y
  1.  S IBQ=0
  1.  I $G(IBPRV) D  G:IBQ ADDIDQ
  1.  . ; Provider specific for insurance co - add to file 355.9
  1.  . S DIC(0)="L",DLAYGO=355.9,DIC="^IBA(355.9,",X=IBPRV
  1.  . S:$G(IBINS) DIC("DR")=".02////"_IBINS
  1.  . D FILE^DICN K DIC,DLAYGO,DD,DO
  1.  . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
  1.  . S IBIEN=+Y
  1.  . D NEWID^IBCEP5B(355.9,IBINS,IBPRV,IBPTYP,IBIEN,"")
  1.  E  D
  1.  . ; Insurance co default - add to file 355.91
  1.  . S DIC(0)="L",DLAYGO=355.91,DIC="^IBA(355.91,",X=IBINS
  1.  . D FILE^DICN K DIC,DLAYGO,DD,DO
  1.  . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
  1.  . S IBIEN=+Y
  1.  . D NEWID^IBCEP5B(355.91,IBINS,"",IBPTYP,IBIEN,1)
  1. ADDIDQ Q IBQ