- IBTOAT ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 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))"
- 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,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
- IBTOAT ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 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 DO ^DIC
- KILL DIC
- IF +Y<1
- GOTO END
- +4 SET DFN=+Y
- +5 ;
- 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,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
