1 | IBCNEUT2 ;DAOU/DAC - IIV MISC. UTILITIES ;06-JUN-2002
|
---|
2 | ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; Can't be called from the top
|
---|
6 | Q
|
---|
7 | ;
|
---|
8 | SAVETQ(IEN,TDT) ; Update service date in TQ record
|
---|
9 | ;
|
---|
10 | N DIE,DA,DR,D,D0,DI,DIC,DQ,X
|
---|
11 | S DIE="^IBCN(365.1,",DA=IEN,DR=".12////"_TDT
|
---|
12 | D ^DIE
|
---|
13 | Q
|
---|
14 | ;
|
---|
15 | ;
|
---|
16 | SST(IEN,STAT) ; Set the Transmission Queue Status
|
---|
17 | ; Input parameters
|
---|
18 | ; IEN = Internal entry number for the record
|
---|
19 | ; STAT= Status IEN
|
---|
20 | ;
|
---|
21 | NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
|
---|
22 | ;
|
---|
23 | I IEN="" Q
|
---|
24 | ;
|
---|
25 | S DIE="^IBCN(365.1,",DA=IEN,DR=".04////^S X=STAT;.15////^S X=$$NOW^XLFDT()"
|
---|
26 | D ^DIE
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | RSP(IEN,STAT) ; Set the Response File Status
|
---|
30 | ; Input parameters
|
---|
31 | ; IEN = Internal entry number for the record
|
---|
32 | ; STAT= Status IEN
|
---|
33 | ;
|
---|
34 | NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X
|
---|
35 | S DIE="^IBCN(365,",DA=IEN,DR=".06////^S X=STAT"
|
---|
36 | D ^DIE
|
---|
37 | Q
|
---|
38 | ;
|
---|
39 | BUFF(BUFF,BNG) ; Set error symbol into Buffer File
|
---|
40 | ; Input Parameter
|
---|
41 | ; BUFF = Buffer internal entry number
|
---|
42 | ; BNG = Buffer Symbol IEN
|
---|
43 | I 'BUFF!'BNG Q
|
---|
44 | NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,DISYS
|
---|
45 | S DIE="^IBA(355.33,",DA=BUFF,DR=".12////^S X=BNG"
|
---|
46 | D ^DIE
|
---|
47 | Q
|
---|
48 | ;
|
---|
49 | PAYR ; Set up the '~NO PAYER' payer. This procedure is called by both
|
---|
50 | ; the post-install routine and by the nightly batch extract routine.
|
---|
51 | S DLAYGO=365.12,DIC(0)="L",DIC("P")=DLAYGO,DIC="^IBE(365.12,"
|
---|
52 | S X="~NO PAYER" D ^DIC
|
---|
53 | S DA=+Y
|
---|
54 | S DR=".02////^S X=""00000""",DIE=DIC D ^DIE
|
---|
55 | ;
|
---|
56 | ; Set up Payer Application with active flags (if needed)
|
---|
57 | ;S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV")
|
---|
58 | ;I '$D(^IBE(365.12,DA,1,0)) S ^IBE(365.12,DA,1,0)="^365.121P^^"
|
---|
59 | ;S DLAYGO=365.121,DIC(0)="L",DIC("P")=DLAYGO,DA(1)=DA
|
---|
60 | ;S DIC="^IBE(365.12,"_DA(1)_",1,"
|
---|
61 | ;S X="IIV" D ^DIC
|
---|
62 | ;S DA=+Y
|
---|
63 | ;S DIE=DIC,DR=".02////1;.03////1;.05////^S X=$$NOW^XLFDT();.06////^S X=$$NOW^XLFDT()"
|
---|
64 | ;S DR=DR_";.04////^S X=IDUZ" D ^DIE
|
---|
65 | ;
|
---|
66 | K DA,DIC,DLAYGO,X,Y,D1,DILN,DISYS,IDUZ,DIE,DR,D0,D,DI,DIERR,DQ
|
---|
67 | Q
|
---|
68 | ;
|
---|