IBTOBI3.m

IBTOBI3 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 27-OCT-93

 ;;2.0;INTEGRATED BILLING;**40,56,458**;21-MAR-94;Build 4

 ;

HR ; -- print hospital review information

 Q:'$O(^IBT(356.1,"C",+IBTRN,0))  ; -no reivews

 I ($Y+11)>IOSL D HDR^IBTOBI Q:IBQUIT

 W !,"  Hospital Review Information "

 N I,J,IBII,IBTRV,IBTRVD

 S IBII="" F  S IBII=$O(^IBT(356.1,"ATIDT",IBTRN,IBII)) Q:'IBII!(IBQUIT)  S IBTRV=0 F  S IBTRV=$O(^IBT(356.1,"ATIDT",IBTRN,IBII,IBTRV)) Q:'IBTRV!(IBQUIT)  D

 .N IBD

 .D HR1

 .D HR2

 .; Patch #40

 .D UNIT

 .S IBJ=0 F  S IBJ=$O(IBD(IBJ)) Q:'IBJ  W !,$E($G(IBD(IBJ,1)),1,40),?40,$E($G(IBD(IBJ,2)),1,39)

 .D COMM1(IBTRV) Q:IBQUIT

 .W !?30,"-----------------------------------"

 .I ($Y+11)>IOSL D HDR^IBTOBI Q:IBQUIT

 W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!

 Q

 ;

