IBCRLC.m

IBCRLC ;ALB/ARH - RATES: DISPLAY CHARGE SETS ; 17-MAY-1996

 ;;2.0;INTEGRATED BILLING;**52,106**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

EN ; -- main entry point for IBCR CHARGE SET

 D EN^VALM("IBCR CHARGE SET")

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="                                                 Default"

 Q

 ;

INIT ; -- init variables and list array

 K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)

 D BLD

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)

 D CLEAR^VALM1,CLEAN^VALM10

 Q

 ;

BLD ; build charge set display array

 N IBBRNM,IBBRFN,IBCSNM,IBCSFN,IBBEVNT,IBLN,IBX,IBY S VALMCNT=0 K ^TMP($J,"IBCRCS")

 ;

 D SORTCS

 ;

 ; create LM display array

 S IBBRNM="" F  S IBBRNM=$O(^TMP($J,"IBCRCS",IBBRNM)) Q:IBBRNM=""  D

 . ;

 . S IBBRFN=+$G(^TMP($J,"IBCRCS",IBBRNM))

 . D SET("",IBBRFN) S IBY="         Billing Rate: "_IBBRNM

 . D SET(IBY) D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)

 . ;

 . S IBBEVNT="" F  S IBBEVNT=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT)) Q:IBBEVNT=""  D

 .. S IBCSNM="" F  S IBCSNM=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM)) Q:IBCSNM=""  D

 ... S IBCSFN=0 F  S IBCSFN=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM,IBCSFN)) Q:'IBCSFN  D

 .... ;

 .... S IBLN=$G(^IBE(363.1,IBCSFN,0)) Q:IBLN=""

 .... S IBY=""

 .... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"CGSET")

 .... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,3),2),IBY=$$SETFLD^VALM1(IBX,IBY,"BEVNT")

 .... S IBX=$$CGTYPE(+$P(IBLN,U,4)),IBY=$$SETFLD^VALM1(IBX,IBY,"CGTYP")

 .... S IBX=$P($G(^DGCR(399.2,+$P(IBLN,U,5),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"DRVCD")

 .... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,6),2),IBY=$$SETFLD^VALM1(IBX,IBY,"DBEDS")

 .... S IBX=$P($G(^IBE(363.31,+$P(IBLN,U,7),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")

 .... D SET(IBY)

 ;

 I VALMCNT=0 D SET(" ",0),SET("No Charge Sets defined",0)

 ;

 K ^TMP($J,"IBCRCS")

 Q

 ;

SET(X,BRFN) ; set up list manager screen array

 S VALMCNT=VALMCNT+1

 S ^TMP("IBCRLC",$J,VALMCNT,0)=X

 I +$G(BRFN) S ^TMP("IBCRLCX1",$J,+BRFN)=VALMCNT

 Q

 ;

SORTCS ; created array of all Charge Sets sorted by billing rate, billable event, and Charge Set name

 ; ^TMP($J,"IBCRCS", billing rate name) = billing rate IFN

 ; ^TMP($J,"IBCRCS", billing rate name, billable event, charge set name, charge set IFN) = ""

 N IBCSFN,IBBRNM,IBBEVNT,IBLN

 S IBCSFN=0 F  S IBCSFN=$O(^IBE(363.1,IBCSFN)) Q:'IBCSFN  D

 . S IBLN=$G(^IBE(363.1,IBCSFN,0))

 . S IBBRNM=$P($G(^IBE(363.3,+$P(IBLN,U,2),0)),U,1) I IBBRNM="" S IBBRNM=" "

 . S IBBEVNT=$$EMUTL^IBCRU1($P(IBLN,U,3),2) I IBBEVNT="" S IBBEVNT=" "

 . S ^TMP($J,"IBCRCS",IBBRNM)=$P(IBLN,U,2)

 . S ^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,$P(IBLN,U,1),IBCSFN)=""

 Q

 ;

CGTYPE(X) ; return external form of Charge Type (363.1)

 S X=$G(X),X=$S(X=1:"INSTITUTIONAL",X=2:"PROFESSIONAL",1:"")

 Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCRLC   2908     printed  Feb 18, 2025@23:46:04                                                                                                                                                                                                      Page 2

IBCRLC    ;ALB/ARH - RATES: DISPLAY CHARGE SETS ; 17-MAY-1996

 +1       ;;2.0;INTEGRATED BILLING;**52,106**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

EN        ; -- main entry point for IBCR CHARGE SET

 +1        DO EN^VALM("IBCR CHARGE SET")

 +2        QUIT 

 +3       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="                                                 Default"

 +2        QUIT 

 +3       ;

INIT      ; -- init variables and list array

 +1        KILL ^TMP("IBCRLC",$JOB),^TMP("IBCRLCX1",$JOB)

 +2        DO BLD

 +3        QUIT 

 +4       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("IBCRLC",$JOB),^TMP("IBCRLCX1",$JOB)

 +2        DO CLEAR^VALM1

           DO CLEAN^VALM10

 +3        QUIT 

 +4       ;

BLD       ; build charge set display array

 +1        NEW IBBRNM,IBBRFN,IBCSNM,IBCSFN,IBBEVNT,IBLN,IBX,IBY

           SET VALMCNT=0

           KILL ^TMP($JOB,"IBCRCS")

 +2       ;

 +3        DO SORTCS

 +4       ;

 +5       ; create LM display array

 +6        SET IBBRNM=""

           FOR 

               SET IBBRNM=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM))

               if IBBRNM=""

                   QUIT 

               Begin DoDot:1

 +7       ;

 +8                SET IBBRFN=+$GET(^TMP($JOB,"IBCRCS",IBBRNM))

 +9                DO SET("",IBBRFN)

                   SET IBY="         Billing Rate: "_IBBRNM

 +10               DO SET(IBY)

                   DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)

 +11      ;

 +12               SET IBBEVNT=""

                   FOR 

                       SET IBBEVNT=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT))

                       if IBBEVNT=""

                           QUIT 

                       Begin DoDot:2

 +13                       SET IBCSNM=""

                           FOR 

                               SET IBCSNM=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM))

                               if IBCSNM=""

                                   QUIT 

                               Begin DoDot:3

 +14                               SET IBCSFN=0

                                   FOR 

                                       SET IBCSFN=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM,IBCSFN))

                                       if 'IBCSFN

                                           QUIT 

                                       Begin DoDot:4

 +15      ;

 +16                                       SET IBLN=$GET(^IBE(363.1,IBCSFN,0))

                                           if IBLN=""

                                               QUIT 

 +17                                       SET IBY=""

 +18                                       SET IBX=$PIECE(IBLN,U,1)

                                           SET IBY=$$SETFLD^VALM1(IBX,IBY,"CGSET")

 +19                                       SET IBX=$$EMUTL^IBCRU1(+$PIECE(IBLN,U,3),2)

                                           SET IBY=$$SETFLD^VALM1(IBX,IBY,"BEVNT")

 +20                                       SET IBX=$$CGTYPE(+$PIECE(IBLN,U,4))

                                           SET IBY=$$SETFLD^VALM1(IBX,IBY,"CGTYP")

 +21                                       SET IBX=$PIECE($GET(^DGCR(399.2,+$PIECE(IBLN,U,5),0)),U,1)

                                           SET IBY=$$SETFLD^VALM1(IBX,IBY,"DRVCD")

 +22                                       SET IBX=$$EMUTL^IBCRU1(+$PIECE(IBLN,U,6),2)

                                           SET IBY=$$SETFLD^VALM1(IBX,IBY,"DBEDS")

 +23                                       SET IBX=$PIECE($GET(^IBE(363.31,+$PIECE(IBLN,U,7),0)),U,1)

                                           SET IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")

 +24                                       DO SET(IBY)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +25      ;

 +26       IF VALMCNT=0

               DO SET(" ",0)

               DO SET("No Charge Sets defined",0)

 +27      ;

 +28       KILL ^TMP($JOB,"IBCRCS")

 +29       QUIT 

 +30      ;

