IBTOAT ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
;;2.0; INTEGRATED BILLING ;**1,199**; 21-MAR-94
;
% I '$D(DT) D DT^DICRW
;
PAT ; -- Select patient
S IBTOAT=1
S DIC="^DPT(",DIC(0)="AEQM" ;,DIC("S")="I $D(^IBT(356,""APTA"",+Y))"
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
D ^DIC K DIC I +Y<1 G END
S DFN=+Y
;
EN1 ;
; -- entry point to call from event driver or registration
N VAIN,VAERR,VA,VAINDT,IBQUIT,DIR,I,J
W !
S IBQUIT=0
Q:'$D(DFN)
I '$G(IBTOAT) Q:'$P($G(^IBE(350.9,1,6)),"^",5)
S VA200="" D INP^VADPT
;Q:'VAIN(1)
S IBTRN=$O(^IBT(356,"AD",+$G(VAIN(1)),0))
I IBTRN D I IBQUIT G END
.N DIR
.S DIR(0)="Y",DIR("A")="Print Admission Sheet for Current Adm. ("_$P(VAIN(7),"^",2)_")"
.S DIR("B")="YES"
.S DIR("?")="Answer 'YES' if you want to print an admission sheet for the current admission, or 'NO' if you wish to select another admission date."
.D ^DIR K DIR I $D(DIRUT) S IBQUIT=1
.S IBTCUR=Y
.Q
;
I '$G(IBTCUR)!('$G(IBTRN))!($P($G(^IBT(356,+$G(IBTRN),0)),"^",2)'=DFN) D TRAC
I '$G(IBTRN) G END
;
DEV ; -- select device, run option
W !
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="ONE^IBTOAT1",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - Print single admission sheet" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G %
U IO D ONE^IBTOAT1,END W !! G %
Q
;
END ; -- Clean up
W !
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K X,Y,DFN,IBTRN,%ZIS,IBTOAT,VA200,IBTCUR,MAX,POP,TAB,TAB2,IBTITLE,IBDT
Q
;
TRAC ; -- Select tracking module internal entry number
W !
S DIC="^IBT(356,",DIC(0)="AEQ",DIC("A")="Select Visit: "
S D="ADFN"_DFN
S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,5)"
D IX^DIC K DIC I +Y<1 G END
S IBTRN=+Y
Q
;
REG(DGPM) ; -- can be called from registration to print an admission sheet
; -- input DGPM = admission movement
N IBTRKR,IBTRN,IBTRND,X,Y,I,J,DIR,DIRUT,DUOUT,DTOUT,IBQUIT,DFN
S IBTRKR=$G(^IBE(350.9,1,6))
Q:'$P(IBTRKR,"^",6) ; quit if use admission sheets = no
Q:'$G(DGPM)
S DFN=$P($G(^DGPM(DGPM,0)),"^",2) Q:'DFN
S IBTRN=$O(^IBT(356,"AD",DGPM,0))
I 'IBTRN D ADM^IBTUTL(DGPM)
S DIR(0)="Y",DIR("A")="PRINT ADMISSION SHEET",DIR("B")="YES"
S DIR("?")="Answer YES if you wish to print an admission sheet which could be place on the top of the inpatient chart. Answer NO if you do not want to print one."
D ^DIR K DIR I Y D
.S ZTRTN="ONE^IBTOAT1",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - Print single admission sheet" D ^%ZTLOAD K ZTSK
.;D ONE^IBTOAT1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOAT 2546 printed Sep 23, 2025@20:03:26 Page 2
IBTOAT ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
+1 ;;2.0; INTEGRATED BILLING ;**1,199**; 21-MAR-94
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
+1 ;
PAT ; -- Select patient
+1 SET IBTOAT=1
+2 ;,DIC("S")="I $D(^IBT(356,""APTA"",+Y))"
SET DIC="^DPT("
SET DIC(0)="AEQM"
+3 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+4 DO ^DIC
KILL DIC
IF +Y<1
GOTO END
+5 SET DFN=+Y
+6 ;
EN1 ;
+1 ; -- entry point to call from event driver or registration
+2 NEW VAIN,VAERR,VA,VAINDT,IBQUIT,DIR,I,J
+3 WRITE !
+4 SET IBQUIT=0
+5 if '$DATA(DFN)
QUIT
+6 IF '$GET(IBTOAT)
if '$PIECE($GET(^IBE(350.9,1,6)),"^",5)
QUIT
+7 SET VA200=""
DO INP^VADPT
+8 ;Q:'VAIN(1)
+9 SET IBTRN=$ORDER(^IBT(356,"AD",+$GET(VAIN(1)),0))
+10 IF IBTRN
Begin DoDot:1
+11 NEW DIR
+12 SET DIR(0)="Y"
SET DIR("A")="Print Admission Sheet for Current Adm. ("_$PIECE(VAIN(7),"^",2)_")"
+13 SET DIR("B")="YES"
+14 SET DIR("?")="Answer 'YES' if you want to print an admission sheet for the current admission, or 'NO' if you wish to select another admission date."
+15 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET IBQUIT=1
+16 SET IBTCUR=Y
+17 QUIT
End DoDot:1
IF IBQUIT
GOTO END
+18 ;
+19 IF '$GET(IBTCUR)!('$GET(IBTRN))!($PIECE($GET(^IBT(356,+$GET(IBTRN),0)),"^",2)'=DFN)
DO TRAC
+20 IF '$GET(IBTRN)
GOTO END
+21 ;
DEV ; -- select device, run option
+1 WRITE !
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+3 IF $DATA(IO("Q"))
SET ZTRTN="ONE^IBTOAT1"
SET ZTSAVE("IB*")=""
SET ZTSAVE("DFN")=""
SET ZTDESC="IB - Print single admission sheet"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO %
+4 USE IO
DO ONE^IBTOAT1
DO END
WRITE !!
GOTO %
+5 QUIT
+6 ;
END ; -- Clean up
+1 WRITE !
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL X,Y,DFN,IBTRN,%ZIS,IBTOAT,VA200,IBTCUR,MAX,POP,TAB,TAB2,IBTITLE,IBDT
+5 QUIT
+6 ;
TRAC ; -- Select tracking module internal entry number
+1 WRITE !
+2 SET DIC="^IBT(356,"
SET DIC(0)="AEQ"
SET DIC("A")="Select Visit: "
+3 SET D="ADFN"_DFN
+4 SET DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,5)"
+5 DO IX^DIC
KILL DIC
IF +Y<1
GOTO END
+6 SET IBTRN=+Y
+7 QUIT
+8 ;
REG(DGPM) ; -- can be called from registration to print an admission sheet
+1 ; -- input DGPM = admission movement
+2 NEW IBTRKR,IBTRN,IBTRND,X,Y,I,J,DIR,DIRUT,DUOUT,DTOUT,IBQUIT,DFN
+3 SET IBTRKR=$GET(^IBE(350.9,1,6))
+4 ; quit if use admission sheets = no
if '$PIECE(IBTRKR,"^",6)
QUIT
+5 if '$GET(DGPM)
QUIT
+6 SET DFN=$PIECE($GET(^DGPM(DGPM,0)),"^",2)
if 'DFN
QUIT
+7 SET IBTRN=$ORDER(^IBT(356,"AD",DGPM,0))
+8 IF 'IBTRN
DO ADM^IBTUTL(DGPM)
+9 SET DIR(0)="Y"
SET DIR("A")="PRINT ADMISSION SHEET"
SET DIR("B")="YES"
+10 SET DIR("?")="Answer YES if you wish to print an admission sheet which could be place on the top of the inpatient chart. Answer NO if you do not want to print one."
+11 DO ^DIR
KILL DIR
IF Y
Begin DoDot:1
+12 SET ZTRTN="ONE^IBTOAT1"
SET ZTSAVE("IB*")=""
SET ZTSAVE("DFN")=""
SET ZTDESC="IB - Print single admission sheet"
DO ^%ZTLOAD
KILL ZTSK
+13 ;D ONE^IBTOAT1
End DoDot:1
+14 QUIT
