IBCORC3 ;ALB/CPM - RANK INSURANCE CARRIERS (NEW BULLETIN) ; 02-DEC-94
;;2.0;INTEGRATED BILLING;**29,47,64,116**;21-MAR-94
;
BULL ; Generate a specially formatted bulletin for the MCCR Program Office.
;
; - first, invert the list by carrier to rank by number of claims
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
;
S IBSITE=$P($$SITE^VASITE,"^",3),IBDAT=$$DAT1^IBOUTL(DT)
S XMSUB="PRQC IBINS: "_IBSITE_" Top "_IBNR_" Billed "_IBDAT
S XMDUZ="INTEGRATED BILLING PACKAGE"
K ^TMP($J,"IBORIC") S XMTEXT="^TMP($J,""IBORIC"","
S XMY(DUZ)=""
I $$PROD^IBCORC() S XMY(IBMAILTO)=""
;
; - set up report body
S IBCNT=0,IBNUM=""
F S IBNUM=$O(^TMP("IBORIC",$J,"NUM",IBNUM)) Q:IBNUM="" D
.S IBINS=0 F S IBINS=$O(^TMP("IBORIC",$J,"NUM",IBNUM,IBINS)) Q:'IBINS D
..S IBCNT=IBCNT+1,IBAMT=+$G(^TMP("IBORIC",$J,"IC",IBINS))
..S ^TMP($J,"IBORIC",IBCNT)=IBSITE_"^"_IBCNT_"^"_$$INS(IBINS)_"^"_$J(IBAMT,"",2)_"^"_-IBNUM_"^"_IBINS
;
; - deliver and quit
D ^XMD
K ^TMP($J,"IBORIC"),IBNUM
K IBAMT,IBCNT,IBC,IBDAT,IBINS,IBSITE,IBT,X,XMSUB,XMDUZ,XMY,XMTEXT,Y
Q
;
INS(IBCNS) ; Format Insurance Company name and address for bulletin.
; Input: IBCNS -- pointer to the insurance company in file #36
N IBCNS0,X,Y
S IBINS0=$G(^DIC(36,IBCNS,0))
S Y=$S($P(IBINS0,"^")]"":$P(IBINS0,"^"),1:"CARRIER UNKNOWN") ; name
S Y=Y_"^"_$S($P(IBINS0,"^",5):0,1:1) ; 1-active, 0-inactive
S X=$G(^DIC(36,IBCNS,.11))
S Y=Y_"^"_$P(X,"^") ; address [line 1]
S Y=Y_"^"_$P(X,"^",2) ; address [line 2]
S Y=Y_"^"_$P(X,"^",4) ; city
S Y=Y_"^"_$P($G(^DIC(5,+$P(X,"^",5),0)),"^",2) ; state
S Y=Y_"^"_$P(X,"^",6) ; zip code
S X=$G(^DIC(36,IBCNS,.13))
S Y=Y_"^"_$P(X,"^") ; phone number
S Y=Y_"^"_$P(X,"^",2) ; billing phone number
Q Y
;
;
IRM ; IRM Entry Point to queue a one-time (?) job for MCCR.
;
I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,'$D(DUZ(0)):1,1:0) D G IRMQ
.W !!?3,"The variable DUZ must be set to an active user code and the variable"
.W !?3,"DUZ(0) must also be defined to run this routine."
;
; - set parameters, if not defined, as needed for the compilation
I '$D(IBABEG) S IBABEG=2971001
I '$D(IBAEND) S IBAEND=2981231
I '$D(IBNR) S IBNR=30
I '$D(IBMAILTO) S IBMAILTO="S.PRQC SERVER IBINS@ISC-ALBANY.DOMAIN.EXT"
S IBIRM=1
;
W !!,"This job will compile a ranking of all your insurance carriers by the total"
W !,"number of claims billed from ",$$DAT1^IBOUTL(IBABEG)," to ",$$DAT1^IBOUTL(IBAEND),". The compilation will be"
W !,"uploaded into a mail message and sent to the MCCR National Database where"
W !,"it will be re-formatted in a PC-downloadable format and sent to the"
W !,"MCCR Program Office. This mail message will also be sent to you."
;
; - warn that the software is not being executed in Production
I '$$PROD^IBCORC() D
.W !!,*7," *** Please note ***"
.W !!?3,"You appear to be executing this routine in a test account."
.W !?3,"The mail message will only be sent to you."
;
; - okay to continue?
S DIR(0)="Y",DIR("A")="Do you want to queue this job now"
W ! D ^DIR K DIR I 'Y G IRMQ
;
; - queue the job up to be run
W !!,"Please enter the date and time to execute this job...",!
S ZTRTN="DQ^IBCORC1",ZTIO="",ZTDESC="IB - RANKING CARRIERS (FROM IRM)"
F I="IBABEG","IBAEND","IBNR","IBIRM","IBMAILTO" S ZTSAVE(I)=""
D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"")
;
IRMQ K IBABEG,IBAEND,IBMAILTO,IBNR,IBIRM,X,Y,DIRUT,DUOUT,DTOUR,DIROUT,I,ZTSK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCORC3 3791 printed Oct 16, 2024@18:19:22 Page 2
IBCORC3 ;ALB/CPM - RANK INSURANCE CARRIERS (NEW BULLETIN) ; 02-DEC-94
+1 ;;2.0;INTEGRATED BILLING;**29,47,64,116**;21-MAR-94
+2 ;
BULL ; Generate a specially formatted bulletin for the MCCR Program Office.
+1 ;
+2 ; - first, invert the list by carrier to rank by number of claims
+3 SET (IBNR,IBINS)=0
FOR
SET IBINS=$ORDER(^TMP("IBORIC",$JOB,"IC1",IBINS))
if 'IBINS
QUIT
SET ^TMP("IBORIC",$JOB,"NUM",-$GET(^(IBINS)),IBINS)=""
SET IBNR=IBNR+1
+4 ;
+5 SET IBSITE=$PIECE($$SITE^VASITE,"^",3)
SET IBDAT=$$DAT1^IBOUTL(DT)
+6 SET XMSUB="PRQC IBINS: "_IBSITE_" Top "_IBNR_" Billed "_IBDAT
+7 SET XMDUZ="INTEGRATED BILLING PACKAGE"
+8 KILL ^TMP($JOB,"IBORIC")
SET XMTEXT="^TMP($J,""IBORIC"","
+9 SET XMY(DUZ)=""
+10 IF $$PROD^IBCORC()
SET XMY(IBMAILTO)=""
+11 ;
+12 ; - set up report body
+13 SET IBCNT=0
SET IBNUM=""
+14 FOR
SET IBNUM=$ORDER(^TMP("IBORIC",$JOB,"NUM",IBNUM))
if IBNUM=""
QUIT
Begin DoDot:1
+15 SET IBINS=0
FOR
SET IBINS=$ORDER(^TMP("IBORIC",$JOB,"NUM",IBNUM,IBINS))
if 'IBINS
QUIT
Begin DoDot:2
+16 SET IBCNT=IBCNT+1
SET IBAMT=+$GET(^TMP("IBORIC",$JOB,"IC",IBINS))
+17 SET ^TMP($JOB,"IBORIC",IBCNT)=IBSITE_"^"_IBCNT_"^"_$$INS(IBINS)_"^"_$JUSTIFY(IBAMT,"",2)_"^"_-IBNUM_"^"_IBINS
End DoDot:2
End DoDot:1
+18 ;
+19 ; - deliver and quit
+20 DO ^XMD
+21 KILL ^TMP($JOB,"IBORIC"),IBNUM
+22 KILL IBAMT,IBCNT,IBC,IBDAT,IBINS,IBSITE,IBT,X,XMSUB,XMDUZ,XMY,XMTEXT,Y
+23 QUIT
+24 ;
INS(IBCNS) ; Format Insurance Company name and address for bulletin.
+1 ; Input: IBCNS -- pointer to the insurance company in file #36
+2 NEW IBCNS0,X,Y
+3 SET IBINS0=$GET(^DIC(36,IBCNS,0))
+4 ; name
SET Y=$SELECT($PIECE(IBINS0,"^")]"":$PIECE(IBINS0,"^"),1:"CARRIER UNKNOWN")
+5 ; 1-active, 0-inactive
SET Y=Y_"^"_$SELECT($PIECE(IBINS0,"^",5):0,1:1)
+6 SET X=$GET(^DIC(36,IBCNS,.11))
+7 ; address [line 1]
SET Y=Y_"^"_$PIECE(X,"^")
+8 ; address [line 2]
SET Y=Y_"^"_$PIECE(X,"^",2)
+9 ; city
SET Y=Y_"^"_$PIECE(X,"^",4)
+10 ; state
SET Y=Y_"^"_$PIECE($GET(^DIC(5,+$PIECE(X,"^",5),0)),"^",2)
+11 ; zip code
SET Y=Y_"^"_$PIECE(X,"^",6)
+12 SET X=$GET(^DIC(36,IBCNS,.13))
+13 ; phone number
SET Y=Y_"^"_$PIECE(X,"^")
+14 ; billing phone number
SET Y=Y_"^"_$PIECE(X,"^",2)
+15 QUIT Y
+16 ;
+17 ;
IRM ; IRM Entry Point to queue a one-time (?) job for MCCR.
+1 ;
+2 IF $SELECT('($DATA(DUZ)#2):1,'$DATA(^VA(200,+DUZ,0)):1,'$DATA(DUZ(0)):1,1:0)
Begin DoDot:1
+3 WRITE !!?3,"The variable DUZ must be set to an active user code and the variable"
+4 WRITE !?3,"DUZ(0) must also be defined to run this routine."
End DoDot:1
GOTO IRMQ
+5 ;
+6 ; - set parameters, if not defined, as needed for the compilation
+7 IF '$DATA(IBABEG)
SET IBABEG=2971001
+8 IF '$DATA(IBAEND)
SET IBAEND=2981231
+9 IF '$DATA(IBNR)
SET IBNR=30
+10 IF '$DATA(IBMAILTO)
SET IBMAILTO="S.PRQC SERVER IBINS@ISC-ALBANY.DOMAIN.EXT"
+11 SET IBIRM=1
+12 ;
+13 WRITE !!,"This job will compile a ranking of all your insurance carriers by the total"
+14 WRITE !,"number of claims billed from ",$$DAT1^IBOUTL(IBABEG)," to ",$$DAT1^IBOUTL(IBAEND),". The compilation will be"
+15 WRITE !,"uploaded into a mail message and sent to the MCCR National Database where"
+16 WRITE !,"it will be re-formatted in a PC-downloadable format and sent to the"
+17 WRITE !,"MCCR Program Office. This mail message will also be sent to you."
+18 ;
+19 ; - warn that the software is not being executed in Production
+20 IF '$$PROD^IBCORC()
Begin DoDot:1
+21 WRITE !!,*7," *** Please note ***"
+22 WRITE !!?3,"You appear to be executing this routine in a test account."
+23 WRITE !?3,"The mail message will only be sent to you."
End DoDot:1
+24 ;
+25 ; - okay to continue?
+26 SET DIR(0)="Y"
SET DIR("A")="Do you want to queue this job now"
+27 WRITE !
DO ^DIR
KILL DIR
IF 'Y
GOTO IRMQ
+28 ;
+29 ; - queue the job up to be run
+30 WRITE !!,"Please enter the date and time to execute this job...",!
+31 SET ZTRTN="DQ^IBCORC1"
SET ZTIO=""
SET ZTDESC="IB - RANKING CARRIERS (FROM IRM)"
+32 FOR I="IBABEG","IBAEND","IBNR","IBIRM","IBMAILTO"
SET ZTSAVE(I)=""
+33 DO ^%ZTLOAD
WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"")
+34 ;
IRMQ KILL IBABEG,IBAEND,IBMAILTO,IBNR,IBIRM,X,Y,DIRUT,DUOUT,DTOUR,DIROUT,I,ZTSK
+1 QUIT
