IBJDI7 ;ALB/CPM - OUTPATIENT WORKLOAD REPORT ; 19-DEC-96
;;2.0;INTEGRATED BILLING;**69,91,98,100,118,133,339**;21-MAR-94;Build 2
;
EN ; - Option entry point.
;
W !!,"This report provides a measure of the number and types of"
W !,"Outpatient Services that are provided in the Medical Center.",!
;
DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
;
; - Sort by division?
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Do you wish to sort this report by division"
S DIR("?")="^D DHLP^IBJDI7" W !
D ^DIR S IBSORT=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
K DIR,DIROUT,DTOUT,DUOUT,DIRUT
;
; - Select division(s).
I IBSORT D PSDR^IBODIV G:Y<0 ENQ
;
W !!,"This report only requires an 80 column printer."
;
W !!,"Note: This report may take a while to run."
W !?6,"You should queue this report to run after normal business hours.",!
;
; - Select a device.
S %ZIS="QM" D ^%ZIS G:POP ENQ
I $D(IO("Q")) D G ENQ
.S ZTRTN="DQ^IBJDI7",ZTDESC="IB - OUTPATIENT WORKLOAD REPORT"
.F I="IBBDT","IBEDT","IBSORT","VAUTD","VAUTD(" S ZTSAVE(I)=""
.D ^%ZTLOAD
.W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
DQ ; - Tasked entry point.
;
I $G(IBXTRACT) D E^IBJDE(7,1) ; Change extract status.
;
N IBQUERY K IB
S IBC="TOT^NSC^SC^SCS^SCN",IBQ=0
I IBSORT D
.S I=0 F S I=$S(VAUTD:$O(^DG(40.8,I)),1:$O(VAUTD(I))) Q:'I D
..S J=$P(^DG(40.8,I,0),U),IB(J,"GTOT")=0
..F K=1:1:5 S IB(J,$P(IBC,U,K)_"-A")=0 S:K<4 IB(J,$P(IBC,U,K)_"-I")=0
S IB("ZZALL","GTOT")=0
F I=1:1:5 D
.S IB("ZZALL",$P(IBC,U,I)_"-A")=0 S:I<4 IB("ZZALL",$P(IBC,U,I)_"-I")=0
;
; - Find outpatient encounters within the user-specified date range.
D OUTPT^IBJDI21("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 D:'IBQ ENC^IBJDI7(Y,Y0)","Outpatient Workload Report",.IBQ,"",.IBQUERY)
D CLOSE^IBSDU(.IBQUERY)
;
I IBQ G ENQ
;
I $G(IBXTRACT) D E^IBJDE(7,0) G ENQ ; Extract summary data.
;
; - Print the report.
S (IBPAG,IBQ)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
S IBDIV="" F S IBDIV=$O(IB(IBDIV)) Q:IBDIV="" D SUM Q:IBQ
;
ENQ I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
;
D ^%ZISC
ENQ1 K IB,IBC,IBH,IBQ,IBBDT,IBEDT,IBD,IBDIV,IBOE,IBOED,IBPAG,IBRUN,IBSORT
K IBPER,IBINS,IBSC,%,%ZIS,DFN,POP,I,J,K,X,Y,VA,VAEL,VAERR,VAUTD
K ZTDESC,ZTRTN,ZTSAVE
Q
;
ENC(IBOE,IBOED) ; - Extract encounter - must be called from DQ above.
I $$TESTP^IBJDI1(+$P(IBOED,U,2)) G ENCQ ; Test patient.
;
I IBSORT D G:'$D(IB(IBDIV,"TOT-A")) ENCQ
.S IBDIV=+$P(IBOED,U,11)
.S IBDIV=$P($G(^DG(40.8,$S('IBDIV:+$$PRIM^VASITE(),1:IBDIV),0)),U)
;
S IBINS=$$INS(IBOE,IBOED) ; Check if insured encounter.
;
; - Set main totals.
S IB("ZZALL","GTOT")=IB("ZZALL","GTOT")+1
S IB("ZZALL","TOT-A")=IB("ZZALL","TOT-A")+1
I IBINS S IB("ZZALL","TOT-I")=IB("ZZALL","TOT-I")+1
I IBSORT D
.S IB(IBDIV,"GTOT")=IB(IBDIV,"GTOT")+1
.S IB(IBDIV,"TOT-A")=IB(IBDIV,"TOT-A")+1
.I IBINS S IB(IBDIV,"TOT-I")=IB(IBDIV,"TOT-I")+1
;
; - Set NSC totals.
S DFN=+$P(IBOED,U,2) D ELIG^VADPT S IBSC=+VAEL(3)
I 'IBSC D G ENCQ
.S IB("ZZALL","NSC-A")=IB("ZZALL","NSC-A")+1
.I IBINS S IB("ZZALL","NSC-I")=IB("ZZALL","NSC-I")+1
.I IBSORT D
..S IB(IBDIV,"NSC-A")=IB(IBDIV,"NSC-A")+1
..I IBINS S IB(IBDIV,"NSC-I")=IB(IBDIV,"NSC-I")+1
;
; - Set SC totals.
S IB("ZZALL","SC-A")=IB("ZZALL","SC-A")+1
I IBINS S IB("ZZALL","SC-I")=IB("ZZALL","SC-I")+1
I IBSORT D
.S IB(IBDIV,"SC-A")=IB(IBDIV,"SC-A")+1
.I IBINS S IB(IBDIV,"SC-I")=IB(IBDIV,"SC-I")+1
;
; - If care related to an SC condition, set SCS totals.
I $$SC(IBOE) D G ENCQ
.S IB("ZZALL","SCS-A")=IB("ZZALL","SCS-A")+1
.I IBSORT S IB(IBDIV,"SCS-A")=IB(IBDIV,"SCS-A")+1
;
; - Set SCN totals.
S IB("ZZALL","SCN-A")=IB("ZZALL","SCN-A")+1
I IBSORT S IB(IBDIV,"SCN-A")=IB(IBDIV,"SCN-A")+1
;
ENCQ Q
;
SUM ; - Print the summary report.
F X="-A","-I" D Q:IBQ
.I X["A" W @IOF,*13
.I X["I",$E(IOST,1,2)="C-" W @IOF,*13
.E W:X["I" !!
.;
.; - Print summary header.
.W !!?$S(X["A":17,1:12),"OUTPATIENT ENCOUNTER WORKLOAD - "
.W $S(X["A":"ALL ENCOUNTERS",1:"INSURED ENCOUNTERS ONLY")
.S IBH="SUMMARY REPORT FOR "_$S(IBDIV="ZZALL":"ALL DIVISIONS",1:IBDIV)
.S IBC=(80-$L(IBH)/2)\1 W !?IBC,IBH
.W !!?$S(X["A":15,1:11),"For ",$S(X["I":"Insured ",1:""),"Outpatient Encounters from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
.I $E(IOST,1,2)="C-" W !!?24,"Run Date: ",IBRUN
.S IBC=$S(X["A":"17^46",1:"12^55") W !?+IBC,$$DASH($P(IBC,U,2)),!!
.;
.; - Print summary statistics.
.S IBPER(1)=$J($S('IB(IBDIV,"TOT"_X):0,1:IB(IBDIV,"NSC"_X)/IB(IBDIV,"TOT"_X)*100),0,2),IBPER(2)=$J($S('IB(IBDIV,"TOT"_X):0,1:100-IBPER(1)),0,2)
.W ?$S(X["A":27,1:21),"Number of Outpatient Encounters:",?$S(X["A":60,1:54),$J(IB(IBDIV,"TOT"_X),7)
.W !?$S(X["A":21,1:15),"Number of Encounters for NSC Veterans:",?$S(X["A":60,1:54),$J(IB(IBDIV,"NSC"_X),7)," (",IBPER(1),"%)"
.W !?$S(X["A":22,1:16),"Number of Encounters for SC Veterans:",?$S(X["A":60,1:54),$J(IB(IBDIV,"SC"_X),7)," (",IBPER(2),"%)"
.I X["A" D
..S IBPER(3)=$J($S('IB(IBDIV,"SC-A"):0,1:IB(IBDIV,"SCS-A")/IB(IBDIV,"SC-A")*100),0,2),IBPER(4)=$J($S('IB(IBDIV,"SC-A"):0,1:100-IBPER(3)),0,2)
..W !?4,"Number of Service Connected Encounters for SC Veterans:",?60,$J(IB(IBDIV,"SCS-A"),7)," (",IBPER(3),"%)"
..W !?3,"Number of Non-Svc. Connected Encounters for SC Veterans:",?60,$J(IB(IBDIV,"SCN-A"),7)," (",IBPER(4),"%)"
.E D
..S IBPER(5)=$J($S('IB(IBDIV,"GTOT"):0,1:IB(IBDIV,"TOT-I")/IB(IBDIV,"GTOT")*100),0,2)
..W !!?5,"Percentage of Insured Outpatient Encounters for ",$S(IBDIV="ZZALL":"All Divisions",1:"This Division"),": ",IBPER(5),"%"
.D PAUSE
Q
;
DASH(X) ; - Return a dashed line.
Q $TR($J("",X)," ","=")
;
PAUSE ; - Page break.
I $E(IOST,1,2)'="C-" Q
N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
Q
;
INS(IBOE,IBOED) ; - Is this an insured encounter?
; Input: IBOE = IEN of outpatient encounter in file #409.68
; IBOED = Outpatient encounter in file #409.68
; Output: 1 = Insured encounter
; 0 = Not an insured encounter
;
N DFN,IBCK,IBPB,VA,VAEL,VAERR,X0
S DFN=+$P(IBOED,U,2)
I $G(^DPT(DFN,"VET"))'="Y" G INSQ ; Patient not a veteran.
I '$$INSURED^IBCNS1(DFN,+IBOED\1) G INSQ ; Patient not insured.
;
; - Check if encounter was made non-billable in Claims Tracking.
I $P($G(^IBT(356,+$O(^IBT(356,"ASCE",IBOE,0)),0)),U,19) G INSQ
;
; - Check encounter for non-billable appt. type (1), non-count
; clinic (2), non-billable clinic (3,12), admission by 11:59pm of
; encounter date (5), non-billable stop code (7,8), non-billable
; disposition (10), and parent encounter (11). If IBPB equals one
; of these numbers, Y will be set to 0 (Not an insured encounter).
F X0=1,2,3,5,7,8,10,11,12 S IBCK(X0)=""
S X0=$$BILLCK^IBAMTEDU(IBOE,IBOED,.IBCK,.IBPB)
I $G(IBPB) G INSQ
;
I $$ENCL^IBAMTS2(IBOE)[1 G INSQ ; Care is related to AO/IR/SWA/SC/MST/HNC/CV/SHAD.
;
S Y=1 Q Y
INSQ S Y=0 Q Y
;
SC(OE) ; - Is the encounter related to the veteran's SC condition?
; Input: OE = IEN of outpatient encounter in file #409.68
; Output: SC = 1 (Encounter related to SC condition)
; 0 (Encounter NOT related to SC condition)
;
N CL,CLD,SC
S (CL,SC)=0 F S CL=$O(^SDD(409.42,"OE",+$G(OE),CL)) Q:'CL D Q:SC
.S CLD=$G(^SDD(409.42,CL,0)) I +CLD=3,$P(CLD,U,3) S SC=1
Q SC
;
DHLP ; - Display 'Sort by division' help.
W !,"Enter RETURN to summarize all outpt. encounters without regard to"
W !,"division, or 'Yes' to select those divisions for which a separate"
W !,"summary report should be created."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDI7 7778 printed Dec 13, 2024@02:23:22 Page 2
IBJDI7 ;ALB/CPM - OUTPATIENT WORKLOAD REPORT ; 19-DEC-96
+1 ;;2.0;INTEGRATED BILLING;**69,91,98,100,118,133,339**;21-MAR-94;Build 2
+2 ;
EN ; - Option entry point.
+1 ;
+2 WRITE !!,"This report provides a measure of the number and types of"
+3 WRITE !,"Outpatient Services that are provided in the Medical Center.",!
+4 ;
DATE DO DATE^IBOUTL
IF IBBDT=""!(IBEDT="")
GOTO ENQ
+1 ;
+2 ; - Sort by division?
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
+4 SET DIR("A")="Do you wish to sort this report by division"
+5 SET DIR("?")="^D DHLP^IBJDI7"
WRITE !
+6 DO ^DIR
SET IBSORT=+Y
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO ENQ
+7 KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT
+8 ;
+9 ; - Select division(s).
+10 IF IBSORT
DO PSDR^IBODIV
if Y<0
GOTO ENQ
+11 ;
+12 WRITE !!,"This report only requires an 80 column printer."
+13 ;
+14 WRITE !!,"Note: This report may take a while to run."
+15 WRITE !?6,"You should queue this report to run after normal business hours.",!
+16 ;
+17 ; - Select a device.
+18 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO ENQ
+19 IF $DATA(IO("Q"))
Begin DoDot:1
+20 SET ZTRTN="DQ^IBJDI7"
SET ZTDESC="IB - OUTPATIENT WORKLOAD REPORT"
+21 FOR I="IBBDT","IBEDT","IBSORT","VAUTD","VAUTD("
SET ZTSAVE(I)=""
+22 DO ^%ZTLOAD
+23 WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+24 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+25 ;
+26 USE IO
+27 ;
DQ ; - Tasked entry point.
+1 ;
+2 ; Change extract status.
IF $GET(IBXTRACT)
DO E^IBJDE(7,1)
+3 ;
+4 NEW IBQUERY
KILL IB
+5 SET IBC="TOT^NSC^SC^SCS^SCN"
SET IBQ=0
+6 IF IBSORT
Begin DoDot:1
+7 SET I=0
FOR
SET I=$SELECT(VAUTD:$ORDER(^DG(40.8,I)),1:$ORDER(VAUTD(I)))
if 'I
QUIT
Begin DoDot:2
+8 SET J=$PIECE(^DG(40.8,I,0),U)
SET IB(J,"GTOT")=0
+9 FOR K=1:1:5
SET IB(J,$PIECE(IBC,U,K)_"-A")=0
if K<4
SET IB(J,$PIECE(IBC,U,K)_"-I")=0
End DoDot:2
End DoDot:1
+10 SET IB("ZZALL","GTOT")=0
+11 FOR I=1:1:5
Begin DoDot:1
+12 SET IB("ZZALL",$PIECE(IBC,U,I)_"-A")=0
if I<4
SET IB("ZZALL",$PIECE(IBC,U,I)_"-I")=0
End DoDot:1
+13 ;
+14 ; - Find outpatient encounters within the user-specified date range.
+15 DO OUTPT^IBJDI21("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 D:'IBQ ENC^IBJDI7(Y,Y0)","Outpatient Workload Report",.IBQ,"",.IBQUERY)
+16 DO CLOSE^IBSDU(.IBQUERY)
+17 ;
+18 IF IBQ
GOTO ENQ
+19 ;
+20 ; Extract summary data.
IF $GET(IBXTRACT)
DO E^IBJDE(7,0)
GOTO ENQ
+21 ;
+22 ; - Print the report.
+23 SET (IBPAG,IBQ)=0
DO NOW^%DTC
SET IBRUN=$$DAT2^IBOUTL(%)
+24 SET IBDIV=""
FOR
SET IBDIV=$ORDER(IB(IBDIV))
if IBDIV=""
QUIT
DO SUM
if IBQ
QUIT
+25 ;
ENQ IF $DATA(ZTQUEUED)
SET ZTREQ="@"
GOTO ENQ1
+1 ;
+2 DO ^%ZISC
ENQ1 KILL IB,IBC,IBH,IBQ,IBBDT,IBEDT,IBD,IBDIV,IBOE,IBOED,IBPAG,IBRUN,IBSORT
+1 KILL IBPER,IBINS,IBSC,%,%ZIS,DFN,POP,I,J,K,X,Y,VA,VAEL,VAERR,VAUTD
+2 KILL ZTDESC,ZTRTN,ZTSAVE
+3 QUIT
+4 ;
ENC(IBOE,IBOED) ; - Extract encounter - must be called from DQ above.
+1 ; Test patient.
IF $$TESTP^IBJDI1(+$PIECE(IBOED,U,2))
GOTO ENCQ
+2 ;
+3 IF IBSORT
Begin DoDot:1
+4 SET IBDIV=+$PIECE(IBOED,U,11)
+5 SET IBDIV=$PIECE($GET(^DG(40.8,$SELECT('IBDIV:+$$PRIM^VASITE(),1:IBDIV),0)),U)
End DoDot:1
if '$DATA(IB(IBDIV,"TOT-A"))
GOTO ENCQ
+6 ;
+7 ; Check if insured encounter.
SET IBINS=$$INS(IBOE,IBOED)
+8 ;
+9 ; - Set main totals.
+10 SET IB("ZZALL","GTOT")=IB("ZZALL","GTOT")+1
+11 SET IB("ZZALL","TOT-A")=IB("ZZALL","TOT-A")+1
+12 IF IBINS
SET IB("ZZALL","TOT-I")=IB("ZZALL","TOT-I")+1
+13 IF IBSORT
Begin DoDot:1
+14 SET IB(IBDIV,"GTOT")=IB(IBDIV,"GTOT")+1
+15 SET IB(IBDIV,"TOT-A")=IB(IBDIV,"TOT-A")+1
+16 IF IBINS
SET IB(IBDIV,"TOT-I")=IB(IBDIV,"TOT-I")+1
End DoDot:1
+17 ;
+18 ; - Set NSC totals.
+19 SET DFN=+$PIECE(IBOED,U,2)
DO ELIG^VADPT
SET IBSC=+VAEL(3)
+20 IF 'IBSC
Begin DoDot:1
+21 SET IB("ZZALL","NSC-A")=IB("ZZALL","NSC-A")+1
+22 IF IBINS
SET IB("ZZALL","NSC-I")=IB("ZZALL","NSC-I")+1
+23 IF IBSORT
Begin DoDot:2
+24 SET IB(IBDIV,"NSC-A")=IB(IBDIV,"NSC-A")+1
+25 IF IBINS
SET IB(IBDIV,"NSC-I")=IB(IBDIV,"NSC-I")+1
End DoDot:2
End DoDot:1
GOTO ENCQ
+26 ;
+27 ; - Set SC totals.
+28 SET IB("ZZALL","SC-A")=IB("ZZALL","SC-A")+1
+29 IF IBINS
SET IB("ZZALL","SC-I")=IB("ZZALL","SC-I")+1
+30 IF IBSORT
Begin DoDot:1
+31 SET IB(IBDIV,"SC-A")=IB(IBDIV,"SC-A")+1
+32 IF IBINS
SET IB(IBDIV,"SC-I")=IB(IBDIV,"SC-I")+1
End DoDot:1
+33 ;
+34 ; - If care related to an SC condition, set SCS totals.
+35 IF $$SC(IBOE)
Begin DoDot:1
+36 SET IB("ZZALL","SCS-A")=IB("ZZALL","SCS-A")+1
+37 IF IBSORT
SET IB(IBDIV,"SCS-A")=IB(IBDIV,"SCS-A")+1
End DoDot:1
GOTO ENCQ
+38 ;
+39 ; - Set SCN totals.
+40 SET IB("ZZALL","SCN-A")=IB("ZZALL","SCN-A")+1
+41 IF IBSORT
SET IB(IBDIV,"SCN-A")=IB(IBDIV,"SCN-A")+1
+42 ;
ENCQ QUIT
+1 ;
SUM ; - Print the summary report.
+1 FOR X="-A","-I"
Begin DoDot:1
+2 IF X["A"
WRITE @IOF,*13
+3 IF X["I"
IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF,*13
+4 IF '$TEST
if X["I"
WRITE !!
+5 ;
+6 ; - Print summary header.
+7 WRITE !!?$SELECT(X["A":17,1:12),"OUTPATIENT ENCOUNTER WORKLOAD - "
+8 WRITE $SELECT(X["A":"ALL ENCOUNTERS",1:"INSURED ENCOUNTERS ONLY")
+9 SET IBH="SUMMARY REPORT FOR "_$SELECT(IBDIV="ZZALL":"ALL DIVISIONS",1:IBDIV)
+10 SET IBC=(80-$LENGTH(IBH)/2)\1
WRITE !?IBC,IBH
+11 WRITE !!?$SELECT(X["A":15,1:11),"For ",$SELECT(X["I":"Insured ",1:""),"Outpatient Encounters from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
+12 IF $EXTRACT(IOST,1,2)="C-"
WRITE !!?24,"Run Date: ",IBRUN
+13 SET IBC=$SELECT(X["A":"17^46",1:"12^55")
WRITE !?+IBC,$$DASH($PIECE(IBC,U,2)),!!
+14 ;
+15 ; - Print summary statistics.
+16 SET IBPER(1)=$JUSTIFY($SELECT('IB(IBDIV,"TOT"_X):0,1:IB(IBDIV,"NSC"_X)/IB(IBDIV,"TOT"_X)*100),0,2)
SET IBPER(2)=$JUSTIFY($SELECT('IB(IBDIV,"TOT"_X):0,1:100-IBPER(1)),0,2)
+17 WRITE ?$SELECT(X["A":27,1:21),"Number of Outpatient Encounters:",?$SELECT(X["A":60,1:54),$JUSTIFY(IB(IBDIV,"TOT"_X),7)
+18 WRITE !?$SELECT(X["A":21,1:15),"Number of Encounters for NSC Veterans:",?$SELECT(X["A":60,1:54),$JUSTIFY(IB(IBDIV,"NSC"_X),7)," (",IBPER(1),"%)"
+19 WRITE !?$SELECT(X["A":22,1:16),"Number of Encounters for SC Veterans:",?$SELECT(X["A":60,1:54),$JUSTIFY(IB(IBDIV,"SC"_X),7)," (",IBPER(2),"%)"
+20 IF X["A"
Begin DoDot:2
+21 SET IBPER(3)=$JUSTIFY($SELECT('IB(IBDIV,"SC-A"):0,1:IB(IBDIV,"SCS-A")/IB(IBDIV,"SC-A")*100),0,2)
SET IBPER(4)=$JUSTIFY($SELECT('IB(IBDIV,"SC-A"):0,1:100-IBPER(3)),0,2)
+22 WRITE !?4,"Number of Service Connected Encounters for SC Veterans:",?60,$JUSTIFY(IB(IBDIV,"SCS-A"),7)," (",IBPER(3),"%)"
+23 WRITE !?3,"Number of Non-Svc. Connected Encounters for SC Veterans:",?60,$JUSTIFY(IB(IBDIV,"SCN-A"),7)," (",IBPER(4),"%)"
End DoDot:2
+24 IF '$TEST
Begin DoDot:2
+25 SET IBPER(5)=$JUSTIFY($SELECT('IB(IBDIV,"GTOT"):0,1:IB(IBDIV,"TOT-I")/IB(IBDIV,"GTOT")*100),0,2)
+26 WRITE !!?5,"Percentage of Insured Outpatient Encounters for ",$SELECT(IBDIV="ZZALL":"All Divisions",1:"This Division"),": ",IBPER(5),"%"
End DoDot:2
+27 DO PAUSE
End DoDot:1
if IBQ
QUIT
+28 QUIT
+29 ;
DASH(X) ; - Return a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",X)," ","=")
+2 ;
PAUSE ; - Page break.
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 FOR IBX=$Y:1:(IOSL-3)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+5 QUIT
+6 ;
INS(IBOE,IBOED) ; - Is this an insured encounter?
+1 ; Input: IBOE = IEN of outpatient encounter in file #409.68
+2 ; IBOED = Outpatient encounter in file #409.68
+3 ; Output: 1 = Insured encounter
+4 ; 0 = Not an insured encounter
+5 ;
+6 NEW DFN,IBCK,IBPB,VA,VAEL,VAERR,X0
+7 SET DFN=+$PIECE(IBOED,U,2)
+8 ; Patient not a veteran.
IF $GET(^DPT(DFN,"VET"))'="Y"
GOTO INSQ
+9 ; Patient not insured.
IF '$$INSURED^IBCNS1(DFN,+IBOED\1)
GOTO INSQ
+10 ;
+11 ; - Check if encounter was made non-billable in Claims Tracking.
+12 IF $PIECE($GET(^IBT(356,+$ORDER(^IBT(356,"ASCE",IBOE,0)),0)),U,19)
GOTO INSQ
+13 ;
+14 ; - Check encounter for non-billable appt. type (1), non-count
+15 ; clinic (2), non-billable clinic (3,12), admission by 11:59pm of
+16 ; encounter date (5), non-billable stop code (7,8), non-billable
+17 ; disposition (10), and parent encounter (11). If IBPB equals one
+18 ; of these numbers, Y will be set to 0 (Not an insured encounter).
+19 FOR X0=1,2,3,5,7,8,10,11,12
SET IBCK(X0)=""
+20 SET X0=$$BILLCK^IBAMTEDU(IBOE,IBOED,.IBCK,.IBPB)
+21 IF $GET(IBPB)
GOTO INSQ
+22 ;
+23 ; Care is related to AO/IR/SWA/SC/MST/HNC/CV/SHAD.
IF $$ENCL^IBAMTS2(IBOE)[1
GOTO INSQ
+24 ;
+25 SET Y=1
QUIT Y
INSQ SET Y=0
QUIT Y
+1 ;
SC(OE) ; - Is the encounter related to the veteran's SC condition?
+1 ; Input: OE = IEN of outpatient encounter in file #409.68
+2 ; Output: SC = 1 (Encounter related to SC condition)
+3 ; 0 (Encounter NOT related to SC condition)
+4 ;
+5 NEW CL,CLD,SC
+6 SET (CL,SC)=0
FOR
SET CL=$ORDER(^SDD(409.42,"OE",+$GET(OE),CL))
if 'CL
QUIT
Begin DoDot:1
+7 SET CLD=$GET(^SDD(409.42,CL,0))
IF +CLD=3
IF $PIECE(CLD,U,3)
SET SC=1
End DoDot:1
if SC
QUIT
+8 QUIT SC
+9 ;
DHLP ; - Display 'Sort by division' help.
+1 WRITE !,"Enter RETURN to summarize all outpt. encounters without regard to"
+2 WRITE !,"division, or 'Yes' to select those divisions for which a separate"
+3 WRITE !,"summary report should be created."
+4 QUIT
