- 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/IBCNSC.m
r613 r623 1 IBCNSC ;ALB/NLR - INSURANCE COMPANY EDIT ;6/1/05 9:42am 2 ;;2.0;INTEGRATED BILLING;**46,137,184,276,320,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;also used for IA #4694 6 ; 7 EN ; -- main entry point for IBCNS INSURANCE COMPANY, IBCNS VIEW INS CO 8 NEW IB1ST 9 K IBFASTXT,VALMQUIT,VALMEVL,XQORS,^TMP("XQORS",$J),IBCNS 10 S IBCHANGE="OKAY" 11 I '$G(IBVIEW) D EN^VALM("IBCNS INSURANCE COMPANY") G ENQ 12 D EN^VALM("IBCNS VIEW INS CO") 13 ENQ Q 14 ; 15 HDR ; -- header code 16 S VALMHDR(1)="Insurance Company Information for: "_$E($P(^DIC(36,IBCNS,0),"^"),1,30) 17 S VALMHDR(2)="Type of Company: "_$E($P($G(^IBE(355.2,+$P($G(^DIC(36,+IBCNS,0)),"^",13),0)),"^"),1,20)_" Currently "_$S(+($P($G(^DIC(36,+IBCNS,0)),"^",5)):"Inactive",1:"Active") 18 Q 19 ; 20 INIT ; -- init variables and list array 21 K VALMQUIT 22 S VALMCNT=0,VALMBG=1 23 I '$D(IBCNS) D INSCO Q:$D(VALMQUIT) 24 D BLD,HDR 25 Q 26 BLD ; -- list builder 27 NEW BLNKI 28 K ^TMP("IBCNSC",$J) 29 D KILL^VALM10() ; delete all video attributes 30 F BLNKI=1:1:54 D BLANK(.BLNKI) ; 54 blank lines to start with 31 D PARAM^IBCNSC01 ; billing parameters 32 D MAIN^IBCNSC01 ; main mailing address 33 D CLAIMS1^IBCNSC0 ; inpatient claims office 34 D CLAIMS2^IBCNSC0 ; outpatient claims office 35 D PRESCR^IBCNSC1 ; prescription claims office 36 D APPEALS ; appeals office 37 D INQUIRY ; inquiry office 38 D DISP^IBCNSC02 ; parent/child associations (ESG 11/3/05) 39 D PROVID^IBCNSC1 ; provider IDs 40 D PAYER^IBCNSC01 ; payer/payer apps (ESG 7/29/02 IIV project) 41 D REMARKS^IBCNSC01 ; remarks 42 D SYN^IBCNSC01 ; synonyms 43 S VALMCNT=+$O(^TMP("IBCNSC",$J,""),-1) 44 Q 45 ; 46 APPEALS ; 47 N OFFSET,START,IBCNS14,IBADD 48 S IBCNS14=$$ADDRESS^IBCNSC0(IBCNS,.14,7) 49 S START=48,OFFSET=2 50 D SET^IBCNSP(START,OFFSET+25," Appeals Office Information ",IORVON,IORVOFF) 51 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS14,"^",7),0)),"^",1)) 52 D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS14,"^",1)) 53 D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS14,"^",2)) 54 N OFFSET S OFFSET=45 55 D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS14,"^",3)) S IBADD=1 56 D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS14,"^",4),1,15)_$S($P(IBCNS14,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS14,"^",5),0)),"^",2)_" "_$E($P(IBCNS14,"^",6),1,5)) 57 D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS14,"^",8)) 58 D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS14,"^",9)) 59 Q 60 ; 61 INQUIRY ; 62 ; 63 N OFFSET,START,IBCNS15,IBADD 64 S IBCNS15=$$ADDRESS^IBCNSC0(IBCNS,.15,8) 65 S START=55,OFFSET=2 66 D SET^IBCNSP(START,OFFSET+25," Inquiry Office Information ",IORVON,IORVOFF) 67 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS15,"^",7),0)),"^",1)) 68 D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS15,"^")) 69 D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS15,"^",2)) 70 N OFFSET S OFFSET=45 71 D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS15,"^",3)) S IBADD=1 72 D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS15,"^",4),1,15)_$S($P(IBCNS15,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS15,"^",5),0)),"^",2)_" "_$E($P(IBCNS15,"^",6),1,5)) 73 D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS15,"^",8)) 74 D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS15,"^",9)) 75 Q 76 ; 77 HELP ; -- help code 78 S X="?" D DISP^XQORM1 W !! 79 Q 80 ; 81 EXIT ; -- exit code 82 K VALMQUIT,IBCNS,IBCHANGE,IBFASTXT 83 D CLEAN^VALM10 84 Q 85 ; 86 INSCO ; -- select insurance company 87 NEW DLAYGO,DIC,X,Y,DTOUT,DUOUT 88 I '$D(IBCNS) D G:$D(VALMQUIT) INSCOQ 89 .S DIC="^DIC(36,",DIC(0)="AEQMZ",DIC("S")="I '$G(^(5))" 90 .I '$G(IBVIEW) S DLAYGO=36,DIC(0)=DIC(0)_"L" 91 .D ^DIC K DIC 92 .S IBCNS=+Y 93 I $G(IBCNS)<1 K IBCNS S VALMQUIT="" G INSCOQ 94 INSCOQ ; 95 K DIC 96 Q 97 ; 98 BLANK(LINE) ; -- Build blank line 99 D SET^VALM10(.LINE,$J("",80)) 100 Q 101 ; 102 EDIKEY() ; input transform code to determine if user is allowed to edit 103 ; certain fields in the insurance company file 104 NEW OK S OK=0 105 I $$KCHK^XUSRB("IB EDI INSURANCE EDIT") S OK=1 G EDIKEYX 106 D EN^DDIOL("You must hold the IB EDI INSURANCE EDIT security key to edit this field.",,"!!") 107 D EN^DDIOL("",,"!!?5") 108 EDIKEYX ; 109 Q OK 110 ; 111 DUPQUAL(IBCNS,QUAL,FIELD) ; input transform to make sure that the sam qualifier is not used twice for 112 ; payer secondary IDs. There are two sets of fields in file 36 that can not be duplicated. 113 ; 6.01 EDI INST SECONDARY ID QUAL(1) can not be the same as 6.03 EDI INST SECONDARY ID QUAL(2) 114 ; 6.05 EDI PROF SECONDARY ID QUAL(1) can not be the same as 6.07 EDI PROF SECONDARY ID QUAL(2) 115 ; 116 ; Input: 117 ; IBCNS is the insurance company internal number 118 ; QUAL is the internal code of the value being input. 119 ; FIELD is the field it is being compare with. 120 ; 121 ; Returns: 122 ; TRUE/1 if they are the same (duplicate) 123 ; FALSE/0 if they are not 124 ; 125 Q:$G(QUAL)="" 0 ; should not happen because this is invoked as an input transform 126 Q:'+$G(IBCNS) 1 ; stop from editing through fileman 127 N DUP 128 S DUP=$$GET1^DIQ(36,+$G(IBCNS)_",",+$G(FIELD),"I") 129 D CLEAN^DILF 130 Q QUAL=DUP 1 IBCNSC ;ALB/NLR - INSURANCE COMPANY EDIT ; 6/1/05 9:42am 2 ;;2.0;INTEGRATED BILLING;**46,137,184,276,320**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ;also used for IA #4694 6 ; 7 EN ; -- main entry point for IBCNS INSURANCE COMPANY, IBCNS VIEW INS CO 8 NEW IB1ST 9 K IBFASTXT,VALMQUIT,VALMEVL,XQORS,^TMP("XQORS",$J),IBCNS 10 S IBCHANGE="OKAY" 11 I '$G(IBVIEW) D EN^VALM("IBCNS INSURANCE COMPANY") G ENQ 12 D EN^VALM("IBCNS VIEW INS CO") 13 ENQ Q 14 ; 15 HDR ; -- header code 16 S VALMHDR(1)="Insurance Company Information for: "_$E($P(^DIC(36,IBCNS,0),"^"),1,30) 17 S VALMHDR(2)="Type of Company: "_$E($P($G(^IBE(355.2,+$P($G(^DIC(36,+IBCNS,0)),"^",13),0)),"^"),1,20)_" Currently "_$S(+($P($G(^DIC(36,+IBCNS,0)),"^",5)):"Inactive",1:"Active") 18 Q 19 ; 20 INIT ; -- init variables and list array 21 K VALMQUIT 22 S VALMCNT=0,VALMBG=1 23 I '$D(IBCNS) D INSCO Q:$D(VALMQUIT) 24 D BLD,HDR 25 Q 26 BLD ; -- list builder 27 NEW BLNKI 28 K ^TMP("IBCNSC",$J) 29 D KILL^VALM10() ; delete all video attributes 30 F BLNKI=1:1:54 D BLANK(.BLNKI) ; 54 blank lines to start with 31 D PARAM^IBCNSC01 ; billing parameters 32 D MAIN^IBCNSC01 ; main mailing address 33 D CLAIMS1^IBCNSC0 ; inpatient claims office 34 D CLAIMS2^IBCNSC0 ; outpatient claims office 35 D PRESCR^IBCNSC1 ; prescription claims office 36 D APPEALS ; appeals office 37 D INQUIRY ; inquiry office 38 D DISP^IBCNSC02 ; parent/child associations (ESG 11/3/05) 39 D PROVID^IBCNSC1 ; provider IDs 40 D PAYER^IBCNSC01 ; payer/payer apps (ESG 7/29/02 IIV project) 41 D REMARKS^IBCNSC01 ; remarks 42 D SYN^IBCNSC01 ; synonyms 43 S VALMCNT=+$O(^TMP("IBCNSC",$J,""),-1) 44 Q 45 ; 46 APPEALS ; 47 N OFFSET,START,IBCNS14,IBADD 48 S IBCNS14=$$ADDRESS^IBCNSC0(IBCNS,.14,7) 49 S START=40,OFFSET=2 50 D SET^IBCNSP(START,OFFSET+25," Appeals Office Information ",IORVON,IORVOFF) 51 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS14,"^",7),0)),"^",1)) 52 D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS14,"^",1)) 53 D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS14,"^",2)) 54 N OFFSET S OFFSET=45 55 D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS14,"^",3)) S IBADD=1 56 D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS14,"^",4),1,15)_$S($P(IBCNS14,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS14,"^",5),0)),"^",2)_" "_$E($P(IBCNS14,"^",6),1,5)) 57 D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS14,"^",8)) 58 D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS14,"^",9)) 59 Q 60 ; 61 INQUIRY ; 62 ; 63 N OFFSET,START,IBCNS15,IBADD 64 S IBCNS15=$$ADDRESS^IBCNSC0(IBCNS,.15,8) 65 S START=47,OFFSET=2 66 D SET^IBCNSP(START,OFFSET+25," Inquiry Office Information ",IORVON,IORVOFF) 67 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS15,"^",7),0)),"^",1)) 68 D SET^IBCNSP(START+2,OFFSET," Street: "_$P(IBCNS15,"^")) 69 D SET^IBCNSP(START+3,OFFSET," Street 2: "_$P(IBCNS15,"^",2)) 70 N OFFSET S OFFSET=45 71 D SET^IBCNSP(START+1,OFFSET," Street 3: "_$P(IBCNS15,"^",3)) S IBADD=1 72 D SET^IBCNSP(START+1+IBADD,OFFSET," City/State: "_$E($P(IBCNS15,"^",4),1,15)_$S($P(IBCNS15,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS15,"^",5),0)),"^",2)_" "_$E($P(IBCNS15,"^",6),1,5)) 73 D SET^IBCNSP(START+2+IBADD,OFFSET," Phone: "_$P(IBCNS15,"^",8)) 74 D SET^IBCNSP(START+3+IBADD,OFFSET," Fax: "_$P(IBCNS15,"^",9)) 75 Q 76 ; 77 HELP ; -- help code 78 S X="?" D DISP^XQORM1 W !! 79 Q 80 ; 81 EXIT ; -- exit code 82 K VALMQUIT,IBCNS,IBCHANGE,IBFASTXT 83 D CLEAN^VALM10 84 Q 85 ; 86 INSCO ; -- select insurance company 87 NEW DLAYGO,DIC,X,Y,DTOUT,DUOUT 88 I '$D(IBCNS) D G:$D(VALMQUIT) INSCOQ 89 .S DIC="^DIC(36,",DIC(0)="AEQMZ",DIC("S")="I '$G(^(5))" 90 .I '$G(IBVIEW) S DLAYGO=36,DIC(0)=DIC(0)_"L" 91 .D ^DIC K DIC 92 .S IBCNS=+Y 93 I $G(IBCNS)<1 K IBCNS S VALMQUIT="" G INSCOQ 94 INSCOQ ; 95 K DIC 96 Q 97 ; 98 BLANK(LINE) ; -- Build blank line 99 D SET^VALM10(.LINE,$J("",80)) 100 Q 101 ; 102 EDIKEY() ; input transform code to determine if user is allowed to edit 103 ; certain fields in the insurance company file 104 NEW OK S OK=0 105 I $$KCHK^XUSRB("IB EDI INSURANCE EDIT") S OK=1 G EDIKEYX 106 D EN^DDIOL("You must hold the IB EDI INSURANCE EDIT security key to edit this field.",,"!!") 107 D EN^DDIOL("",,"!!?5") 108 EDIKEYX ; 109 Q OK 110 ;
Note:
See TracChangeset
for help on using the changeset viewer.
