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

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBJPB ;ALB/MAF,ARH - IBSP AUTOMATED BILLING SCREEN ; 28-DEC-1995
2 ;;Version 2.0 ; INTEGRATED BILLING ;**39,55**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBJP AUTO BILLING screen
6 D EN^VALM("IBJP AUTO BILLING")
7 Q
8 ;
9HDR ; -- header code
10 S VALMHDR(1)="Only authorized persons may edit this data."
11 Q
12 ;
13INIT ; -- init variables and list array
14 K ^TMP("IBJPB",$J)
15 D BLD
16 Q
17HELP ; -- help code
18 S X="?" D DISP^XQORM1 W !!
19 Q
20 ;
21EXIT ; -- exit code
22 K ^TMP("IBJPB",$J)
23 D CLEAR^VALM1
24 Q
25 ;
26BLD ; - build screen array, no variables required
27 N IBNC,IBTC,IBTW,IBSW,IBLN,IBX,IBLR,IBJDATA,IBGRPB,IBGRPE,IBON
28 S IBNC(1)=11,IBTC(1)=2,IBTW(1)=23,IBSW(1)=13,IBNC(2)=50,IBTC(2)=41,IBTW(2)=23,IBSW(2)=13
29 ;
30 S (VALMCNT,IBLN)=1,IBLR=1,IBLN=$$SET("","",IBLN,IBLR),IBGRPB=IBLN
31 ;
32 ; - general parameters controlling AB
33 S IBJDATA=$G(^IBE(350.9,1,7))
34 S IBLN=$$SETN("GENERAL PARAMETERS",IBLN,IBLR,1)
35 S IBLN=$$SET("Auto Biller Frequency: ",+$P(IBJDATA,"^",1),IBLN,IBLR)
36 S IBLN=$$SET("Date Last Completed: ",$$DATE^IBJU1($P(IBJDATA,"^",2)),IBLN,IBLR)
37 S IBLN=$$SET("Inpatient Status: ",$$EXSET^IBJU1($P(IBJDATA,"^",3),350.9,7.03),IBLN,IBLR)
38 ;
39 ; - inpatient, outpatient, and prescription refill parameters
40 F IBX=1,2,4 D
41 . I IBLR=1 S IBLN=IBGRPB,IBGRPE=IBLN,IBLR=2
42 . E S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE),IBLN=$$SET("","",IBLN,IBLR),IBGRPB=IBLN,IBLR=1
43 . ;
44 . S IBX=$O(^IBE(356.6,"AC",+IBX,0)),IBJDATA=$G(^IBE(356.6,+IBX,0))
45 . S IBLN=$$SETN($P(IBJDATA,U,1),IBLN,IBLR,1),IBON=+$P(IBJDATA,"^",4)
46 . S IBLN=$$SET("Automate Billing: ",$S(+IBON:"YES",1:"NO"),IBLN,IBLR)
47 . S IBLN=$$SET("Billing Cycle: ",$S(+$P(IBJDATA,"^",5):$P(IBJDATA,"^",5),+IBON:"Monthly",1:""),IBLN,IBLR)
48 . S IBLN=$$SET("Days Delay: ",$P(IBJDATA,"^",6),IBLN,IBLR)
49 ;
50 S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE)-1
51 Q
52 ;
53SET(TTL,DATA,LN,LR) ;
54 N IBY
55 S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
56 S LN=LN+1
57 Q LN
58 ;
59SETN(TTL,LN,LR,RV) ;
60 N IBY
61 S IBY=" "_TTL_" " D SET1(IBY,LN,IBNC(LR),$L(IBY),$G(RV))
62 S LN=LN+1
63 Q LN
64 ;
65SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
66 N IBX S IBX=$G(^TMP("IBJPB",$J,LN,0))
67 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
68 D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
69 Q
70 ;
71ABEDIT(IBJABP) ; -- IBJP AB EDIT ACTIONS (IP,OP,RX): Edit Automated Billing Parameters
72 ; Entry Code (356.6,.08) of CT Type to edit passed in
73 D FULL^VALM1
74 S IBJABP=$O(^IBE(356.6,"AC",IBJABP,0)) I 'IBJABP S VALMSG="Parameter set not found."
75 I +IBJABP S DIE="^IBE(356.6,",DA=+IBJABP,DR=".04;.05;.06" D ^DIE K DIE,DIC,DA,DR,X,Y
76 D INIT S VALMBCK="R"
77 Q
78 ;
79ABGEDIT ; -- IBJP AB GENERAL EDIT ACTION (GP): Edit General Automated Billing Parameters
80 D FULL^VALM1 N IBFR,IBFR2,IBZWRT,DIE,DIC,DA,DR,X,Y,DIR,DIRUT
81 S IBFR=$P($G(^IBE(350.9,1,7)),U,1)
82 S DIE="^IBE(350.9,",DA=1,DR="7.01;7.03" D ^DIE I $D(Y) K DIE,DIC,DA,DR,X,Y
83 S IBFR2=$P($G(^IBE(350.9,1,7)),U,1)
84 S IBZWRT=1 D:'IBFR CLEAN^IBCDC D:'IBFR2 ABOFF^IBCDC I 'IBZWRT S DIR(0)="E" D ^DIR K DIR
85 D INIT S VALMBCK="R"
86 Q
Note: See TracBrowser for help on using the repository browser.