source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTOAT.m@ 677

Last change on this file since 677 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1IBTOAT ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
2 ;;2.0; INTEGRATED BILLING ;**1,199**; 21-MAR-94
3 ;
4% I '$D(DT) D DT^DICRW
5 ;
6PAT ; -- Select patient
7 S IBTOAT=1
8 S DIC="^DPT(",DIC(0)="AEQM" ;,DIC("S")="I $D(^IBT(356,""APTA"",+Y))"
9 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
10 D ^DIC K DIC I +Y<1 G END
11 S DFN=+Y
12 ;
13EN1 ;
14 ; -- entry point to call from event driver or registration
15 N VAIN,VAERR,VA,VAINDT,IBQUIT,DIR,I,J
16 W !
17 S IBQUIT=0
18 Q:'$D(DFN)
19 I '$G(IBTOAT) Q:'$P($G(^IBE(350.9,1,6)),"^",5)
20 S VA200="" D INP^VADPT
21 ;Q:'VAIN(1)
22 S IBTRN=$O(^IBT(356,"AD",+$G(VAIN(1)),0))
23 I IBTRN D I IBQUIT G END
24 .N DIR
25 .S DIR(0)="Y",DIR("A")="Print Admission Sheet for Current Adm. ("_$P(VAIN(7),"^",2)_")"
26 .S DIR("B")="YES"
27 .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."
28 .D ^DIR K DIR I $D(DIRUT) S IBQUIT=1
29 .S IBTCUR=Y
30 .Q
31 ;
32 I '$G(IBTCUR)!('$G(IBTRN))!($P($G(^IBT(356,+$G(IBTRN),0)),"^",2)'=DFN) D TRAC
33 I '$G(IBTRN) G END
34 ;
35DEV ; -- select device, run option
36 W !
37 S %ZIS="QM" D ^%ZIS G:POP END
38 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 %
39 U IO D ONE^IBTOAT1,END W !! G %
40 Q
41 ;
42END ; -- Clean up
43 W !
44 I $D(ZTQUEUED) S ZTREQ="@" Q
45 D ^%ZISC
46 K X,Y,DFN,IBTRN,%ZIS,IBTOAT,VA200,IBTCUR,MAX,POP,TAB,TAB2,IBTITLE,IBDT
47 Q
48 ;
49TRAC ; -- Select tracking module internal entry number
50 W !
51 S DIC="^IBT(356,",DIC(0)="AEQ",DIC("A")="Select Visit: "
52 S D="ADFN"_DFN
53 S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,5)"
54 D IX^DIC K DIC I +Y<1 G END
55 S IBTRN=+Y
56 Q
57 ;
58REG(DGPM) ; -- can be called from registration to print an admission sheet
59 ; -- input DGPM = admission movement
60 N IBTRKR,IBTRN,IBTRND,X,Y,I,J,DIR,DIRUT,DUOUT,DTOUT,IBQUIT,DFN
61 S IBTRKR=$G(^IBE(350.9,1,6))
62 Q:'$P(IBTRKR,"^",6) ; quit if use admission sheets = no
63 Q:'$G(DGPM)
64 S DFN=$P($G(^DGPM(DGPM,0)),"^",2) Q:'DFN
65 S IBTRN=$O(^IBT(356,"AD",DGPM,0))
66 I 'IBTRN D ADM^IBTUTL(DGPM)
67 S DIR(0)="Y",DIR("A")="PRINT ADMISSION SHEET",DIR("B")="YES"
68 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."
69 D ^DIR K DIR I Y D
70 .S ZTRTN="ONE^IBTOAT1",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - Print single admission sheet" D ^%ZTLOAD K ZTSK
71 .;D ONE^IBTOAT1
72 Q
Note: See TracBrowser for help on using the repository browser.