- IBTRE1 ;ALB/AAS - CLAIMS TRACKING - ACTIONS ; 27-JUN-93
- ;;Version 2.0 ; INTEGRATED BILLING ;**45**; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % G EN^IBTRE
- ;
- NX(IBTMPNM) ; -- Go to next template
- ; -- Input template name
- N VALMY,I,J,IBXXT
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
- .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
- .I IBTRN D EN^VALM(IBTMPNM)
- .K IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
- .K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
- .D KVAR^VADPT
- .Q
- I '$D(IBFASTXT) D HDR^IBTRE,BLD^IBTRE
- S VALMBCK="R"
- Q
- ;
- DT ; -- Delete tracking entry
- I '$D(^XUSEC("IB CLAIMS SUPERVISOR",DUZ)) D SORRY G DTQ
- N I,J,IBXX,VALMY,DIRUT
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) D FULL^VALM1 S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
- .S IBTRN=$P($G(^TMP("IBTREDX",$J,$O(^TMP("IBTRE",$J,"IDX",IBXX,0)))),"^",2)
- .; do some error checking here
- .I $O(^IBT(356.1,"C",IBTRN,0)) W !!,*7,"There are Hospital Reviews associated with this entry."
- .I $O(^IBT(356.2,"C",IBTRN,0)) W !!,*7,"There are Insurance Reviews associated with this entry."
- .W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete entry #"_IBXX
- .D ^DIR I Y'=1 W !,"Entry #",IBXX," not Deleted!" Q
- .D DP1
- .Q
- DTQ D BLD^IBTRE
- S VALMBCK="R" Q
- ;
- DP1 ; -- actual deletion
- N DA,DIC,DIK
- ;
- ; -- delete reviews, communications,
- N IBI,IBCNT
- S (IBI,IBCNT)=0 F S IBI=$O(^IBT(356.1,"C",IBTRN,IBI)) Q:'IBI D
- .S DA=IBI,DIK="^IBT(356.1," D ^DIK
- .S IBCNT=IBCNT+1
- I IBCNT W !,"Number of Hospital Reviews Deleted: ",IBCNT
- ;
- S (IBI,IBCNT)=0 F S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI D
- .S DA=IBI,DIK="^IBT(356.2," D ^DIK
- .S IBCNT=IBCNT+1
- I IBCNT W !,"Number of Insurance Reviews Deleted: ",IBCNT
- ;
- ; -- delete entry in claims tracking file
- S DA=IBTRN,DIK="^IBT(356," D ^DIK
- W !,"Entry ",IBXX," Deleted"
- Q
- ;
- CP ; -- change patient
- N VALMQUIT,IBDFN
- D FULL^VALM1
- S IBDFN=DFN D PAT^IBCNSM
- I $D(VALMQUIT) S DFN=IBDFN
- S VALMBG=1 D HDR^IBTRE,BLD^IBTRE
- S VALMBCK="R"
- CPQ K IBDFN
- Q
- ;
- QE ; -- Quick edit tracking entry
- D EN^VALM2($G(XQORNOD(0)))
- N I,J,IBXX
- I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
- .S IBTRN=$P($G(^TMP("IBTREDX",$J,$O(^TMP("IBTRE",$J,"IDX",IBXX,0)))),"^",2)
- .D QE1
- QEQ S VALMBCK="R"
- D BLD^IBTRE
- Q
- ;
- QE1 N X,Y,DA,DR,DIC,DIE,IBTRTP,IBSEL
- S DIE="^IBT(356,",DA=IBTRN
- D EDIT^IBTRED1("[IBT QUICK EDIT]",1)
- ;
- I '$D(IBTATRK),$$TRTP^IBTRE1(IBTRN)<3 D ;clinical info only on inpt/outpt
- .; -- diagnosis edit
- .D EN^IBTRE3(IBTRN) Q:$G(IBSEL)["^"
- .;
- .; -- procedure edit / only inpt. / outpt use add/edit
- .I $$TRTP^IBTRE1(IBTRN)<2 D EN^IBTRE4(IBTRN) Q:$G(IBSEL)["^"
- .;
- .; -- provider edit
- .D EN^IBTRE5(IBTRN)
- .;
- .; -- compute drg
- .I $P($G(^IBT(356,IBTRN,0)),"^",5) W !! D DRG^IBTRV2(IBTRN)
- Q
- ;
- CD ; -- Change Date range
- D FULL^VALM1
- S VALMB=IBTBDT D RANGE^VALM11
- I $S('VALMBEG:1,IBTBDT'=VALMBEG:0,1:IBTEDT=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G CDQ
- S IBTBDT=VALMBEG,IBTEDT=VALMEND
- S VALMBG=1 D HDR^IBTRE,BLD^IBTRE
- CDQ K VALMB,VALMBEG,VALMEND
- S VALMBCK="R"
- Q
- ;
- EDIT(IBTEMP) ; -- Edit visit
- ; -- Input template name
- N VALMY,I,J,IBXXT
- D EN^VALM2($G(XQORNOD(0)))
- ;N I,J,IBXXT
- I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
- .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
- .I IBTRN D EDIT^IBTRED1(IBTEMP,1)
- .Q
- D BLD^IBTRE
- S VALMBCK="R"
- Q
- DIAG ; -- diagnosis editing
- N VALMY,I,J,IBXXT
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
- .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
- .I IBTRN D EN^IBTRE3(IBTRN)
- .I $P($G(^IBT(356,IBTRN,0)),"^",5) W !! D DRG^IBTRV2(IBTRN)
- .Q
- S VALMBCK="R"
- Q
- ;
- TRTP(X) ; -- compute tracking type code
- ; input x = internal entry in 356
- ; output = code of tracking type from 356.6
- Q $P($G(^IBE(356.6,+$P($G(^IBT(356,+$G(X),0)),"^",18),0)),"^",3)
- ;
- SORRY ; -- can't delete, don't have key.
- W !!,"You do not have access to delete entries. See your application coordinator.",!
- Q
- ;
- PU ; -- procedure editing
- N VALMY,I,J,IBXXT
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
- .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
- .I IBTRN D EN^IBTRE4(IBTRN)
- .Q
- S VALMBCK="R"
- Q
- ;
- PRV ; -- provider editing
- N VALMY,I,J,IBXXT
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) S IBXXT=0 F S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT D
- .S IBTRN=$P($G(^TMP("IBTREDX",$J,+$O(^TMP("IBTRE",$J,"IDX",IBXXT,0)))),"^",2)
- .I IBTRN D EN^IBTRE5(IBTRN)
- .Q
- S VALMBCK="R"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRE1 4989 printed Jan 18, 2025@03:28:58 Page 2
- IBTRE1 ;ALB/AAS - CLAIMS TRACKING - ACTIONS ; 27-JUN-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**45**; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % GOTO EN^IBTRE
- +1 ;
- NX(IBTMPNM) ; -- Go to next template
- +1 ; -- Input template name
- +2 NEW VALMY,I,J,IBXXT
- +3 DO EN^VALM2($GET(XQORNOD(0)))
- +4 IF $DATA(VALMY)
- SET IBXXT=0
- FOR
- SET IBXXT=$ORDER(VALMY(IBXXT))
- if 'IBXXT
- QUIT
- Begin DoDot:1
- +5 SET IBTRN=$PIECE($GET(^TMP("IBTREDX",$JOB,+$ORDER(^TMP("IBTRE",$JOB,"IDX",IBXXT,0)))),"^",2)
- +6 IF IBTRN
- DO EN^VALM(IBTMPNM)
- +7 KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD
- +8 KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA
- +9 DO KVAR^VADPT
- +10 QUIT
- End DoDot:1
- +11 IF '$DATA(IBFASTXT)
- DO HDR^IBTRE
- DO BLD^IBTRE
- +12 SET VALMBCK="R"
- +13 QUIT
- +14 ;
- DT ; -- Delete tracking entry
- +1 IF '$DATA(^XUSEC("IB CLAIMS SUPERVISOR",DUZ))
- DO SORRY
- GOTO DTQ
- +2 NEW I,J,IBXX,VALMY,DIRUT
- +3 DO EN^VALM2($GET(XQORNOD(0)))
- +4 IF $DATA(VALMY)
- DO FULL^VALM1
- SET IBXX=0
- FOR
- SET IBXX=$ORDER(VALMY(IBXX))
- if 'IBXX!$DATA(DIRUT)
- QUIT
- Begin DoDot:1
- +5 SET IBTRN=$PIECE($GET(^TMP("IBTREDX",$JOB,$ORDER(^TMP("IBTRE",$JOB,"IDX",IBXX,0)))),"^",2)
- +6 ; do some error checking here
- +7 IF $ORDER(^IBT(356.1,"C",IBTRN,0))
- WRITE !!,*7,"There are Hospital Reviews associated with this entry."
- +8 IF $ORDER(^IBT(356.2,"C",IBTRN,0))
- WRITE !!,*7,"There are Insurance Reviews associated with this entry."
- +9 WRITE !
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Are You Sure you want to delete entry #"_IBXX
- +10 DO ^DIR
- IF Y'=1
- WRITE !,"Entry #",IBXX," not Deleted!"
- QUIT
- +11 DO DP1
- +12 QUIT
- End DoDot:1
- DTQ DO BLD^IBTRE
- +1 SET VALMBCK="R"
- QUIT
- +2 ;
- DP1 ; -- actual deletion
- +1 NEW DA,DIC,DIK
- +2 ;
- +3 ; -- delete reviews, communications,
- +4 NEW IBI,IBCNT
- +5 SET (IBI,IBCNT)=0
- FOR
- SET IBI=$ORDER(^IBT(356.1,"C",IBTRN,IBI))
- if 'IBI
- QUIT
- Begin DoDot:1
- +6 SET DA=IBI
- SET DIK="^IBT(356.1,"
- DO ^DIK
- +7 SET IBCNT=IBCNT+1
- End DoDot:1
- +8 IF IBCNT
- WRITE !,"Number of Hospital Reviews Deleted: ",IBCNT
- +9 ;
- +10 SET (IBI,IBCNT)=0
- FOR
- SET IBI=$ORDER(^IBT(356.2,"C",IBTRN,IBI))
- if 'IBI
- QUIT
- Begin DoDot:1
- +11 SET DA=IBI
- SET DIK="^IBT(356.2,"
- DO ^DIK
- +12 SET IBCNT=IBCNT+1
- End DoDot:1
- +13 IF IBCNT
- WRITE !,"Number of Insurance Reviews Deleted: ",IBCNT
- +14 ;
- +15 ; -- delete entry in claims tracking file
- +16 SET DA=IBTRN
- SET DIK="^IBT(356,"
- DO ^DIK
- +17 WRITE !,"Entry ",IBXX," Deleted"
- +18 QUIT
- +19 ;
- CP ; -- change patient
- +1 NEW VALMQUIT,IBDFN
- +2 DO FULL^VALM1
- +3 SET IBDFN=DFN
- DO PAT^IBCNSM
- +4 IF $DATA(VALMQUIT)
- SET DFN=IBDFN
- +5 SET VALMBG=1
- DO HDR^IBTRE
- DO BLD^IBTRE
- +6 SET VALMBCK="R"
- CPQ KILL IBDFN
- +1 QUIT
- +2 ;
- QE ; -- Quick edit tracking entry
- +1 DO EN^VALM2($GET(XQORNOD(0)))
- +2 NEW I,J,IBXX
- +3 IF $DATA(VALMY)
- SET IBXX=0
- FOR
- SET IBXX=$ORDER(VALMY(IBXX))
- if 'IBXX
- QUIT
- Begin DoDot:1
- +4 SET IBTRN=$PIECE($GET(^TMP("IBTREDX",$JOB,$ORDER(^TMP("IBTRE",$JOB,"IDX",IBXX,0)))),"^",2)
- +5 DO QE1
- End DoDot:1
- QEQ SET VALMBCK="R"
- +1 DO BLD^IBTRE
- +2 QUIT
- +3 ;
- QE1 NEW X,Y,DA,DR,DIC,DIE,IBTRTP,IBSEL
- +1 SET DIE="^IBT(356,"
- SET DA=IBTRN
- +2 DO EDIT^IBTRED1("[IBT QUICK EDIT]",1)
- +3 ;
- +4 ;clinical info only on inpt/outpt
- IF '$DATA(IBTATRK)
- IF $$TRTP^IBTRE1(IBTRN)<3
- Begin DoDot:1
- +5 ; -- diagnosis edit
- +6 DO EN^IBTRE3(IBTRN)
- if $GET(IBSEL)["^"
- QUIT
- +7 ;
- +8 ; -- procedure edit / only inpt. / outpt use add/edit
- +9 IF $$TRTP^IBTRE1(IBTRN)<2
- DO EN^IBTRE4(IBTRN)
- if $GET(IBSEL)["^"
- QUIT
- +10 ;
- +11 ; -- provider edit
- +12 DO EN^IBTRE5(IBTRN)
- +13 ;
- +14 ; -- compute drg
- +15 IF $PIECE($GET(^IBT(356,IBTRN,0)),"^",5)
- WRITE !!
- DO DRG^IBTRV2(IBTRN)
- End DoDot:1
- +16 QUIT
- +17 ;
- CD ; -- Change Date range
- +1 DO FULL^VALM1
- +2 SET VALMB=IBTBDT
- DO RANGE^VALM11
- +3 IF $SELECT('VALMBEG:1,IBTBDT'=VALMBEG:0,1:IBTEDT=VALMEND)
- WRITE !!,"Date range was not changed."
- DO PAUSE^VALM1
- SET VALMBCK=""
- GOTO CDQ
- +4 SET IBTBDT=VALMBEG
- SET IBTEDT=VALMEND
- +5 SET VALMBG=1
- DO HDR^IBTRE
- DO BLD^IBTRE
- CDQ KILL VALMB,VALMBEG,VALMEND
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
- EDIT(IBTEMP) ; -- Edit visit
- +1 ; -- Input template name
- +2 NEW VALMY,I,J,IBXXT
- +3 DO EN^VALM2($GET(XQORNOD(0)))
- +4 ;N I,J,IBXXT
- +5 IF $DATA(VALMY)
- SET IBXXT=0
- FOR
- SET IBXXT=$ORDER(VALMY(IBXXT))
- if 'IBXXT
- QUIT
- Begin DoDot:1
- +6 SET IBTRN=$PIECE($GET(^TMP("IBTREDX",$JOB,+$ORDER(^TMP("IBTRE",$JOB,"IDX",IBXXT,0)))),"^",2)
- +7 IF IBTRN
- DO EDIT^IBTRED1(IBTEMP,1)
- +8 QUIT
- End DoDot:1
- +9 DO BLD^IBTRE
- +10 SET VALMBCK="R"
- +11 QUIT
- DIAG ; -- diagnosis editing
- +1 NEW VALMY,I,J,IBXXT
- +2 DO EN^VALM2($GET(XQORNOD(0)))
- +3 IF $DATA(VALMY)
- SET IBXXT=0
- FOR
- SET IBXXT=$ORDER(VALMY(IBXXT))
- if 'IBXXT
- QUIT
- Begin DoDot:1
- +4 SET IBTRN=$PIECE($GET(^TMP("IBTREDX",$JOB,+$ORDER(^TMP("IBTRE",$JOB,"IDX",IBXXT,0)))),"^",2)
- +5 IF IBTRN
- DO EN^IBTRE3(IBTRN)
- +6 IF $PIECE($GET(^IBT(356,IBTRN,0)),"^",5)
- WRITE !!
- DO DRG^IBTRV2(IBTRN)
- +7 QUIT
- End DoDot:1
- +8 SET VALMBCK="R"
- +9 QUIT
- +10 ;
- TRTP(X) ; -- compute tracking type code
- +1 ; input x = internal entry in 356
- +2 ; output = code of tracking type from 356.6
- +3 QUIT $PIECE($GET(^IBE(356.6,+$PIECE($GET(^IBT(356,+$GET(X),0)),"^",18),0)),"^",3)
- +4 ;
- SORRY ; -- can't delete, don't have key.
- +1 WRITE !!,"You do not have access to delete entries. See your application coordinator.",!
- +2 QUIT
- +3 ;
- PU ; -- procedure editing
- +1 NEW VALMY,I,J,IBXXT
- +2 DO EN^VALM2($GET(XQORNOD(0)))
- +3 IF $DATA(VALMY)
- SET IBXXT=0
- FOR
- SET IBXXT=$ORDER(VALMY(IBXXT))
- if 'IBXXT
- QUIT
- Begin DoDot:1
- +4 SET IBTRN=$PIECE($GET(^TMP("IBTREDX",$JOB,+$ORDER(^TMP("IBTRE",$JOB,"IDX",IBXXT,0)))),"^",2)
- +5 IF IBTRN
- DO EN^IBTRE4(IBTRN)
- +6 QUIT
- End DoDot:1
- +7 SET VALMBCK="R"
- +8 QUIT
- +9 ;
- PRV ; -- provider editing
- +1 NEW VALMY,I,J,IBXXT
- +2 DO EN^VALM2($GET(XQORNOD(0)))
- +3 IF $DATA(VALMY)
- SET IBXXT=0
- FOR
- SET IBXXT=$ORDER(VALMY(IBXXT))
- if 'IBXXT
- QUIT
- Begin DoDot:1
- +4 SET IBTRN=$PIECE($GET(^TMP("IBTREDX",$JOB,+$ORDER(^TMP("IBTRE",$JOB,"IDX",IBXXT,0)))),"^",2)
- +5 IF IBTRN
- DO EN^IBTRE5(IBTRN)
- +6 QUIT
- End DoDot:1
- +7 SET VALMBCK="R"
- +8 QUIT