source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEPB.m@ 1226

Last change on this file since 1226 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1IBCEPB ;ALB/WCJ - Insurance company ID parameters ;22-DEC-2005
2 ;;2.0;INTEGRATED BILLING;**320,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4EN ; -- main entry point for IBCE INSCO ID MAINT
5 D EN^VALM("IBCE INSCO ID MAINT")
6 Q
7 ;
8HDR ; -- header code
9 N PCF,PCDISP
10 I '$D(IBCNS) N IBCNS S IBCNS=IBINS
11 S PCF=$P($G(^DIC(36,+IBCNS,3)),U,13),PCDISP=$S(PCF="P":"(Parent)",1:"")
12 S VALMHDR(1)="Insurance Co: "_$P($G(^DIC(36,+IBCNS,0)),U)_PCDISP
13 Q
14 ;
15INIT ; Initialize
16 I '$D(IBCNS) N IBCNS S IBCNS=IBINS
17 N IBLCT
18 S IBLCT=0
19 ; Display the list
20 D SET1(.IBLCT,"Attending/Rendering Provider Secondary ID")
21 D SET1(.IBLCT,"Default ID (1500) : "_$$GET1^DIQ(36,IBCNS,4.01))
22 D SET1(.IBLCT,"Default ID (UB-04): "_$$GET1^DIQ(36,IBCNS,4.02))
23 D SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.03))
24 D SET1(.IBLCT," ")
25 D SET1(.IBLCT,"Referring Provider Secondary ID")
26 D SET1(.IBLCT,"Default ID (1500): "_$$GET1^DIQ(36,IBCNS,4.04))
27 D SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.05))
28 D SET1(.IBLCT," ")
29 D SET1(.IBLCT,"Billing Provider Secondary IDs")
30 D SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (1500)? : "_$$GET1^DIQ(36,IBCNS,4.06))
31 D SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (UB-04)?: "_$$GET1^DIQ(36,IBCNS,4.08))
32 D SET1(.IBLCT,"Transmit no Billing Provider Sec ID for the following Electronic Plan Types:")
33 D LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
34 F I=1:1:+$G(TAR("DILIST",0)) D
35 . D SET1(.IBLCT,TAR("DILIST",1,I))
36 D SET1(.IBLCT," ")
37 D SET1(.IBLCT,"VA-Laboratory or Facility IDs")
38 D SET1(.IBLCT,"Send VA Lab/Facility IDs or Facility Data for VAMC?: "_$$GET1^DIQ(36,IBCNS,4.07))
39 S VALMBG=1,VALMCNT=IBLCT
40 Q
41 ;
42SET1(IBLCT,TEXT,IBCT) ;
43 S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT)
44 Q
45 ;
46EXPND ;
47 Q
48HELP ;
49 Q
50EXIT ;
51 D CLEAN^VALM10
52 Q
53 ;
54IDPARAM ;
55 D FULL^VALM1
56 N DIE,DA,DR
57 I '$D(IBCNS) N IBCNS S IBCNS=IBINS
58 S DIE="^DIC(36,",(DA,Y)=IBCNS,DR="[IBEDIT INS CO1]"
59 I '$D(IBY) N IBY S IBY=",12,"
60 D ^DIE K DIE
61 K ^TMP("IBCE_PRVFAC_MAINT",$J)
62 D INIT
63 S VALMBCK="R"
64 Q
65 ;
66BILLPRVP ;
67 D FULL^VALM1
68 D EN^IBCEPC
69 D INIT
70 K ^TMP("IBCE_PRVFAC_MAINT",$J)
71 S VALMBCK="R"
72 Q
Note: See TracBrowser for help on using the repository browser.