IBCNSMR1 ;ALB/AAS - MEDICARE BILLS ; 9-SEP-97
 ;;2.0;INTEGRATED BILLING;**92,103**;21-MAR-94
 ;
% G RPRT^IBCNSMRA
 ;
BULL ; -- send bulletin
 N CNT1,I,J,X,Y,IBSITE,IBT,IBGRP,XMDUZ,XMN,XMTEXT,XMY,XMSUB,XMZ,XCNP
 K ^TMP($J,"IBT")
 ;
 S IBT="^TMP($J,""IBT"")"
 S IBSITE=$P($$SITE^VASITE,"^",2,3)
 S XMSUB="IB MRA ANALYSIS REPORT FOR "_$TR(IBSITE,"^","-")
 S @IBT@(1)="ACTIVITY     := $$MRA-ANALYSIS$$"
 S @IBT@(2)="SITE         := $$"_IBSITE_"$$"
 S @IBT@(3)="SUMMARY DATA := "
 S @IBT@(4)="$$0$$:"_+$G(CNT)_U_+$G(CNT(0))_U_+$G(CNT(1))_U_+$G(CNT(2))_U_+$G(CNT("OP"))_U_+$G(CNT("OP",0))_U_+$G(CNT("OP",1))_U_+$G(CNT("OP",2))_U_+$G(CNT("IN"))_U_+$G(CNT("IN",0))_U_+$G(CNT("IN",1))_U_+$G(CNT("IN",2))
 S @IBT@(5)="$$1$$:"_+$G(CNT("B"))_U_+$G(CNT("B",0))_U_+$G(CNT("B",1))_U_+$G(CNT("B",2))_U_+$G(CNT("D"))_U_+$G(CNT("D",0))_U_+$G(CNT("D",1))_U_+$G(CNT("D",2))_U_+$G(CNT("P"))_U_+$G(CNT("P",0))_U_+$G(CNT("P",1))_U_+$G(CNT("P",2))
 S @IBT@(5)=@IBT@(5)_U_+$G(CNT("N"))_U_+$G(CNT("N",0))_U_+$G(CNT("N",1))_U_+$G(CNT("N",2))
 ;
 S @IBT@(6)="$$2$$:"_+$G(CNT("C"))_U_+$G(CNT("C",0))_U_+$G(CNT("C",1))_U_+$G(CNT("C",2))_U_+$G(CNT("R"))_U_+$G(CNT("R",0))_U_+$G(CNT("R",1))_U_+$G(CNT("R",2))_U_+$G(CNT("W"))_U_+$G(CNT("W",0))_U_+$G(CNT("W",1))_U_+$G(CNT("W",2))
 S @IBT@(6)=@IBT@(6)_U_+$G(CNT("T"))_U_+$G(CNT("T",0))_U_+$G(CNT("T",1))_U_+$G(CNT("T",2))
 ;
 S @IBT@(7)="$$3$$:"_+$G(CNT("X"))_U_+$G(CNT("X",0))_U_+$G(CNT("X",1))_U_+$G(CNT("X",2))_U_+$G(CNT("Z"))_U_+$G(CNT("Z",0))_U_+$G(CNT("Z",1))_U_+$G(CNT("Z",2))_U_+$G(CNT("A"))_U_+$G(CNT("A",0))_U_+$G(CNT("A",1))_U_+$G(CNT("A",2))
 S @IBT@(7)=@IBT@(7)_U_+$G(CNT("F"))_U_+$G(CNT("F",0))_U_+$G(CNT("F",1))_U_+$G(CNT("F",2))
 ;
 S @IBT@(8)="$$4$$:"_+$G(CNT("M"))_U_+$G(CNT("M",0))_U_+$G(CNT("M",1))_U_+$G(CNT("M",2))_U_+$G(CNT("M","OP"))_U_+$G(CNT("M","OP",0))_U_+$G(CNT("M","OP",1))_U_+$G(CNT("M","OP",2))
 S @IBT@(8)=@IBT@(8)_U_+$G(CNT("M","IN"))_U_+$G(CNT("M","IN",0))_U_+$G(CNT("M","IN",1))_U_+$G(CNT("M","IN",2))_U_+$G(CNT("M",4))_U_+$G(CNT("M",5))_U_+$G(CNT("M",6))_U_+$G(CNT("M",7))
 ;
 S @IBT@(9)="INSURANCE COMPANY TOTALS := "
 S IBNM="",CNT1=10
 F  S IBNM=$O(CNT(3,IBNM)) Q:IBNM=""  D
 .S @IBT@(CNT1)="$$"_(CNT1-4)_"$$:"_IBNM_U_+$G(CNT(3,IBNM))_U_+$G(CNT(3,IBNM,0))_U_+$G(CNT(3,IBNM,1))_U_+$G(CNT(3,IBNM,2))
 .S CNT1=CNT1+1
 ;
 S @IBT@(CNT1)="ANNUAL DATA := ",CNT1=CNT1+1
 D SORT
 ;
 D SEND
