Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTOAT2

IBTOAT2.m

Go to the documentation of this file.
  1. IBTOAT2 ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;
  1. ;D DEMO,LINE,ADM,LINE,EM,LINE,INS,LINE,DIAG,PROC,FNL,SC,STMT
  1. D DIAG,PROC,SC,STMT
  1. Q
  1. ;
  1. DIAG ; -- pirnt diagnosis/procedure block
  1. W !?TAB,"Date",?12,"Diagnosis",?37,"Procedure",?60,"Final",?68,"DRG",?73,"LOS"
  1. F I=1:1:5 D BLINE
  1. Q
  1. ;
  1. PROC ; -- print procedures done
  1. ;W !!?TAB,"Procedures Done",?56,"Date"
  1. ;D TWOL^IBTOAT1
  1. Q
  1. ;
  1. ;
  1. SC ; -- prints sc conditions
  1. N I,I1,I2,I3
  1. S I3=0
  1. S MAX=$S(IOSL<61:4,IOSL<67:6,1:11)
  1. I '+VAEL(3) W !! G SCQ
  1. W !!?TAB,"Service Connected Conditions: " W:'$G(IBTRCSC) ?54,"Treated"
  1. F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I D I '$G(IBTRCSC),I3>MAX W !?TAB,"MORE...." Q
  1. .S I1=^DPT(DFN,.372,I,0)
  1. .Q:'$P(I1,"^",3)
  1. .S I2=$G(^DIC(31,+I1,0))
  1. .S:$P(I2,"^",4)'="" I2=$P(I2,"^",4)
  1. .S I2=$P(I2,"^")
  1. .W !?TAB+5,$E(I2,1,39),?49,$J($P(I1,"^",2),3)_"%" W:'$G(IBTRCSC) " _______" S I3=I3+1
  1. .Q
  1. I 'I3 W !?TAB,$S('$O(^DPT(DFN,.372,0)):"NONE STATED",1:"NO SC DISABILITIES LISTED") S I3=1
  1. SCQ F I3=I3:1:MAX W !
  1. Q
  1. ;
  1. STMT ; -- print attestation and sig. lines
  1. W !!,"I attest that these are the diagnoses and procedures for which the"
  1. W !,"Patient was treated during this episode of care."
  1. W !!,"MD: __________________________________ Date: __________________"
  1. 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)
  1. Q
  1. ;
  1. BLINE ; -- write line with BARS
  1. ;
  1. W !?TAB," | | | | |"
  1. W !?TAB,"_____|________________________|______________________|________|_____|_____"
  1. Q