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

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1IBCEP ;ALB/TMP - Functions for PROVIDER ID MAINT - INS CO PARAMS ;11-02-00
2 ;;2.0;INTEGRATED BILLING;**137,232,320,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBCE PRV INS PARAMS
6 N IBINS,IBCUINC ; Variable should be available throughout actions
7 D FULL^VALM1
8 D EN^VALM("IBCE PRV INS PARAMS")
9 Q
10 ;
11HDR ; -- header code
12 K VALMHDR
13 I $G(IBINS) S VALMHDR(1)="INSURANCE CO: "_$P($G(^DIC(36,+IBINS,0)),U)
14 Q
15 ;
16INIT ; Initialization
17 N DIR,DIC,DA,X,Y,DTOUT,DUOUT
18 S DIC(0)="AEMQ",DIC="^DIC(36," D ^DIC
19 I Y'>0 D
20 . S VALMQUIT=1
21 E D
22 . S DIR="YA",DIR("A")="DO YOU WANT TO INCLUDE ANY CARE UNIT DETAIL?: ",DIR("?",1)="If you want to see the specific care unit defined for the insurance co",DIR("?")="you should respond yes here"
23 . W ! D ^DIR K DIR W !
24 . I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 Q
25 . S IBCUINC=(Y=1)
26 . S IBINS=+Y D BLD(IBINS,IBCUINC)
27 Q
28 ;
29BLD(IBINS,IBCUINC) ; Build display for ins co level provider ID parameters
30 ; IBINS = ien of ins co (file 36)
31 ; IBCUINC = flag:
32 ; = 1 if care unit list should be included or 0 if not
33 N A,A0,A1,A2,A3,Z0,IB1,IB12,IB4,IBLCT,IBPTYP
34 S IBLCT=0
35 S IB4=$G(^DIC(36,IBINS,4))
36 K ^TMP("IBPRV_INS_ID_PARAMS",$J)
37 ;
38 S Z0="Perf Prov Secondary ID Type (1500): "_$E($$EXPAND^IBTRE(36,4.01,+$P(IB4,U))_$J("",20),1,20) D SET1(.IBLCT,Z0)
39 S Z0="Perf Prov Secondary ID Type (UB04): "_$E($$EXPAND^IBTRE(36,4.02,+$P(IB4,U,2))_$J("",20),1,20) D SET1(.IBLCT,Z0)
40 S Z0=$J("",20)_"Required: "_$$EXPAND^IBTRE(36,4.03,$P(IB4,U,3)) D SET1(.IBLCT,Z0)
41 S Z0=$J("",10)_"Care Unit Name: "_$$EXPAND^IBTRE(36,4.09,$P(IB4,U,9)) D SET1(.IBLCT,Z0)
42 S Z0="" D SET1(.IBLCT,Z0)
43 ;
44 I '$D(^IBA(355.96,"D",IBINS)) D G BLDQ ;No care unit needed
45 . S Z0=$J("",7)_"*** NO CARE UNITS DEFINED FOR THIS INS CO PROVIDER SECONDARY ID ***" D SET1(.IBLCT,Z0)
46 ;
47 S Z0=$J("",17)_"VALID CARE UNITS FOR THIS INSURANCE COMPANY" D SET1(.IBLCT,Z0),CNTRL^VALM10(IBLCT,18,46,IORVON,IORVOFF)
48 S A=0
49 F S A=$O(^IBA(355.96,"AC",IBINS,A)) Q:'A S IBPTYP=$P($G(^IBE(355.97,A,0)),U) I IBPTYP'="" D
50 . S A2=IBPTYP_U_A,^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A2)=""
51 . S A0=0 F S A0=$O(^IBA(355.96,"AC",IBINS,A,A0)) Q:'A0 S A1=$G(^IBA(355.96,A0,0)) D
52 .. I '$G(IBCUINC) S:'$D(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A2,$P(A1,U,4)_U_$P(A1,U,5))) ^($P(A1,U,4)_U_$P(A1,U,5))="" Q
53 .. I $P(A1,U,4)'="",$P(A1,U,5)'="" D
54 ... S A3=$E($P($G(^IBE(355.95,+A1,0)),U)_$J("",1,30),1,30)_U_$S($P($G(^(0)),U,2)'="":$P(^(0),U,2),1:"<No description available>")
55 ... I '$D(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A2,$P(A1,U,4)_U_$P(A1,U,5),$P(A3,U))) S ^($P(A3,U))=$P(A3,U,2)
56 . ; records are fully sorted
57 S A=""
58 F S A=$O(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A)) Q:'A S A2="PROVIDER ID TYPE: "_$P(A,U),IB1=1 D:'IB1 SET1(.IBLCT,"") D SET1(.IBLCT,A2) S IB12=1 S:$G(IBCUINC) IB1=0 D
59 . S A0="" F S A0=$O(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A,A0)) Q:A0="" D
60 .. S Z0=$J("",5)_"FORM TYPE: "_$E($$EXPAND^IBTRE(355.96,.04,$P(A0,U))_$J("",25),1,25)_" CARE TYPE: "_$E($$EXPAND^IBTRE(355.96,.05,$P(A0,U,2))_$J("",25),1,25)
61 .. D:'IB12 SET1(.IBLCT,"") D SET1(.IBLCT,Z0)
62 .. Q:'$G(IBCUINC)
63 .. S IB12=0
64 .. S A1="" F S A1=$O(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A,A0,A1)) Q:A1="" S Z0=$J("",10)_A1_$G(^(A1)) D SET1(.IBLCT,Z0)
65 ;
66BLDQ K ^TMP("IBPRV_INS_ID_PARAMS_SORT",$J)
67 S VALMCNT=IBLCT,VALMBG=1
68 Q
69 ;
70SET1(IBLCT,Z0) ;
71 S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,Z0)
72 Q
73 ;
74EXPND ;
75 Q
76 ;
77HELP ;
78 Q
79 ;
80EXIT ;
81 K ^TMP("IBPRV_INS_ID_PARAMS",$J)
82 D CLEAN^VALM10
83 Q
84 ;
85EDIT ; Entrypoint called from IBCSCE to invoke provider id edit functions
86 Q
87 ;
88EDIT1 ; Edit parameters
89 N IB,IBY,IBCNS,DIE,DR,X,Y
90 D FULL^VALM1
91 S IBCNS=IBINS,IBY=12
92 D MAIN^IBCNSC1
93 S VALMBCK="R"
94 Q
95 ;
96NETID() ; Returns the ien of the entry in file 355.97 that is designated as the
97 ; NETWORK ID
98 N Z S Z=0 F S Z=$O(^IBE(355.97,Z)) Q:'Z Q:$P($G(^(Z,1)),U,6)
99 Q Z
100 ;
101EMCID() ; Returns the ien of the entry in file 355.97 that is designated as the
102 ; EMC ID
103 N Z S Z=0 F S Z=$O(^IBE(355.97,Z)) Q:'Z Q:$P($G(^(Z,1)),U,5)
104 Q Z
105 ;
106UPIN() ; Returns the ien of the entry in file 355.97 that is designated as the
107 ; UPIN ID
108 Q +$O(^IBE(355.97,"B","UPIN",0))
109 ;
110EDITID(IBCNS) ; Edit provider id's from insurance co enter/edit
111 ; IBCNS = ien of file 36
112 Q ; WCJ 12/30/2005
113 N X,Y,Z4,DIR
114 S Z4=$G(^DIC(36,IBCNS,4))
115 I 'Z4,'$P(Z4,U,2) Q
116 S DIR("A",1)="USE PROVIDER ID MAINTENANCE TO ENTER/EDIT PROV SECONDARY ID'S FOR THIS CO.",DIR("A")="PRESS RETURN TO CONTINUE: ",DIR(0)="EA" W ! D ^DIR K DIR
117 Q
118 ;
Note: See TracBrowser for help on using the repository browser.