IBTRPR1.m

IBTRPR1 ;ALB/AAS - CLAIMS TRACKING - PENDING WORK ACTIONS ; 9-AUG-93

 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

% G EN^IBTRPR

 ;

NX(IBTMPNM) ; -- Go to next template

 ; -- Input template name

 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D

 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))

 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)

 .I IBTMPNM["REVIEW EDITOR"!(IBTMPNM["COMMUNICATIONS EDITOR") D

 ..I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3),IBTMPNM="IBT REVIEW EDITOR"

 ..I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3),IBTMPNM="IBT COMMUNICATIONS EDITOR"

 .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 BLD^IBTRPR

 S VALMBCK="R"

 Q

 ;

CD ; -- Change Date range

 S VALMB=IBTPBDT D RANGE^VALM11

 I $S('VALMBEG:1,IBTPBDT'=VALMBEG:0,1:IBTPEDT=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G CDQ

 S IBTPBDT=VALMBEG,IBTPEDT=VALMEND

 D BLD^IBTRPR

 D HDR^IBTRPR S VALMBG=1

CDQ K VALMB,VALMBEG,VALMEND

 S VALMBCK="R"

 Q

 ;

QE ; -- Quick Edit Entry

 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D

 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))

 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)

 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D QE1^IBTRV1 Q

 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D QE1^IBTRC1 Q

 .D EN^VALM(IBTMPNM)

 .Q

 D BLD^IBTRPR

 S VALMBCK="R"

 Q

 D BLD^IBTRPR

 S VALMBCK="R"

 Q

 ;

VE ; -- View Edit entry

 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D

 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))

 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)

 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3),IBTMPNM="IBT EXPAND/EDIT REVIEW"

 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3),IBTMPNM="IBT EXPAND/EDIT COMMUNICATIONS"

 .D EN^VALM(IBTMPNM)

 .Q

 D BLD^IBTRPR

 S VALMBCK="R"

 Q

 ;

SC ; -- Status Change

 N VALMY,I,J,IBT,IBXXT,IBTEMP

 D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) S IBXXT=0 F  S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT  D

 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXXT,0))))

 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)

 .S IBTEMP="[IBT STATUS CHANGE]"

 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D EDIT^IBTRVD1(IBTEMP,1) Q

 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D EDIT^IBTRCD1(IBTEMP,1) Q

 .Q

 D BLD^IBTRPR

 S VALMBCK="R"

 Q

 ;

RL ; -- Remove from list

 ;    Just delete Next review date

 N VALMY,I,J,IBT,IBXXT,IBTEMP

 D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) S IBXXT=0 F  S IBXXT=$O(VALMY(IBXXT)) Q:'IBXXT  D

 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXXT,0))))

 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)

 .S IBTEMP="[IBT REMOVE NEXT REVIEW]"

 .W !!,"Removing Next Review Date from entry #",IBXXT

 .I $P(IBT,"^",2)=356.1 S IBTRV=$P(IBT,"^",3) D EDIT^IBTRVD1(IBTEMP,1) Q

 .I $P(IBT,"^",2)=356.2 S IBTRC=$P(IBT,"^",3) D EDIT^IBTRCD1(IBTEMP,1) Q

 .Q

 D BLD^IBTRPR

 S VALMBCK="R"

 Q

 ;

SHOWSC ; -- show sc conditions

 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D

 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))

 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)

 .D SHOWSC^IBTRC1

 .Q

 S VALMBCK="R"

 Q

 ;

PW ; -- Print worksheet

 N I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 D EN^VALM2($G(XQORNOD(0)))

 I $D(VALMY) S IBXX=0 F  S IBXX=$O(VALMY(IBXX)) Q:'IBXX  D

 .S IBT=$G(^TMP("IBTRPRDX",$J,+$O(^TMP("IBTRPR",$J,"IDX",IBXX,0))))

 .S IBTRN=$P(IBT,"^",4),DFN=$P(^IBT(356,+IBTRN,0),"^",2)

 .D RW^IBTRC4

 .Q

 S VALMBCK="R"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBTRPR1   4184     printed  Mar 13, 2025@21:33:51                                                                                                                                                                                                     Page 2

IBTRPR1   ;ALB/AAS - CLAIMS TRACKING - PENDING WORK ACTIONS ; 9-AUG-93

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