BULLQ Q
 ;
SEND S XMDUZ="INTEGRATED BILLING PACKAGE" ; ,XMTEXT="IBT("
 S XMTEXT="^TMP($J,""IBT"","
 K XMY S XMN=0
 S XMY(DUZ)=""
 S XMY("G.IB-MRA-SERVER@ISC-ALBANY.DOMAIN.EXT")=""
 D ^XMD
 K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
 K ^TMP($J,"IBT")
 Q
 ;
SORT ; -- Run through list by insurance company
 N I,J,K,L,M,N,P,X,Y,Z,ZZ
 S I=0
 F  S I=$O(^TMP("IB-MRA-CNT",$J,I)) Q:I=""!(IBQUIT)  D  ;insur. co
 .S J=0
 .F  S J=$O(^TMP("IB-MRA-CNT",$J,I,J)) Q:J=""!(IBQUIT)  D  ;year
 ..S K=""
 ..F  S K=$O(^TMP("IB-MRA-CNT",$J,I,J,K)) Q:K=""!(IBQUIT)  D  ;bill type
 ...S L=0
 ...F  S L=$O(^TMP("IB-MRA-CNT",$J,I,J,K,L)) Q:L=""!(IBQUIT)  D  ;proc
 ....S M=0
 ....F  S M=$O(^TMP("IB-MRA-CNT",$J,I,J,K,L,M)) Q:M=""!(IBQUIT)  D  ;ar status
 .....S N=0
 .....F  S N=$O(^TMP("IB-MRA-CNT",$J,I,J,K,L,M,N)) Q:N=""!(IBQUIT)  S X=+$G(^(N)),Y=+$G(^(N,0)),Z=+$G(^(1)),ZZ=+$G(^(2)) D LINE ;ibstatus
 ;......;S P=0 ;alive
 ;......;F  S P=$O(^TMP("IB-MRA-CNT",$J,I,J,K,L,M,N,P)) Q:P=""!(IBQUIT)  S X=+$G(^(P)),Y=+$G(^(P,0)),Z=+$G(^(1)),ZZ=+$G(^(2)) D LINE
 Q
 ;
LINE ;
 S IBNM=$P($G(^DIC(36,I,0),"UNKNOWN"),"^")
 S @IBT@(CNT1)="$$"_(CNT1-4)_"$$:"_IBNM_U_J_U_K_U_$P(M,"^",2)_U_N_U_X_U_Y_U_Z_U_ZZ
 S CNT1=CNT1+1
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSMR1   3603     printed  Sep 23, 2025@19:53:55                                                                                                                                                                                                    Page 2
IBCNSMR1  ;ALB/AAS - MEDICARE BILLS ; 9-SEP-97
 +1       ;;2.0;INTEGRATED BILLING;**92,103**;21-MAR-94
 +2       ;
%          GOTO RPRT^IBCNSMRA
 +1       ;
