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

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1IB20PT87 ;ALB/CPM - EXPORT ROUTINE 'DGRPDB' ; 14-FEB-94
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4DGRPDB ;ALB/AAS - VIEW ONLY SCREEN TO DETERMINE BILLING ELIGIBILITY ; 20 DEC 90 1:30 pm
5 ;;5.3;Registration;**26**;Aug 13, 1993
6 ;
7% S:'$D(DGQUIT) DGQUIT=0
8 G:DGQUIT END S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC G:+Y<1 END S DFN=+Y D EN
9 G %
10 ;
11EN ;entry with DFN defined.
12 Q:'$D(DFN) D HOME^%ZIS,2^VADPT,HDR
13 D MT,AOIR,ELIG,DIS
14 S C=$S($D(^DPT(DFN,.312,0)):$P(^(0),"^",4),1:0),C=C+6
15 D:($Y>(IOSL-C)) PAUSE,HDR:'DGQUIT Q:DGQUIT D INS,PAUSE
16 Q
17 ;
18ELIG ;eligibility code(s)
19 W !!," Primary Elig. Code: ",$P(VAEL(1),"^",2)," -- ",$S(VAEL(8)']"":"NOT VERIFIED",1:$P(VAEL(8),"^",2))
20 I VAEL(8)]"" S Y=$S($D(^DPT(DFN,.361)):$P(^(.361),"^",2),1:"") W " " D DT^DIQ
21 W !,"Other Elig. Code(s): " I $D(VAEL(1))>9 S I1=0 F I=0:0 S I=$O(VAEL(1,I)) Q:'I S I1=I1+1 W:I1>1 !?21 W $P(VAEL(1,I),"^",2)
22 E W "NO ADDITIONAL ELIGIBILITIES IDENTIFIED"
23 Q
24 ;
25DIS ;rated disabilities
26 ;
27 ; This is called from the FEE and MCCR package!!!
28 ;
29 ; Input: DFN as IEN of PATIENT file
30 ; VAEL array (if no passed, it is set) of eligibility info
31 ;
32 I '$D(VAEL) D ELIG^VADPT S DGKVAR=1
33 W:'+VAEL(3) !!," Service Connected: NO" W:+VAEL(3) !!," SC Percent: ",$P(VAEL(3),"^",2)_"%"
34 W !," Rated Disabilities: " I 'VAEL(4),$S('$D(^DG(391,+VAEL(6),0)):1,$P(^(0),"^",2):0,1:1) W "NOT A VETERAN" G DISQ
35 S I3=0 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I S I1=^(I,0),I2=$S($D(^DIC(31,+I1,0)):$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",$P(I1,"^",3)']"":"not specified",1:"NSC")_")",1:""),I3=I3+1 W:I3>1 !?21 W I2
36 W:'I3 "NONE STATED"
37DISQ I $D(DGKVAR) D KVAR^VADPT K DGKVAR
38 K I,I1,I2,I3
39 Q
40 ;
41INS ;insurance information
42 ;
43 ; This is called form the FEE package!!!
44 ;
45 ; Input: DFN as IEN of PATIENT file
46 ;
47 Q:'$D(DFN)
48 W !!," Health Insurance: " S Z=$S($D(^DPT(DFN,.31)):$P(^(.31),"^",11),1:"") W $S(Z="Y":"YES",Z="N":"NO",Z="U":"UNKNOWN",1:"NOT ANSWERED")
49 D DISP^IBCNSP2
50INSQ K I,I1,DGX,Z
51 Q
52 ;
53IN W !?3,$S($D(^DIC(36,+$P(DGX,"^",1),0)):$E($P(^(0),"^",1),1,25),1:"UNKNOWN"),?30,$S($P(DGX,"^",2)]"":$P(DGX,"^",2),1:"UNKNOWN"),?52,$S($P(DGX,"^",3)]"":$P(DGX,"^",3),1:"UNKNOWN")
54 W ?71,$S($P(DGX,"^",6)="v":"APPLICANT",$P(DGX,"^",6)="s":"SPOUSE",$P(DGX,"^",6)="o":"OTHER",1:"UNKNOWN")
55 Q
56 ;
57AOIR ;Agent Orange/ionizing radiation
58 S DGX=$S($D(^DPT(DFN,.321)):^(.321),1:"")
59 F I=2,3 S X=$P(DGX,"^",I) W:I=2 !," A/O Exp.: " W:I=3 "ION Rad.: " W $S(X="Y":"YES",X="N":"NO",X="U":"UNKNOWN",1:"NOT ANSWERED")," "
60 S X=$G(^DPT(DFN,.38)),X1=$P(X,"^",1) W "Medicaid Elig: ",$S(X1="":"NOT ANSWERED",'X1:"NO",1:"YES") I ($X+15)'>IOM W " - " S Y=$P(X,"^",2) D D^DIQ W $P(Y,"@")
61 Q
62 ;
63PAUSE F J=1:1 Q:($Y>(IOSL-3)) W !
64 S DGX1="" I $E(IOST,1,2)["C-" N DIR S DIR(0)="E" D ^DIR S DGQUIT='Y
65 Q
66 ;
67HDR ;Screen Header
68 W @IOF I $P(VAEL(6),"^",2)]"" S DGTYPE=$P(VAEL(6),"^",2)
69 W $P(VADM(1),"^",1),?32,VA("PID"),?47,$P(VADM(3),"^",2) S X=$S($D(DGTYPE):$P(DGTYPE,"^",1),1:"PATIENT TYPE UNKNOWN"),X1=79-$L(X) W ?X1,X
70 S X="",$P(X,"=",80)="" W !,X Q
71 Q
72 ;
73MT I '$O(^DGMT(408.31,"AD",1,DFN,0)) W !," Means Test Status: NOT IN MEANS TEST FILE" Q
74 D DIS^DGMTU(DFN)
75 Q
76 ;
77END D KVAR^VADPT
78 K A,C,I,I1,I2,I3,J,DIC,DIR,DFN,DGA1,DGMT,DGMTL,DGMTLA,DGX,DGX1,DGT,DGTYPE,DGQUIT,DGMTLL,X,X1,VAROOT,VA,Y,Z
79 Q
Note: See TracBrowser for help on using the repository browser.