- 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/IBCSCH.m
r613 r623 1 IBCSCH ;ALB/MJB - MCCR HELP ROUTINE ;03 JUN 88 15:25 2 ;;2.0;INTEGRATED BILLING;**52,80,106,124,138,51,148,137,161,245,232,287,348,349,374,371,395**;21-MAR-94;Build 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;MAP TO DGCRSCH 6 ; 7 N I,C,IBSCNNZ,IBQ,IBPRNT,Z S IBSCNNZ=$$UP^XLFSTR($G(IBSCNN)),IBQ=0 8 I '$D(IBPAR) D Q:IBQ 9 . I $F(".?1500.?HCFA.","."_$G(IBSCNNZ)_"."),$$FT^IBCEF(IBIFN)=2 S IBQ=1,IBPRNT=2 D BL24(IBIFN,0) Q 10 . I $G(IBSCNNZ)="?SC" S IBQ=1 D DISPSC(IBIFN) Q 11 . I $G(IBSCNNZ)="?INS" S IBQ=1 D INSDSPL(IBIFN) Q 12 . I $G(IBSCNNZ)="?INX" S IBQ=1 D INSDSPLX(IBIFN) Q 13 . I $G(IBSCNNZ)="?PRV" S IBQ=1 D DISPROPT(IBIFN) Q 14 . I $G(IBSCNNZ)="?CHG" S IBQ=1 D DISPCHG^IBCRBH1(IBIFN) Q 15 . I $G(IBSCNNZ)="?PRC" S IBQ=1 D DISPPRC^IBCSCH1(IBIFN) Q 16 . I $G(IBSCNNZ)="?CPT" S IBQ=1 D BCPTCHG^IBCRBH2(IBIFN) Q 17 . I $G(IBSCNNZ)="?INC" S IBQ=1 D EDIT^IBCBB(IBIFN) Q 18 . I $G(IBSCNNZ)="?CLA",$$CK0^IBCIUT1() S IBQ=1 D CLA^IBCISC(IBIFN) Q 19 . I $G(IBSCNNZ)="?MRA",$$MCRONBIL^IBEFUNC(IBIFN),$T(SCR^IBCEMVU)'="" S IBQ=1 D SCR^IBCEMVU(IBIFN) Q 20 . I $G(IBSCNNZ)="?ID" S IBQ=1 D DISPID^IBCEF74(IBIFN) Q 21 . I $G(IBSCNNZ)="?RX" S IBQ=1 D DISPRX^IBCSCH1(IBIFN) Q 22 . Q 23 ; 24 S IBH("HELP")="" D ^IBCSCU,H^IBCSCU K IBH("HELP") W !,"Enter '^' to stop the display ",$S(IBV:"",1:"and edit "),"of data," 25 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 26 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" 27 W !,"enclosed in arrows ""<>"" are not." 28 G:$D(IBPAR) M1 29 M W " Special help screens:" 30 W !,?5,"Enter '?SC' to view SC Status and Rated Disabilities." 31 W !,?5,"Enter '?INS' to view the patients insurance policies." 32 W !,?5,"Enter '?INX' to view the patients insurance policies with comments." 33 W !,?5,"Enter '?PRV' to view provider specific information." 34 W !,?5,"Enter '?PRC' to view all procedures on the bill and related data." 35 W !,?5,"Enter '?CHG' to view all items on the bill with potential charges." 36 W !,?5,"Enter '?CPT' to view all charges for selected CPT codes and bill type." 37 I $$FT^IBCEF(IBIFN)=2 W !,?5,"Enter '?1500' to view how block 24 will print on a CMS-1500." 38 W !,?5,"Enter '?INC' to execute the edits & view the bill inconsistencies." 39 I $$CK0^IBCIUT1() W !?5,"Enter '?CLA' to view the ClaimsManager options." 40 I $$MCRONBIL^IBEFUNC(IBIFN) W !?5,"Enter '?MRA' to view Medicare Remittance Advice EOB's on file." 41 W !,?5,"Enter '?ID' to view all IDs to be electronically transmitted on this claim." 42 W !,?5,"Enter '?RX' to view all prescriptions on this claim." 43 ; 44 I +IBSR'=9 S Z="DATA GROUPS ON SCREEN "_+IBSR W ! X IBWW D @(IBSR1_IBSR) D W 45 D S W ! F I=$Y:1:20 W ! 46 S Z="PRESS <RETURN> KEY" X IBWW W " to RETURN to SCREEN ",+IBSR R X:DTIME Q 47 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 ! 48 S Z="PRESS <RETURN> KEY" X IBWW W " to RETURN to PARAMETER SCREEN" R X:DTIME Q 49 1 S X="DOB^Alias Name^Sex, Marital Status^Veteran Status, Eligibility^Address, Temporary Address^SC at Time of Care" Q 50 2 S X="Patient Employer Name, Address^Spouse Employer Name, Address" Q 51 3 S X="Payer Information^Provider Numbers^Mailing Address" Q 52 4 S X="Admission Information^Discharge Information^Diagnosis Code(s)^Coding Method, Inpt Proc Code(s)^Occurrence Code(s)^Condition Code(s)^Value Code(s)" Q 53 5 S X="Event Date^Outpatient Diagnosis^Outpatient Visits^Coding Method, Opt. Pro. Code(s)^Occurrence Code(s)^Condition Code(s)" Q 54 6 S X="Bill Type, Covered/Non-Covered Days^R.O.I., Assignment of Benefits^Statement Covers Period^Bedsection, Length of Stay^Revenue Code(s), Offset, Total^Rate Schedule(s)^Prior Payments/Claims" Q 55 7 S X="Bill Type, Covered/Non-Covered Days^R.O.I., Assignment of Benefits^Statement Covers Period^Outpatient Visits^Revenue Code(s), Offset, Total^Rate Schedule(s)^Prior Payments/Claims" Q 56 8 S X="Bill Remark^Form Locator 2^Form Locator 9^Form Locator 27^Form Locator 45^Form Locator 92^Form Locator 93^Tx Auth. Code" Q 57 9 S X="Locally defined fields" Q 58 28 S X="Bill Remark, ICN/DCN's, Tx Auth. Code, Admit Diagnosis/Source ^Providers^Force to Print^Provider ID Maintenance^Other Facility (VA/non)" Q 59 H8 S X="Period Unable to Work^Admit Dx, ICN/DCN, Tx/Prior Auth. Code^Providers^Non-VA Facility^Chiropractic Data^Form Locator 19^Force to Print^Provider ID Maintenance" Q 60 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 61 S N C,I,Z,J W !! S Z="AVAILABLE SCREENS" X IBWW 62 S X="Demographic^Employment^Payer^Inpatient Event^Outpatient Event^Inpatient Billing - General^Outpatient Billing - General^Billing - Specific^Locally Defined" 63 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 64 Q 65 W N I,J,Z 66 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 67 W:'(I-1)#2 ! Q 68 Q 69 ;IBCSCH 70 ; 71 ; 72 BL24(IBIFN,IBNOSHOW) ; display block 24 of CMS-1500 73 ; IBNOSHOW = 1 for not to show error/warning text line 74 N X,Y,DIR,IBPG,IBLN,IBCOL,IBX,IBQ,IBLC,IBLIN,IBPFORM,IBD,IBC1,Z,Z0,IBXDATA,IBXSAVE,IBNXPG 75 K ^TMP("IBXSAVE",$J) 76 S IBQ=0,IBLC=9 Q:'$G(IBIFN) K ^TMP("IBXDISP",$J) 77 ; 78 S IBLIN=$$BOX24D^IBCEF11() 79 S IBPFORM=$S($P($G(^IBE(353,2,2)),U,8):$P(^(2),U,8),1:2) 80 S IBX=$$BILLN^IBCEFG0(0,"1^99",IBLIN,+IBIFN,IBPFORM) 81 ; 82 W @IOF,!,"Example of diagnoses, procedures and charges printing on the CMS-1500" 83 W !,"--------------------------------------------------------------------------------" 84 ; 85 ; box 19 - lines 36-37 86 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 87 ; 88 ; box 21 - lines 39-41 89 W !,"21. diagnosis" 90 I $D(^TMP("IBXDISP",$J,2,IBLIN+3)) W ?16,"(1st 4 only)" 91 W !,?5,"1. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,3)),?25,"3. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,30)) 92 W !,?5,"2. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,3)),?25,"4. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,30)) 93 ; 94 ; box 24 - lines 44-55 95 D PG 96 S IBPG=0 F S IBPG=$O(^TMP("IBXDISP",$J,IBPG)) Q:'IBPG D Q:IBQ 97 . I '$D(^TMP("IBXDISP",$J,IBPG,IBLIN+9)) Q ; no line's on this page 98 . 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 99 .. S IBCOL=0,IBC1=1 F S IBCOL=$O(^TMP("IBXDISP",$J,IBPG,IBLN,IBCOL)) Q:'IBCOL I $TR($G(^(IBCOL))," ")'="" D 100 ... W:IBC1 ! S IBC1=0 W ?(IBCOL-1),$G(^TMP("IBXDISP",$J,IBPG,IBLN,IBCOL)) 101 . S IBNXPG=$O(^TMP("IBXDISP",$J,IBPG)) ; next page 102 . 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 103 . Q 104 ; 105 W !,"--------------------------------------------------------------------------------" 106 I 'IBPG,'IBQ S IBQ=$$PAUSE^IBCSCH1(IBLC) 107 K ^TMP("IBXDISP",$J),^TMP("IBXSAVE",$J) 108 Q 109 ; 110 PG ; Display box 24 letters at top of charge list 111 W !,"24. A B C D E F G H I J" 112 W !,"--------------------------------------------------------------------------------" 113 Q 114 ; 115 INSDSPL(IBIFN) ; Display patient's policies 116 N DIR,X,Y,IBX,DFN,IBDTIN,IBCOVEXT W @IOF 117 S IBX=$G(^DGCR(399,+$G(IBIFN),0)),DFN=$P(IBX,U,2),IBDTIN=$P(IBX,U,3),IBCOVEXT=1 118 I +DFN D DISPDT^IBCNS W ! S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR 119 Q 120 ; 121 INSDSPLX(IBIFN) ; Display patient's policies extended (?INX) 122 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) 123 Q 124 ; 125 DISPSC(IBIFN) ; display patients SC Status and Rated Disabilities 126 N IB0,DFN,IBSC,IBX,VAEL,VAERR 127 S IB0=$G(^DGCR(399,+$G(IBIFN),0)),DFN=$P(IB0,U,2),IBSC=$P(IB0,U,18) 128 W !,@IOF,!,"SC Status and Rated Disabilities for ",$P($G(^DPT(+$G(DFN),0)),U,1) 129 W !,"--------------------------------------------------------------------------------",! 130 I +$G(IBIFN) W !," SC At Time Of Care: ",$S(IBSC=1:"Yes",IBSC=0:"No",1:"") 131 I +$G(DFN) D ELIG^VADPT D DIS^DGRPDB 132 W !!,"--------------------------------------------------------------------------------" 133 S IBX=$$PAUSE^IBCSCH1(19) 134 Q 135 ; 136 DISPROPT(IBIFN) ; prompt for VA or Non-VA provider. 137 N X,Y,DIR 138 S DIR(0)="SAO^V:VA PROVIDER;N:NON-VA PROVIDER",DIR("A")="(V)A or (N)on-VA Provider: ",DIR("B")="V" 139 D ^DIR 140 I Y="V" D DISPPRV^IBCSCH2(IBIFN) Q 141 I Y="N" D DISPNVA^IBCSCH2(IBIFN) 142 Q 143 ; 1 IBCSCH ;ALB/MJB - MCCR HELP ROUTINE ;03 JUN 88 15:25 2 ;;2.0;INTEGRATED BILLING;**52,80,106,124,138,51,148,137,161,245,232,287,348,349,374**;21-MAR-94;Build 16 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;MAP TO DGCRSCH 6 ; 7 N I,C,IBSCNNZ,IBQ,IBPRNT,Z S IBSCNNZ=$$UP^XLFSTR($G(IBSCNN)),IBQ=0 8 I '$D(IBPAR) D Q:IBQ 9 . I $F(".?1500.?HCFA.","."_$G(IBSCNNZ)_"."),$$FT^IBCEF(IBIFN)=2 S IBQ=1,IBPRNT=2 D BL24(IBIFN,0) Q 10 . I $G(IBSCNNZ)="?SC" S IBQ=1 D DISPSC(IBIFN) Q 11 . I $G(IBSCNNZ)="?INS" S IBQ=1 D INSDSPL(IBIFN) Q 12 . I $G(IBSCNNZ)="?INX" S IBQ=1 D INSDSPLX(IBIFN) Q 13 . I $G(IBSCNNZ)="?PRV" S IBQ=1 D DISPROPT(IBIFN) Q 14 . I $G(IBSCNNZ)="?CHG" S IBQ=1 D DISPCHG^IBCRBH1(IBIFN) Q 15 . I $G(IBSCNNZ)="?PRC" S IBQ=1 D DISPPRC^IBCSCH1(IBIFN) Q 16 . I $G(IBSCNNZ)="?CPT" S IBQ=1 D BCPTCHG^IBCRBH2(IBIFN) Q 17 . I $G(IBSCNNZ)="?INC" S IBQ=1 D EDIT^IBCBB(IBIFN) Q 18 . I $G(IBSCNNZ)="?CLA",$$CK0^IBCIUT1() S IBQ=1 D CLA^IBCISC(IBIFN) Q 19 . I $G(IBSCNNZ)="?MRA",$$MCRONBIL^IBEFUNC(IBIFN),$T(SCR^IBCEMVU)'="" S IBQ=1 D SCR^IBCEMVU(IBIFN) Q 20 . I $G(IBSCNNZ)="?ID" S IBQ=1 D DISPID^IBCEF74(IBIFN) Q 21 . Q 22 ; 23 S IBH("HELP")="" D ^IBCSCU,H^IBCSCU K IBH("HELP") W !,"Enter '^' to stop the display ",$S(IBV:"",1:"and edit "),"of data," 24 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 25 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" 26 W !,"enclosed in arrows ""<>"" are not." 27 G:$D(IBPAR) M1 28 M W " Special help screens:" 29 W !,?5,"Enter '?SC' to view SC Status and Rated Disabilities." 30 W !,?5,"Enter '?INS' to view the patients insurance policies." 31 W !,?5,"Enter '?INX' to view the patients insurance policies with comments." 32 W !,?5,"Enter '?PRV' to view provider specific information." 33 W !,?5,"Enter '?PRC' to view all procedures on the bill and related data." 34 W !,?5,"Enter '?CHG' to view all items on the bill with potential charges." 35 W !,?5,"Enter '?CPT' to view all charges for selected CPT codes and bill type." 36 I $$FT^IBCEF(IBIFN)=2 W !,?5,"Enter '?1500' to view how block 24 will print on a CMS-1500." 37 W !,?5,"Enter '?INC' to execute the edits & view the bill inconsistencies." 38 I $$CK0^IBCIUT1() W !?5,"Enter '?CLA' to view the ClaimsManager options." 39 I $$MCRONBIL^IBEFUNC(IBIFN) W !?5,"Enter '?MRA' to view Medicare Remittance Advice EOB's on file." 40 W !,?5,"Enter '?ID' to view all IDs to be electronically transmitted on this claim." 41 ; 42 I +IBSR'=9 S Z="DATA GROUPS ON SCREEN "_+IBSR W ! X IBWW D @(IBSR1_IBSR) D W 43 D S W ! F I=$Y:1:20 W ! 44 S Z="PRESS <RETURN> KEY" X IBWW W " to RETURN to SCREEN ",+IBSR R X:DTIME Q 45 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 ! 46 S Z="PRESS <RETURN> KEY" X IBWW W " to RETURN to PARAMETER SCREEN" R X:DTIME Q 47 1 S X="DOB^Alias Name^Sex, Marital Status^Veteran Status, Eligibility^Address, Temporary Address^SC at Time of Care" Q 48 2 S X="Patient Employer Name, Address^Spouse Employer Name, Address" Q 49 3 S X="Payer Information^Provider Numbers^Mailing Address" Q 50 4 S X="Admission Information^Discharge Information^Diagnosis Code(s)^Coding Method, Inpt Proc Code(s)^Occurrence Code(s)^Condition Code(s)^Value Code(s)" Q 51 5 S X="Event Date^Outpatient Diagnosis^Outpatient Visits^Coding Method, Opt. Pro. Code(s)^Occurrence Code(s)^Condition Code(s)" Q 52 6 S X="Bill Type, Covered/Non-Covered Days^R.O.I., Assignment of Benefits^Statement Covers Period^Bedsection, Length of Stay^Revenue Code(s), Offset, Total^Rate Schedule(s)^Prior Payments/Claims" Q 53 7 S X="Bill Type, Covered/Non-Covered Days^R.O.I., Assignment of Benefits^Statement Covers Period^Outpatient Visits^Revenue Code(s), Offset, Total^Rate Schedule(s)^Prior Payments/Claims" Q 54 8 S X="Bill Remark^Form Locator 2^Form Locator 9^Form Locator 27^Form Locator 45^Form Locator 92^Form Locator 93^Tx Auth. Code" Q 55 9 S X="Locally defined fields" Q 56 28 S X="Bill Remark, ICN/DCN's, Tx Auth. Code, Admit Diagnosis/Source ^Providers^Force to Print^Provider ID Maintenance^Other Facility (VA/non)" Q 57 H8 S X="Period Unable to Work^Admit Dx, ICN/DCN, Tx/Prior Auth. Code^Providers^Non-VA Facility^Form Locator 19^Force to Print" Q 58 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 59 S N C,I,Z,J W !! S Z="AVAILABLE SCREENS" X IBWW 60 S X="Demographic^Employment^Payer^Inpatient Event^Outpatient Event^Inpatient Billing - General^Outpatient Billing - General^Billing - Specific^Locally Defined" 61 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 62 Q 63 W N I,J,Z 64 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 65 W:'(I-1)#2 ! Q 66 Q 67 ;IBCSCH 68 ; 69 ; 70 BL24(IBIFN,IBNOSHOW) ; display block 24 of CMS-1500 71 ; IBNOSHOW = 1 for not to show error/warning text line 72 N X,Y,DIR,IBPG,IBLN,IBCOL,IBX,IBQ,IBLC,IBLIN,IBPFORM,IBD,IBC1,Z,Z0,IBXDATA,IBXSAVE,IBNXPG 73 K ^TMP("IBXSAVE",$J) 74 S IBQ=0,IBLC=9 Q:'$G(IBIFN) K ^TMP("IBXDISP",$J) 75 ; 76 S IBLIN=$$BOX24D^IBCEF11() 77 S IBPFORM=$S($P($G(^IBE(353,2,2)),U,8):$P(^(2),U,8),1:2) 78 S IBX=$$BILLN^IBCEFG0(0,"1^99",IBLIN,+IBIFN,IBPFORM) 79 ; 80 W @IOF,!,"Example of diagnoses, procedures and charges printing on the CMS-1500" 81 W !,"--------------------------------------------------------------------------------" 82 ; 83 ; box 19 - lines 36-37 84 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 85 ; 86 ; box 21 - lines 39-41 87 W !,"21. diagnosis" 88 I $D(^TMP("IBXDISP",$J,2,IBLIN+3)) W ?16,"(1st 4 only)" 89 W !,?5,"1. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,3)),?25,"3. ",$G(^TMP("IBXDISP",$J,1,IBLIN+3,30)) 90 W !,?5,"2. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,3)),?25,"4. ",$G(^TMP("IBXDISP",$J,1,IBLIN+5,30)) 91 ; 92 ; box 24 - lines 44-55 93 D PG 94 S IBPG=0 F S IBPG=$O(^TMP("IBXDISP",$J,IBPG)) Q:'IBPG D Q:IBQ 95 . I '$D(^TMP("IBXDISP",$J,IBPG,IBLIN+9)) Q ; no line's on this page 96 . 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 97 .. S IBCOL=0,IBC1=1 F S IBCOL=$O(^TMP("IBXDISP",$J,IBPG,IBLN,IBCOL)) Q:'IBCOL I $TR($G(^(IBCOL))," ")'="" D 98 ... W:IBC1 ! S IBC1=0 W ?(IBCOL-1),$G(^TMP("IBXDISP",$J,IBPG,IBLN,IBCOL)) 99 . S IBNXPG=$O(^TMP("IBXDISP",$J,IBPG)) ; next page 100 . 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 101 . Q 102 ; 103 W !,"--------------------------------------------------------------------------------" 104 I 'IBPG,'IBQ S IBQ=$$PAUSE^IBCSCH1(IBLC) 105 K ^TMP("IBXDISP",$J),^TMP("IBXSAVE",$J) 106 Q 107 ; 108 PG ; Display box 24 letters at top of charge list 109 W !,"24. A B C D E F G H I J" 110 W !,"--------------------------------------------------------------------------------" 111 Q 112 ; 113 INSDSPL(IBIFN) ; Display patient's policies 114 N DIR,X,Y,IBX,DFN,IBDTIN,IBCOVEXT W @IOF 115 S IBX=$G(^DGCR(399,+$G(IBIFN),0)),DFN=$P(IBX,U,2),IBDTIN=$P(IBX,U,3),IBCOVEXT=1 116 I +DFN D DISPDT^IBCNS W ! S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR 117 Q 118 ; 119 INSDSPLX(IBIFN) ; Display patient's policies extended (?INX) 120 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) 121 Q 122 ; 123 DISPSC(IBIFN) ; display patients SC Status and Rated Disabilities 124 N IB0,DFN,IBSC,IBX,VAEL,VAERR 125 S IB0=$G(^DGCR(399,+$G(IBIFN),0)),DFN=$P(IB0,U,2),IBSC=$P(IB0,U,18) 126 W !,@IOF,!,"SC Status and Rated Disabilities for ",$P($G(^DPT(+$G(DFN),0)),U,1) 127 W !,"--------------------------------------------------------------------------------",! 128 I +$G(IBIFN) W !," SC At Time Of Care: ",$S(IBSC=1:"Yes",IBSC=0:"No",1:"") 129 I +$G(DFN) D ELIG^VADPT D DIS^DGRPDB 130 W !!,"--------------------------------------------------------------------------------" 131 S IBX=$$PAUSE^IBCSCH1(19) 132 Q 133 ; 134 DISPROPT(IBIFN) ; prompt for VA or Non-VA provider. 135 N X,Y,DIR 136 S DIR(0)="SAO^V:VA PROVIDER;N:NON-VA PROVIDER",DIR("A")="(V)A or (N)on-VA Provider: ",DIR("B")="V" 137 D ^DIR 138 I Y="V" D DISPPRV^IBCSCH2(IBIFN) Q 139 I Y="N" D DISPNVA^IBCSCH2(IBIFN) 140 Q 141 ;
Note:
See TracChangeset
for help on using the changeset viewer.
