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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1IBCORC3 ;ALB/CPM - RANK INSURANCE CARRIERS (NEW BULLETIN) ; 02-DEC-94
2 ;;2.0;INTEGRATED BILLING;**29,47,64,116**;21-MAR-94
3 ;
4BULL ; Generate a specially formatted bulletin for the MCCR Program Office.
5 ;
6 ; - first, invert the list by carrier to rank by number of claims
7 S (IBNR,IBINS)=0 F S IBINS=$O(^TMP("IBORIC",$J,"IC1",IBINS)) Q:'IBINS S ^TMP("IBORIC",$J,"NUM",-$G(^(IBINS)),IBINS)="",IBNR=IBNR+1
8 ;
9 S IBSITE=$P($$SITE^VASITE,"^",3),IBDAT=$$DAT1^IBOUTL(DT)
10 S XMSUB="PRQC IBINS: "_IBSITE_" Top "_IBNR_" Billed "_IBDAT
11 S XMDUZ="INTEGRATED BILLING PACKAGE"
12 K ^TMP($J,"IBORIC") S XMTEXT="^TMP($J,""IBORIC"","
13 S XMY(DUZ)=""
14 I $$PROD^IBCORC() S XMY(IBMAILTO)=""
15 ;
16 ; - set up report body
17 S IBCNT=0,IBNUM=""
18 F S IBNUM=$O(^TMP("IBORIC",$J,"NUM",IBNUM)) Q:IBNUM="" D
19 .S IBINS=0 F S IBINS=$O(^TMP("IBORIC",$J,"NUM",IBNUM,IBINS)) Q:'IBINS D
20 ..S IBCNT=IBCNT+1,IBAMT=+$G(^TMP("IBORIC",$J,"IC",IBINS))
21 ..S ^TMP($J,"IBORIC",IBCNT)=IBSITE_"^"_IBCNT_"^"_$$INS(IBINS)_"^"_$J(IBAMT,"",2)_"^"_-IBNUM_"^"_IBINS
22 ;
23 ; - deliver and quit
24 D ^XMD
25 K ^TMP($J,"IBORIC"),IBNUM
26 K IBAMT,IBCNT,IBC,IBDAT,IBINS,IBSITE,IBT,X,XMSUB,XMDUZ,XMY,XMTEXT,Y
27 Q
28 ;
29INS(IBCNS) ; Format Insurance Company name and address for bulletin.
30 ; Input: IBCNS -- pointer to the insurance company in file #36
31 N IBCNS0,X,Y
32 S IBINS0=$G(^DIC(36,IBCNS,0))
33 S Y=$S($P(IBINS0,"^")]"":$P(IBINS0,"^"),1:"CARRIER UNKNOWN") ; name
34 S Y=Y_"^"_$S($P(IBINS0,"^",5):0,1:1) ; 1-active, 0-inactive
35 S X=$G(^DIC(36,IBCNS,.11))
36 S Y=Y_"^"_$P(X,"^") ; address [line 1]
37 S Y=Y_"^"_$P(X,"^",2) ; address [line 2]
38 S Y=Y_"^"_$P(X,"^",4) ; city
39 S Y=Y_"^"_$P($G(^DIC(5,+$P(X,"^",5),0)),"^",2) ; state
40 S Y=Y_"^"_$P(X,"^",6) ; zip code
41 S X=$G(^DIC(36,IBCNS,.13))
42 S Y=Y_"^"_$P(X,"^") ; phone number
43 S Y=Y_"^"_$P(X,"^",2) ; billing phone number
44 Q Y
45 ;
46 ;
47IRM ; IRM Entry Point to queue a one-time (?) job for MCCR.
48 ;
49 I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,'$D(DUZ(0)):1,1:0) D G IRMQ
50 .W !!?3,"The variable DUZ must be set to an active user code and the variable"
51 .W !?3,"DUZ(0) must also be defined to run this routine."
52 ;
53 ; - set parameters, if not defined, as needed for the compilation
54 I '$D(IBABEG) S IBABEG=2971001
55 I '$D(IBAEND) S IBAEND=2981231
56 I '$D(IBNR) S IBNR=30
57 I '$D(IBMAILTO) S IBMAILTO="S.PRQC SERVER IBINS@ISC-ALBANY.VA.GOV"
58 S IBIRM=1
59 ;
60 W !!,"This job will compile a ranking of all your insurance carriers by the total"
61 W !,"number of claims billed from ",$$DAT1^IBOUTL(IBABEG)," to ",$$DAT1^IBOUTL(IBAEND),". The compilation will be"
62 W !,"uploaded into a mail message and sent to the MCCR National Database where"
63 W !,"it will be re-formatted in a PC-downloadable format and sent to the"
64 W !,"MCCR Program Office. This mail message will also be sent to you."
65 ;
66 ; - warn that the software is not being executed in Production
67 I '$$PROD^IBCORC() D
68 .W !!,*7," *** Please note ***"
69 .W !!?3,"You appear to be executing this routine in a test account."
70 .W !?3,"The mail message will only be sent to you."
71 ;
72 ; - okay to continue?
73 S DIR(0)="Y",DIR("A")="Do you want to queue this job now"
74 W ! D ^DIR K DIR I 'Y G IRMQ
75 ;
76 ; - queue the job up to be run
77 W !!,"Please enter the date and time to execute this job...",!
78 S ZTRTN="DQ^IBCORC1",ZTIO="",ZTDESC="IB - RANKING CARRIERS (FROM IRM)"
79 F I="IBABEG","IBAEND","IBNR","IBIRM","IBMAILTO" S ZTSAVE(I)=""
80 D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"")
81 ;
82IRMQ K IBABEG,IBAEND,IBMAILTO,IBNR,IBIRM,X,Y,DIRUT,DUOUT,DTOUR,DIROUT,I,ZTSK
83 Q
Note: See TracBrowser for help on using the repository browser.