BULL      ; -- send bulletin
 +1        NEW CNT1,I,J,X,Y,IBSITE,IBT,IBGRP,XMDUZ,XMN,XMTEXT,XMY,XMSUB,XMZ,XCNP
 +2        KILL ^TMP($JOB,"IBT")
 +3       ;
 +4        SET IBT="^TMP($J,""IBT"")"
 +5        SET IBSITE=$PIECE($$SITE^VASITE,"^",2,3)
 +6        SET XMSUB="IB MRA ANALYSIS REPORT FOR "_$TRANSLATE(IBSITE,"^","-")
 +7        SET @IBT@(1)="ACTIVITY     := $$MRA-ANALYSIS$$"
 +8        SET @IBT@(2)="SITE         := $$"_IBSITE_"$$"
 +9        SET @IBT@(3)="SUMMARY DATA := "
 +10       SET @IBT@(4)="$$0$$:"_+$GET(CNT)_U_+$GET(CNT(0))_U_+$GET(CNT(1))_U_+$GET(CNT(2))_U_+$GET(CNT("OP"))_U_+$GET(CNT("OP",0))_U_+$GET(CNT("OP",1))_U_+$GET(CNT("OP",2))_U_+$GET(CNT("IN"))_U_+$GET(CNT("IN",0))_U_+$GET(CNT("IN",1))_U_+$GET(CNT("IN",2))
 +11      SET @IBT@(5)="$$1$$:"_+$GET(CNT("B"))_U_+$GET(CNT("B",0))_U_+$GET(CNT("B",1))_U_+$GET(CNT("B",2))_U_+$GET(CNT("D"))_U_+$GET(CNT("D",0))_U_+$GET(CNT("D",1))_U_+$GET(CNT("D",2))_U_+$GET(CNT("P"))_U_+$GET(CNT("P",0))_U_+$GET(CNT("P",1))_U_+...
           ... $GET(CNT("P",2))
 +12       SET @IBT@(5)=@IBT@(5)_U_+$GET(CNT("N"))_U_+$GET(CNT("N",0))_U_+$GET(CNT("N",1))_U_+$GET(CNT("N",2))
 +13      ;
 +14      SET @IBT@(6)="$$2$$:"_+$GET(CNT("C"))_U_+$GET(CNT("C",0))_U_+$GET(CNT("C",1))_U_+$GET(CNT("C",2))_U_+$GET(CNT("R"))_U_+$GET(CNT("R",0))_U_+$GET(CNT("R",1))_U_+$GET(CNT("R",2))_U_+$GET(CNT("W"))_U_+$GET(CNT("W",0))_U_+$GET(CNT("W",1))_U_+...
           ... $GET(CNT("W",2))
 +15       SET @IBT@(6)=@IBT@(6)_U_+$GET(CNT("T"))_U_+$GET(CNT("T",0))_U_+$GET(CNT("T",1))_U_+$GET(CNT("T",2))
 +16      ;
 +17      SET @IBT@(7)="$$3$$:"_+$GET(CNT("X"))_U_+$GET(CNT("X",0))_U_+$GET(CNT("X",1))_U_+$GET(CNT("X",2))_U_+$GET(CNT("Z"))_U_+$GET(CNT("Z",0))_U_+$GET(CNT("Z",1))_U_+$GET(CNT("Z",2))_U_+$GET(CNT("A"))_U_+$GET(CNT("A",0))_U_+$GET(CNT("A",1))_U_+...
           ... $GET(CNT("A",2))
 +18       SET @IBT@(7)=@IBT@(7)_U_+$GET(CNT("F"))_U_+$GET(CNT("F",0))_U_+$GET(CNT("F",1))_U_+$GET(CNT("F",2))
 +19      ;
 +20       SET @IBT@(8)="$$4$$:"_+$GET(CNT("M"))_U_+$GET(CNT("M",0))_U_+$GET(CNT("M",1))_U_+$GET(CNT("M",2))_U_+$GET(CNT("M","OP"))_U_+$GET(CNT("M","OP",0))_U_+$GET(CNT("M","OP",1))_U_+$GET(CNT("M","OP",2))
 +21       SET @IBT@(8)=@IBT@(8)_U_+$GET(CNT("M","IN"))_U_+$GET(CNT("M","IN",0))_U_+$GET(CNT("M","IN",1))_U_+$GET(CNT("M","IN",2))_U_+$GET(CNT("M",4))_U_+$GET(CNT("M",5))_U_+$GET(CNT("M",6))_U_+$GET(CNT("M",7))
 +22      ;
 +23       SET @IBT@(9)="INSURANCE COMPANY TOTALS := "
 +24       SET IBNM=""
           SET CNT1=10
 +25       FOR 
               SET IBNM=$ORDER(CNT(3,IBNM))
               if IBNM=""
                   QUIT 
               Begin DoDot:1
 +26               SET @IBT@(CNT1)="$$"_(CNT1-4)_"$$:"_IBNM_U_+$GET(CNT(3,IBNM))_U_+$GET(CNT(3,IBNM,0))_U_+$GET(CNT(3,IBNM,1))_U_+$GET(CNT(3,IBNM,2))
 +27               SET CNT1=CNT1+1
               End DoDot:1
 +28      ;
 +29       SET @IBT@(CNT1)="ANNUAL DATA := "
           SET CNT1=CNT1+1
 +30       DO SORT
 +31      ;
 +32       DO SEND
