source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRE2.m@ 861

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

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1IBTRE2 ;ALB/AAS - CLAIMS TRACKING - ACTIONS ;27-JUN-93
2 ;;2.0;INTEGRATED BILLING;**23,121,249,312**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G EN^IBTRE
6 ;
7AT ; -- Add tracking entry
8 I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q ;IB*2.0*312
9 D FULL^VALM1
10 N X,Y,DIC,DA,DR,DD,DO,DIR,DIRUT,DTOUT,DUOUT,IBETYP,IBQUIT,IBTDT,VAIN,VAINDT,IBTRN,IBTDTE
11 ;
12TEST S IBQUIT=0
13 S DIC(0)="AEQMNZ",DIC="^IBE(356.6,",DIC("S")="I $P(^(0),U,3)<3",DIC("A")="Select Tracking Type: "
14 D ^DIC K DIC S IBETYP=+Y I +Y<0 G ATQ
15 W !
16 ;
17ADM I IBETYP=$O(^IBE(356.6,"AC",1,0)) D I IBQUIT G ATQ
18 .N DIR
19 .S DIR("?")=" "
20 .S DIR("?",1)=" Enter any Date!"
21 .S DIR("?",2)=" "
22 .S DIR("?",3)=" If the patient was an inpatient on that date the system will use the"
23 .S DIR("?",4)=" correct admission date. If you are tracking an admissions at another"
24 .S DIR("?",5)=" facility you may enter that date. Enter '??' to get a list of the"
25 .S DIR("?",6)=" last 10 admissions for this patient."
26 .S DIR("??")="^D LISTA^IBTRE20"
27 .S DIR(0)="DO^::AEXTP",DIR("A")="Admission Date"
28 .D ^DIR K DIR S (IBTDT,VAINDT)=+Y I $P(VAINDT,".",2)="" S VAINDT=VAINDT+.24
29 .I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
30 .; -- check for valid admission
31 .S VA200="" D INP^VADPT I VAIN(1)="" D ;look for one day admission
32 ..S IBX=+$O(^(+$O(^DGPM("ATID1",DFN,9999999-IBTDT)),0)),IBX=+$G(^DGPM(IBX,0))
33 ..I $E(IBX,1,7)=IBTDT S VAINDT=IBX D INP^VADPT ;9999999.9999999
34 ..I VAIN(1) W !!,"WARNING: This appears to be a one day stay."
35 .I VAIN(1)="" D
36 ..W !!,*7,"WARNING: Patient does not appear to be an inpatient on this date!",!
37 ..I VAIN(7)="" S VAIN(7)=IBTDT,Y=IBTDT D D^DIQ S $P(VAIN(7),"^",2)=Y
38 .;
39 .S DIR("?")="No admission was found for this date, enter 'Yes' if you want to add this anyway, or 'No' if you do not wish to track this date."
40 .S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Admission Date "_$P(VAIN(7),"^",2),DIR("B")="NO"
41 .D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
42 .I VAIN(1) D ADM^IBTUTL(VAIN(1))
43 .I 'VAIN(1) D OTH^IBTUTL(DFN,IBETYP,IBTDT)
44 .Q
45 ;
46OPT I IBETYP=$O(^IBE(356.6,"AC",2,0)) D I IBQUIT G ATQ
47 .;
48 .N DIR,IBSD,IBARRAY
49 .;get all possible scheduling data for patient
50 .K ^TMP($J,"SDAMA301")
51 .S IBARRAY(4)=DFN,IBARRAY("SORT")="P",IBARRAY("FLDS")="1;2;3;10;12",IBSD=$$SDAPI^SDAMA301(.IBARRAY)
52 .;
53 .S DIR("?")="Time is Required."
54 .S DIR("?",1)=" Enter the Outpatient Visit Date."
55 .S DIR("?",2)=" If no scheduled visit is found you will be given a warning. Enter"
56 .S DIR("?",3)=" '??' to get a list of scheduled visits between "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_"."
57 .I '$D(IBTASS) S DIR("?",4)=" Use the change date range action to change listing of scheduled Visits."
58 .S DIR("??")="^D LISTO^IBTRE20"
59 .S DIR(0)="DO^::AEXTP",DIR("A")="Outpatient Visit Date"
60 .D ^DIR K DIR S IBTDT=Y
61 .I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
62 .;
63 .; check scheduling and encounters file for entries
64 .S X=$D(^TMP($J,"SDAMA301",DFN,IBTDT))
65 .;
66 .I 'X,IBSD<0 W !!,*7,"WARNING: Unable to look up Visit information for this Patient" X "N IBX S IBX=0 F S IBX=$O(^TMP($J,""SDAMA301"",IBX)) W !?5,IBX,?10,$G(^(IBX))"
67 .;
68 .I 'X,IBSD S Y=$O(^TMP($J,"SDAMA301",DFN,$P(IBTDT,"."))) I $P(IBTDT,".")=$P(Y,".") S IBTDT=Y,X=1
69 .;
70 .; if non say so
71 .I 'X,IBSD'=-1 W !!,*7,"WARNING: No Visit information for this Patient for this date.",!
72 .;
73 .; ask if okay to add entry.
74 .S Y=IBTDT D D^DIQ S IBTDTE=Y
75 .S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Visit Date "_IBTDTE,DIR("B")="NO"
76 .D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
77 .D OPT^IBTUTL1(DFN,IBETYP,IBTDT,$P($G(^TMP($J,"SDAMA301",DFN,IBTDT)),"^",12))
78 .K ^TMP($J,"SDAMA301")
79 .Q
80 ;
81SCH I IBETYP=$O(^IBE(356.6,"AC",5,0)) D I IBQUIT G ATQ
82 .N DIR
83 .S DIR("?")=" "
84 .S DIR("?",1)=" Enter date of the scheduled admission."
85 .S DIR("?",2)=" If you use the scheduled admission package to schedule admissions"
86 .S DIR("?",3)=" you may enter '??' to get a list of scheduled admissions between"
87 .S DIR("?",4)=" "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_". Use the change date range action"
88 .S DIR("?",5)=" to change listing of scheduled admissions."
89 .S DIR("?",5)=" This should be a future scheduled admission."
90 .S DIR(0)="DO^::AEXT",DIR("A")="Scheduled Admission Date"
91 .S DIR("??")="^D LISTS^IBTRE20"
92 .D ^DIR K DIR S IBTDT=+Y
93 .I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
94 .; ask if okay to add entry.
95 .D FINDS^IBTRE20
96 .S Y=IBTDT D D^DIQ S IBTDTE=Y
97 .S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Scheduled Adm. Date "_IBTDTE,DIR("B")="NO"
98 .D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
99 .I IBTDT\1'>DT S VAINDT=IBTDT\1+.24 D INP^VADPT I $G(VAIN(1)) D Q
100 ..W !!,"Patient an inpatient on this date, using inpatient admission."
101 ..D ADM^IBTUTL(VAIN(1))
102 .D SCH^IBTUTL2(DFN,IBTDT)
103 .Q
104 I $G(IBQUIT) G ATQ
105 I $D(IBTASS) Q ; leave prematurely if from assign reason
106 ;
107 I $G(IBTRN) N IBTATRK S IBTATRK=1 D QE1^IBTRE1
108 ;
109 D BLD^IBTRE
110ATQ Q:$D(IBTASS)
111 I $G(IBQUIT) W !,"Nothing Added",! D PAUSE^VALM1
112 S VALMBCK="R"
113 Q
Note: See TracBrowser for help on using the repository browser.