- 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 Feb 18, 2025@23:47:15 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
