IBCEP6 ;ALB/TMP/OIFO-BP/RBN - PROVIDER ID MAINT menu and INS CO EDIT hook ;11-02-00
;;2.0;INTEGRATED BILLING;**137,232,320,377,436**;21-MAR-94;Build 31
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN ; -- main entry point
N IBRESP,IBFLPFLP,IBCEP6FL
S IBCEP6FL=1
D FULL^VALM1
F Q:'$$MENU(.IBRESP) D @IBRESP
ENQ ;
Q
;
EN1 ; Provider maintenance from the billing screen 8
N DIR,X,Y,IBEDIT
W !
I '$D(^XUSEC("IB PROVIDER EDIT",DUZ)) S DIR(0)="EA",DIR("A")="Press ENTER to continue: ",DIR("A",1)="YOU LACK THE SECURITY KEY FOR THIS ACTION" D ^DIR K DIR Q
D EN
Q
;
PO ; provider's own IDs
N IBPRV,IBINS
N IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF
K IBFASTXT
S IBIF=""
S IBPRMPT="PROVIDER"
D FULL^VALM1
S IBSLEV=1
D EN^VALM("IBCE PRVPRV MAINT")
POX ;
Q
;
PI ; provider's IDs provided by an insurance company
N IBPRV,IBINS
N IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF
K IBFASTXT
S IBIF=""
S IBPRMPT="PROVIDER"
D FULL^VALM1
S IBSLEV=2
D EN^VALM("IBCE PRVPRV MAINT")
PIX ;
Q
;
BI ; Insurance company batch ID entry
D EN^IBCEP9
BIX ;
Q
;
II ; Insurance company IDs
D EN^IBCEP0
IIX ;
Q
;
CP ; Care Unit maintenance - performing providers
N IBINS,IBALL,IB95
N IBSLEV,DIR,Y
K IBFASTXT
D FULL^VALM1
S IBSLEV=1
D EN^VALM("IBCE PRVCARE UNIT MAINT")
CPX ;
Q
;
CB ; Care Unit maintenance - billing provider
N IBINS,IBALL,IB95
N IBSLEV,DIR,Y
K IBFASTXT
D FULL^VALM1
S IBSLEV=2
D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
CBX ;
Q
;
NP ; non-VA individual provider information
N IBNVPMIF
S IBNVPMIF="I"
;
; *** Begin IB*2.0*436 - RBN
;
D EN^DDIOL("For individual type entries: The name should be entered in")
D EN^DDIOL(" LAST,FIRST MIDDLE format.")
D EN^DDIOL(" ")
;
; *** End IB*2.0*436 - RBN
;
D EN^IBCEP8
NPX ;
Q
;
NF ; non-VA facility provider information
N IBNVPMIF
S IBNVPMIF="F"
;
; *** Begin IB*2.0*436 - RBN
;
D EN^DDIOL("For facility type entries: The name MUST start with an")
D EN^DDIOL("Alpha character and may contain numerals, spaces, commas, ")
D EN^DDIOL("periods, and a hyphen or dash.")
D EN^DDIOL(" ")
;
; *** End IB*2.0*436 - RBN
;
D EN^IBCEP8
NFX ;
Q
;
; function value returns 0 if user exits from menu or "^" out
; function value returns 1 otherwise
; IBSEL is the internal value of the user's selection if any (pass by reference)
N IBQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,C,Z
N IORESET,IORVON,IORVOFF,IOUON,IOUOFF,IOINHI,IOINLOW,IOINORM
S IBQ=1,IBSEL=""
S X="IORESET;IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINLOW;IOINORM"
D ENDR^%ZISS
;
S $P(DIR(0),U,1)="SOA"
S $P(Z,";",1)="PO:Provider Own IDs"
S $P(Z,";",2)="PI:Provider Insurance IDs"
S $P(Z,";",3)="BI:Batch ID Entry"
S $P(Z,";",4)="II:Insurance Co IDs"
S $P(Z,";",5)="CP:Care Units for Providers"
S $P(Z,";",6)="CB:Care Units for Billing Provider"
S $P(Z,";",7)="NP:Non-VA Provider"
S $P(Z,";",8)="NF:Non-VA Facility"
;
S $P(DIR(0),U,2)=Z
;
S DIR("L",1)=" "_IOINHI_"Provider IDs"_IOINORM
S DIR("L",2)=" "_$P($P(Z,";",1),":",1)_" "_$P($P(Z,";",1),":",2)
S DIR("L",3)=" "_$P($P(Z,";",2),":",1)_" "_$P($P(Z,";",2),":",2)
S DIR("L",4)=""
S DIR("L",5)=" "_IOINHI_"Insurance IDs"_IOINORM
S DIR("L",6)=" "_$P($P(Z,";",3),":",1)_" "_$P($P(Z,";",3),":",2)
S DIR("L",7)=" "_$P($P(Z,";",4),":",1)_" "_$P($P(Z,";",4),":",2)
S DIR("L",8)=""
S DIR("L",9)=" "_IOINHI_"Care Units"_IOINORM
S DIR("L",10)=" "_$P($P(Z,";",5),":",1)_" "_$P($P(Z,";",5),":",2)
S DIR("L",11)=" "_$P($P(Z,";",6),":",1)_" "_$P($P(Z,";",6),":",2)
S DIR("L",12)=""
S DIR("L",13)=" "_IOINHI_"Non-VA Items"_IOINORM
S DIR("L",14)=" "_$P($P(Z,";",7),":",1)_" "_$P($P(Z,";",7),":",2)
S DIR("L")=" "_$P($P(Z,";",8),":",1)_" "_$P($P(Z,";",8),":",2)
;
S DIR("?")="^D MENH^IBCEP6"
S DIR("A")=" Select Provider ID Maintenance Option: "
;
; paint the screen and display menu first time in
D MENH
W !
S C=0 F S C=$O(DIR("L",C)) Q:'C W !,DIR("L",C)
W !,DIR("L"),!
D ^DIR K DIR W !
I $D(DIRUT) S IBQ=0 G MENUX
S IBSEL=Y
I IBSEL="" S IBQ=0
Q IBQ
;
MENH ; menu help
W @IOF,!?4,"Provider ID Maintenance Main Menu"
W !!?4,"Enter a code from the list."
MENHX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP6 4542 printed Oct 16, 2024@18:12:23 Page 2
IBCEP6 ;ALB/TMP/OIFO-BP/RBN - PROVIDER ID MAINT menu and INS CO EDIT hook ;11-02-00
+1 ;;2.0;INTEGRATED BILLING;**137,232,320,377,436**;21-MAR-94;Build 31
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN ; -- main entry point
+1 NEW IBRESP,IBFLPFLP,IBCEP6FL
+2 SET IBCEP6FL=1
+3 DO FULL^VALM1
+4 FOR
if '$$MENU(.IBRESP)
QUIT
DO @IBRESP
ENQ ;
+1 QUIT
+2 ;
EN1 ; Provider maintenance from the billing screen 8
+1 NEW DIR,X,Y,IBEDIT
+2 WRITE !
+3 IF '$DATA(^XUSEC("IB PROVIDER EDIT",DUZ))
SET DIR(0)="EA"
SET DIR("A")="Press ENTER to continue: "
SET DIR("A",1)="YOU LACK THE SECURITY KEY FOR THIS ACTION"
DO ^DIR
KILL DIR
QUIT
+4 DO EN
+5 QUIT
+6 ;
PO ; provider's own IDs
+1 NEW IBPRV,IBINS
+2 NEW IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF
+3 KILL IBFASTXT
+4 SET IBIF=""
+5 SET IBPRMPT="PROVIDER"
+6 DO FULL^VALM1
+7 SET IBSLEV=1
+8 DO EN^VALM("IBCE PRVPRV MAINT")
POX ;
+1 QUIT
+2 ;
PI ; provider's IDs provided by an insurance company
+1 NEW IBPRV,IBINS
+2 NEW IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF
+3 KILL IBFASTXT
+4 SET IBIF=""
+5 SET IBPRMPT="PROVIDER"
+6 DO FULL^VALM1
+7 SET IBSLEV=2
+8 DO EN^VALM("IBCE PRVPRV MAINT")
PIX ;
+1 QUIT
+2 ;
BI ; Insurance company batch ID entry
+1 DO EN^IBCEP9
BIX ;
+1 QUIT
+2 ;
II ; Insurance company IDs
+1 DO EN^IBCEP0
IIX ;
+1 QUIT
+2 ;
CP ; Care Unit maintenance - performing providers
+1 NEW IBINS,IBALL,IB95
+2 NEW IBSLEV,DIR,Y
+3 KILL IBFASTXT
+4 DO FULL^VALM1
+5 SET IBSLEV=1
+6 DO EN^VALM("IBCE PRVCARE UNIT MAINT")
CPX ;
+1 QUIT
+2 ;
CB ; Care Unit maintenance - billing provider
+1 NEW IBINS,IBALL,IB95
+2 NEW IBSLEV,DIR,Y
+3 KILL IBFASTXT
+4 DO FULL^VALM1
+5 SET IBSLEV=2
+6 DO EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
CBX ;
+1 QUIT
+2 ;
NP ; non-VA individual provider information
+1 NEW IBNVPMIF
+2 SET IBNVPMIF="I"
+3 ;
+4 ; *** Begin IB*2.0*436 - RBN
+5 ;
+6 DO EN^DDIOL("For individual type entries: The name should be entered in")
+7 DO EN^DDIOL(" LAST,FIRST MIDDLE format.")
+8 DO EN^DDIOL(" ")
+9 ;
+10 ; *** End IB*2.0*436 - RBN
+11 ;
+12 DO EN^IBCEP8
NPX ;
+1 QUIT
+2 ;
NF ; non-VA facility provider information
+1 NEW IBNVPMIF
+2 SET IBNVPMIF="F"
+3 ;
+4 ; *** Begin IB*2.0*436 - RBN
+5 ;
+6 DO EN^DDIOL("For facility type entries: The name MUST start with an")
+7 DO EN^DDIOL("Alpha character and may contain numerals, spaces, commas, ")
+8 DO EN^DDIOL("periods, and a hyphen or dash.")
+9 DO EN^DDIOL(" ")
+10 ;
+11 ; *** End IB*2.0*436 - RBN
+12 ;
+13 DO EN^IBCEP8
NFX ;
+1 QUIT
+2 ;
+1 ; function value returns 0 if user exits from menu or "^" out
+2 ; function value returns 1 otherwise
+3 ; IBSEL is the internal value of the user's selection if any (pass by reference)
+4 NEW IBQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,C,Z
+5 NEW IORESET,IORVON,IORVOFF,IOUON,IOUOFF,IOINHI,IOINLOW,IOINORM
+6 SET IBQ=1
SET IBSEL=""
+7 SET X="IORESET;IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINLOW;IOINORM"
+8 DO ENDR^%ZISS
+9 ;
+10 SET $PIECE(DIR(0),U,1)="SOA"
+11 SET $PIECE(Z,";",1)="PO:Provider Own IDs"
+12 SET $PIECE(Z,";",2)="PI:Provider Insurance IDs"
+13 SET $PIECE(Z,";",3)="BI:Batch ID Entry"
+14 SET $PIECE(Z,";",4)="II:Insurance Co IDs"
+15 SET $PIECE(Z,";",5)="CP:Care Units for Providers"
+16 SET $PIECE(Z,";",6)="CB:Care Units for Billing Provider"
+17 SET $PIECE(Z,";",7)="NP:Non-VA Provider"
+18 SET $PIECE(Z,";",8)="NF:Non-VA Facility"
+19 ;
+20 SET $PIECE(DIR(0),U,2)=Z
+21 ;
+22 SET DIR("L",1)=" "_IOINHI_"Provider IDs"_IOINORM
+23 SET DIR("L",2)=" "_$PIECE($PIECE(Z,";",1),":",1)_" "_$PIECE($PIECE(Z,";",1),":",2)
+24 SET DIR("L",3)=" "_$PIECE($PIECE(Z,";",2),":",1)_" "_$PIECE($PIECE(Z,";",2),":",2)
+25 SET DIR("L",4)=""
+26 SET DIR("L",5)=" "_IOINHI_"Insurance IDs"_IOINORM
+27 SET DIR("L",6)=" "_$PIECE($PIECE(Z,";",3),":",1)_" "_$PIECE($PIECE(Z,";",3),":",2)
+28 SET DIR("L",7)=" "_$PIECE($PIECE(Z,";",4),":",1)_" "_$PIECE($PIECE(Z,";",4),":",2)
+29 SET DIR("L",8)=""
+30 SET DIR("L",9)=" "_IOINHI_"Care Units"_IOINORM
+31 SET DIR("L",10)=" "_$PIECE($PIECE(Z,";",5),":",1)_" "_$PIECE($PIECE(Z,";",5),":",2)
+32 SET DIR("L",11)=" "_$PIECE($PIECE(Z,";",6),":",1)_" "_$PIECE($PIECE(Z,";",6),":",2)
+33 SET DIR("L",12)=""
+34 SET DIR("L",13)=" "_IOINHI_"Non-VA Items"_IOINORM
+35 SET DIR("L",14)=" "_$PIECE($PIECE(Z,";",7),":",1)_" "_$PIECE($PIECE(Z,";",7),":",2)
+36 SET DIR("L")=" "_$PIECE($PIECE(Z,";",8),":",1)_" "_$PIECE($PIECE(Z,";",8),":",2)
+37 ;
+38 SET DIR("?")="^D MENH^IBCEP6"
+39 SET DIR("A")=" Select Provider ID Maintenance Option: "
+40 ;
+41 ; paint the screen and display menu first time in
+42 DO MENH
+43 WRITE !
+44 SET C=0
FOR
SET C=$ORDER(DIR("L",C))
if 'C
QUIT
WRITE !,DIR("L",C)
+45 WRITE !,DIR("L"),!
+46 DO ^DIR
KILL DIR
WRITE !
+47 IF $DATA(DIRUT)
SET IBQ=0
GOTO MENUX
+48 SET IBSEL=Y
+49 IF IBSEL=""
SET IBQ=0
+1 QUIT IBQ
+2 ;
MENH ; menu help
+1 WRITE @IOF,!?4,"Provider ID Maintenance Main Menu"
+2 WRITE !!?4,"Enter a code from the list."
MENHX ;
+1 QUIT
+2 ;