%          GOTO EN^IBTRPR

 +1       ;

NX(IBTMPNM) ; -- Go to next template

 +1       ; -- Input template name

 +2        NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 +3        DO EN^VALM2($GET(XQORNOD(0)))

 +4        IF $DATA(VALMY)

               SET IBXX=0

               FOR 

                   SET IBXX=$ORDER(VALMY(IBXX))

                   if 'IBXX

                       QUIT 

                   Begin DoDot:1

 +5                    SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))

 +6                    SET IBTRN=$PIECE(IBT,"^",4)

                       SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)

 +7                    IF IBTMPNM["REVIEW EDITOR"!(IBTMPNM["COMMUNICATIONS EDITOR")

                           Begin DoDot:2

 +8                            IF $PIECE(IBT,"^",2)=356.1

                                   SET IBTRV=$PIECE(IBT,"^",3)

                                   SET IBTMPNM="IBT REVIEW EDITOR"

 +9                            IF $PIECE(IBT,"^",2)=356.2

                                   SET IBTRC=$PIECE(IBT,"^",3)

                                   SET IBTMPNM="IBT COMMUNICATIONS EDITOR"

                           End DoDot:2

 +10                   DO EN^VALM(IBTMPNM)

 +11                   KILL IBAMT,IBAPR,IBADG,IBDA,IBDGCR,IBDGCRU1,IBDV,IBETYP,IBETYPD,IBI,IBICD,IBLCNT,IBSEL,IBT,IBTEXT,IBTNOD,IBTSAV,VAUTD

 +12                   KILL IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA

 +13                   DO KVAR^VADPT

 +14                   QUIT 

                   End DoDot:1

 +15       IF '$DATA(IBFASTXT)

               DO BLD^IBTRPR

 +16       SET VALMBCK="R"

 +17       QUIT 

 +18      ;

CD        ; -- Change Date range

 +1        SET VALMB=IBTPBDT

           DO RANGE^VALM11

 +2        IF $SELECT('VALMBEG:1,IBTPBDT'=VALMBEG:0,1:IBTPEDT=VALMEND)

               WRITE !!,"Date range was not changed."

               DO PAUSE^VALM1

               SET VALMBCK=""

               GOTO CDQ

 +3        SET IBTPBDT=VALMBEG

           SET IBTPEDT=VALMEND

 +4        DO BLD^IBTRPR

 +5        DO HDR^IBTRPR

           SET VALMBG=1

CDQ        KILL VALMB,VALMBEG,VALMEND

 +1        SET VALMBCK="R"

 +2        QUIT 

 +3       ;

QE        ; -- Quick Edit Entry

 +1        NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 +2        DO EN^VALM2($GET(XQORNOD(0)))

 +3        IF $DATA(VALMY)

               SET IBXX=0

               FOR 

                   SET IBXX=$ORDER(VALMY(IBXX))

                   if 'IBXX

                       QUIT 

                   Begin DoDot:1

 +4                    SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))

 +5                    SET IBTRN=$PIECE(IBT,"^",4)

                       SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)

 +6                    IF $PIECE(IBT,"^",2)=356.1

                           SET IBTRV=$PIECE(IBT,"^",3)

                           DO QE1^IBTRV1

                           QUIT 

 +7                    IF $PIECE(IBT,"^",2)=356.2

                           SET IBTRC=$PIECE(IBT,"^",3)

                           DO QE1^IBTRC1

                           QUIT 

 +8                    DO EN^VALM(IBTMPNM)

 +9                    QUIT 

                   End DoDot:1

 +10       DO BLD^IBTRPR

 +11       SET VALMBCK="R"

 +12       QUIT 

 +13       DO BLD^IBTRPR

 +14       SET VALMBCK="R"

 +15       QUIT 

 +16      ;

