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  Sep 23, 2025@20:03:28                                                                                                                                                                                                     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