- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP6.m
r613 r623 1 IBCEP6 ;ALB/TMP - PROVIDER ID MAINT menu and INS CO EDIT hook ;11-02-00 2 ;;2.0;INTEGRATED BILLING;**137,232,320,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 EN ; -- main entry point 6 N IBRESP 7 D FULL^VALM1 8 F Q:'$$MENU(.IBRESP) D @IBRESP 9 ENQ ; 10 Q 11 ; 12 EN1 ; Provider maintenance from the billing screen 8 13 N DIR,X,Y,IBEDIT 14 W ! 15 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 16 D EN 17 Q 18 ; 19 PO ; provider's own IDs 20 N IBPRV,IBINS 21 N IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF 22 K IBFASTXT 23 S IBIF="" 24 S IBPRMPT="PROVIDER" 25 D FULL^VALM1 26 S IBSLEV=1 27 D EN^VALM("IBCE PRVPRV MAINT") 28 POX ; 29 Q 30 ; 31 PI ; provider's IDs provided by an insurance company 32 N IBPRV,IBINS 33 N IBSLEV,DIR,Y,X,IBPRMPT,IBNVAFL,IBIF 34 K IBFASTXT 35 S IBIF="" 36 S IBPRMPT="PROVIDER" 37 D FULL^VALM1 38 S IBSLEV=2 39 D EN^VALM("IBCE PRVPRV MAINT") 40 PIX ; 41 Q 42 ; 43 BI ; Insurance company batch ID entry 44 D EN^IBCEP9 45 BIX ; 46 Q 47 ; 48 II ; Insurance company IDs 49 D EN^IBCEP0 50 IIX ; 51 Q 52 ; 53 CP ; Care Unit maintenance - performing providers 54 N IBINS,IBALL,IB95 55 N IBSLEV,DIR,Y 56 K IBFASTXT 57 D FULL^VALM1 58 S IBSLEV=1 59 D EN^VALM("IBCE PRVCARE UNIT MAINT") 60 CPX ; 61 Q 62 ; 63 CB ; Care Unit maintenance - billing provider 64 N IBINS,IBALL,IB95 65 N IBSLEV,DIR,Y 66 K IBFASTXT 67 D FULL^VALM1 68 S IBSLEV=2 69 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT") 70 CBX ; 71 Q 72 ; 73 NP ; non-VA individual provider information 74 N IBNVPMIF 75 S IBNVPMIF="I" 76 D EN^IBCEP8 77 NPX ; 78 Q 79 ; 80 NF ; non-VA facility provider information 81 N IBNVPMIF 82 S IBNVPMIF="F" 83 D EN^IBCEP8 84 NFX ; 85 Q 86 ; 87 MENU(IBSEL) ; display main provider ID maintenance menu and receive response from user 88 ; function value returns 0 if user exits from menu or "^" out 89 ; function value returns 1 otherwise 90 ; IBSEL is the internal value of the user's selection if any (pass by reference) 91 N IBQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,C,Z 92 N IORESET,IORVON,IORVOFF,IOUON,IOUOFF,IOINHI,IOINLOW,IOINORM 93 S IBQ=1,IBSEL="" 94 S X="IORESET;IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINLOW;IOINORM" 95 D ENDR^%ZISS 96 ; 97 S $P(DIR(0),U,1)="SOA" 98 S $P(Z,";",1)="PO:Provider Own IDs" 99 S $P(Z,";",2)="PI:Provider Insurance IDs" 100 S $P(Z,";",3)="BI:Batch ID Entry" 101 S $P(Z,";",4)="II:Insurance Co IDs" 102 S $P(Z,";",5)="CP:Care Units for Providers" 103 S $P(Z,";",6)="CB:Care Units for Billing Provider" 104 S $P(Z,";",7)="NP:Non-VA Provider" 105 S $P(Z,";",8)="NF:Non-VA Facility" 106 ; 107 S $P(DIR(0),U,2)=Z 108 ; 109 S DIR("L",1)=" "_IOINHI_"Provider IDs"_IOINORM 110 S DIR("L",2)=" "_$P($P(Z,";",1),":",1)_" "_$P($P(Z,";",1),":",2) 111 S DIR("L",3)=" "_$P($P(Z,";",2),":",1)_" "_$P($P(Z,";",2),":",2) 112 S DIR("L",4)="" 113 S DIR("L",5)=" "_IOINHI_"Insurance IDs"_IOINORM 114 S DIR("L",6)=" "_$P($P(Z,";",3),":",1)_" "_$P($P(Z,";",3),":",2) 115 S DIR("L",7)=" "_$P($P(Z,";",4),":",1)_" "_$P($P(Z,";",4),":",2) 116 S DIR("L",8)="" 117 S DIR("L",9)=" "_IOINHI_"Care Units"_IOINORM 118 S DIR("L",10)=" "_$P($P(Z,";",5),":",1)_" "_$P($P(Z,";",5),":",2) 119 S DIR("L",11)=" "_$P($P(Z,";",6),":",1)_" "_$P($P(Z,";",6),":",2) 120 S DIR("L",12)="" 121 S DIR("L",13)=" "_IOINHI_"Non-VA Items"_IOINORM 122 S DIR("L",14)=" "_$P($P(Z,";",7),":",1)_" "_$P($P(Z,";",7),":",2) 123 S DIR("L")=" "_$P($P(Z,";",8),":",1)_" "_$P($P(Z,";",8),":",2) 124 ; 125 S DIR("?")="^D MENH^IBCEP6" 126 S DIR("A")=" Select Provider ID Maintenance Option: " 127 ; 128 ; paint the screen and display menu first time in 129 D MENH 130 W ! 131 S C=0 F S C=$O(DIR("L",C)) Q:'C W !,DIR("L",C) 132 W !,DIR("L"),! 133 D ^DIR K DIR W ! 134 I $D(DIRUT) S IBQ=0 G MENUX 135 S IBSEL=Y 136 I IBSEL="" S IBQ=0 137 MENUX ; 138 Q IBQ 139 ; 140 MENH ; menu help 141 W @IOF,!?4,"Provider ID Maintenance Main Menu" 142 W !!?4,"Enter a code from the list." 143 MENHX ; 144 Q 145 ; 1 IBCEP6 ;ALB/TMP - PROVIDER ID MAINT menu and INS CO EDIT hook ;11-02-00 2 ;;2.0;INTEGRATED BILLING;**137,232,320**;21-MAR-94 3 ; 4 EN ; -- main entry point for IBCE PRV INS PARAMS 5 D FULL^VALM1 6 D EN^VALM("IBCE PRVMAINT") 7 ENQ Q 8 ; 9 HDR ; -- header code 10 K VALMHDR 11 Q 12 ; 13 INIT ; Initialization 14 N IBLCT,IBCT,Z,Z0 15 S (IBLCT,IBCT)=0,XQORM("B")="Select" 16 K ^TMP("IBCE_PRVMAINT_MENU",$J) 17 F Z=1:1:2 S Z0=$J("",10) D SET1(.IBLCT,Z0,1) 18 S Z0=$J("",17)_"-- PROVIDER ID EDITS --" D SET1(.IBLCT,Z0,1),CNTRL^VALM10(IBLCT,18,23,IORVON,IORVOFF) 19 S Z0=$J("",10)_"1 > PROVIDER SPECIFIC IDS" D SET1(.IBLCT,Z0,1) 20 S Z0=$J("",14)_"o PROVIDER'S OWN IDS" D SET1(.IBLCT,Z0,1) 21 S Z0=$J("",14)_"o PROVIDER IDS FURNISHED BY INSURANCE CO" D SET1(.IBLCT,Z0,1) 22 S Z0=$J("",10)_"2 > INSURANCE CO IDS" D SET1(.IBLCT,Z0,2) 23 ;S Z0=$J("",10)_"3 > FACILITY IDS" D SET1(.IBLCT,Z0,3) ;WCJ removed 24 S Z0=$J("",10)_"4 > CARE UNIT MAINTENANCE" D SET1(.IBLCT,Z0,4) 25 S Z0=$J("",14)_"o Care Units for Performing Provider IDs" D SET1(.IBLCT,Z0,1) 26 S Z0=$J("",14)_"o Care Units for Billing Provider Secondary IDs" D SET1(.IBLCT,Z0,1) 27 S Z0=$J("",10)_"5 > INS CO BATCH ID ENTRY" D SET1(.IBLCT,Z0,5) 28 F Z=1:1:2 S Z0=$J("",10) D SET1(.IBLCT,Z0,6) 29 S Z0=$J("",14)_"-- NON/OTHER VA ENTITY EDITS --" D SET1(.IBLCT,Z0,6),CNTRL^VALM10(IBLCT,15,31,IORVON,IORVOFF) 30 S Z0=$J("",10)_"6 > NON/OTHER VA PROVIDER ID INFORMATION" D SET1(.IBLCT,Z0,6) 31 K VALMBG,VALMCNT 32 S VALMBG=1,VALMCNT=IBLCT 33 Q 34 ; 35 SET1(IBLCT,Z0,IBCT) ; 36 S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,Z0,$G(IBCT)) 37 Q 38 ; 39 EXPND ; 40 Q 41 ; 42 HELP ; 43 Q 44 ; 45 EXIT ; 46 K ^TMP("IBCE_PRVMAINT_MENU",$J) 47 D CLEAN^VALM10 48 Q 49 ; 50 SEL ; 51 N Z,Z1,DIR 52 D FULL^VALM1 53 D EN^VALM2($G(XQORNOD(0)),"OS") 54 S Z=+$O(VALMY(0)) 55 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 56 I Z=3 D G SELQ 57 . S DIR(0)="EA",DIR("A",1)="This Action is no longer available",DIR("A")="Press ENTER to continue" 58 . D ^DIR K DIR 59 I Z S Z1=$P($T(ACT+Z),U,2,3) I Z1'="" D @Z1 60 SELQ K VALMBCK,XQORM("B") 61 S VALMBCK="R",XQORM("B")="Quit" 62 Q 63 ; 64 EN1 ; Provider maintenance from the billing screen 8 65 N DIR,X,Y,IBEDIT 66 ;S IBEDIT=1 67 W ! 68 ;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 69 ;Q:$D(DTOUT)!$D(DUOUT) 70 ;I Y=1 S IBEDIT=0 D RECALCA^IBCEP2A(IBIFN) W ! 71 ; 72 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 73 ;I 'IBEDIT D 74 ;. S DIR(0)="YA",DIR("A")="WANT TO CONTINUE WITH GENERAL PROVIDER ID MAINTENANCE?: ",DIR("B")="NO" D ^DIR K DIR 75 ;. I $D(DTOUT)!$D(DUOUT)!'Y Q 76 ;. S IBEDIT=1 77 D EN 78 Q 79 ; 80 ACT ; Actions available 81 ;;PROVIDER LEVEL ID EDIT^EN^IBCEP5 82 ;;INS CO LEVEL ID EDIT^EN^IBCEP0 83 ;; 84 ;;CARE UNIT EDIT^EN^IBCEP4 85 ;;BATCH ID ENTRY BY INS CO^EN^IBCEP9 86 ;;NON-VA PROVIDER EDIT^EN^IBCEP8 87 ; 88 ; 89 ; 90 ;;SITE LEVEL ID EDIT^EN^IBCEP7
Note:
See TracChangeset
for help on using the changeset viewer.
