IBCORC3.m

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 ---IBCORC3   3791     printed  Feb 18, 2025@23:45:06                                                                                                                                                                                                     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