| [613] | 1 | IBCNEAME ;DAOU/ESG - IIV AUTO MATCH ENTRY/EDIT ;29-APR-2002
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184,252**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ENTER ;
|
|---|
| 6 | NEW STOP,AMIEN,NEWENTRY
|
|---|
| 7 | D INIT
|
|---|
| 8 | LOOP ;
|
|---|
| 9 | D LOOKUP() I STOP G EXIT ; lookup or add an entry
|
|---|
| 10 | D EDIT I STOP G LOOP ; edit the entry values
|
|---|
| 11 | D CONFIRM ; display a confirmation message
|
|---|
| 12 | G LOOP ; repeat
|
|---|
| 13 | EXIT ;
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | ;
|
|---|
| 17 | INIT ; clear the screen; display the purpose of this option
|
|---|
| 18 | W @IOF
|
|---|
| 19 | W !?14,"Enter/Edit Insurance Company Name Auto Match Entries"
|
|---|
| 20 | W !!,"This option will allow you to enter, edit, and manage the entries in the"
|
|---|
| 21 | W !,"Insurance Company Auto Match file. This file will aid in the proper selection"
|
|---|
| 22 | W !,"of Insurance Companies by associating together a valid, correct Insurance"
|
|---|
| 23 | W !,"Company name with an incorrect entry that a clerk may enter during data entry."
|
|---|
| 24 | W !
|
|---|
| 25 | INITX ;
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | LOOKUP(DEFAULT) ; Procedure to look-up or add an entry
|
|---|
| 29 | ;
|
|---|
| 30 | ; Optional input parameter DEFAULT will be set if calling this
|
|---|
| 31 | ; procedure from routine IBCNEAMC. Otherwise it will be undefined.
|
|---|
| 32 | ;
|
|---|
| 33 | NEW DA,DIC,DILN,DISYS,X,Y,DTOUT,DUOUT
|
|---|
| 34 | S STOP=0
|
|---|
| 35 | S (AMIEN,NEWENTRY)=""
|
|---|
| 36 | S DIC="^IBCN(365.11,",DLAYGO=365.11
|
|---|
| 37 | S DIC(0)="AELMVZ"
|
|---|
| 38 | S DIC("A")="Select an Auto Match Entry: "
|
|---|
| 39 | I $G(DEFAULT)'="" S DIC("B")=DEFAULT
|
|---|
| 40 | S DIC("W")="D LIST^IBCNEAME(Y)"
|
|---|
| 41 | D ^DIC
|
|---|
| 42 | I Y=-1!$D(DTOUT)!$D(DUOUT) S STOP=1 G LOOKX
|
|---|
| 43 | S AMIEN=+Y
|
|---|
| 44 | I $P(Y,U,3) S NEWENTRY=1
|
|---|
| 45 | LOOKX ;
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | EDIT ; Procedure to Edit the fields for this entry
|
|---|
| 49 | NEW DIE,DA,DR,DTOUT,D,D0,DDH,DI,DIC,DISYS,DQ,DZ,X,Y
|
|---|
| 50 | S DIE=365.11
|
|---|
| 51 | S DA=AMIEN
|
|---|
| 52 | S DR=".01;.02;.05////"_$$NOW^XLFDT_";.06////"_DUZ
|
|---|
| 53 | I NEWENTRY D
|
|---|
| 54 | . ; if this is a new entry, then stuff in all of these fields
|
|---|
| 55 | . ; without user interaction
|
|---|
| 56 | . S DR=".03////"_$$NOW^XLFDT_";.04////"_DUZ
|
|---|
| 57 | . S DR=DR_";.05////"_$$NOW^XLFDT_";.06////"_DUZ
|
|---|
| 58 | . S DR=DR_";.07////"_$P($G(^IBCN(365.11,DA,0)),U,1)
|
|---|
| 59 | . S DR=DR_";.08////"_$P($G(^IBCN(365.11,DA,0)),U,2)
|
|---|
| 60 | . Q
|
|---|
| 61 | D ^DIE
|
|---|
| 62 | I $D(Y) W ! S STOP=1 G EDITX ; user entered up arrow
|
|---|
| 63 | I '$D(DA) W !!?3,"This entry has been deleted.",! S STOP=1 G EDITX
|
|---|
| 64 | EDITX ;
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | CONFIRM ; Display a confirmation message indicating what was filed
|
|---|
| 68 | NEW DATA
|
|---|
| 69 | I 'AMIEN G CONFX
|
|---|
| 70 | S DATA=$G(^IBCN(365.11,AMIEN,0))
|
|---|
| 71 | W !!?3,$P(DATA,U,1)," is now associated with ",$P(DATA,U,2),".",!
|
|---|
| 72 | CONFX ;
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | LIST(IEN) ; FileMan lister display
|
|---|
| 76 | NEW DATA,D1,D2
|
|---|
| 77 | ; DATA=^IBCN(365.11,IEN,0)
|
|---|
| 78 | S DATA=^(0)
|
|---|
| 79 | S D1=$P(DATA,U,1),D2=$P(DATA,U,2)
|
|---|
| 80 | W $$FO^IBCNEUT1("",12-$L(D1))," is associated with ",D2
|
|---|
| 81 | LISTX ;
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
