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

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