IBCU74 ;OAK/ELZ - INTERCEPT SCREEN INPUT OF PROCEDURE CODES (CONT) ;6-JAN-04
;;2.0;INTEGRATED BILLING;**228,260,339,432,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
;
DATA(IBP,IBLNPRV) ; this is used to add data when new procedures are added for
; inpatient cases
; Return IBRPROV - renderring providers ;ib*2.0*432
N IBX,IBY,IB1,IB2,IBC,DO,X,DIC,DIE,DA,DR,IB9,Y,IBQ,IBDR,IBZ,IBS
S DR="" I '$P(IBP,"^",2)!('DGPROCDT) Q
S IB1=0 F S IB1=$O(^UTILITY($J,"IB",IB1)) Q:IB1<1!(DR) I $P($G(^UTILITY($J,"IB",IB1,1)),"^",2)=DGPROCDT D
. S IB2=0 F S IB2=$O(^UTILITY($J,"IB",IB1,IB2)) Q:IB2<1!(DR) S IBY=$G(^UTILITY($J,"IB",IB1,IB2)) I +IBY=+$P(IBP,"^",2) D Q
.. F IBX=6:1:9 I $P(IBY,"^",IBX) D
... F IBC=1:1:4 Q:'$D(^IBA(362.3,"AO",IBIFN,IBC))
... I $D(^IBA(362.3,"AO",IBIFN,IBC)) Q
... S IB9=$$ICD9^IBACSV($P(IBY,"^",IBX),DGPROCDT)
... W !?10,"Adding associated dx: ",$P(IB9,"^")," ",$P(IB9,"^",3)
... ; first check to see if dx on bill already
... S Y=$O(^IBA(362.3,"AIFN"_IBIFN,$P(IBY,"^",IBX),0))
... I 'Y S DIC="^IBA(362.3,",DIC(0)="",X=$P(IBY,"^",IBX),DIC("DR")=".02////^S X=IBIFN;.03////^S X=IBC" D FILE^DICN Q:Y<1
... ;need to find what field is not occupied starting with 10
... S IBZ=10 F IBS=1:1 Q:$P(DR,";",IBS)="" I $P(DR,";",IBS)[IBZ_"////" S IBZ=IBZ+1
... S DR=DR_IBZ_"////"_(+Y)_";"
.. I $P(IBY,"^",13) D
... I $$GETNPI^IBCEF73A($P(IBY,"^",13)_";VA(200,")="" Q ;Don't file provider if no NPI - IB*2*516
... W !!?10,"Associating Provider: ",$P($G(^VA(200,$P(IBY,"^",13),0)),"^") D S DR=DR_"18////"_$P(IBY,"^",13)_";",IBLNPRV("IBCCPT")="`"_$P(IBY,U,13) ;WCJ;IB*2.0*432;Save off renderring to return
.... ; as requested by users, need to update the last look up value for
.... ; the provider
.... N DIC,X,DR,Y S DIC="^VA(200,",DIC(0)="INOS",X="`"_$P(IBY,"^",13)
.... D ^DIC
.... ;
.. I $P(IBY,"^",14) W !?10,"Assigning Location: ",$P($G(^SC($P(IBY,"^",14),0)),"^") S DR=DR_"6////"_$P(IBY,"^",14)_";"_$S($P($G(^SC($P(IBY,"^",14),0)),"^",15):"5////"_$P(^(0),"^",15)_";",1:"")
.. I $L(DR) S DIE="^DGCR(399,"_IBIFN_",""CP"",",DA(1)=IBIFN,DA=+IBP,IBDR=DR D ^DIE
.. S IBC=0 F IBX=11,12 I $P(IBY,"^",IBX) S IB9=$$MOD^ICPTMOD($P(IBY,"^",IBX),"I") W !?10,"Adding Modifier: ",$P(IB9,"^",2)," - ",$P(IB9,"^",3) D
... S IBC=IBC+1,DIC="^DGCR(399,"_IBIFN_",""CP"","_(+IBP)_",""MOD"",",DA(1)=+IBP,DA(2)=IBIFN,X=IBC,DIC("DR")=".02////"_$P(IBY,"^",IBX),DIC(0)="" D FILE^DICN
.. ;
.. ; need to check for quantity >1 then duplicate entry
.. I $P(IBY,"^",10)>1 W !!?10,"Duplicating Procedure for Quantity of ",$P(IBY,"^",10) F IBQ=1:1:$P(IBY,"^",10)-1 D
... K DO S DIC="^DGCR(399,"_IBIFN_",""CP"",",DIC(0)="",X=(+IBY)_";ICPT(",DA(1)=IBIFN,DIC("DR")="1////"_DGPROCDT_";"_$G(IBDR) D FILE^DICN S IBCP=+Y
... S IBC=0 F IBX=11,12 I $P(IBY,"^",IBX) S IB9=$$MOD^ICPTMOD($P(IBY,"^",IBX),"I"),IBC=IBC+1,DIC="^DGCR(399,"_IBIFN_",""CP"","_IBCP_",""MOD"",",DA(1)=IBCP,DA(2)=IBIFN,X=IBC,DIC("DR")=".02////"_$P(IBY,"^",IBX),DIC(0)="" D FILE^DICN
.. K IBDR
Q
;
SROMIN(IBIFN,IBPROCP) ; will ask as user to select anesthesia to populate into
; the minutes of a bill
N IBSR,DFN,IBFDT,IBTDT,IBSRC,IBSRSDT,IBSREDT,IBC,IBSRDAT,IBSRMIN,DR,DA
N DIE,X,Y,IBP,DIR
K ^TMP("SRANES",$J),^TMP("IBSRDAT",$J)
;
S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),"^",2)
S IBFDT=+$G(^DGCR(399,IBIFN,"U")),IBTDT=$P($G(^("U")),"^",2)
I 'DFN!('IBFDT)!('IBTDT) G SROMINQ
;
S IBSR=$$ANESTIME^SROANEST(DFN,IBFDT,IBTDT) I IBSR<1 G SROMINQ
;
W !!,"The following surgical/anesthesia times were found:",!
S (IBC,IBSRC)=0 F S IBSRC=$O(^TMP("SRANES",$J,IBSRC)) Q:IBSRC<1 S IBSRSDT=0 F S IBSRSDT=$O(^TMP("SRANES",$J,IBSRC,IBSRSDT)) Q:'IBSRSDT S IBSREDT=0 F S IBSREDT=$O(^TMP("SRANES",$J,IBSRC,IBSRSDT,IBSREDT)) Q:'IBSREDT D
. ;
. S IBC=IBC+1
. S IBSRDAT=^TMP("SRANES",$J,IBSRC,IBSRSDT,IBSREDT)
. S ^TMP("IBSRDAT",$J,IBC)=IBSRDAT
. W !,$J(IBC,4)," Case #",IBSRC,?20,$$FMTE^XLFDT(IBSRSDT,2),?35,$$FMTE^XLFDT(IBSREDT,2),?50,$P(IBSRDAT,"^",2),?60
. F IBP=4:1:11 I $P(IBSRDAT,"^",IBP) W:$X>61 "," W $P($T(EXEMPT+(IBP-3)),";",3)
;
S DIR(0)="LO^1:"_IBC_":0" D ^DIR G:'Y SROMINQ
;
S IBSRMIN=0 F IBP=1:1 Q:'$P(Y,",",IBP) S IBSRMIN=IBSRMIN+$P(^TMP("IBSRDAT",$J,$P(Y,",",IBP)),"^",2)
S DIE="^DGCR(399,"_IBIFN_",""CP"",",DR="15///"_IBSRMIN,DA=IBPROCP,DA(1)=IBIFN D ^DIE
;
SROMINQ K ^TMP("SRANES",$J),^TMP("IBSRDAT",$J)
Q
;
;
OBSHOUR(DFN,EVNTDT) ; Get Observation Hours (for Procedures whose charge requires Hours)
; display Observation Discharges 72 hours before date (procedure date)
; allow user to input exact observation date times, using the last observation admission/discharge as default
; based on the date/times entered by the user calculate the total hours
; Input: DFN = Patient ifn, EVNTDT = Procedure Date
; Output: returns total hours with 1 decimal digit selected/input or ""
;
N IBBEG,IBEND,IBDATE,IBPTF,IBPTF0,IBPTF70,IBDSPLT,IBADMDT,IBDSCDT,IBDSH,DIR,X,Y,DIRUT,DTOUT,DUOUT,IBHOURS
S (IBDSH,IBHOURS,IBADMDT,IBDSCDT)="" I '$G(DFN) G OBSHOURQ
S EVNTDT=$S(+$G(EVNTDT):EVNTDT,1:DT)\1,IBBEG=$$FMADD^XLFDT(EVNTDT,-3)+.0001,IBEND=EVNTDT+.2359
;
W !!,?6,"Inpatient Observation Discharges 72 hours before "_$$FMTE^XLFDT(EVNTDT,2),":"
S IBDATE=IBBEG F S IBDATE=$O(^DGPT("ADS",IBDATE)) Q:'IBDATE Q:IBDATE>IBEND D
. S IBPTF=0 F S IBPTF=$O(^DGPT("ADS",IBDATE,IBPTF)) Q:'IBPTF D
.. S IBPTF0=$G(^DGPT(IBPTF,0)) Q:+IBPTF0'=DFN S IBPTF70=$G(^DGPT(IBPTF,70))
.. ;
.. S IBDSPLT=+$P(IBPTF70,U,2) I ",18,23,24,36,41,65,94,"'[(","_IBDSPLT_",") Q
.. ;
.. S IBDSPLT=$G(^DIC(42.4,IBDSPLT,0)),IBADMDT=$E(+$P(IBPTF0,U,2),1,12),IBDSCDT=$E(+IBPTF70,1,12)
.. ;
.. S IBDSH=$$FMDIFF^XLFDT(IBDSCDT,IBADMDT,2)/60/60
.. ;
.. W !,?6,$P(IBDSPLT,U,1),?39,$$FMTE^XLFDT(IBADMDT,2),?55,$$FMTE^XLFDT(IBDSCDT,2),?72,"(",$J(IBDSH,"",1),")"
I 'IBDSH W " None found"
;
W !!,?6,"Observation Start/Stop Times are optional, used only to calculate Hours:"
S DIR("A")=" Enter Observation Start Date/Time: " I +IBADMDT S DIR("B")=$$FMTE^XLFDT(IBADMDT,2)
S DIR(0)="DAO^::XR" D ^DIR S IBADMDT=+Y I ('Y)!($D(DIRUT)) G OBSHOURQ
;
S DIR("A")=" Enter Observation Stop Date/Time: " I IBDSCDT>IBADMDT S DIR("B")=$$FMTE^XLFDT(IBDSCDT,2)
S DIR(0)="DAO^"_IBADMDT_"::XR" D ^DIR S IBDSCDT=+Y I ('Y)!($D(DIRUT)) G OBSHOURQ
;
S IBHOURS=$J($$FMDIFF^XLFDT(IBDSCDT,IBADMDT,2)/60/60,"",1) W " (",IBHOURS,")",!
;
OBSHOURQ Q IBHOURS
;
;
EXEMPT ; exemption reasons to display
;;SC
;;CV
;;AO
;;IR
;;SWA
;;MST
;;HNC
;;SHAD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCU74 6589 printed Dec 13, 2024@02:20:51 Page 2
IBCU74 ;OAK/ELZ - INTERCEPT SCREEN INPUT OF PROCEDURE CODES (CONT) ;6-JAN-04
+1 ;;2.0;INTEGRATED BILLING;**228,260,339,432,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
DATA(IBP,IBLNPRV) ; this is used to add data when new procedures are added for
+1 ; inpatient cases
+2 ; Return IBRPROV - renderring providers ;ib*2.0*432
+3 NEW IBX,IBY,IB1,IB2,IBC,DO,X,DIC,DIE,DA,DR,IB9,Y,IBQ,IBDR,IBZ,IBS
+4 SET DR=""
IF '$PIECE(IBP,"^",2)!('DGPROCDT)
QUIT
+5 SET IB1=0
FOR
SET IB1=$ORDER(^UTILITY($JOB,"IB",IB1))
if IB1<1!(DR)
QUIT
IF $PIECE($GET(^UTILITY($JOB,"IB",IB1,1)),"^",2)=DGPROCDT
Begin DoDot:1
+6 SET IB2=0
FOR
SET IB2=$ORDER(^UTILITY($JOB,"IB",IB1,IB2))
if IB2<1!(DR)
QUIT
SET IBY=$GET(^UTILITY($JOB,"IB",IB1,IB2))
IF +IBY=+$PIECE(IBP,"^",2)
Begin DoDot:2
+7 FOR IBX=6:1:9
IF $PIECE(IBY,"^",IBX)
Begin DoDot:3
+8 FOR IBC=1:1:4
if '$DATA(^IBA(362.3,"AO",IBIFN,IBC))
QUIT
+9 IF $DATA(^IBA(362.3,"AO",IBIFN,IBC))
QUIT
+10 SET IB9=$$ICD9^IBACSV($PIECE(IBY,"^",IBX),DGPROCDT)
+11 WRITE !?10,"Adding associated dx: ",$PIECE(IB9,"^")," ",$PIECE(IB9,"^",3)
+12 ; first check to see if dx on bill already
+13 SET Y=$ORDER(^IBA(362.3,"AIFN"_IBIFN,$PIECE(IBY,"^",IBX),0))
+14 IF 'Y
SET DIC="^IBA(362.3,"
SET DIC(0)=""
SET X=$PIECE(IBY,"^",IBX)
SET DIC("DR")=".02////^S X=IBIFN;.03////^S X=IBC"
DO FILE^DICN
if Y<1
QUIT
+15 ;need to find what field is not occupied starting with 10
+16 SET IBZ=10
FOR IBS=1:1
if $PIECE(DR,";",IBS)=""
QUIT
IF $PIECE(DR,";",IBS)[IBZ_"////"
SET IBZ=IBZ+1
+17 SET DR=DR_IBZ_"////"_(+Y)_";"
End DoDot:3
+18 IF $PIECE(IBY,"^",13)
Begin DoDot:3
+19 ;Don't file provider if no NPI - IB*2*516
IF $$GETNPI^IBCEF73A($PIECE(IBY,"^",13)_";VA(200,")=""
QUIT
+20 ;WCJ;IB*2.0*432;Save off renderring to return
WRITE !!?10,"Associating Provider: ",$PIECE($GET(^VA(200,$PIECE(IBY,"^",13),0)),"^")
Begin DoDot:4
+21 ; as requested by users, need to update the last look up value for
+22 ; the provider
+23 NEW DIC,X,DR,Y
SET DIC="^VA(200,"
SET DIC(0)="INOS"
SET X="`"_$PIECE(IBY,"^",13)
+24 DO ^DIC
+25 ;
End DoDot:4
SET DR=DR_"18////"_$PIECE(IBY,"^",13)_";"
SET IBLNPRV("IBCCPT")="`"_$PIECE(IBY,U,13)
End DoDot:3
+26 IF $PIECE(IBY,"^",14)
WRITE !?10,"Assigning Location: ",$PIECE($GET(^SC($PIECE(IBY,"^",14),0)),"^")
SET DR=DR_"6////"_$PIECE(IBY,"^",14)_";"_$SELECT($PIECE($GET(^SC($PIECE(IBY,"^",14),0)),"^",15):"5////"_$PIECE(^(0),"^",15)_";",1:"")
+27 IF $LENGTH(DR)
SET DIE="^DGCR(399,"_IBIFN_",""CP"","
SET DA(1)=IBIFN
SET DA=+IBP
SET IBDR=DR
DO ^DIE
+28 SET IBC=0
FOR IBX=11,12
IF $PIECE(IBY,"^",IBX)
SET IB9=$$MOD^ICPTMOD($PIECE(IBY,"^",IBX),"I")
WRITE !?10,"Adding Modifier: ",$PIECE(IB9,"^",2)," - ",$PIECE(IB9,"^",3)
Begin DoDot:3
+29 SET IBC=IBC+1
SET DIC="^DGCR(399,"_IBIFN_",""CP"","_(+IBP)_",""MOD"","
SET DA(1)=+IBP
SET DA(2)=IBIFN
SET X=IBC
SET DIC("DR")=".02////"_$PIECE(IBY,"^",IBX)
SET DIC(0)=""
DO FILE^DICN
End DoDot:3
+30 ;
+31 ; need to check for quantity >1 then duplicate entry
+32 IF $PIECE(IBY,"^",10)>1
WRITE !!?10,"Duplicating Procedure for Quantity of ",$PIECE(IBY,"^",10)
FOR IBQ=1:1:$PIECE(IBY,"^",10)-1
Begin DoDot:3
+33 KILL DO
SET DIC="^DGCR(399,"_IBIFN_",""CP"","
SET DIC(0)=""
SET X=(+IBY)_";ICPT("
SET DA(1)=IBIFN
SET DIC("DR")="1////"_DGPROCDT_";"_$GET(IBDR)
DO FILE^DICN
SET IBCP=+Y
+34 SET IBC=0
FOR IBX=11,12
IF $PIECE(IBY,"^",IBX)
SET IB9=$$MOD^ICPTMOD($PIECE(IBY,"^",IBX),"I")
SET IBC=IBC+1
SET DIC="^DGCR(399,"_IBIFN_",""CP"","_IBCP_",""MOD"","
SET DA(1)=IBCP
SET DA(2)=IBIFN
SET X=IBC
SET DIC("DR")=".02////"_$PIECE(IBY,"^",IBX)
SET DIC(0)=""
DO FILE^DICN
End DoDot:3
+35 KILL IBDR
End DoDot:2
QUIT
End DoDot:1
+36 QUIT
+37 ;
SROMIN(IBIFN,IBPROCP) ; will ask as user to select anesthesia to populate into
+1 ; the minutes of a bill
+2 NEW IBSR,DFN,IBFDT,IBTDT,IBSRC,IBSRSDT,IBSREDT,IBC,IBSRDAT,IBSRMIN,DR,DA
+3 NEW DIE,X,Y,IBP,DIR
+4 KILL ^TMP("SRANES",$JOB),^TMP("IBSRDAT",$JOB)
+5 ;
+6 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),"^",2)
+7 SET IBFDT=+$GET(^DGCR(399,IBIFN,"U"))
SET IBTDT=$PIECE($GET(^("U")),"^",2)
+8 IF 'DFN!('IBFDT)!('IBTDT)
GOTO SROMINQ
+9 ;
+10 SET IBSR=$$ANESTIME^SROANEST(DFN,IBFDT,IBTDT)
IF IBSR<1
GOTO SROMINQ
+11 ;
+12 WRITE !!,"The following surgical/anesthesia times were found:",!
+13 SET (IBC,IBSRC)=0
FOR
SET IBSRC=$ORDER(^TMP("SRANES",$JOB,IBSRC))
if IBSRC<1
QUIT
SET IBSRSDT=0
FOR
SET IBSRSDT=$ORDER(^TMP("SRANES",$JOB,IBSRC,IBSRSDT))
if 'IBSRSDT
QUIT
SET IBSREDT=0
FOR
SET IBSREDT=$ORDER(^TMP("SRANES",$JOB,IBSRC,IBSRSDT,IBSREDT))
if 'IBSREDT
QUIT
Begin DoDot:1
+14 ;
+15 SET IBC=IBC+1
+16 SET IBSRDAT=^TMP("SRANES",$JOB,IBSRC,IBSRSDT,IBSREDT)
+17 SET ^TMP("IBSRDAT",$JOB,IBC)=IBSRDAT
+18 WRITE !,$JUSTIFY(IBC,4)," Case #",IBSRC,?20,$$FMTE^XLFDT(IBSRSDT,2),?35,$$FMTE^XLFDT(IBSREDT,2),?50,$PIECE(IBSRDAT,"^",2),?60
+19 FOR IBP=4:1:11
IF $PIECE(IBSRDAT,"^",IBP)
if $X>61
WRITE ","
WRITE $PIECE($TEXT(EXEMPT+(IBP-3)),";",3)
End DoDot:1
+20 ;
+21 SET DIR(0)="LO^1:"_IBC_":0"
DO ^DIR
if 'Y
GOTO SROMINQ
+22 ;
+23 SET IBSRMIN=0
FOR IBP=1:1
if '$PIECE(Y,",",IBP)
QUIT
SET IBSRMIN=IBSRMIN+$PIECE(^TMP("IBSRDAT",$JOB,$PIECE(Y,",",IBP)),"^",2)
+24 SET DIE="^DGCR(399,"_IBIFN_",""CP"","
SET DR="15///"_IBSRMIN
SET DA=IBPROCP
SET DA(1)=IBIFN
DO ^DIE
+25 ;
SROMINQ KILL ^TMP("SRANES",$JOB),^TMP("IBSRDAT",$JOB)
+1 QUIT
+2 ;
+3 ;
OBSHOUR(DFN,EVNTDT) ; Get Observation Hours (for Procedures whose charge requires Hours)
+1 ; display Observation Discharges 72 hours before date (procedure date)
+2 ; allow user to input exact observation date times, using the last observation admission/discharge as default
+3 ; based on the date/times entered by the user calculate the total hours
+4 ; Input: DFN = Patient ifn, EVNTDT = Procedure Date
+5 ; Output: returns total hours with 1 decimal digit selected/input or ""
+6 ;
+7 NEW IBBEG,IBEND,IBDATE,IBPTF,IBPTF0,IBPTF70,IBDSPLT,IBADMDT,IBDSCDT,IBDSH,DIR,X,Y,DIRUT,DTOUT,DUOUT,IBHOURS
+8 SET (IBDSH,IBHOURS,IBADMDT,IBDSCDT)=""
IF '$GET(DFN)
GOTO OBSHOURQ
+9 SET EVNTDT=$SELECT(+$GET(EVNTDT):EVNTDT,1:DT)\1
SET IBBEG=$$FMADD^XLFDT(EVNTDT,-3)+.0001
SET IBEND=EVNTDT+.2359
+10 ;
+11 WRITE !!,?6,"Inpatient Observation Discharges 72 hours before "_$$FMTE^XLFDT(EVNTDT,2),":"
+12 SET IBDATE=IBBEG
FOR
SET IBDATE=$ORDER(^DGPT("ADS",IBDATE))
if 'IBDATE
QUIT
if IBDATE>IBEND
QUIT
Begin DoDot:1
+13 SET IBPTF=0
FOR
SET IBPTF=$ORDER(^DGPT("ADS",IBDATE,IBPTF))
if 'IBPTF
QUIT
Begin DoDot:2
+14 SET IBPTF0=$GET(^DGPT(IBPTF,0))
if +IBPTF0'=DFN
QUIT
SET IBPTF70=$GET(^DGPT(IBPTF,70))
+15 ;
+16 SET IBDSPLT=+$PIECE(IBPTF70,U,2)
IF ",18,23,24,36,41,65,94,"'[(","_IBDSPLT_",")
QUIT
+17 ;
+18 SET IBDSPLT=$GET(^DIC(42.4,IBDSPLT,0))
SET IBADMDT=$EXTRACT(+$PIECE(IBPTF0,U,2),1,12)
SET IBDSCDT=$EXTRACT(+IBPTF70,1,12)
+19 ;
+20 SET IBDSH=$$FMDIFF^XLFDT(IBDSCDT,IBADMDT,2)/60/60
+21 ;
+22 WRITE !,?6,$PIECE(IBDSPLT,U,1),?39,$$FMTE^XLFDT(IBADMDT,2),?55,$$FMTE^XLFDT(IBDSCDT,2),?72,"(",$JUSTIFY(IBDSH,"",1),")"
End DoDot:2
End DoDot:1
+23 IF 'IBDSH
WRITE " None found"
+24 ;
+25 WRITE !!,?6,"Observation Start/Stop Times are optional, used only to calculate Hours:"
+26 SET DIR("A")=" Enter Observation Start Date/Time: "
IF +IBADMDT
SET DIR("B")=$$FMTE^XLFDT(IBADMDT,2)
+27 SET DIR(0)="DAO^::XR"
DO ^DIR
SET IBADMDT=+Y
IF ('Y)!($DATA(DIRUT))
GOTO OBSHOURQ
+28 ;
+29 SET DIR("A")=" Enter Observation Stop Date/Time: "
IF IBDSCDT>IBADMDT
SET DIR("B")=$$FMTE^XLFDT(IBDSCDT,2)
+30 SET DIR(0)="DAO^"_IBADMDT_"::XR"
DO ^DIR
SET IBDSCDT=+Y
IF ('Y)!($DATA(DIRUT))
GOTO OBSHOURQ
+31 ;
+32 SET IBHOURS=$JUSTIFY($$FMDIFF^XLFDT(IBDSCDT,IBADMDT,2)/60/60,"",1)
WRITE " (",IBHOURS,")",!
+33 ;
OBSHOURQ QUIT IBHOURS
+1 ;
+2 ;
EXEMPT ; exemption reasons to display
+1 ;;SC
+2 ;;CV
+3 ;;AO
+4 ;;IR
+5 ;;SWA
+6 ;;MST
+7 ;;HNC
+8 ;;SHAD