- 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 Feb 18, 2025@23:53:38 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