IBCNSI ;ALB/NLR- INSURANCE COMPANY BILLING ADDRESSES ; 21-SEP-2017
;;2.0;INTEGRATED BILLING;**592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
;also used for IA #4694
;KDM US2487 IB*2.0*592
; new template needed for option AD of the insurance compnay editor menu
; create submenu of just billing address to have it's own screen and display
;
EN ; -- main entry point for IBCNSC INSURANCE CO ADDRESSES
;
D EN^VALM("IBCNSC INSURANCE CO ADDRESSES")
Q
;
HDR ; -- header code
;D HDR^IBCNSC
S VALMHDR(1)="Insurance Co: "_$E($P(^DIC(36,IBCNS,0),"^"),1,30)_" Claims Processing Addresses"
;S VALMHDR(2)="This is the second line"
Q
;
INIT ; -- Option AD
;
;K VALMQUIT
K ^TMP("IBCNSI",$J)
S VALMCNT=0,VALMBG=1
;D BLDAD,HDR ; WCJ
D BLDAD ; WCJ
Q
;
BLDAD ; -- Option AD list builder display items
;kdm US2487 IB*2.0*592
;NEW BLNKI
N BLNKI,IBACMAX ; new variable set in PARAM section and needed throughout for display
;
;K ^TMP("IBCNSI",$J)
S IBACMAX=0
D KILL^VALM10() ; delete all video attributes
F BLNKI=1:1:50 D BLANK(.BLNKI) ;blank lines to start with
;
; MAIN MAILING
N OFFSET,START,IBCNS11,IBCNS13,IBADD
S IBCNS11=$G(^DIC(36,+IBCNS,.11))
S IBCNS13=$G(^DIC(36,+IBCNS,.13))
S START=1,OFFSET=25 D MAINAD^IBCNSC01 ; main mailing address
;
; CLAIMS INPATIENT
;JWS;N OFFSET,START,IBCNS12,IBADD
N IBCNS12
S START=8,OFFSET=2 D CLMS1AD^IBCNSC0 ; inpatient claims office
;
; CLAIMS OUTPATIENT
;JWS;N OFFSET,START,IBCNS16,IBADD
N IBCNS16
S START=16,OFFSET=2 D CLMS2AD^IBCNSC0 ; outpatient claims office
;
; RX
;JWS;N OFFSET,START,IBCNS18,IBADD
N IBCNS18
S IBCNS18=$$ADD2^IBCNSC0(IBCNS,.18,11)
S START=24,OFFSET=2 D PRESCRAD^IBCNSC1 ; prescription claims office
;
; APPEALS OFFICE
;JWS;N OFFSET,START,IBCNS14,IBADD
N IBCNS14
S START=31,OFFSET=2 D APPEALAD^IBCNSC ; appeals office
;
; INQUIRY OFFICE
;JWS;N OFFSET,START,IBCNS15,IBADD
N IBCNS15
S START=39+(2*$G(IBACMAX)),OFFSET=2 D INQAD^IBCNSC ; inquiry office
;
; DENTAL CLAIMS OFFICE
;JWS;N OFFSET,START,IBCNS19,IBADD
N IBCNS19
S START=46+(2*$G(IBACMAX)),OFFSET=2 D DENTALAD^IBCNSC ; Dental Claims Office
;
S VALMCNT=+$O(^TMP("IBCNSI",$J,""),-1) ; no of lines in the list
Q
;INIT ; -- init variables and list array
;F LINE=1:1:30 D SET^VALM10(LINE,LINE_" Line number "_LINE)
;S VALMCNT=30
;Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
BLANK(LINE) ; -- Build blank line
D SET^VALM10(.LINE,$J("",80))
Q
;
EA ;
D FULL^VALM1
D MAIN^IBCNSC1
D HDR,BLDAD
S VALMBCK="R"
Q
;
EXIT ; -- exit code
;
K ^TMP("IBCNSI",$J)
;S VALMBCK="R"
D CLEAR^VALM1
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSI 2813 printed Nov 22, 2024@17:27:15 Page 2
IBCNSI ;ALB/NLR- INSURANCE COMPANY BILLING ADDRESSES ; 21-SEP-2017
+1 ;;2.0;INTEGRATED BILLING;**592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;also used for IA #4694
+5 ;KDM US2487 IB*2.0*592
+6 ; new template needed for option AD of the insurance compnay editor menu
+7 ; create submenu of just billing address to have it's own screen and display
+8 ;
EN ; -- main entry point for IBCNSC INSURANCE CO ADDRESSES
+1 ;
+2 DO EN^VALM("IBCNSC INSURANCE CO ADDRESSES")
+3 QUIT
+4 ;
HDR ; -- header code
+1 ;D HDR^IBCNSC
+2 SET VALMHDR(1)="Insurance Co: "_$EXTRACT($PIECE(^DIC(36,IBCNS,0),"^"),1,30)_" Claims Processing Addresses"
+3 ;S VALMHDR(2)="This is the second line"
+4 QUIT
+5 ;
INIT ; -- Option AD
+1 ;
+2 ;K VALMQUIT
+3 KILL ^TMP("IBCNSI",$JOB)
+4 SET VALMCNT=0
SET VALMBG=1
+5 ;D BLDAD,HDR ; WCJ
+6 ; WCJ
DO BLDAD
+7 QUIT
+8 ;
BLDAD ; -- Option AD list builder display items
+1 ;kdm US2487 IB*2.0*592
+2 ;NEW BLNKI
+3 ; new variable set in PARAM section and needed throughout for display
NEW BLNKI,IBACMAX
+4 ;
+5 ;K ^TMP("IBCNSI",$J)
+6 SET IBACMAX=0
+7 ; delete all video attributes
DO KILL^VALM10()
+8 ;blank lines to start with
FOR BLNKI=1:1:50
DO BLANK(.BLNKI)
+9 ;
+10 ; MAIN MAILING
+11 NEW OFFSET,START,IBCNS11,IBCNS13,IBADD
+12 SET IBCNS11=$GET(^DIC(36,+IBCNS,.11))
+13 SET IBCNS13=$GET(^DIC(36,+IBCNS,.13))
+14 ; main mailing address
SET START=1
SET OFFSET=25
DO MAINAD^IBCNSC01
+15 ;
+16 ; CLAIMS INPATIENT
+17 ;JWS;N OFFSET,START,IBCNS12,IBADD
+18 NEW IBCNS12
+19 ; inpatient claims office
SET START=8
SET OFFSET=2
DO CLMS1AD^IBCNSC0
+20 ;
+21 ; CLAIMS OUTPATIENT
+22 ;JWS;N OFFSET,START,IBCNS16,IBADD
+23 NEW IBCNS16
+24 ; outpatient claims office
SET START=16
SET OFFSET=2
DO CLMS2AD^IBCNSC0
+25 ;
+26 ; RX
+27 ;JWS;N OFFSET,START,IBCNS18,IBADD
+28 NEW IBCNS18
+29 SET IBCNS18=$$ADD2^IBCNSC0(IBCNS,.18,11)
+30 ; prescription claims office
SET START=24
SET OFFSET=2
DO PRESCRAD^IBCNSC1
+31 ;
+32 ; APPEALS OFFICE
+33 ;JWS;N OFFSET,START,IBCNS14,IBADD
+34 NEW IBCNS14
+35 ; appeals office
SET START=31
SET OFFSET=2
DO APPEALAD^IBCNSC
+36 ;
+37 ; INQUIRY OFFICE
+38 ;JWS;N OFFSET,START,IBCNS15,IBADD
+39 NEW IBCNS15
+40 ; inquiry office
SET START=39+(2*$GET(IBACMAX))
SET OFFSET=2
DO INQAD^IBCNSC
+41 ;
+42 ; DENTAL CLAIMS OFFICE
+43 ;JWS;N OFFSET,START,IBCNS19,IBADD
+44 NEW IBCNS19
+45 ; Dental Claims Office
SET START=46+(2*$GET(IBACMAX))
SET OFFSET=2
DO DENTALAD^IBCNSC
+46 ;
+47 ; no of lines in the list
SET VALMCNT=+$ORDER(^TMP("IBCNSI",$JOB,""),-1)
+48 QUIT
+49 ;INIT ; -- init variables and list array
+50 ;F LINE=1:1:30 D SET^VALM10(LINE,LINE_" Line number "_LINE)
+51 ;S VALMCNT=30
+52 ;Q
+53 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
BLANK(LINE) ; -- Build blank line
+1 DO SET^VALM10(.LINE,$JUSTIFY("",80))
+2 QUIT
+3 ;
EA ;
+1 DO FULL^VALM1
+2 DO MAIN^IBCNSC1
+3 DO HDR
DO BLDAD
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
EXIT ; -- exit code
+1 ;
+2 KILL ^TMP("IBCNSI",$JOB)
+3 ;S VALMBCK="R"
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