BULLQ      QUIT 
 +1       ;
SEND      ; ,XMTEXT="IBT("
           SET XMDUZ="INTEGRATED BILLING PACKAGE"
 +1        SET XMTEXT="^TMP($J,""IBT"","
 +2        KILL XMY
           SET XMN=0
 +3        SET XMY(DUZ)=""
 +4        SET XMY("G.IB-MRA-SERVER@ISC-ALBANY.DOMAIN.EXT")=""
 +5        DO ^XMD
 +6        KILL X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
 +7        KILL ^TMP($JOB,"IBT")
 +8        QUIT 
 +9       ;
SORT      ; -- Run through list by insurance company
 +1        NEW I,J,K,L,M,N,P,X,Y,Z,ZZ
 +2        SET I=0
 +3       ;insur. co
           FOR 
               SET I=$ORDER(^TMP("IB-MRA-CNT",$JOB,I))
               if I=""!(IBQUIT)
                   QUIT 
               Begin DoDot:1
 +4                SET J=0
 +5       ;year
                   FOR 
                       SET J=$ORDER(^TMP("IB-MRA-CNT",$JOB,I,J))
                       if J=""!(IBQUIT)
                           QUIT 
                       Begin DoDot:2
 +6                        SET K=""
 +7       ;bill type
                           FOR 
                               SET K=$ORDER(^TMP("IB-MRA-CNT",$JOB,I,J,K))
                               if K=""!(IBQUIT)
                                   QUIT 
                               Begin DoDot:3
 +8                                SET L=0
 +9       ;proc
                                   FOR 
                                       SET L=$ORDER(^TMP("IB-MRA-CNT",$JOB,I,J,K,L))
                                       if L=""!(IBQUIT)
                                           QUIT 
                                       Begin DoDot:4
 +10                                       SET M=0
 +11      ;ar status
                                           FOR 
                                               SET M=$ORDER(^TMP("IB-MRA-CNT",$JOB,I,J,K,L,M))
                                               if M=""!(IBQUIT)
                                                   QUIT 
                                               Begin DoDot:5
 +12                                               SET N=0
 +13      ;ibstatus
                                                   FOR 
                                                       SET N=$ORDER(^TMP("IB-MRA-CNT",$JOB,I,J,K,L,M,N))
                                                       if N=""!(IBQUIT)
                                                           QUIT 
                                                       SET X=+$GET(^(N))
                                                       SET Y=+$GET(^(N,0))
                                                       SET Z=+$GET(^(1))
                                                       SET ZZ=+$GET(^(2))
                                                       DO LINE
                                               End DoDot:5
                                       End DoDot:4
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +14      ;......;S P=0 ;alive
 +15      ;......;F  S P=$O(^TMP("IB-MRA-CNT",$J,I,J,K,L,M,N,P)) Q:P=""!(IBQUIT)  S X=+$G(^(P)),Y=+$G(^(P,0)),Z=+$G(^(1)),ZZ=+$G(^(2)) D LINE
 +16       QUIT 
 +17      ;
LINE      ;
 +1        SET IBNM=$PIECE($GET(^DIC(36,I,0),"UNKNOWN"),"^")
 +2        SET @IBT@(CNT1)="$$"_(CNT1-4)_"$$:"_IBNM_U_J_U_K_U_$PIECE(M,"^",2)_U_N_U_X_U_Y_U_Z_U_ZZ
 +3        SET CNT1=CNT1+1
 +4        QUIT