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