SET(X,BRFN) ; set up list manager screen array

 +1        SET VALMCNT=VALMCNT+1

 +2        SET ^TMP("IBCRLC",$JOB,VALMCNT,0)=X

 +3        IF +$GET(BRFN)

               SET ^TMP("IBCRLCX1",$JOB,+BRFN)=VALMCNT

 +4        QUIT 

 +5       ;

SORTCS    ; created array of all Charge Sets sorted by billing rate, billable event, and Charge Set name

 +1       ; ^TMP($J,"IBCRCS", billing rate name) = billing rate IFN

 +2       ; ^TMP($J,"IBCRCS", billing rate name, billable event, charge set name, charge set IFN) = ""

 +3        NEW IBCSFN,IBBRNM,IBBEVNT,IBLN

 +4        SET IBCSFN=0

           FOR 

               SET IBCSFN=$ORDER(^IBE(363.1,IBCSFN))

               if 'IBCSFN

                   QUIT 

               Begin DoDot:1

 +5                SET IBLN=$GET(^IBE(363.1,IBCSFN,0))

 +6                SET IBBRNM=$PIECE($GET(^IBE(363.3,+$PIECE(IBLN,U,2),0)),U,1)

                   IF IBBRNM=""

                       SET IBBRNM=" "

 +7                SET IBBEVNT=$$EMUTL^IBCRU1($PIECE(IBLN,U,3),2)

                   IF IBBEVNT=""

                       SET IBBEVNT=" "

 +8                SET ^TMP($JOB,"IBCRCS",IBBRNM)=$PIECE(IBLN,U,2)

 +9                SET ^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT,$PIECE(IBLN,U,1),IBCSFN)=""

               End DoDot:1

 +10       QUIT 

 +11      ;

CGTYPE(X) ; return external form of Charge Type (363.1)

 +1        SET X=$GET(X)

           SET X=$SELECT(X=1:"INSTITUTIONAL",X=2:"PROFESSIONAL",1:"")

 +2        QUIT X