- IBECEA5 ;ALB/CPM - Cancel/Edit/Add... Update Events ; 05-MAY-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN ; Update Events -- invoke the List Manager.
- N VALMIDX,VALMHDR
- D EN^VALM("IB EVENTS")
- Q
- ;
- INIT ; List Manager (IB EVENTS) main entry point.
- N IBAX,IBD,IBN,IBND,IBSTAT,IBLAST,IBWARD
- S IBACME="^TMP(""IBACME"",$J)",IBACMEI="^TMP(""IBACMEI"",$J)",IBD=""
- S VALMIDX="^TMP(""IBACMLI"",$J)",VALMBG=1,VALMCNT=0,VALMBCK="R"
- K @IBACME,@IBACMEI,@VALMIDX
- F S IBD=$O(^IB("AFDT",DFN,IBD)) Q:'IBD D
- .S IBN=0 F S IBN=$O(^IB("AFDT",DFN,IBD,IBN)) Q:'IBN D
- ..S IBND=$G(^IB(IBN,0)) Q:$P(IBND,"^",8)'["ADMISSION"
- ..S IBSTAT=$S($P(IBND,"^",5)=1:"OPEN",1:"CLOSED"),IBLAST=$P(IBND,"^",18)
- ..S Y=+$P($P(IBND,"^",4),":",2),Y=+$P($G(^DGPM(Y,0)),"^",6),Y=$E($P($G(^DIC(42,Y,0)),"^"),1,20)
- ..S VALMCNT=VALMCNT+1,IBWARD=$S(Y]"":Y,1:"*** unknown ***")
- ..S IBAX=$$SETSTR^VALM1($P(IBND,"^",8),VALMCNT,+$P(VALMDDF("TYPE"),"^",2),+$P(VALMDDF("TYPE"),"^",3))
- ..S IBAX=$$SETSTR^VALM1(IBWARD,IBAX,+$P(VALMDDF("WARD"),"^",2),+$P(VALMDDF("WARD"),"^",3))
- ..S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P(IBND,"^",17)),IBAX,+$P(VALMDDF("EDATE"),"^",2),+$P(VALMDDF("EDATE"),"^",3))
- ..S IBAX=$$SETSTR^VALM1(IBSTAT,IBAX,+$P(VALMDDF("STATUS"),"^",2),+$P(VALMDDF("STATUS"),"^",3))
- ..S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL(IBLAST),IBAX,+$P(VALMDDF("LCALC"),"^",2),+$P(VALMDDF("LCALC"),"^",3))
- ..S @IBACME@(VALMCNT,0)=IBAX,@IBACME@("IDX",VALMCNT,VALMCNT)="",@VALMIDX@(VALMCNT)=VALMCNT
- ..S @IBACMEI@(VALMCNT)=IBSTAT_"^"_IBLAST_"^"_IBN_"^"_$P(IBND,"^",17)
- I '$O(@IBACME@(0)) S @IBACME@(1,0)=" ",@IBACME@(2,0)=" This patient has no inpatient event records stored in Billing.",VALMCNT=2,@VALMIDX@(1)=1,@VALMIDX@(2)=2
- Q
- ;
- HDR ; Build screen header.
- S VALMHDR(1)=$$SETSTR^VALM1("Update Billable Events","Cancel/Edit/Add Charges",59,22)
- S VALMHDR(2)=$$SETSTR^VALM1("Date Charges",$E("Patient: "_$P(IBNAM,"^"),1,25)_" "_$E(IBNAM)_$P(IBNAM,"^",3),68,12)
- Q
- ;
- EXIT ; List Manager (IB EVENTS) exit action.
- K:$D(IBACME) @IBACME K:$D(IBACMEI) IBACMEI
- K IBACME,IBACMEI
- D FULL^VALM1,CLEAN^VALM10
- ;D CLEAN^VALM10,CLEAR^VALM1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA5 2215 printed Jan 18, 2025@03:22:39 Page 2
- IBECEA5 ;ALB/CPM - Cancel/Edit/Add... Update Events ; 05-MAY-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- EN ; Update Events -- invoke the List Manager.
- +1 NEW VALMIDX,VALMHDR
- +2 DO EN^VALM("IB EVENTS")
- +3 QUIT
- +4 ;
- INIT ; List Manager (IB EVENTS) main entry point.
- +1 NEW IBAX,IBD,IBN,IBND,IBSTAT,IBLAST,IBWARD
- +2 SET IBACME="^TMP(""IBACME"",$J)"
- SET IBACMEI="^TMP(""IBACMEI"",$J)"
- SET IBD=""
- +3 SET VALMIDX="^TMP(""IBACMLI"",$J)"
- SET VALMBG=1
- SET VALMCNT=0
- SET VALMBCK="R"
- +4 KILL @IBACME,@IBACMEI,@VALMIDX
- +5 FOR
- SET IBD=$ORDER(^IB("AFDT",DFN,IBD))
- if 'IBD
- QUIT
- Begin DoDot:1
- +6 SET IBN=0
- FOR
- SET IBN=$ORDER(^IB("AFDT",DFN,IBD,IBN))
- if 'IBN
- QUIT
- Begin DoDot:2
- +7 SET IBND=$GET(^IB(IBN,0))
- if $PIECE(IBND,"^",8)'["ADMISSION"
- QUIT
- +8 SET IBSTAT=$SELECT($PIECE(IBND,"^",5)=1:"OPEN",1:"CLOSED")
- SET IBLAST=$PIECE(IBND,"^",18)
- +9 SET Y=+$PIECE($PIECE(IBND,"^",4),":",2)
- SET Y=+$PIECE($GET(^DGPM(Y,0)),"^",6)
- SET Y=$EXTRACT($PIECE($GET(^DIC(42,Y,0)),"^"),1,20)
- +10 SET VALMCNT=VALMCNT+1
- SET IBWARD=$SELECT(Y]"":Y,1:"*** unknown ***")
- +11 SET IBAX=$$SETSTR^VALM1($PIECE(IBND,"^",8),VALMCNT,+$PIECE(VALMDDF("TYPE"),"^",2),+$PIECE(VALMDDF("TYPE"),"^",3))
- +12 SET IBAX=$$SETSTR^VALM1(IBWARD,IBAX,+$PIECE(VALMDDF("WARD"),"^",2),+$PIECE(VALMDDF("WARD"),"^",3))
- +13 SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($PIECE(IBND,"^",17)),IBAX,+$PIECE(VALMDDF("EDATE"),"^",2),+$PIECE(VALMDDF("EDATE"),"^",3))
- +14 SET IBAX=$$SETSTR^VALM1(IBSTAT,IBAX,+$PIECE(VALMDDF("STATUS"),"^",2),+$PIECE(VALMDDF("STATUS"),"^",3))
- +15 SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL(IBLAST),IBAX,+$PIECE(VALMDDF("LCALC"),"^",2),+$PIECE(VALMDDF("LCALC"),"^",3))
- +16 SET @IBACME@(VALMCNT,0)=IBAX
- SET @IBACME@("IDX",VALMCNT,VALMCNT)=""
- SET @VALMIDX@(VALMCNT)=VALMCNT
- +17 SET @IBACMEI@(VALMCNT)=IBSTAT_"^"_IBLAST_"^"_IBN_"^"_$PIECE(IBND,"^",17)
- End DoDot:2
- End DoDot:1
- +18 IF '$ORDER(@IBACME@(0))
- SET @IBACME@(1,0)=" "
- SET @IBACME@(2,0)=" This patient has no inpatient event records stored in Billing."
- SET VALMCNT=2
- SET @VALMIDX@(1)=1
- SET @VALMIDX@(2)=2
- +19 QUIT
- +20 ;
- HDR ; Build screen header.
- +1 SET VALMHDR(1)=$$SETSTR^VALM1("Update Billable Events","Cancel/Edit/Add Charges",59,22)
- +2 SET VALMHDR(2)=$$SETSTR^VALM1("Date Charges",$EXTRACT("Patient: "_$PIECE(IBNAM,"^"),1,25)_" "_$EXTRACT(IBNAM)_$PIECE(IBNAM,"^",3),68,12)
- +3 QUIT
- +4 ;
- EXIT ; List Manager (IB EVENTS) exit action.
- +1 if $DATA(IBACME)
- KILL @IBACME
- if $DATA(IBACMEI)
- KILL IBACMEI
- +2 KILL IBACME,IBACMEI
- +3 DO FULL^VALM1
- DO CLEAN^VALM10
- +4 ;D CLEAN^VALM10,CLEAR^VALM1
- +5 QUIT