HR1 ; -- print one review

 S IBTRVD=$G(^IBT(356.1,+IBTRV,0))

 S IBTRTP=$P($G(^IBE(356.11,+$P($G(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)

 D @IBTRTP

 Q

10 ; -- precert review

15 ; -- admission review

20 ; -- urgent adm. review

25 ; -- snf/nhcu review

35 ; -- inpt retrospective review

 S IBD(1,2)=" Severity of Ill: "_$$SI^IBTRVD0($P(IBTRVD,"^",4))

 S IBD(2,2)="Intensity of Svc: "_$$SI^IBTRVD0($P(IBTRVD,"^",5))

 S IBD(3,2)="    Criteria Met: "_$$EXPAND^IBTRE(356.1,.06,$P(IBTRVD,"^",6))

 S IBD(4,2)=" Prov. Intervwed: "_$$EXPAND^IBTRE(356.1,.1,$P(IBTRVD,"^",10))

 S IBD(5,2)=" Dec. Influenced: "_$$EXPAND^IBTRE(356.1,.11,$P(IBTRVD,"^",11))

 S IBD=5

 S IBNAR=0 F  S IBNAR=+$O(^IBT(356.1,+IBTRV,12,IBNAR)) Q:'IBNAR  D

 .S IBNARD=$G(^IBT(356.1,+IBTRV,12,IBNAR,0))

 .S IBD=IBD+1

 .S IBD(IBD,2)="Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P(^(0),"^")

 Q

30 ; -- concurrent review

 S IBD(1,2)="   Day of Review: "_$J($P(IBTRVD,"^",3),2)

 S IBD(2,2)=" Severity of Ill: "_$$SI^IBTRVD0($P(IBTRVD,"^",4))

 S IBD(3,2)="Intensity of Svc: "_$$SI^IBTRVD0($P(IBTRVD,"^",5))

 S IBD(4,2)="Dschg Screen Met: "_$$EXPAND^IBTRE(356.1,.12,$P(IBTRVD,"^",12))

 S IBD(5,2)="Acute Care Dschg: "_$$EXPAND^IBTRE(356.1,1.17,$P($G(^IBT(356.1,+IBTRV,1)),"^",17))

 S IBD=5

 S IBNAR=0 F  S IBNAR=+$O(^IBT(356.1,+IBTRV,13,IBNAR)) Q:'IBNAR  D

 .S IBNARD=$G(^IBT(356.1,+IBTRV,13,IBNAR,0))

 .S IBD=IBD+1

 .S IBD(IBD,2)="Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P(^(0),"^")

 Q

40 ; -- discharge review

 S IBD(1,2)="Discharge Screen: "_$$SI^IBTRVD0($P(IBTRVD,"^",12))

 S IBD=1

 Q

 ;

50 ;

55 ;

60 ;

65 ;

70 ;

80 ;

85 ;

90 ;

 S IBD=0

 Q

 ;

UNIT ; -- Special unit information

 I '$D(IBD) S IBD=0

 I IBTRTP=40 S IBD(IBD+1,2)="  D/C Screen Met: "_$$SI^IBTRVD0($P(IBTRVD,"^",13)) Q

 ; Patch #40

 S IBD(IBD+1,2)=" Special Unit SI: "_$$SI^IBTRVD0($P(IBTRVD,"^",8))

 S IBD(IBD+2,2)=" Special Unit IS: "_$$SI^IBTRVD0($P(IBTRVD,"^",9))

 Q

 ;

HR2 ; -- contact information

 S IBD(1,1)="     Review Date: "_$$DAT1^IBOUTL(+IBTRVD,"2P")

 S IBD(2,1)="     Review Type: "_$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",1)

 S IBD(3,1)="       Specialty: "_$P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^")

 S IBD(4,1)="     Methodology: "_$$EXPAND^IBTRE(356.1,.23,$P(IBTRVD,"^",23))

 S IBD(5,1)="          Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21))

 S IBD(6,1)="  Last Edited By: "_$E($$EXPAND^IBTRE(356.1,1.04,$P($G(^IBT(356.1,+$G(IBTRV),1)),"^",4)),1,20)

 S IBD(7,1)="Next Review Date: "_$$DAT1^IBOUTL($P(IBTRVD,"^",20))

 Q

 ;

COMM1(DA) ; -- print comments from ins. reviews.

 W !,"Comment: "

 K ^UTILITY($J,"W")

 S DIWL=10,DIWR=IOM-12,DIWF="W"

 S IBJ=0 F  S IBJ=$O(^IBT(356.1,DA,11,IBJ)) Q:'IBJ  S X=^(IBJ,0) D ^DIWP  I IOSL<($Y+4) Q:IBQUIT  D HDR^IBTOBI

 Q:IBQUIT

 D ^DIWW

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBTOBI3   3649     printed  Feb 18, 2025@23:53:42                                                                                                                                                                                                     Page 2

IBTOBI3   ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 27-OCT-93

 +1       ;;2.0;INTEGRATED BILLING;**40,56,458**;21-MAR-94;Build 4

 +2       ;

HR        ; -- print hospital review information

 +1       ; -no reivews

           if '$ORDER(^IBT(356.1,"C",+IBTRN,0))

               QUIT 

 +2        IF ($Y+11)>IOSL

               DO HDR^IBTOBI

               if IBQUIT

                   QUIT 

 +3        WRITE !,"  Hospital Review Information "

 +4        NEW I,J,IBII,IBTRV,IBTRVD

 +5        SET IBII=""

           FOR 

               SET IBII=$ORDER(^IBT(356.1,"ATIDT",IBTRN,IBII))

               if 'IBII!(IBQUIT)

                   QUIT 

               SET IBTRV=0

               FOR 

                   SET IBTRV=$ORDER(^IBT(356.1,"ATIDT",IBTRN,IBII,IBTRV))

                   if 'IBTRV!(IBQUIT)

                       QUIT 

                   Begin DoDot:1

 +6                    NEW IBD

 +7                    DO HR1

 +8                    DO HR2

 +9       ; Patch #40

 +10                   DO UNIT

 +11                   SET IBJ=0

                       FOR 

                           SET IBJ=$ORDER(IBD(IBJ))

                           if 'IBJ

                               QUIT 

                           WRITE !,$EXTRACT($GET(IBD(IBJ,1)),1,40),?40,$EXTRACT($GET(IBD(IBJ,2)),1,39)

 +12                   DO COMM1(IBTRV)

                       if IBQUIT

                           QUIT 

 +13                   WRITE !?30,"-----------------------------------"

 +14                   IF ($Y+11)>IOSL

                           DO HDR^IBTOBI

                           if IBQUIT

                               QUIT 

                   End DoDot:1

 +15       if 'IBQUIT

               WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!

 +16       QUIT 

 +17      ;

HR1       ; -- print one review

 +1        SET IBTRVD=$GET(^IBT(356.1,+IBTRV,0))

 +2        SET IBTRTP=$PIECE($GET(^IBE(356.11,+$PIECE($GET(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)

 +3        DO @IBTRTP

 +4        QUIT 

10        ; -- precert review

15        ; -- admission review

20        ; -- urgent adm. review

25        ; -- snf/nhcu review

35        ; -- inpt retrospective review

 +1        SET IBD(1,2)=" Severity of Ill: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",4))

 +2        SET IBD(2,2)="Intensity of Svc: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",5))

 +3        SET IBD(3,2)="    Criteria Met: "_$$EXPAND^IBTRE(356.1,.06,$PIECE(IBTRVD,"^",6))

 +4        SET IBD(4,2)=" Prov. Intervwed: "_$$EXPAND^IBTRE(356.1,.1,$PIECE(IBTRVD,"^",10))

 +5        SET IBD(5,2)=" Dec. Influenced: "_$$EXPAND^IBTRE(356.1,.11,$PIECE(IBTRVD,"^",11))

 +6        SET IBD=5

 +7        SET IBNAR=0

           FOR 

               SET IBNAR=+$ORDER(^IBT(356.1,+IBTRV,12,IBNAR))

               if 'IBNAR

                   QUIT 

               Begin DoDot:1

 +8                SET IBNARD=$GET(^IBT(356.1,+IBTRV,12,IBNAR,0))

 +9                SET IBD=IBD+1

 +10               SET IBD(IBD,2)="Non-Acute Reason: "_$PIECE($GET(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$PIECE(^(0),"^")

               End DoDot:1

 +11       QUIT 

30        ; -- concurrent review

 +1        SET IBD(1,2)="   Day of Review: "_$JUSTIFY($PIECE(IBTRVD,"^",3),2)

 +2        SET IBD(2,2)=" Severity of Ill: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",4))

 +3        SET IBD(3,2)="Intensity of Svc: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",5))

 +4        SET IBD(4,2)="Dschg Screen Met: "_$$EXPAND^IBTRE(356.1,.12,$PIECE(IBTRVD,"^",12))

 +5        SET IBD(5,2)="Acute Care Dschg: "_$$EXPAND^IBTRE(356.1,1.17,$PIECE($GET(^IBT(356.1,+IBTRV,1)),"^",17))

 +6        SET IBD=5

 +7        SET IBNAR=0

           FOR 

               SET IBNAR=+$ORDER(^IBT(356.1,+IBTRV,13,IBNAR))

               if 'IBNAR

                   QUIT 

               Begin DoDot:1

 +8                SET IBNARD=$GET(^IBT(356.1,+IBTRV,13,IBNAR,0))

 +9                SET IBD=IBD+1

 +10               SET IBD(IBD,2)="Non-Acute Reason: "_$PIECE($GET(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$PIECE(^(0),"^")

               End DoDot:1

 +11       QUIT 

40        ; -- discharge review

 +1        SET IBD(1,2)="Discharge Screen: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",12))

 +2        SET IBD=1

 +3        QUIT 

 +4       ;

50        ;

55        ;

60        ;

65        ;

70        ;

80        ;

85        ;

90        ;

 +1        SET IBD=0

 +2        QUIT 

 +3       ;

UNIT      ; -- Special unit information

 +1        IF '$DATA(IBD)

               SET IBD=0

 +2        IF IBTRTP=40

               SET IBD(IBD+1,2)="  D/C Screen Met: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",13))

               QUIT 

 +3       ; Patch #40

 +4        SET IBD(IBD+1,2)=" Special Unit SI: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",8))

 +5        SET IBD(IBD+2,2)=" Special Unit IS: "_$$SI^IBTRVD0($PIECE(IBTRVD,"^",9))

 +6        QUIT 

 +7       ;

