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