source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCOPP2.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: 4.3 KB
Line 
1IBCOPP2 ;ALB/NLR - LIST INS. PLANS BY CO. (COMPILE) ; 06-SEP-94
2V ;;2.0;INTEGRATED BILLING;**28,62,93**;21-MAR-94
3 ;
4EN ; Queued Entry Point for Report.
5 ; Required variable input: IBAI, IBAPL, IBAPA
6 ; ^TMP("IBINC",$J) required if all companies and plans not selected
7 ;
8 ; - compile report data
9 S IBI=0 K ^TMP($J,"PR"),^TMP($J,"PL")
10 ;
11 ; - user wanted all companies and plans
12 I IBAI,IBAPL D G PRINT
13 .S IBIC1="" F S IBIC1=$O(^DIC(36,"B",IBIC1)) Q:IBIC1="" D
14 ..S IBCNS=0 F S IBCNS=$O(^DIC(36,"B",IBIC1,IBCNS)) Q:'IBCNS I $D(^IBA(355.3,"B",IBCNS)) S IBIC=IBIC1 D GATH
15 ;
16 ; - user selected companies or plans
17 S IBIC="" F S IBIC=$O(^TMP("IBINC",$J,IBIC)) Q:IBIC="" D
18 .S IBCNS=0 F S IBCNS=$O(^TMP("IBINC",$J,IBIC,IBCNS)) Q:'IBCNS D GATH
19 ;
20PRINT ; - print report
21 D ^IBCOPP3
22 K ^TMP($J,"PR"),^TMP("IBINC",$J)
23 ;
24 I $D(ZTQUEUED) S ZTREQ="@" Q
25 D ^%ZISC
26 K IBI,IBIC,IBIC1,IBCNS,IBCPT,IBCPS,IBCST,IBCSS
27 Q
28 ;
29 ;
30GATH ; Gather all data for a company.
31 S IBI=IBI+1,(IBCPT,IBCPS,IBCST,IBCSS)=0 ; initialize counters
32 D COMP ; gather company info
33 D PLAN ; gather plan info
34 ;
35 ; - set final company info
36 S ^TMP($J,"PR",IBI)=$$COMPINF(IBCNS)_"^"_IBCPT_"^"_IBCST_"^"_IBCPS_"^"_IBCSS
37 K ^TMP($J,"PL")
38 Q
39 ;
40 ;
41COMP ; Gather Company counts and subscription information, if necessary
42 ; Input: IBCNS -- Pointer to the insurance company in file #36
43 ; initialized counters, plus the 'Plan' array (^TMP("IBINC",$J))
44 ;
45 S DFN=0 F S DFN=$O(^DPT("AB",IBCNS,DFN)) Q:'DFN D
46 .S IBCDFN=0 F S IBCDFN=$O(^DPT("AB",IBCNS,DFN,IBCDFN)) Q:'IBCDFN D
47 ..;
48 ..; - set company subscriber count; plan subscriber counts if necessary
49 ..S IBIND=$G(^DPT(DFN,.312,+IBCDFN,0)) Q:+IBIND'=IBCNS
50 ..S IBPTR=+$P(IBIND,"^",18)
51 ..S IBCST=IBCST+1
52 ..I 'IBAPL,'$D(^TMP("IBINC",$J,IBIC,IBCNS,IBPTR)) Q ; not a selected plan
53 ..S IBCSS=IBCSS+1,^(IBPTR)=$G(^TMP($J,"PL",IBPTR))+1
54 ..Q:'IBAPA ; policy information not selected
55 ..;
56 ..; - gather demographic/policy information
57 ..S X=$$PT^IBEFUNC(DFN)
58 ..S IBNAM=$E($S($P(X,"^")]"":$P(X,"^"),1:"<Pt. "_DFN_" Name Missing>")_$J("",25),1,25)_" ("_$E(X)_$P(X,"^",3)_")"
59 ..S IBDOB=$$DAT3^IBOUTL($P($G(^DPT(DFN,0)),"^",3))
60 ..S IBWI=$P(IBIND,"^",6),IBWI=$S(IBWI="v":"VET",IBWI="s":"SPO",IBWI="o":"OTH",1:"<UNK>")
61 ..S VAOA("A")=$S(IBWI="SPO":6,1:5) D OAD^VADPT
62 ..;
63 ..; - build detail line
64 ..S IBX=IBNAM_U_IBDOB_U_$E(VAOA(9),1,18)_U_$S($P(IBIND,"^",2)]"":$E($P(IBIND,"^",2),1,17),1:"<NO SUBS ID>")
65 ..S IBX=IBX_U_IBWI_U_$$DAT1^IBOUTL($P(IBIND,"^",8))_U_$$DAT1^IBOUTL($P(IBIND,"^",4))
66 ..S X=0,Y="" F S Y=$O(^IBA(355.5,"APPY",DFN,IBPTR,Y)) Q:Y="" I $O(^(Y,0))=IBCDFN S X=1 Q
67 ..S ^TMP($J,"PR",IBI,IBPTR,IBNAM_"@@"_DFN_"@@"_IBCDFN)=IBX_"^"_X
68 ;
69 K DFN,IBCDFN,IBIND,IBPTR,IBNAM,IBDOB,IBWI,IBX,X,VAOA,VA,VAERR,Y
70 Q
71 ;
72PLAN ; Gather Insurance Plan information, if necessary
73 ; Input: IBCNS -- Pointer to the insurance company in file #36
74 ; initialized counters, plus the 'Plan' array (^TMP("IBINC",$J))
75 ;
76 S IBPTR=0 F S IBPTR=$O(^IBA(355.3,"B",IBCNS,IBPTR)) Q:'IBPTR D
77 .S IBCPT=IBCPT+1
78 .I 'IBAPL,'$D(^TMP("IBINC",$J,IBIC,IBCNS,IBPTR)) Q ; not a selected plan
79 .S IBCPS=IBCPS+1
80 .S ^TMP($J,"PR",IBI,IBPTR)=$$PLANINF(IBPTR)_"^"_+$G(^TMP($J,"PL",IBPTR))
81 K IBPTR
82 Q
83 ;
84PLANINF(PLAN) ; Return formatted Insurance Plan information.
85 ; Input: PLAN -- Pointer to the plan in file #355.3
86 ; Output: plan number ^ name ^ grp/ind ^ act/inact
87 ;
88 N ACT,NAME,NUM,TY,X
89 S X=$G(^IBA(355.3,PLAN,0))
90 S TY=$S($P(X,"^",2):"GRP",1:"IND")
91 S NAME=$P(X,"^",3) S:NAME="" NAME="<NO GROUP NAME>"
92 S NUM=$P(X,"^",4) S:NUM="" NUM="<NO GROUP NUMBER>"
93 S ACT=$S($P(X,"^",11):"IN",1:"")_"ACTIVE"
94 Q NUM_"^"_NAME_"^"_TY_"^"_ACT_"^"_$S($D(^IBA(355.4,"APY",PLAN))>0:"YES",1:"NO")_"^"_$S($D(^IBA(355.5,"B",PLAN))>0:"YES",1:"NO")
95 ;
96COMPINF(IBCNS) ; Return formatted Insurance Company information
97 ; Input: IBCNS -- Pointer to the insurance company in file #36
98 ; Output: company name ^ addr ^ city/st/zip ^ phone ^ precert ^ act?
99 ;
100 N ST,X,X0,X11,X13,Z
101 S X0=$G(^DIC(36,IBCNS,0)),X11=$G(^(.11)),X13=$G(^(.13)),Z=$P(X11,"^",6)
102 S ST=$S($P(X11,"^",5):$P($G(^DIC(5,$P(X11,"^",5),0)),"^",2),1:"<STATE MISSING>")
103 S X="Ins. Co.: "_$E($P(X0,"^"),1,25)
104 S X=X_U_$S($P(X11,"^")'="":$P(X11,"^"),1:"<Street Addr. 1 Missing>")
105 S X=X_U_$P(X11,"^",4)_", "_ST_" "_$E(Z,1,5)_$S($E(Z,6,9)]"":"-"_$E(Z,6,9),1:"")
106 S X=X_U_"Phone: "_$P(X13,"^")_U_"Precert Phone: "_$P(X13,"^",3)
107 Q X_U_$S($P(X0,"^",5):"IN",1:"")_"ACTIVE COMPANY"
Note: See TracBrowser for help on using the repository browser.