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

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1IBJDF8I1 ;ALB/RRG-ADD/EDIT IB DM WORKLOAD PARAMETERS-(CONT.) ;11/06/00
2 ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EDIT ; - Edit existing assignments
6 ;
7 N IBASDA0,IBASNNUM W !
8 S DIR("A")="Choose a valid Assignment Number to edit: "
9 S DIR(0)="LA^1:"_(IBNEWASN-1)_"^K:'$D(IBAS(X)) X"
10 S DIR("?")="Must be a valid assignment listed above..."
11 D ^DIR K IBAS I ($D(DTOUT))!($D(DUOUT))!(Y'>0) S IBQUIT=1 L -^IBE(351.73,IBCL) Q
12 S IBASNNUM=X K DIR,DIROUT,DTOUT,DUOUT,Y
13 I '$D(^IBE(351.73,IBCL,1,IBASNNUM)) G EDIT
14 S IBASDA0=$G(^IBE(351.73,IBCL,1,IBASNNUM,0)),IBBCAT=$P(IBASDA0,"^",2)
15 W !?3,"Bill Category for assignment # "_IBASNNUM_" is "_$P(^PRCA(430.2,IBBCAT,0),"^",1)
16 S IBFOTP=$$CATTYP^IBJD1(IBBCAT)
17 ;
18EDIT1 ; - Add/Edit assignment parameters
19 ;
20 N IBMINBAL,IBRCFLG
21 S DIR(0)="351.731,.03",DA(1)=IBCL,DA=IBASNNUM
22 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 L -^IBE(351.73,IBCL) Q
23 S IBMINBAL=Y K DIR,DIROUT,DTOUT,DUOUT,Y
24 S IBRCFLG=$P($G(^IBE(351.73,IBCL,1,IBASNNUM,0)),"^",5)
25 S DIR(0)="Y",DIR("B")=$S(IBRCFLG=0:"NO",1:"YES")
26 S DIR("A")="EXCLUDE RECEIVABLES REFERRED TO RC"
27 S DIR("?")="^S IBOFF=67 D HELP^IBJDF8H"
28 D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 L -^IBE(351.73,IBCL) Q
29 S IBRCFLG=Y K DIR,DIROUT,DTOUT,DUOUT,Y
30 S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
31 S DR=".03///"_IBMINBAL_";.05///"_IBRCFLG D ^DIE K DIE,DR,DA
32 I IBFOTP="F" D FPEDIT I IBQUIT L -^IBE(351.73,IBCL) Q
33 I IBFOTP="T" D TPEDIT I IBQUIT L -^IBE(351.73,IBCL) Q
34 Q
35 ;
36FPEDIT ; - First Party edit questions
37 ;
38 N IBFPDATA,IBSDEF,IBTDEF,IBSN,IBDSLP,IBDEF
39 S IBFPDATA=$G(^IBE(351.73,IBCL,1,IBASNNUM,1)),IBDSLP=$P(IBFPDATA,"^",1)
40 S IBDEF=$S(IBDSLP'="":IBDSLP,1:45),DA(1)=IBCL
41 S DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM,DR="1.01//^S X=IBDEF"
42 D ^DIE K DIE,DA,DR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
43 ;
44 ; - Determine range of patient by name or last 4 of SSN
45 ;
46 S IBSN=$$SNL() I (IBSN="")!(IBSN="^") S IBQUIT=1 Q
47 ;
48 I IBSN="N" S IBSDEF=$P(IBFPDATA,"^",2),IBTDEF=$P(IBFPDATA,"^",3)
49 I IBSN="L" S IBSDEF=$P(IBFPDATA,"^",4),IBTDEF=$P(IBFPDATA,"^",5)
50 ;
51PAT S DIR(0)="FO",DIR("A")="START WITH "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
52 S DIR("B")=$S(IBSDEF="":"FIRST",1:IBSDEF)
53 S DIR("?")="^S IBOFF=33 D HELP^IBJDF8H"
54 D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
55 S IBSNF=X I X="FIRST" S IBSNF="@"
56 S DIR(0)="FO",DIR("A")="GO TO "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
57 S DIR("B")=$S(IBTDEF="":"LAST",1:IBTDEF)
58 S DIR("?")="^S IBOFF=40 D HELP^IBJDF8H"
59 D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
60 S IBSNL=X I X="LAST" S IBSNL="@"
61 I (IBSNL'="@")&($G(IBSNL)']$G(IBSNF))&($G(IBSNL)'=$G(IBSNF))&(IBSNF'="@") W !!,?3,"* The Go To Patient Name/SSN must follow after the Start With Name/SSN. *",! G PAT
62 S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
63 I IBSN="N" S DR="1.02///"_IBSNF_";1.03///"_IBSNL_";1.04///@;1.05///@" D ^DIE
64 I IBSN="L" S DR="1.04///"_IBSNF_";1.05///"_IBSNL_";1.02///@;1.03///@" D ^DIE
65 K DIE,DA,DR
66 L -^IBE(351.73,IBCL)
67 Q
68 ;
69TPEDIT ; - Third Party edit questions
70 ;
71 N IBTPDATA,IBDSLT,IBDEF
72 S IBTPDATA=$G(^IBE(351.73,IBCL,1,IBASNNUM,2)),IBDSLT=$P(IBTPDATA,"^",1)
73 S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
74 S IBDEF=$S(IBDSLT'="":IBDSLT,1:45),DR="2.01//^S X=IBDEF"
75 D ^DIE K DIE,DA,DR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
76 ;
77TYP ; - Select type of receivables to print
78 S DIR("A")="TYPE OF RECEIVABLE: "
79 I $P(IBTPDATA,"^",8) S DIR("B")=$P(IBTPDATA,"^",8)
80 S DIR(0)="SAX^1:INPATIENT;2:OUTPATIENT;3:PROSTHETICS;4:PHARMACY REFILL;5:ALL RECEIVABLES"
81 D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
82 S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM,DR="2.08///"_Y
83 D ^DIE K DIE,DR,DA
84 K DIROUT,DTOUT,DUOUT,Y
85 ;
86 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,IBRF,IBRL,IBSDEF,IBTDEF
87ICR S IBSDEF=$P(IBTPDATA,"^",2),IBTDEF=$P(IBTPDATA,"^",3)
88 S DIR(0)="FO",DIR("A")="START WITH INSURANCE CARRIER"
89 S DIR("B")=$S(IBSDEF="":"FIRST",1:IBSDEF)
90 S DIR("?")="^S IBOFF=47 D HELP^IBJDF8H"
91 D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
92 S IBRF=X I X="FIRST" S IBRF="@"
93 S DIR(0)="FO",DIR("A")="GO TO INSURANCE CARRIER"
94 S DIR("B")=$S(IBTDEF="":"LAST",1:IBTDEF)
95 S DIR("?")="^S IBOFF=54 D HELP^IBJDF8H"
96 D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
97 S IBRL=X I X="LAST" S IBRL="@"
98 I ($G(IBRL)']$G(IBRF))&($G(IBRL)'=$G(IBRF))&(IBRL'="@") W !!,?3,"* The Go to Insurance Carrier Name must follow after the Start with Insurance Carrier. *",! G ICR
99 S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
100 S DR="2.02///"_IBRF_";2.03///"_IBRL D ^DIE K DIE,DR,DA
101 ;
102NAM ; - Determine range of patients
103 ;
104 ; - Determine range of patient by name or last 4 of SSN
105 ;
106 S IBSN=$$SNL() I (IBSN="")!(IBSN="^") S IBQUIT=1 Q
107 ;
108 I IBSN="N" S IBSDEF=$P(IBTPDATA,"^",4),IBTDEF=$P(IBTPDATA,"^",5)
109 I IBSN="L" S IBSDEF=$P(IBTPDATA,"^",6),IBTDEF=$P(IBTPDATA,"^",7)
110 ;
111NAM1 S DIR(0)="FO",DIR("A")="START WITH "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
112 S DIR("B")=$S(IBSDEF="":"FIRST",1:IBSDEF)
113 S DIR("?")="^S IBOFF=33 D HELP^IBJDF8H"
114 D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
115 S IBSNF=X I X="FIRST" S IBSNF="@"
116 S DIR(0)="FO",DIR("A")="GO TO "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
117 S DIR("B")=$S(IBTDEF="":"LAST",1:IBTDEF)
118 S DIR("?")="^S IBOFF=40 D HELP^IBJDF8H"
119 D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
120 S IBSNL=X I X="LAST" S IBSNL="@"
121 I (IBSNL'="@")&($G(IBSNL)']$G(IBSNF))&($G(IBSNL)'=$G(IBSNF))&(IBSNF'="@") W !!,?3,"* The Go To Patient Name/SSN must follow after the Start With Name/SSN. *",! G NAM1
122 S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
123 I IBSN="N" S DR="2.04///"_IBSNF_";2.05///"_IBSNL_";2.06///@;2.07///@" D ^DIE
124 I IBSN="L" S DR="2.06///"_IBSNF_";2.07///"_IBSNL_";2.04///@;2.05///@" D ^DIE
125 K DIE,DA,DR
126 ;
127 L -^IBE(351.73,IBCL)
128 Q
129 ;
130SNL() ; - Determine the patient data to be stored-either by Name or
131 ; last 4 SSN
132 N DIR,DIRUT,DTOUT,DUOUT,DIROUT,IBSN,IBDEF,IBWLDAT
133 I IBFOTP="F" S IBWLDAT=$G(^IBE(351.73,IBCL,1,IBASNNUM,1)) D
134 . S IBDEF=$S($P(IBWLDAT,"^",2)'="":"NAME",$P(IBWLDAT,"^",3)'="":"NAME",$P(IBWLDAT,"^",4)'="":"LAST 4",$P(IBWLDAT,"^",5)'="":"LAST 4",1:"")
135 I IBFOTP="T" S IBWLDAT=$G(^IBE(351.73,IBCL,1,IBASNNUM,2)) D
136 . S IBDEF=$S($P(IBWLDAT,"^",4)'="":"NAME",$P(IBWLDAT,"^",5)'="":"NAME",$P(IBWLDAT,"^",6)'="":"LAST 4",$P(IBWLDAT,"^",7)'="":"LAST 4",1:"")
137 S IBSN=""
138 S DIR(0)="SA^N:NAME;L:LAST 4"
139 S DIR("A")="Sort Patients by (N)ame or (L)ast 4 of the SSN: "
140 I IBDEF'="" S DIR("B")=IBDEF
141 S DIR("?")="^D HNL^IBJD"
142 W ! D ^DIR K DIR I Y=""!(X="^") Q "^"
143 S IBSN=Y
144 Q IBSN
145 ;
Note: See TracBrowser for help on using the repository browser.