IBTOAT1 ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
;;Version 2.0 ; INTEGRATED BILLING ;**1**; 21-MAR-94
;
ONE ; -- print one sheet here - no close device, no form feeds
; input DFN = patient file pointer
; IBTRN = Tracking module entry
;
Q:'$D(DFN)
I '$D(IOST) D HOME^%ZIS
N I,J,X,Y,VADM,VAOA,VAPA,VA,VAEC,VAIN,IBTRND,VAEL,VAINDT,VA200
;
; -- Make sure tracking entry exists
I +$G(IBTRN)<1!('$D(^IBT(356,+$G(IBTRN),0))) Q ;D ADM^IBTUTL()
S IBTRND=$G(^IBT(356,+$G(IBTRN),0))
;
S TAB=4,TAB2=45
W $C(13),?(IOM-15/2),"ADMISSION SHEET"
S IBTITLE=$G(^IBE(350.9,1,5))
F I=1:1:3 W !,?(IOM-$L($P(IBTITLE,"^",I))/2),$P(IBTITLE,"^",I)
;
D DEMO,LINE,ADM,LINE,EM,LINE
I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G END
D INS,LINE,^IBTOAT2
END D KVAR^VADPT K VAEC,DIRUT
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
ADM ; -- print admissions data
I $G(IBTRN)="" W !?TAB,"No admission Found",!!!! G ADMQ
;S VA200="" D INP^VADPT
N VAINDT S VAINDT=$P(+$G(^DGPM(+$P($G(^IBT(356,IBTRN,0)),"^",5),0)),".")_.2359 D INP^VADPT
W !?TAB,"Adm. Date: ",$P(VAIN(7),"^",2)
W ?TAB2,"Adm. Type: ",$E($$ATYPE($P(IBTRND,"^",7)),1,19) ; urgent/emergent
W !?TAB," Provider: ",$P(VAIN(2),"^",2)
W ?TAB2,"Specialty: ",$P(VAIN(3),"^",2)
W !?TAB," Ward: ",$P(VAIN(4),"^",2)
W ?TAB2," Room/Bed: ",VAIN(5)
W !?TAB,"Adm. Diag: ",$$ADMDIAG^IBTRE6(IBTRN)
;
ADMQ Q
;
DEMO ; -- print pt. demographics
D 4^VADPT ;demographic and pt address
D ELIG^VADPT ;eligiblity data
;
W !!?TAB," Patient: ",VADM(1)
W ?TAB2," Address: ",VAPA(1)
W !?TAB," Pt ID: ",VA("PID")
I VAPA(2)'="" W ?TAB2+11,VAPA(2)
W !?TAB," Dob: ",$P(VADM(3),"^",2)
I VAPA(3)'="" W ?TAB2+11,VAPA(3)
W !?TAB," SC: ",$S(+VAEL(3):"YES - "_$P(VAEL(3),"^",2)_"%",1:"NO")
W ?TAB2+11,VAPA(4),$S(VAPA(4)'="":", ",1:""),$P($G(^DIC(5,+VAPA(5),0)),"^",2)," ",VAPA(6)
W !?TAB," Sex: ",$P(VADM(5),"^",2),?TAB2," Phone: ",VAPA(8)
Q
;
EM S VAROOT="VAEC",VAOA("A")=1 D OAD^VADPT K VAROOT ;emergency contact info
S VAOA("A")=5 D OAD^VADPT ;patient employer info
W !,?TAB," Employer: ",VAOA(9)
W ?TAB2," E-Cont.: ",VAEC(9) I VAEC(10)'="" W " - ",VAEC(10)
W !?TAB+11,VAOA(1),?TAB2+11,VAEC(1)
I VAEC(2)'=""!(VAOA(2)'="") W !?TAB+11,VAOA(2),?TAB2+11,VAEC(2)
I VAEC(3)'=""!(VAOA(3)'="") W !?TAB+11,VAOA(3),?TAB2+11,VAEC(3)
W !?TAB+11,VAOA(4),$S(VAOA(4)'="":", ",1:""),$P($G(^DIC(5,+VAOA(5),0)),"^",2)," ",VAOA(6)
W ?TAB2+11,VAEC(4),$S(VAEC(4)'="":", ",1:""),$P($G(^DIC(5,+VAEC(5),0)),"^",2)," ",VAEC(6)
W !?TAB," Phone: ",VAOA(8),?TAB2," Phone: ",VAEC(8)
Q
;
INS ; -- print insurance info
N IBINS,IBCNT,I
I '$D(IBDT) S IBDT=DT
D ALL^IBCNS1(DFN,"IBINS",1,IBDT)
I $G(IBINS(0))<1 W !,?TAB,"No Insurance Information",!!! G INSQ
S MAX=$S(IOSL<61:1,IOSL<67:2,1:3)
S I=0,IBCNT=0 F S I=$O(IBINS(I)) Q:'I S IBINS=IBINS(I,0) D I '$D(IBALLIN),IBCNT>MAX W !?TAB,"MORE......" Q
.S IBCNT=IBCNT+1
.I IBCNT>1 W !
.W !?TAB,"Ins. Co "_IBCNT_": ",$P($G(^DIC(36,+IBINS,0)),"^")
.S X=$G(^DIC(36,+IBINS,.13)),X=$S($P(X,"^",3)'="":$P(X,"^",3),1:$P(X,"^"))
.W ?TAB2," Phone: ",X
.W !?TAB," Subsc.: ",$P(IBINS,"^",17)
.W ?TAB2," Type: ",$E($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBINS,"^",18),0)),"^",9),0)),"^"),1,20)
.W !?TAB,"Subsc. ID: ",$P(IBINS,"^",2)
.W ?TAB2," Group: ",$$GRP^IBCNS($P(IBINS,"^",18))
INSQ Q
;
LINE ; -- write a line
W !,$$L("-",IOM)
Q
;
TWOL ; -- write two underlines
W !?TAB,$$L("_",IOM-TAB),!!?TAB,$$L("_",IOM-TAB)
Q
;
L(C,L) ; -- output line
S:$G(C)="" C="-"
S:$G(L)="" L=IOM
Q $TR($J(" ",L)," ",C)
;
ATYPE(X) ; -- Admission Type Expand Set
; -- input internal form (number)
; -- output external form
Q $P($P($P(^DD(356,.07,0),"^",3),+$G(X)_":",2),";",1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOAT1 3817 printed Sep 23, 2025@20:03:27 Page 2
IBTOAT1 ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**1**; 21-MAR-94
+2 ;
ONE ; -- print one sheet here - no close device, no form feeds
+1 ; input DFN = patient file pointer
+2 ; IBTRN = Tracking module entry
+3 ;
+4 if '$DATA(DFN)
QUIT
+5 IF '$DATA(IOST)
DO HOME^%ZIS
+6 NEW I,J,X,Y,VADM,VAOA,VAPA,VA,VAEC,VAIN,IBTRND,VAEL,VAINDT,VA200
+7 ;
+8 ; -- Make sure tracking entry exists
+9 ;D ADM^IBTUTL()
IF +$GET(IBTRN)<1!('$DATA(^IBT(356,+$GET(IBTRN),0)))
QUIT
+10 SET IBTRND=$GET(^IBT(356,+$GET(IBTRN),0))
+11 ;
+12 SET TAB=4
SET TAB2=45
+13 WRITE $CHAR(13),?(IOM-15/2),"ADMISSION SHEET"
+14 SET IBTITLE=$GET(^IBE(350.9,1,5))
+15 FOR I=1:1:3
WRITE !,?(IOM-$LENGTH($PIECE(IBTITLE,"^",I))/2),$PIECE(IBTITLE,"^",I)
+16 ;
+17 DO DEMO
DO LINE
DO ADM
DO LINE
DO EM
DO LINE
+18 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
IF $DATA(DIRUT)
GOTO END
+19 DO INS
DO LINE
DO ^IBTOAT2
END DO KVAR^VADPT
KILL VAEC,DIRUT
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;
ADM ; -- print admissions data
+1 IF $GET(IBTRN)=""
WRITE !?TAB,"No admission Found",!!!!
GOTO ADMQ
+2 ;S VA200="" D INP^VADPT
+3 NEW VAINDT
SET VAINDT=$PIECE(+$GET(^DGPM(+$PIECE($GET(^IBT(356,IBTRN,0)),"^",5),0)),".")_.2359
DO INP^VADPT
+4 WRITE !?TAB,"Adm. Date: ",$PIECE(VAIN(7),"^",2)
+5 ; urgent/emergent
WRITE ?TAB2,"Adm. Type: ",$EXTRACT($$ATYPE($PIECE(IBTRND,"^",7)),1,19)
+6 WRITE !?TAB," Provider: ",$PIECE(VAIN(2),"^",2)
+7 WRITE ?TAB2,"Specialty: ",$PIECE(VAIN(3),"^",2)
+8 WRITE !?TAB," Ward: ",$PIECE(VAIN(4),"^",2)
+9 WRITE ?TAB2," Room/Bed: ",VAIN(5)
+10 WRITE !?TAB,"Adm. Diag: ",$$ADMDIAG^IBTRE6(IBTRN)
+11 ;
ADMQ QUIT
+1 ;
DEMO ; -- print pt. demographics
+1 ;demographic and pt address
DO 4^VADPT
+2 ;eligiblity data
DO ELIG^VADPT
+3 ;
+4 WRITE !!?TAB," Patient: ",VADM(1)
+5 WRITE ?TAB2," Address: ",VAPA(1)
+6 WRITE !?TAB," Pt ID: ",VA("PID")
+7 IF VAPA(2)'=""
WRITE ?TAB2+11,VAPA(2)
+8 WRITE !?TAB," Dob: ",$PIECE(VADM(3),"^",2)
+9 IF VAPA(3)'=""
WRITE ?TAB2+11,VAPA(3)
+10 WRITE !?TAB," SC: ",$SELECT(+VAEL(3):"YES - "_$PIECE(VAEL(3),"^",2)_"%",1:"NO")
+11 WRITE ?TAB2+11,VAPA(4),$SELECT(VAPA(4)'="":", ",1:""),$PIECE($GET(^DIC(5,+VAPA(5),0)),"^",2)," ",VAPA(6)
+12 WRITE !?TAB," Sex: ",$PIECE(VADM(5),"^",2),?TAB2," Phone: ",VAPA(8)
+13 QUIT
+14 ;
EM ;emergency contact info
SET VAROOT="VAEC"
SET VAOA("A")=1
DO OAD^VADPT
KILL VAROOT
+1 ;patient employer info
SET VAOA("A")=5
DO OAD^VADPT
+2 WRITE !,?TAB," Employer: ",VAOA(9)
+3 WRITE ?TAB2," E-Cont.: ",VAEC(9)
IF VAEC(10)'=""
WRITE " - ",VAEC(10)
+4 WRITE !?TAB+11,VAOA(1),?TAB2+11,VAEC(1)
+5 IF VAEC(2)'=""!(VAOA(2)'="")
WRITE !?TAB+11,VAOA(2),?TAB2+11,VAEC(2)
+6 IF VAEC(3)'=""!(VAOA(3)'="")
WRITE !?TAB+11,VAOA(3),?TAB2+11,VAEC(3)
+7 WRITE !?TAB+11,VAOA(4),$SELECT(VAOA(4)'="":", ",1:""),$PIECE($GET(^DIC(5,+VAOA(5),0)),"^",2)," ",VAOA(6)
+8 WRITE ?TAB2+11,VAEC(4),$SELECT(VAEC(4)'="":", ",1:""),$PIECE($GET(^DIC(5,+VAEC(5),0)),"^",2)," ",VAEC(6)
+9 WRITE !?TAB," Phone: ",VAOA(8),?TAB2," Phone: ",VAEC(8)
+10 QUIT
+11 ;
INS ; -- print insurance info
+1 NEW IBINS,IBCNT,I
+2 IF '$DATA(IBDT)
SET IBDT=DT
+3 DO ALL^IBCNS1(DFN,"IBINS",1,IBDT)
+4 IF $GET(IBINS(0))<1
WRITE !,?TAB,"No Insurance Information",!!!
GOTO INSQ
+5 SET MAX=$SELECT(IOSL<61:1,IOSL<67:2,1:3)
+6 SET I=0
SET IBCNT=0
FOR
SET I=$ORDER(IBINS(I))
if 'I
QUIT
SET IBINS=IBINS(I,0)
Begin DoDot:1
+7 SET IBCNT=IBCNT+1
+8 IF IBCNT>1
WRITE !
+9 WRITE !?TAB,"Ins. Co "_IBCNT_": ",$PIECE($GET(^DIC(36,+IBINS,0)),"^")
+10 SET X=$GET(^DIC(36,+IBINS,.13))
SET X=$SELECT($PIECE(X,"^",3)'="":$PIECE(X,"^",3),1:$PIECE(X,"^"))
+11 WRITE ?TAB2," Phone: ",X
+12 WRITE !?TAB," Subsc.: ",$PIECE(IBINS,"^",17)
+13 WRITE ?TAB2," Type: ",$EXTRACT($PIECE($GET(^IBE(355.1,+$PIECE($GET(^IBA(355.3,+$PIECE(IBINS,"^",18),0)),"^",9),0)),"^"),1,20)
+14 WRITE !?TAB,"Subsc. ID: ",$PIECE(IBINS,"^",2)
+15 WRITE ?TAB2," Group: ",$$GRP^IBCNS($PIECE(IBINS,"^",18))
End DoDot:1
IF '$DATA(IBALLIN)
IF IBCNT>MAX
WRITE !?TAB,"MORE......"
QUIT
INSQ QUIT
+1 ;
LINE ; -- write a line
+1 WRITE !,$$L("-",IOM)
+2 QUIT
+3 ;
TWOL ; -- write two underlines
+1 WRITE !?TAB,$$L("_",IOM-TAB),!!?TAB,$$L("_",IOM-TAB)
+2 QUIT
+3 ;
L(C,L) ; -- output line
+1 if $GET(C)=""
SET C="-"
+2 if $GET(L)=""
SET L=IOM
+3 QUIT $TRANSLATE($JUSTIFY(" ",L)," ",C)
+4 ;
ATYPE(X) ; -- Admission Type Expand Set
+1 ; -- input internal form (number)
+2 ; -- output external form
+3 QUIT $PIECE($PIECE($PIECE(^DD(356,.07,0),"^",3),+$GET(X)_":",2),";",1)
