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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOAT2 1680 printed Dec 13, 2024@02:27:09 Page 2
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
