| 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 | ; | 
|---|