HR2       ; -- contact information

 +1        SET IBD(1,1)="     Review Date: "_$$DAT1^IBOUTL(+IBTRVD,"2P")

 +2        SET IBD(2,1)="     Review Type: "_$PIECE($GET(^IBE(356.11,+$PIECE(IBTRVD,"^",22),0)),"^",1)

 +3        SET IBD(3,1)="       Specialty: "_$PIECE($GET(^DIC(45.7,+$PIECE(IBTRVD,"^",7),0)),"^")

 +4        SET IBD(4,1)="     Methodology: "_$$EXPAND^IBTRE(356.1,.23,$PIECE(IBTRVD,"^",23))

 +5        SET IBD(5,1)="          Status: "_$$EXPAND^IBTRE(356.1,.21,$PIECE(IBTRVD,"^",21))

 +6        SET IBD(6,1)="  Last Edited By: "_$EXTRACT($$EXPAND^IBTRE(356.1,1.04,$PIECE($GET(^IBT(356.1,+$GET(IBTRV),1)),"^",4)),1,20)

 +7        SET IBD(7,1)="Next Review Date: "_$$DAT1^IBOUTL($PIECE(IBTRVD,"^",20))

 +8        QUIT 

 +9       ;

COMM1(DA) ; -- print comments from ins. reviews.

 +1        WRITE !,"Comment: "

 +2        KILL ^UTILITY($JOB,"W")

 +3        SET DIWL=10

           SET DIWR=IOM-12

           SET DIWF="W"

 +4        SET IBJ=0

           FOR 

               SET IBJ=$ORDER(^IBT(356.1,DA,11,IBJ))

               if 'IBJ

                   QUIT 

               SET X=^(IBJ,0)

               DO ^DIWP

               IF IOSL<($Y+4)

                   if IBQUIT

                       QUIT 

                   DO HDR^IBTOBI

 +5        if IBQUIT

               QUIT 

 +6        DO ^DIWW

 +7        QUIT