IBCSCH ;ALB/MJB - MCCR HELP ROUTINE ;03 JUN 88 15:25
;;2.0;INTEGRATED BILLING;**52,80,106,124,138,51,148,137,161,245,232,287,348,349,374,371,395,400,432,447,458,488,623**;21-MAR-94;Build 70
;;Per VA Directive 6402, this routine should not be modified.
;
;MAP TO DGCRSCH
;
N I,C,IBSCNNZ,IBQ,IBPRNT,Z S IBSCNNZ=$$UP^XLFSTR($G(IBSCNN)),IBQ=0
I '$D(IBPAR) D Q:IBQ
. I $F(".?1500.?HCFA.","."_$G(IBSCNNZ)_"."),$$FT^IBCEF(IBIFN)=2 S IBQ=1,IBPRNT=2 D BL24(IBIFN,0) Q
. I $G(IBSCNNZ)="?J430D",$$FT^IBCEF(IBIFN)=7 S IBQ=1 D DENTAL^IBCSCH2(IBIFN) Q ;/vd - IB*2.0*623 - US4055. Added to display DENTAL Mock-up screen when ?J430D is entered on any screen.
. I $G(IBSCNNZ)="?SC" S IBQ=1 D DISPSC(IBIFN) Q
. I $G(IBSCNNZ)="?INS" S IBQ=1 D INSDSPL(IBIFN) Q
. I $G(IBSCNNZ)="?INX" S IBQ=1 D INSDSPLX(IBIFN) Q
. I $G(IBSCNNZ)="?PRV" S IBQ=1 D DISPROPT(IBIFN) Q
. I $G(IBSCNNZ)="?CHG" S IBQ=1 D DISPCHG^IBCRBH1(IBIFN) Q
. I $G(IBSCNNZ)="?PRC" S IBQ=1 D DISPPRC^IBCSCH1(IBIFN) Q
. I $G(IBSCNNZ)="?CPT" S IBQ=1 D BCPTCHG^IBCRBH2(IBIFN) Q
. I $G(IBSCNNZ)="?INC" S IBQ=1 D EDIT^IBCBB(IBIFN) Q
. I $G(IBSCNNZ)="?CLA",$$CK0^IBCIUT1() S IBQ=1 D CLA^IBCISC(IBIFN) Q
. I $G(IBSCNNZ)="?MRA",$$MCRONBIL^IBEFUNC(IBIFN),$T(SCR^IBCEMVU)'="" S IBQ=1 D SCR^IBCEMVU(IBIFN) Q
. I $G(IBSCNNZ)="?ID" S IBQ=1 D DISPID^IBCEF74(IBIFN) Q
. I $G(IBSCNNZ)="?RX" S IBQ=1 D DISPRX^IBCSCH1(IBIFN) Q
. I $G(IBSCNNZ)="?RNB" S IBQ=1 D EDITRNB^IBCSCH1(IBIFN) Q
. Q
;
S IBH("HELP")="" D ^IBCSCU,H^IBCSCU K IBH("HELP") W !,"Enter '^' to stop the display ",$S(IBV:"",1:"and edit "),"of data,"
W:'$D(IBPAR) " '^N' to jump to screen #N (see",!,"listing below), <RET> to continue on to the next available screen" I IBV W "." G M
W " or enter",!,"the field group number(s) you wish to edit using commas and dashes as",!,"delimiters. Those groups enclosed in brackets ""[]"" are editable while those"
W !,"enclosed in arrows ""<>"" are not."
G:$D(IBPAR) M1
M W " Special help screens:"
W !,?5,"Enter '?SC' to view SC Status and Rated Disabilities."
W !,?5,"Enter '?INS' to view the patients insurance policies."
W !,?5,"Enter '?INX' to view the patients insurance policies with comments."
W !,?5,"Enter '?PRV' to view provider specific information."
W !,?5,"Enter '?PRC' to view all procedures on the bill and related data."
W !,?5,"Enter '?CHG' to view all items on the bill with potential charges."
W !,?5,"Enter '?CPT' to view all charges for selected CPT codes and bill type."
I $$FT^IBCEF(IBIFN)=2 W !,?5,"Enter '?1500' to view how block 24 will print on a CMS-1500."
I $$FT^IBCEF(IBIFN)=7 W !,?5,"Enter '?J430D' to view data entered on the Dental claim." ;/vd - Added for IB*2.0*623 - US4055.
W !,?5,"Enter '?INC' to execute the edits & view the bill inconsistencies."
I $$CK0^IBCIUT1() W !?5,"Enter '?CLA' to view the ClaimsManager options."
I $$MCRONBIL^IBEFUNC(IBIFN) W !?5,"Enter '?MRA' to view Medicare Remittance Advice EOB's on file."
W !,?5,"Enter '?ID' to view all IDs to be electronically transmitted on this claim."
W !,?5,"Enter '?RX' to view all prescriptions on this claim."
W !,?5,"Enter '?RNB' to enter an RNB for bill associated Claims Tracking entries."
;
D S W ! F I=$Y:1:20 W !
S Z="PRESS <RETURN> KEY" X IBWW W " to RETURN to SCREEN ",+IBSR
R X:DTIME
Q
;
M1 N I,Z S Z="DATA GROUPS ON PARAMETER SCREEN" W !! X IBWW D @(IBSR1_IBSR) D W W ! F I=$Y:1:20 W !
S Z="PRESS <RETURN> KEY" X IBWW W " to RETURN to PARAMETER SCREEN"
R X:DTIME
Q
;
;
PAR S X="Fed Tax #, BC/BS #, MAS Svc Pointer^Bill Signer, Billing Supervisor^Security Parameters, Outpatient CPT parameters ^Remarks, Mailgroups^Agent Cashier Address/Phone" Q
;
S ; display the available screen data
N C,I,Z,J W ! S Z="AVAILABLE SCREENS" X IBWW
; Start IB*2.0*447 BI
;S X="Demographic^Employment^Payer^Inpatient Event^Outpatient Event^Inpatient Billing - General^Outpatient Billing - General^Billing - Claim Information^Locally Defined^Billing - Specific"
S X="Demographic^Employment^Payer^Inpatient Event^Outpatient Event^Inpatient Billing - General^Outpatient Billing - General^Billing - Claim Information^Ambulance^Billing - Specific^Locally Defined"
; End IB*2.0*447 BI
S C=0 F I=1:1 S J=$P(X,"^",I) Q:J="" I '$E(IBVV,I) S C=C+1,Z="^"_I,IBW=(C#2) W:'(C#2) ?41 X IBWW S Z=$S(I?1N:" ",1:" ")_J_" Data" W Z
Q
;
W ;
N I,J,Z
F I=1:1 S J=$P(X,"^",I) Q:J="" S Z=I,IBW=(I#2) W:'(I#2) ?42 X IBWW W " "_J
W:'(I-1)#2 ! Q
Q
;IBCSCH
;
;
BL24(IBIFN,IBNOSHOW) ; display block 24 of CMS-1500
; IBNOSHOW = 1 for not to show error/warning text line
N X,Y,DIR,IBPG,IBLN,IBCOL,IBX,IBQ,IBLC,IBLIN,IBPFORM,IBD,IBC1,Z,Z0,IBXDATA,IBXSAVE,IBNXPG,L,T,NUM
K ^TMP("IBXSAVE",$J)
S IBQ=0,IBLC=9 Q:'$G(IBIFN) K ^TMP("IBXDISP",$J)
;
S IBLIN=$$BOX24D^IBCEF11()
S IBPFORM=$S($P($G(^IBE(353,2,2)),U,8):$P(^(2),U,8),1:2)
S IBX=$$BILLN^IBCEFG0(0,"1^99",IBLIN,+IBIFN,IBPFORM)
;
W @IOF,!,"Example of diagnoses, procedures and charges printing on the CMS-1500"
W !,"--------------------------------------------------------------------------------"
;
; box 19 - lines 36-37
F Z=+IBLIN,IBLIN+1 I $D(^TMP("IBXDISP",$J,1,Z)) S Z0=$G(^TMP("IBXDISP",$J,1,Z,+$O(^TMP("IBXDISP",$J,1,Z,20),-1))) I Z0'="" S:Z=+IBLIN Z0="BOX 19 DATA: "_Z0 W !,Z0
;
; box 21 - lines 39-41
W !,"21. Diagnosis"
;I $D(^TMP("IBXDISP",$J,2,IBLIN+3)) W ?16,"(1st 4 only)" ; -> baa *488*
; Print all 12 diagnosis codes -> baa *488*
F L=3,4,5 D
.W !
.F T=3,16,29,42 D
..S NUM=""
..I L=3 S NUM=$S(T=3:1,T=16:2,T=29:3,T=42:4,1:"")
..I L=4 S NUM=$S(T=3:5,T=16:6,T=29:7,T=42:8,1:"")
..I L=5 S NUM=$S(T=3:9,T=16:10,T=29:11,T=42:12,1:"")
..S T2=T+2,T1=T I NUM>9 S T1=T-1
..W ?T1,NUM,".",?T2,$G(^TMP("IBXDISP",$J,1,IBLIN+L,T))
;W !,?5,"1. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,3)),?25,"3. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,30))
;W !,?5,"2. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,3)),?25,"4. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,30))
;
; box 24 - lines 44-55
D PG
S IBPG=0 F S IBPG=$O(^TMP("IBXDISP",$J,IBPG)) Q:'IBPG D Q:IBQ
. I '$D(^TMP("IBXDISP",$J,IBPG,IBLIN+9)) Q ; no line's on this page
. F IBLN=IBLIN+8:1:+$P(IBLIN,U,2) S IBCOL=$O(^TMP("IBXDISP",$J,IBPG,IBLN,0)) Q:'IBCOL&'$O(^TMP("IBXDISP",$J,IBPG,IBLN)) S IBLC=IBLC+1 I IBCOL D Q:IBQ
.. S IBCOL=0,IBC1=1 F S IBCOL=$O(^TMP("IBXDISP",$J,IBPG,IBLN,IBCOL)) Q:'IBCOL I $TR($G(^(IBCOL))," ")'="" D
... W:IBC1 ! S IBC1=0 W ?(IBCOL-1),$G(^TMP("IBXDISP",$J,IBPG,IBLN,IBCOL))
. S IBNXPG=$O(^TMP("IBXDISP",$J,IBPG)) ; next page
. I 'IBQ,IBNXPG,$D(^TMP("IBXDISP",$J,IBNXPG,IBLIN+9)) S IBLIN=$$BOX24D^IBCEF11(),IBQ=$$PAUSE^IBCSCH1(IBLC) Q:IBQ S IBLC=9 W @IOF D PG
. Q
;
W !,"--------------------------------------------------------------------------------"
I 'IBPG,'IBQ S IBQ=$$PAUSE^IBCSCH1(IBLC)
K ^TMP("IBXDISP",$J),^TMP("IBXSAVE",$J)
Q
;
PG ; Display box 24 letters at top of charge list
W !,"24. A B C D E F G H I J"
W !,"--------------------------------------------------------------------------------"
Q
;
INSDSPL(IBIFN) ; Display patient's policies
N DIR,X,Y,IBX,DFN,IBDTIN,IBCOVEXT W @IOF
S IBX=$G(^DGCR(399,+$G(IBIFN),0)),DFN=$P(IBX,U,2),IBDTIN=$P(IBX,U,3),IBCOVEXT=1
I +DFN D DISPDT^IBCNS W ! S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
Q
;
INSDSPLX(IBIFN) ; Display patient's policies extended (?INX)
N IBX,DFN,IBDATE S IBX=$G(^DGCR(399,+$G(IBIFN),0)),DFN=$P(IBX,U,2),IBDATE=$P(IBX,U,3) D DISP^IBCNS3(DFN,IBDATE,123)
Q
;
DISPSC(IBIFN) ; display patients SC Status and Rated Disabilities
N IB0,DFN,IBSC,IBX,VAEL,VAERR
S IB0=$G(^DGCR(399,+$G(IBIFN),0)),DFN=$P(IB0,U,2),IBSC=$P(IB0,U,18)
W !,@IOF,!,"SC Status and Rated Disabilities for ",$P($G(^DPT(+$G(DFN),0)),U,1)
W !,"--------------------------------------------------------------------------------",!
I +$G(IBIFN) W !," SC At Time Of Care: ",$S(IBSC=1:"Yes",IBSC=0:"No",1:"")
I +$G(DFN) D ELIG^VADPT D DIS^DGRPDB
W !!,"--------------------------------------------------------------------------------"
S IBX=$$PAUSE^IBCSCH1(19)
Q
;
DISPROPT(IBIFN) ; prompt for VA or Non-VA provider.
N X,Y,DIR
S DIR(0)="SAO^V:VA PROVIDER;N:NON-VA PROVIDER",DIR("A")="(V)A or (N)on-VA Provider: ",DIR("B")="V"
D ^DIR
I Y="V" D DISPPRV^IBCSCH2(IBIFN) Q
I Y="N" D DISPNVA^IBCSCH2(IBIFN)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCSCH 8402 printed Jan 18, 2025@03:21:42 Page 2
IBCSCH ;ALB/MJB - MCCR HELP ROUTINE ;03 JUN 88 15:25
+1 ;;2.0;INTEGRATED BILLING;**52,80,106,124,138,51,148,137,161,245,232,287,348,349,374,371,395,400,432,447,458,488,623**;21-MAR-94;Build 70
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRSCH
+5 ;
+6 NEW I,C,IBSCNNZ,IBQ,IBPRNT,Z
SET IBSCNNZ=$$UP^XLFSTR($GET(IBSCNN))
SET IBQ=0
+7 IF '$DATA(IBPAR)
Begin DoDot:1
+8 IF $FIND(".?1500.?HCFA.","."_$GET(IBSCNNZ)_".")
IF $$FT^IBCEF(IBIFN)=2
SET IBQ=1
SET IBPRNT=2
DO BL24(IBIFN,0)
QUIT
+9 ;/vd - IB*2.0*623 - US4055. Added to display DENTAL Mock-up screen when ?J430D is entered on any screen.
IF $GET(IBSCNNZ)="?J430D"
IF $$FT^IBCEF(IBIFN)=7
SET IBQ=1
DO DENTAL^IBCSCH2(IBIFN)
QUIT
+10 IF $GET(IBSCNNZ)="?SC"
SET IBQ=1
DO DISPSC(IBIFN)
QUIT
+11 IF $GET(IBSCNNZ)="?INS"
SET IBQ=1
DO INSDSPL(IBIFN)
QUIT
+12 IF $GET(IBSCNNZ)="?INX"
SET IBQ=1
DO INSDSPLX(IBIFN)
QUIT
+13 IF $GET(IBSCNNZ)="?PRV"
SET IBQ=1
DO DISPROPT(IBIFN)
QUIT
+14 IF $GET(IBSCNNZ)="?CHG"
SET IBQ=1
DO DISPCHG^IBCRBH1(IBIFN)
QUIT
+15 IF $GET(IBSCNNZ)="?PRC"
SET IBQ=1
DO DISPPRC^IBCSCH1(IBIFN)
QUIT
+16 IF $GET(IBSCNNZ)="?CPT"
SET IBQ=1
DO BCPTCHG^IBCRBH2(IBIFN)
QUIT
+17 IF $GET(IBSCNNZ)="?INC"
SET IBQ=1
DO EDIT^IBCBB(IBIFN)
QUIT
+18 IF $GET(IBSCNNZ)="?CLA"
IF $$CK0^IBCIUT1()
SET IBQ=1
DO CLA^IBCISC(IBIFN)
QUIT
+19 IF $GET(IBSCNNZ)="?MRA"
IF $$MCRONBIL^IBEFUNC(IBIFN)
IF $TEXT(SCR^IBCEMVU)'=""
SET IBQ=1
DO SCR^IBCEMVU(IBIFN)
QUIT
+20 IF $GET(IBSCNNZ)="?ID"
SET IBQ=1
DO DISPID^IBCEF74(IBIFN)
QUIT
+21 IF $GET(IBSCNNZ)="?RX"
SET IBQ=1
DO DISPRX^IBCSCH1(IBIFN)
QUIT
+22 IF $GET(IBSCNNZ)="?RNB"
SET IBQ=1
DO EDITRNB^IBCSCH1(IBIFN)
QUIT
+23 QUIT
End DoDot:1
if IBQ
QUIT
+24 ;
+25 SET IBH("HELP")=""
DO ^IBCSCU
DO H^IBCSCU
KILL IBH("HELP")
WRITE !,"Enter '^' to stop the display ",$SELECT(IBV:"",1:"and edit "),"of data,"
+26 if '$DATA(IBPAR)
WRITE " '^N' to jump to screen #N (see",!,"listing below), <RET> to continue on to the next available screen"
IF IBV
WRITE "."
GOTO M
+27 WRITE " or enter",!,"the field group number(s) you wish to edit using commas and dashes as",!,"delimiters. Those groups enclosed in brackets ""[]"" are editable while those"
+28 WRITE !,"enclosed in arrows ""<>"" are not."
+29 if $DATA(IBPAR)
GOTO M1
M WRITE " Special help screens:"
+1 WRITE !,?5,"Enter '?SC' to view SC Status and Rated Disabilities."
+2 WRITE !,?5,"Enter '?INS' to view the patients insurance policies."
+3 WRITE !,?5,"Enter '?INX' to view the patients insurance policies with comments."
+4 WRITE !,?5,"Enter '?PRV' to view provider specific information."
+5 WRITE !,?5,"Enter '?PRC' to view all procedures on the bill and related data."
+6 WRITE !,?5,"Enter '?CHG' to view all items on the bill with potential charges."
+7 WRITE !,?5,"Enter '?CPT' to view all charges for selected CPT codes and bill type."
+8 IF $$FT^IBCEF(IBIFN)=2
WRITE !,?5,"Enter '?1500' to view how block 24 will print on a CMS-1500."
+9 ;/vd - Added for IB*2.0*623 - US4055.
IF $$FT^IBCEF(IBIFN)=7
WRITE !,?5,"Enter '?J430D' to view data entered on the Dental claim."
+10 WRITE !,?5,"Enter '?INC' to execute the edits & view the bill inconsistencies."
+11 IF $$CK0^IBCIUT1()
WRITE !?5,"Enter '?CLA' to view the ClaimsManager options."
+12 IF $$MCRONBIL^IBEFUNC(IBIFN)
WRITE !?5,"Enter '?MRA' to view Medicare Remittance Advice EOB's on file."
+13 WRITE !,?5,"Enter '?ID' to view all IDs to be electronically transmitted on this claim."
+14 WRITE !,?5,"Enter '?RX' to view all prescriptions on this claim."
+15 WRITE !,?5,"Enter '?RNB' to enter an RNB for bill associated Claims Tracking entries."
+16 ;
+17 DO S
WRITE !
FOR I=$Y:1:20
WRITE !
+18 SET Z="PRESS <RETURN> KEY"
XECUTE IBWW
WRITE " to RETURN to SCREEN ",+IBSR
+19 READ X:DTIME
+20 QUIT
+21 ;
M1 NEW I,Z
SET Z="DATA GROUPS ON PARAMETER SCREEN"
WRITE !!
XECUTE IBWW
DO @(IBSR1_IBSR)
DO W
WRITE !
FOR I=$Y:1:20
WRITE !
+1 SET Z="PRESS <RETURN> KEY"
XECUTE IBWW
WRITE " to RETURN to PARAMETER SCREEN"
+2 READ X:DTIME
+3 QUIT
+4 ;
+5 ;
PAR SET X="Fed Tax #, BC/BS #, MAS Svc Pointer^Bill Signer, Billing Supervisor^Security Parameters, Outpatient CPT parameters ^Remarks, Mailgroups^Agent Cashier Address/Phone"
QUIT
+1 ;
S ; display the available screen data
+1 NEW C,I,Z,J
WRITE !
SET Z="AVAILABLE SCREENS"
XECUTE IBWW
+2 ; Start IB*2.0*447 BI
+3 ;S X="Demographic^Employment^Payer^Inpatient Event^Outpatient Event^Inpatient Billing - General^Outpatient Billing - General^Billing - Claim Information^Locally Defined^Billing - Specific"
+4 SET X="Demographic^Employment^Payer^Inpatient Event^Outpatient Event^Inpatient Billing - General^Outpatient Billing - General^Billing - Claim Information^Ambulance^Billing - Specific^Locally Defined"
+5 ; End IB*2.0*447 BI
+6 SET C=0
FOR I=1:1
SET J=$PIECE(X,"^",I)
if J=""
QUIT
IF '$EXTRACT(IBVV,I)
SET C=C+1
SET Z="^"_I
SET IBW=(C#2)
if '(C#2)
WRITE ?41
XECUTE IBWW
SET Z=$SELECT(I?1N:" ",1:" ")_J_" Data"
WRITE Z
+7 QUIT
+8 ;
W ;
+1 NEW I,J,Z
+2 FOR I=1:1
SET J=$PIECE(X,"^",I)
if J=""
QUIT
SET Z=I
SET IBW=(I#2)
if '(I#2)
WRITE ?42
XECUTE IBWW
WRITE " "_J
+3 if '(I-1)#2
WRITE !
QUIT
+4 QUIT
+5 ;IBCSCH
+6 ;
+7 ;
BL24(IBIFN,IBNOSHOW) ; display block 24 of CMS-1500
+1 ; IBNOSHOW = 1 for not to show error/warning text line
+2 NEW X,Y,DIR,IBPG,IBLN,IBCOL,IBX,IBQ,IBLC,IBLIN,IBPFORM,IBD,IBC1,Z,Z0,IBXDATA,IBXSAVE,IBNXPG,L,T,NUM
+3 KILL ^TMP("IBXSAVE",$JOB)
+4 SET IBQ=0
SET IBLC=9
if '$GET(IBIFN)
QUIT
KILL ^TMP("IBXDISP",$JOB)
+5 ;
+6 SET IBLIN=$$BOX24D^IBCEF11()
+7 SET IBPFORM=$SELECT($PIECE($GET(^IBE(353,2,2)),U,8):$PIECE(^(2),U,8),1:2)
+8 SET IBX=$$BILLN^IBCEFG0(0,"1^99",IBLIN,+IBIFN,IBPFORM)
+9 ;
+10 WRITE @IOF,!,"Example of diagnoses, procedures and charges printing on the CMS-1500"
+11 WRITE !,"--------------------------------------------------------------------------------"
+12 ;
+13 ; box 19 - lines 36-37
+14 FOR Z=+IBLIN,IBLIN+1
IF $DATA(^TMP("IBXDISP",$JOB,1,Z))
SET Z0=$GET(^TMP("IBXDISP",$JOB,1,Z,+$ORDER(^TMP("IBXDISP",$JOB,1,Z,20),-1)))
IF Z0'=""
if Z=+IBLIN
SET Z0="BOX 19 DATA: "_Z0
WRITE !,Z0
+15 ;
+16 ; box 21 - lines 39-41
+17 WRITE !,"21. Diagnosis"
+18 ;I $D(^TMP("IBXDISP",$J,2,IBLIN+3)) W ?16,"(1st 4 only)" ; -> baa *488*
+19 ; Print all 12 diagnosis codes -> baa *488*
+20 FOR L=3,4,5
Begin DoDot:1
+21 WRITE !
+22 FOR T=3,16,29,42
Begin DoDot:2
+23 SET NUM=""
+24 IF L=3
SET NUM=$SELECT(T=3:1,T=16:2,T=29:3,T=42:4,1:"")
+25 IF L=4
SET NUM=$SELECT(T=3:5,T=16:6,T=29:7,T=42:8,1:"")
+26 IF L=5
SET NUM=$SELECT(T=3:9,T=16:10,T=29:11,T=42:12,1:"")
+27 SET T2=T+2
SET T1=T
IF NUM>9
SET T1=T-1
+28 WRITE ?T1,NUM,".",?T2,$GET(^TMP("IBXDISP",$JOB,1,IBLIN+L,T))
End DoDot:2
End DoDot:1
+29 ;W !,?5,"1. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,3)),?25,"3. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,30))
+30 ;W !,?5,"2. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,3)),?25,"4. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,30))
+31 ;
+32 ; box 24 - lines 44-55
+33 DO PG
+34 SET IBPG=0
FOR
SET IBPG=$ORDER(^TMP("IBXDISP",$JOB,IBPG))
if 'IBPG
QUIT
Begin DoDot:1
+35 ; no line's on this page
IF '$DATA(^TMP("IBXDISP",$JOB,IBPG,IBLIN+9))
QUIT
+36 FOR IBLN=IBLIN+8:1:+$PIECE(IBLIN,U,2)
SET IBCOL=$ORDER(^TMP("IBXDISP",$JOB,IBPG,IBLN,0))
if 'IBCOL&'$ORDER(^TMP("IBXDISP",$JOB,IBPG,IBLN))
QUIT
SET IBLC=IBLC+1
IF IBCOL
Begin DoDot:2
+37 SET IBCOL=0
SET IBC1=1
FOR
SET IBCOL=$ORDER(^TMP("IBXDISP",$JOB,IBPG,IBLN,IBCOL))
if 'IBCOL
QUIT
IF $TRANSLATE($GET(^(IBCOL))," ")'=""
Begin DoDot:3
+38 if IBC1
WRITE !
SET IBC1=0
WRITE ?(IBCOL-1),$GET(^TMP("IBXDISP",$JOB,IBPG,IBLN,IBCOL))
End DoDot:3
End DoDot:2
if IBQ
QUIT
+39 ; next page
SET IBNXPG=$ORDER(^TMP("IBXDISP",$JOB,IBPG))
+40 IF 'IBQ
IF IBNXPG
IF $DATA(^TMP("IBXDISP",$JOB,IBNXPG,IBLIN+9))
SET IBLIN=$$BOX24D^IBCEF11()
SET IBQ=$$PAUSE^IBCSCH1(IBLC)
if IBQ
QUIT
SET IBLC=9
WRITE @IOF
DO PG
+41 QUIT
End DoDot:1
if IBQ
QUIT
+42 ;
+43 WRITE !,"--------------------------------------------------------------------------------"
+44 IF 'IBPG
IF 'IBQ
SET IBQ=$$PAUSE^IBCSCH1(IBLC)
+45 KILL ^TMP("IBXDISP",$JOB),^TMP("IBXSAVE",$JOB)
+46 QUIT
+47 ;
PG ; Display box 24 letters at top of charge list
+1 WRITE !,"24. A B C D E F G H I J"
+2 WRITE !,"--------------------------------------------------------------------------------"
+3 QUIT
+4 ;
INSDSPL(IBIFN) ; Display patient's policies
+1 NEW DIR,X,Y,IBX,DFN,IBDTIN,IBCOVEXT
WRITE @IOF
+2 SET IBX=$GET(^DGCR(399,+$GET(IBIFN),0))
SET DFN=$PIECE(IBX,U,2)
SET IBDTIN=$PIECE(IBX,U,3)
SET IBCOVEXT=1
+3 IF +DFN
DO DISPDT^IBCNS
WRITE !
SET DIR("A")="Press RETURN to continue"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 QUIT
+5 ;
INSDSPLX(IBIFN) ; Display patient's policies extended (?INX)
+1 NEW IBX,DFN,IBDATE
SET IBX=$GET(^DGCR(399,+$GET(IBIFN),0))
SET DFN=$PIECE(IBX,U,2)
SET IBDATE=$PIECE(IBX,U,3)
DO DISP^IBCNS3(DFN,IBDATE,123)
+2 QUIT
+3 ;
DISPSC(IBIFN) ; display patients SC Status and Rated Disabilities
+1 NEW IB0,DFN,IBSC,IBX,VAEL,VAERR
+2 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
SET DFN=$PIECE(IB0,U,2)
SET IBSC=$PIECE(IB0,U,18)
+3 WRITE !,@IOF,!,"SC Status and Rated Disabilities for ",$PIECE($GET(^DPT(+$GET(DFN),0)),U,1)
+4 WRITE !,"--------------------------------------------------------------------------------",!
+5 IF +$GET(IBIFN)
WRITE !," SC At Time Of Care: ",$SELECT(IBSC=1:"Yes",IBSC=0:"No",1:"")
+6 IF +$GET(DFN)
DO ELIG^VADPT
DO DIS^DGRPDB
+7 WRITE !!,"--------------------------------------------------------------------------------"
+8 SET IBX=$$PAUSE^IBCSCH1(19)
+9 QUIT
+10 ;
DISPROPT(IBIFN) ; prompt for VA or Non-VA provider.
+1 NEW X,Y,DIR
+2 SET DIR(0)="SAO^V:VA PROVIDER;N:NON-VA PROVIDER"
SET DIR("A")="(V)A or (N)on-VA Provider: "
SET DIR("B")="V"
+3 DO ^DIR
+4 IF Y="V"
DO DISPPRV^IBCSCH2(IBIFN)
QUIT
+5 IF Y="N"
DO DISPNVA^IBCSCH2(IBIFN)
+6 QUIT
+7 ;
