source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP6.m@ 1397

IBCEP6 ;ALB/TMP - PROVIDER ID MAINT menu and INS CO EDIT hook ;11-02-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.
 ;
EN ; -- main entry point
 N IBRESP
 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"
 D EN^IBCEP8
NPX ;
 Q
 ;
NF ; non-VA facility provider information
 N IBNVPMIF
 S IBNVPMIF="F"
 D EN^IBCEP8
NFX ;
 Q
 ;
MENU(IBSEL) ; display main provider ID maintenance menu and receive response from user
 ; 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
MENUX ;
 Q IBQ
 ;
MENH ; menu help
 W @IOF,!?4,"Provider ID Maintenance Main Menu"
 W !!?4,"Enter a code from the list."
MENHX ;
 Q
 ;