IBJPS1 ;ALB/MAF,ARH - IBSP IB SITE PARAMETER BUILD ;22-DEC-1995
;;2.0;INTEGRATED BILLING;**39,52,70,115,153,137,161,384**;21-MAR-94;Build 74
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
BLD ; - build screen array for IB parameters
N IBTW,IBTC,IBSW,IBLN,IBGRPB,IBGRPE,IBX,IBT,IBI,IBLR,IBSEL,IBPD0,IBPD1,IBPD2,IBPD4,IBPD6,IBPD7,IBPD8,IBPD9,IBPD10
N IBPD50,IBCISOCK,IBCIMFLG
N IBPD11,IBPD12,IBZ
;
; IBTW = max width of data IBTC = start column of data
; IBSW = total width of prompt field (including the ":")
S IBTW(1)=21,IBTC(1)=5,IBSW(1)=19
S IBTW(2)=21,IBTC(2)=47,IBSW(2)=13
S IBTW(3)=21,IBTC(3)=5,IBSW(3)=53
S IBTW(4)=27,IBTC(4)=5,IBSW(4)=47
S IBTW(5)=17,IBTC(5)=5,IBSW(5)=19
S IBTW(6)=19,IBTC(6)=41,IBSW(6)=17
S IBTW(7)=35,IBTC(7)=5,IBSW(7)=46
S IBTW(8)=32,IBTC(8)=5,IBSW(8)=46
S IBTW(9)=31,IBTC(9)=5,IBSW(9)=43
;
S IBPD0=$G(^IBE(350.9,1,0)),IBPD1=$G(^IBE(350.9,1,1)),IBPD2=$G(^IBE(350.9,1,2))
S IBPD4=$G(^IBE(350.9,1,4)),IBPD6=$G(^IBE(350.9,1,6)),IBPD8=$G(^(8)),IBPD9=$G(^IBE(350.9,1,9))
S IBPD7=$G(^IBE(350.9,1,7)),IBPD10=$G(^IBE(350.9,1,10)),IBPD50=$G(^IBE(350.9,1,50))
S IBPD11=$G(^IBE(350.9,1,11))
S IBZ=0 F S IBZ=$O(^IBE(350.9,1,12,IBZ)) Q:+IBZ=0 S IBPD12(IBZ)=$G(^IBE(350.9,1,12,IBZ,0))
;
S (VALMCNT,IBLN,IBGRPB,IBGRPE)=1,IBSEL=0
;
D RIGHT(4,1,"") ; - copay stuff
S IBLN=$$SET("Copay Background Error Mg",$$EXSET^IBJU1($P(IBPD0,U,9),350.9,.09),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Copay Exemption Mailgroup",$$EXSET^IBJU1($P(IBPD0,U,13),350.9,.13),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Use Alerts for Exemption",$$YN($P(IBPD0,U,14)),IBLN,IBLR,IBSEL)
;
D RIGHT(4,1,1) ; - patient Billing
S IBLN=$$SET("Hold MT Bills w/Ins",$$YN(+$P(IBPD1,U,20)),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Suppress MT Ins Bulletin",$$YN(+$P(IBPD0,U,15)),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Means Test Mailgroup",$$EXSET^IBJU1($P(IBPD0,U,11),350.9,.11),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Per Diem Start Date",$$DATE^IBJU1(+$P(IBPD0,U,12)),IBLN,IBLR,IBSEL)
;
D LEFT(2)
S IBLN=$$SET("# of Days Charges Held",$$EXSET^IBJU1($P(IBPD7,U,4),350.9,7.04),IBLN,IBLR,IBSEL)
;
D RIGHT(4,1,1) ; - third party stuff
S IBLN=$$SET("Disapproval Mailgroup",$$EXSET^IBJU1($P(IBPD1,U,9),350.9,1.09),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Cancellation Mailgroup",$$EXSET^IBJU1($P(IBPD1,U,7),350.9,1.07),IBLN,IBLR,IBSEL)
D FSTRNG^IBJU1($P(IBPD2,U,7),IBSW(IBLR),.IBX) D K IBX
. S IBI=$O(IBX(0)) S IBLN=$$SET("Cancellation Remark",$G(IBX(+IBI)),IBLN,IBLR,IBSEL)
. F S IBI=$O(IBX(IBI)) Q:'IBI S IBLN=$$SET("",IBX(+IBI),IBLN,IBLR,IBSEL)
;
D RIGHT(4,1,1)
S IBLN=$$SET("New Insurance Mailgroup",$$EXSET^IBJU1($P(IBPD4,U,4),350.9,4.04),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Unbilled Mailgroup",$$EXSET^IBJU1($P(IBPD6,U,25),350.9,6.25),IBLN,IBLR,IBSEL)
S IBLN=$$SET("Auto Print Unbilled List",$$YN(+$P(IBPD6,U,24)),IBLN,IBLR,IBSEL)
;
D BLD2^IBJPS2
;
S VALMCNT=$S(IBLN>IBGRPE:IBLN,1:IBGRPE)-1
Q
;
SET(TTL,DATA,LN,LR,SEL) ;
N IBY,IBX,IBC S IBC=": " I TTL="" S IBC=" "
S IBY=TTL_$J("",(IBTW(LR)-$L(TTL)-2))_IBC_DATA,IBX=$G(^TMP("IBJPS",$J,LN,0))
S IBX=$$SETSTR^VALM1(IBY,IBX,IBTC(LR),(IBTW(LR)+IBSW(LR)))
D SET1(IBX,LN,SEL)
S LN=LN+1
Q LN
;
SET1(STR,LN,SEL,RV) ; set up TMP array with screen data
S ^TMP("IBJPS",$J,LN,0)=STR
S ^TMP("IBJPS",$J,"IDX",LN,SEL)=""
S ^TMP("IBJPSAX",$J,SEL)=SEL
I $G(RV)'="" D CNTRL^VALM10(LN,1,4,IOINHI,IOINORM)
Q
;
YN(X) Q $S(+X:"YES",1:"NO")
;
RIGHT(LR,SEL,BL) ; - reset control variables for right side of screen
S IBLN=$S(IBLN>IBGRPE:IBLN,1:IBGRPE) I $G(BL) S IBLN=$$SET("","",IBLN,IBLR,IBSEL)
S IBLR=$G(LR),IBGRPB=IBLN I +$G(SEL) S IBSEL=IBSEL+1 D SET1("["_IBSEL_"]",IBLN,IBSEL,1)
Q
;
LEFT(LR) ; - reset control variables for left side of screen
S IBLR=$G(LR),IBGRPE=IBLN,IBLN=IBGRPB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPS1 3822 printed Apr 09, 2024@21:22:05 Page 2
IBJPS1 ;ALB/MAF,ARH - IBSP IB SITE PARAMETER BUILD ;22-DEC-1995
+1 ;;2.0;INTEGRATED BILLING;**39,52,70,115,153,137,161,384**;21-MAR-94;Build 74
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
BLD ; - build screen array for IB parameters
+1 NEW IBTW,IBTC,IBSW,IBLN,IBGRPB,IBGRPE,IBX,IBT,IBI,IBLR,IBSEL,IBPD0,IBPD1,IBPD2,IBPD4,IBPD6,IBPD7,IBPD8,IBPD9,IBPD10
+2 NEW IBPD50,IBCISOCK,IBCIMFLG
+3 NEW IBPD11,IBPD12,IBZ
+4 ;
+5 ; IBTW = max width of data IBTC = start column of data
+6 ; IBSW = total width of prompt field (including the ":")
+7 SET IBTW(1)=21
SET IBTC(1)=5
SET IBSW(1)=19
+8 SET IBTW(2)=21
SET IBTC(2)=47
SET IBSW(2)=13
+9 SET IBTW(3)=21
SET IBTC(3)=5
SET IBSW(3)=53
+10 SET IBTW(4)=27
SET IBTC(4)=5
SET IBSW(4)=47
+11 SET IBTW(5)=17
SET IBTC(5)=5
SET IBSW(5)=19
+12 SET IBTW(6)=19
SET IBTC(6)=41
SET IBSW(6)=17
+13 SET IBTW(7)=35
SET IBTC(7)=5
SET IBSW(7)=46
+14 SET IBTW(8)=32
SET IBTC(8)=5
SET IBSW(8)=46
+15 SET IBTW(9)=31
SET IBTC(9)=5
SET IBSW(9)=43
+16 ;
+17 SET IBPD0=$GET(^IBE(350.9,1,0))
SET IBPD1=$GET(^IBE(350.9,1,1))
SET IBPD2=$GET(^IBE(350.9,1,2))
+18 SET IBPD4=$GET(^IBE(350.9,1,4))
SET IBPD6=$GET(^IBE(350.9,1,6))
SET IBPD8=$GET(^(8))
SET IBPD9=$GET(^IBE(350.9,1,9))
+19 SET IBPD7=$GET(^IBE(350.9,1,7))
SET IBPD10=$GET(^IBE(350.9,1,10))
SET IBPD50=$GET(^IBE(350.9,1,50))
+20 SET IBPD11=$GET(^IBE(350.9,1,11))
+21 SET IBZ=0
FOR
SET IBZ=$ORDER(^IBE(350.9,1,12,IBZ))
if +IBZ=0
QUIT
SET IBPD12(IBZ)=$GET(^IBE(350.9,1,12,IBZ,0))
+22 ;
+23 SET (VALMCNT,IBLN,IBGRPB,IBGRPE)=1
SET IBSEL=0
+24 ;
+25 ; - copay stuff
DO RIGHT(4,1,"")
+26 SET IBLN=$$SET("Copay Background Error Mg",$$EXSET^IBJU1($PIECE(IBPD0,U,9),350.9,.09),IBLN,IBLR,IBSEL)
+27 SET IBLN=$$SET("Copay Exemption Mailgroup",$$EXSET^IBJU1($PIECE(IBPD0,U,13),350.9,.13),IBLN,IBLR,IBSEL)
+28 SET IBLN=$$SET("Use Alerts for Exemption",$$YN($PIECE(IBPD0,U,14)),IBLN,IBLR,IBSEL)
+29 ;
+30 ; - patient Billing
DO RIGHT(4,1,1)
+31 SET IBLN=$$SET("Hold MT Bills w/Ins",$$YN(+$PIECE(IBPD1,U,20)),IBLN,IBLR,IBSEL)
+32 SET IBLN=$$SET("Suppress MT Ins Bulletin",$$YN(+$PIECE(IBPD0,U,15)),IBLN,IBLR,IBSEL)
+33 SET IBLN=$$SET("Means Test Mailgroup",$$EXSET^IBJU1($PIECE(IBPD0,U,11),350.9,.11),IBLN,IBLR,IBSEL)
+34 SET IBLN=$$SET("Per Diem Start Date",$$DATE^IBJU1(+$PIECE(IBPD0,U,12)),IBLN,IBLR,IBSEL)
+35 ;
+36 DO LEFT(2)
+37 SET IBLN=$$SET("# of Days Charges Held",$$EXSET^IBJU1($PIECE(IBPD7,U,4),350.9,7.04),IBLN,IBLR,IBSEL)
+38 ;
+39 ; - third party stuff
DO RIGHT(4,1,1)
+40 SET IBLN=$$SET("Disapproval Mailgroup",$$EXSET^IBJU1($PIECE(IBPD1,U,9),350.9,1.09),IBLN,IBLR,IBSEL)
+41 SET IBLN=$$SET("Cancellation Mailgroup",$$EXSET^IBJU1($PIECE(IBPD1,U,7),350.9,1.07),IBLN,IBLR,IBSEL)
+42 DO FSTRNG^IBJU1($PIECE(IBPD2,U,7),IBSW(IBLR),.IBX)
Begin DoDot:1
+43 SET IBI=$ORDER(IBX(0))
SET IBLN=$$SET("Cancellation Remark",$GET(IBX(+IBI)),IBLN,IBLR,IBSEL)
+44 FOR
SET IBI=$ORDER(IBX(IBI))
if 'IBI
QUIT
SET IBLN=$$SET("",IBX(+IBI),IBLN,IBLR,IBSEL)
End DoDot:1
KILL IBX
+45 ;
+46 DO RIGHT(4,1,1)
+47 SET IBLN=$$SET("New Insurance Mailgroup",$$EXSET^IBJU1($PIECE(IBPD4,U,4),350.9,4.04),IBLN,IBLR,IBSEL)
+48 SET IBLN=$$SET("Unbilled Mailgroup",$$EXSET^IBJU1($PIECE(IBPD6,U,25),350.9,6.25),IBLN,IBLR,IBSEL)
+49 SET IBLN=$$SET("Auto Print Unbilled List",$$YN(+$PIECE(IBPD6,U,24)),IBLN,IBLR,IBSEL)
+50 ;
+51 DO BLD2^IBJPS2
+52 ;
+53 SET VALMCNT=$SELECT(IBLN>IBGRPE:IBLN,1:IBGRPE)-1
+54 QUIT
+55 ;
SET(TTL,DATA,LN,LR,SEL) ;
+1 NEW IBY,IBX,IBC
SET IBC=": "
IF TTL=""
SET IBC=" "
+2 SET IBY=TTL_$JUSTIFY("",(IBTW(LR)-$LENGTH(TTL)-2))_IBC_DATA
SET IBX=$GET(^TMP("IBJPS",$JOB,LN,0))
+3 SET IBX=$$SETSTR^VALM1(IBY,IBX,IBTC(LR),(IBTW(LR)+IBSW(LR)))
+4 DO SET1(IBX,LN,SEL)
+5 SET LN=LN+1
+6 QUIT LN
+7 ;
SET1(STR,LN,SEL,RV) ; set up TMP array with screen data
+1 SET ^TMP("IBJPS",$JOB,LN,0)=STR
+2 SET ^TMP("IBJPS",$JOB,"IDX",LN,SEL)=""
+3 SET ^TMP("IBJPSAX",$JOB,SEL)=SEL
+4 IF $GET(RV)'=""
DO CNTRL^VALM10(LN,1,4,IOINHI,IOINORM)
+5 QUIT
+6 ;
YN(X) QUIT $SELECT(+X:"YES",1:"NO")
+1 ;
RIGHT(LR,SEL,BL) ; - reset control variables for right side of screen
+1 SET IBLN=$SELECT(IBLN>IBGRPE:IBLN,1:IBGRPE)
IF $GET(BL)
SET IBLN=$$SET("","",IBLN,IBLR,IBSEL)
+2 SET IBLR=$GET(LR)
SET IBGRPB=IBLN
IF +$GET(SEL)
SET IBSEL=IBSEL+1
DO SET1("["_IBSEL_"]",IBLN,IBSEL,1)
+3 QUIT
+4 ;
LEFT(LR) ; - reset control variables for left side of screen
+1 SET IBLR=$GET(LR)
SET IBGRPE=IBLN
SET IBLN=IBGRPB
+2 QUIT
