IBTOAT2.m

IBTOAT2	;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93

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

	;

	;D DEMO,LINE,ADM,LINE,EM,LINE,INS,LINE,DIAG,PROC,FNL,SC,STMT

	D DIAG,PROC,SC,STMT

	Q

	;

DIAG	; -- pirnt diagnosis/procedure block

	W !?TAB,"Date",?12,"Diagnosis",?37,"Procedure",?60,"Final",?68,"DRG",?73,"LOS"

	F I=1:1:5 D BLINE

	Q

	;

PROC	; -- print procedures done

	;W !!?TAB,"Procedures Done",?56,"Date"

	;D TWOL^IBTOAT1

	Q

	;

	;

SC	; -- prints sc conditions

	N I,I1,I2,I3

	S I3=0

	S MAX=$S(IOSL<61:4,IOSL<67:6,1:11)

	I '+VAEL(3) W !! G SCQ

	W !!?TAB,"Service Connected Conditions: " W:'$G(IBTRCSC) ?54,"Treated"

	F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I  D  I '$G(IBTRCSC),I3>MAX W !?TAB,"MORE...." Q

	.S I1=^DPT(DFN,.372,I,0)

	.Q:'$P(I1,"^",3)

	.S I2=$G(^DIC(31,+I1,0))

	.S:$P(I2,"^",4)'="" I2=$P(I2,"^",4)

	.S I2=$P(I2,"^")

	.W !?TAB+5,$E(I2,1,39),?49,$J($P(I1,"^",2),3)_"%" W:'$G(IBTRCSC) " _______" S I3=I3+1

	.Q

	I 'I3 W !?TAB,$S('$O(^DPT(DFN,.372,0)):"NONE STATED",1:"NO SC DISABILITIES LISTED") S I3=1

SCQ	F I3=I3:1:MAX W !

	Q

	;

STMT	; -- print attestation and sig. lines

	W !!,"I attest that these are the diagnoses and procedures for which the"

	W !,"Patient was treated during this episode of care."

	W !!,"MD: __________________________________    Date: __________________"

	W !!,"Patient: ",$E(VADM(1),1,20),"  ",VA("PID"),?IOM-30," Printed: " D NOW^%DTC S Y=% D D^DIQ W $P(Y,":",1,2)

	Q

	;

BLINE	; -- write line with BARS

	;

	W !?TAB,"     |                        |                      |        |     |"

	W !?TAB,"_____|________________________|______________________|________|_____|_____"

	Q

IBTOAT2   ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93

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

 +2       ;

 +3       ;D DEMO,LINE,ADM,LINE,EM,LINE,INS,LINE,DIAG,PROC,FNL,SC,STMT

 +4        DO DIAG

           DO PROC

           DO SC

           DO STMT

 +5        QUIT 

 +6       ;

DIAG      ; -- pirnt diagnosis/procedure block

 +1        WRITE !?TAB,"Date",?12,"Diagnosis",?37,"Procedure",?60,"Final",?68,"DRG",?73,"LOS"

 +2        FOR I=1:1:5

               DO BLINE

 +3        QUIT 

 +4       ;

PROC      ; -- print procedures done

 +1       ;W !!?TAB,"Procedures Done",?56,"Date"

 +2       ;D TWOL^IBTOAT1

 +3        QUIT 

 +4       ;

 +5       ;

SC        ; -- prints sc conditions

 +1        NEW I,I1,I2,I3

 +2        SET I3=0

 +3        SET MAX=$SELECT(IOSL<61:4,IOSL<67:6,1:11)

 +4        IF '+VAEL(3)

               WRITE !!

               GOTO SCQ

 +5        WRITE !!?TAB,"Service Connected Conditions: "

           IF '$GET(IBTRCSC)

               WRITE ?54,"Treated"

 +6        FOR I=0:0

               SET I=$ORDER(^DPT(DFN,.372,I))

               IF 'I

                   QUIT 

               Begin DoDot:1

 +7                SET I1=^DPT(DFN,.372,I,0)

 +8                IF '$PIECE(I1,"^",3)

                       QUIT 

 +9                SET I2=$GET(^DIC(31,+I1,0))

 +10               IF $PIECE(I2,"^",4)'=""

                       SET I2=$PIECE(I2,"^",4)

 +11               SET I2=$PIECE(I2,"^")

 +12               WRITE !?TAB+5,$EXTRACT(I2,1,39),?49,$JUSTIFY($PIECE(I1,"^",2),3)_"%"

                   IF '$GET(IBTRCSC)

                       WRITE " _______"

                   SET I3=I3+1

 +13               QUIT 

               End DoDot:1

               IF '$GET(IBTRCSC)

                   IF I3>MAX

                       WRITE !?TAB,"MORE...."

                       QUIT 

 +14       IF 'I3

               WRITE !?TAB,$SELECT('$ORDER(^DPT(DFN,.372,0)):"NONE STATED",1:"NO SC DISABILITIES LISTED")

               SET I3=1

SCQ        FOR I3=I3:1:MAX

               WRITE !

 +1        QUIT 

 +2       ;

STMT      ; -- print attestation and sig. lines

 +1        WRITE !!,"I attest that these are the diagnoses and procedures for which the"

 +2        WRITE !,"Patient was treated during this episode of care."

 +3        WRITE !!,"MD: __________________________________    Date: __________________"

 +4        WRITE !!,"Patient: ",$EXTRACT(VADM(1),1,20),"  ",VA("PID"),?IOM-30," Printed: "

           DO NOW^%DTC

           SET Y=%

           DO D^DIQ

           WRITE $PIECE(Y,":",1,2)

 +5        QUIT 

 +6       ;

BLINE     ; -- write line with BARS

 +1       ;

 +2        WRITE !?TAB,"     |                        |                      |        |     |"

 +3        WRITE !?TAB,"_____|________________________|______________________|________|_____|_____"

 +4        QUIT