Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP6.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP6.m (modified) (1 diff)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP6.m

@@ -1 +1 @@
 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.
+ ;;2.0;INTEGRATED BILLING;**137,232,320**;21-MAR-94
  ;
-EN ; -- main entry point
- N IBRESP
+EN ; -- main entry point for IBCE PRV INS PARAMS
  D FULL^VALM1
- F  Q:'$$MENU(.IBRESP)  D @IBRESP
-ENQ ;
+ D EN^VALM("IBCE PRVMAINT")
+ENQ Q
+ ;
+HDR ; -- header code
+ K VALMHDR
+ Q
+ ;
+INIT ; Initialization
+ N IBLCT,IBCT,Z,Z0
+ S (IBLCT,IBCT)=0,XQORM("B")="Select"
+ K ^TMP("IBCE_PRVMAINT_MENU",$J)
+ F Z=1:1:2 S Z0=$J("",10) D SET1(.IBLCT,Z0,1)
+ S Z0=$J("",17)_"-- PROVIDER ID EDITS --" D SET1(.IBLCT,Z0,1),CNTRL^VALM10(IBLCT,18,23,IORVON,IORVOFF)
+ S Z0=$J("",10)_"1 > PROVIDER SPECIFIC IDS" D SET1(.IBLCT,Z0,1)
+ S Z0=$J("",14)_"o PROVIDER'S OWN IDS" D SET1(.IBLCT,Z0,1)
+ S Z0=$J("",14)_"o PROVIDER IDS FURNISHED BY INSURANCE CO" D SET1(.IBLCT,Z0,1)
+ S Z0=$J("",10)_"2 > INSURANCE CO IDS" D SET1(.IBLCT,Z0,2)
+ ;S Z0=$J("",10)_"3 > FACILITY IDS" D SET1(.IBLCT,Z0,3)  ;WCJ removed
+ S Z0=$J("",10)_"4 > CARE UNIT MAINTENANCE" D SET1(.IBLCT,Z0,4)
+ S Z0=$J("",14)_"o Care Units for Performing Provider IDs" D SET1(.IBLCT,Z0,1)
+ S Z0=$J("",14)_"o Care Units for Billing Provider Secondary IDs" D SET1(.IBLCT,Z0,1)
+ S Z0=$J("",10)_"5 > INS CO BATCH ID ENTRY" D SET1(.IBLCT,Z0,5)
+ F Z=1:1:2 S Z0=$J("",10) D SET1(.IBLCT,Z0,6)
+ S Z0=$J("",14)_"-- NON/OTHER VA ENTITY EDITS --" D SET1(.IBLCT,Z0,6),CNTRL^VALM10(IBLCT,15,31,IORVON,IORVOFF)
+ S Z0=$J("",10)_"6 > NON/OTHER VA PROVIDER ID INFORMATION" D SET1(.IBLCT,Z0,6)
+ K VALMBG,VALMCNT
+ S VALMBG=1,VALMCNT=IBLCT
+ Q
+ ;
+SET1(IBLCT,Z0,IBCT) ;
+ S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,Z0,$G(IBCT))
+ Q
+ ;
+EXPND ;
+ Q
+ ;
+HELP ;
+ Q
+ ;
+EXIT ;
+ K ^TMP("IBCE_PRVMAINT_MENU",$J)
+ D CLEAN^VALM10
+ Q
+ ;
+SEL ;
+ N Z,Z1,DIR
+ D FULL^VALM1
+ D EN^VALM2($G(XQORNOD(0)),"OS")
+ S Z=+$O(VALMY(0))
+ I Z,Z<6,'$D(^XUSEC("IB PROVIDER EDIT",DUZ)) S DIR(0)="EA",DIR("A",1)="YOU ARE NOT AUTHORIZED TO EDIT PROVIDER IDS",DIR("A")="Press ENTER to continue" W ! D ^DIR K DIR W ! G SELQ
+ I Z=3 D  G SELQ
+ . S DIR(0)="EA",DIR("A",1)="This Action is no longer available",DIR("A")="Press ENTER to continue"
+ . D ^DIR K DIR
+ I Z S Z1=$P($T(ACT+Z),U,2,3) I Z1'="" D @Z1
+SELQ K VALMBCK,XQORM("B")
+ S VALMBCK="R",XQORM("B")="Quit"
  Q
  ;
 EN1 ; Provider maintenance from the billing screen 8
  N DIR,X,Y,IBEDIT
+ ;S IBEDIT=1
  W !
+ ;S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="WANT TO ATTEMPT TO RESET ALL PROVIDER IDS TO THE CALCULATED",DIR("A")="DEFAULTS FOR THIS BILL?: " D ^DIR K DIR
+ ;Q:$D(DTOUT)!$D(DUOUT)
+ ;I Y=1 S IBEDIT=0 D RECALCA^IBCEP2A(IBIFN) 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
+ ;I 'IBEDIT D
+ ;. S DIR(0)="YA",DIR("A")="WANT TO CONTINUE WITH GENERAL PROVIDER ID MAINTENANCE?: ",DIR("B")="NO" D ^DIR K DIR
+ ;. I $D(DTOUT)!$D(DUOUT)!'Y Q
+ ;. S IBEDIT=1
  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
+ACT ; Actions available
+ ;;PROVIDER LEVEL ID EDIT^EN^IBCEP5
+ ;;INS CO LEVEL ID EDIT^EN^IBCEP0
+ ;;
+ ;;CARE UNIT EDIT^EN^IBCEP4
+ ;;BATCH ID ENTRY BY INS CO^EN^IBCEP9
+ ;;NON-VA PROVIDER EDIT^EN^IBCEP8
  ;
-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
- ;
+ ;;SITE LEVEL ID EDIT^EN^IBCEP7