VE        ; -- View Edit entry

 +1        NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 +2        DO EN^VALM2($GET(XQORNOD(0)))

 +3        IF $DATA(VALMY)

               SET IBXX=0

               FOR 

                   SET IBXX=$ORDER(VALMY(IBXX))

                   if 'IBXX

                       QUIT 

                   Begin DoDot:1

 +4                    SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))

 +5                    SET IBTRN=$PIECE(IBT,"^",4)

                       SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)

 +6                    IF $PIECE(IBT,"^",2)=356.1

                           SET IBTRV=$PIECE(IBT,"^",3)

                           SET IBTMPNM="IBT EXPAND/EDIT REVIEW"

 +7                    IF $PIECE(IBT,"^",2)=356.2

                           SET IBTRC=$PIECE(IBT,"^",3)

                           SET IBTMPNM="IBT EXPAND/EDIT COMMUNICATIONS"

 +8                    DO EN^VALM(IBTMPNM)

 +9                    QUIT 

                   End DoDot:1

 +10       DO BLD^IBTRPR

 +11       SET VALMBCK="R"

 +12       QUIT 

 +13      ;

SC        ; -- Status Change

 +1        NEW VALMY,I,J,IBT,IBXXT,IBTEMP

 +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 IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXXT,0))))

 +5                    SET IBTRN=$PIECE(IBT,"^",4)

                       SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)

 +6                    SET IBTEMP="[IBT STATUS CHANGE]"

 +7                    IF $PIECE(IBT,"^",2)=356.1

                           SET IBTRV=$PIECE(IBT,"^",3)

                           DO EDIT^IBTRVD1(IBTEMP,1)

                           QUIT 

 +8                    IF $PIECE(IBT,"^",2)=356.2

                           SET IBTRC=$PIECE(IBT,"^",3)

                           DO EDIT^IBTRCD1(IBTEMP,1)

                           QUIT 

 +9                    QUIT 

                   End DoDot:1

 +10       DO BLD^IBTRPR

 +11       SET VALMBCK="R"

 +12       QUIT 

 +13      ;

RL        ; -- Remove from list

 +1       ;    Just delete Next review date

 +2        NEW VALMY,I,J,IBT,IBXXT,IBTEMP

 +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 IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXXT,0))))

 +6                    SET IBTRN=$PIECE(IBT,"^",4)

                       SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)

 +7                    SET IBTEMP="[IBT REMOVE NEXT REVIEW]"

 +8                    WRITE !!,"Removing Next Review Date from entry #",IBXXT

 +9                    IF $PIECE(IBT,"^",2)=356.1

                           SET IBTRV=$PIECE(IBT,"^",3)

                           DO EDIT^IBTRVD1(IBTEMP,1)

                           QUIT 

 +10                   IF $PIECE(IBT,"^",2)=356.2

                           SET IBTRC=$PIECE(IBT,"^",3)

                           DO EDIT^IBTRCD1(IBTEMP,1)

                           QUIT 

 +11                   QUIT 

                   End DoDot:1

 +12       DO BLD^IBTRPR

 +13       SET VALMBCK="R"

 +14       QUIT 

 +15      ;

SHOWSC    ; -- show sc conditions

 +1        NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 +2        DO EN^VALM2($GET(XQORNOD(0)))

 +3        IF $DATA(VALMY)

               SET IBXX=0

               FOR 

                   SET IBXX=$ORDER(VALMY(IBXX))

                   if 'IBXX

                       QUIT 

                   Begin DoDot:1

 +4                    SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))

 +5                    SET IBTRN=$PIECE(IBT,"^",4)

                       SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)

 +6                    DO SHOWSC^IBTRC1

 +7                    QUIT 

                   End DoDot:1

 +8        SET VALMBCK="R"

 +9        QUIT 

 +10      ;

PW        ; -- Print worksheet

 +1        NEW I,J,IBXX,VALMY,IBTRN,IBTRV,IBTRC,DFN

 +2        DO EN^VALM2($GET(XQORNOD(0)))

 +3        IF $DATA(VALMY)

               SET IBXX=0

               FOR 

                   SET IBXX=$ORDER(VALMY(IBXX))

                   if 'IBXX

                       QUIT 

                   Begin DoDot:1

 +4                    SET IBT=$GET(^TMP("IBTRPRDX",$JOB,+$ORDER(^TMP("IBTRPR",$JOB,"IDX",IBXX,0))))

 +5                    SET IBTRN=$PIECE(IBT,"^",4)

                       SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)

 +6                    DO RW^IBTRC4

 +7                    QUIT 

                   End DoDot:1

 +8        SET VALMBCK="R"

 +9        QUIT