source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJPS1.m@ 1581

Last change on this file since 1581 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1IBJPS1 ;ALB/MAF,ARH - IBSP IB SITE PARAMETER BUILD ;22-DEC-1995
2 ;;2.0;INTEGRATED BILLING;**39,52,70,115,153,137,161**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLD ; - build screen array for IB parameters
6 N IBTW,IBTC,IBSW,IBLN,IBGRPB,IBGRPE,IBX,IBT,IBI,IBLR,IBSEL,IBPD0,IBPD1,IBPD2,IBPD4,IBPD6,IBPD7,IBPD8,IBPD9,IBPD10
7 N IBPD50,IBCISOCK,IBCIMFLG
8 ;
9 ; IBTW = max width of data IBTC = start column of data
10 ; IBSW = total width of prompt field (including the ":")
11 S IBTW(1)=21,IBTC(1)=5,IBSW(1)=19
12 S IBTW(2)=21,IBTC(2)=47,IBSW(2)=13
13 S IBTW(3)=21,IBTC(3)=5,IBSW(3)=53
14 S IBTW(4)=27,IBTC(4)=5,IBSW(4)=47
15 S IBTW(5)=17,IBTC(5)=5,IBSW(5)=19
16 S IBTW(6)=19,IBTC(6)=41,IBSW(6)=17
17 S IBTW(7)=35,IBTC(7)=5,IBSW(7)=46
18 S IBTW(8)=32,IBTC(8)=5,IBSW(8)=46
19 S IBTW(9)=31,IBTC(9)=5,IBSW(9)=43
20 ;
21 S IBPD0=$G(^IBE(350.9,1,0)),IBPD1=$G(^IBE(350.9,1,1)),IBPD2=$G(^IBE(350.9,1,2))
22 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))
23 S IBPD7=$G(^IBE(350.9,1,7)),IBPD10=$G(^IBE(350.9,1,10)),IBPD50=$G(^IBE(350.9,1,50))
24 ;
25 S (VALMCNT,IBLN,IBGRPB,IBGRPE)=1,IBSEL=0
26 ;
27 D RIGHT(4,1,"") ; - copay stuff
28 S IBLN=$$SET("Copay Background Error Mg",$$EXSET^IBJU1($P(IBPD0,U,9),350.9,.09),IBLN,IBLR,IBSEL)
29 S IBLN=$$SET("Copay Exemption Mailgroup",$$EXSET^IBJU1($P(IBPD0,U,13),350.9,.13),IBLN,IBLR,IBSEL)
30 S IBLN=$$SET("Use Alerts for Exemption",$$YN($P(IBPD0,U,14)),IBLN,IBLR,IBSEL)
31 ;
32 D RIGHT(4,1,1) ; - patient Billing
33 S IBLN=$$SET("Hold MT Bills w/Ins",$$YN(+$P(IBPD1,U,20)),IBLN,IBLR,IBSEL)
34 S IBLN=$$SET("Suppress MT Ins Bulletin",$$YN(+$P(IBPD0,U,15)),IBLN,IBLR,IBSEL)
35 S IBLN=$$SET("Means Test Mailgroup",$$EXSET^IBJU1($P(IBPD0,U,11),350.9,.11),IBLN,IBLR,IBSEL)
36 S IBLN=$$SET("Per Diem Start Date",$$DATE^IBJU1(+$P(IBPD0,U,12)),IBLN,IBLR,IBSEL)
37 ;
38 D LEFT(2)
39 S IBLN=$$SET("# of Days Charges Held",$$EXSET^IBJU1($P(IBPD7,U,4),350.9,7.04),IBLN,IBLR,IBSEL)
40 ;
41 D RIGHT(4,1,1) ; - third party stuff
42 S IBLN=$$SET("Disapproval Mailgroup",$$EXSET^IBJU1($P(IBPD1,U,9),350.9,1.09),IBLN,IBLR,IBSEL)
43 S IBLN=$$SET("Cancellation Mailgroup",$$EXSET^IBJU1($P(IBPD1,U,7),350.9,1.07),IBLN,IBLR,IBSEL)
44 D FSTRNG^IBJU1($P(IBPD2,U,7),IBSW(IBLR),.IBX) D K IBX
45 . S IBI=$O(IBX(0)) S IBLN=$$SET("Cancellation Remark",$G(IBX(+IBI)),IBLN,IBLR,IBSEL)
46 . F S IBI=$O(IBX(IBI)) Q:'IBI S IBLN=$$SET("",IBX(+IBI),IBLN,IBLR,IBSEL)
47 ;
48 D RIGHT(4,1,1)
49 S IBLN=$$SET("New Insurance Mailgroup",$$EXSET^IBJU1($P(IBPD4,U,4),350.9,4.04),IBLN,IBLR,IBSEL)
50 S IBLN=$$SET("Unbilled Mailgroup",$$EXSET^IBJU1($P(IBPD6,U,25),350.9,6.25),IBLN,IBLR,IBSEL)
51 S IBLN=$$SET("Auto Print Unbilled List",$$YN(+$P(IBPD6,U,24)),IBLN,IBLR,IBSEL)
52 ;
53 D BLD2^IBJPS2
54 ;
55 S VALMCNT=$S(IBLN>IBGRPE:IBLN,1:IBGRPE)-1
56 Q
57 ;
58SET(TTL,DATA,LN,LR,SEL) ;
59 N IBY,IBX,IBC S IBC=": " I TTL="" S IBC=" "
60 S IBY=TTL_$J("",(IBTW(LR)-$L(TTL)-2))_IBC_DATA,IBX=$G(^TMP("IBJPS",$J,LN,0))
61 S IBX=$$SETSTR^VALM1(IBY,IBX,IBTC(LR),(IBTW(LR)+IBSW(LR)))
62 D SET1(IBX,LN,SEL)
63 S LN=LN+1
64 Q LN
65 ;
66SET1(STR,LN,SEL,RV) ; set up TMP array with screen data
67 S ^TMP("IBJPS",$J,LN,0)=STR
68 S ^TMP("IBJPS",$J,"IDX",LN,SEL)=""
69 S ^TMP("IBJPSAX",$J,SEL)=SEL
70 I $G(RV)'="" D CNTRL^VALM10(LN,1,4,IOINHI,IOINORM)
71 Q
72 ;
73YN(X) Q $S(+X:"YES",1:"NO")
74 ;
75RIGHT(LR,SEL,BL) ; - reset control variables for right side of screen
76 S IBLN=$S(IBLN>IBGRPE:IBLN,1:IBGRPE) I $G(BL) S IBLN=$$SET("","",IBLN,IBLR,IBSEL)
77 S IBLR=$G(LR),IBGRPB=IBLN I +$G(SEL) S IBSEL=IBSEL+1 D SET1("["_IBSEL_"]",IBLN,IBSEL,1)
78 Q
79 ;
80LEFT(LR) ; - reset control variables for left side of screen
81 S IBLR=$G(LR),IBGRPE=IBLN,IBLN=IBGRPB
82 Q
Note: See TracBrowser for help on using the repository browser.