VistA-WorldVistAEHR/r/INTEGRATED_BILLING-IB-PRQ--.../IBJPS1.m

83 lines
3.5 KiB
Mathematica

IBJPS1 ;ALB/MAF,ARH - IBSP IB SITE PARAMETER BUILD ;22-DEC-1995
;;2.0;INTEGRATED BILLING;**39,52,70,115,153,137,161**;21-MAR-94
;;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
;
; 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 (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