IBCNEAME ;DAOU/ESG - IIV AUTO MATCH ENTRY/EDIT ;29-APR-2002
;;2.0;INTEGRATED BILLING;**184,252,595**;21-MAR-94;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
ENTER ;
NEW STOP,AMIEN,NEWENTRY,DUOUT,DTOUT
D INIT
LOOP ;
N DIR
D LOOKUP() I STOP G EXIT ; lookup or add an entry
; IB*595/HN Updates Add New Question and Delete logic
I $G(NEWENTRY)=1 W !,$P(^IBCN(365.11,AMIEN,0),"^",1)_" is now associated with "_$P(^IBCN(365.11,AMIEN,0),"^",2),! G LOOP
S DIR(0)="SA^E:Edit;D:Delete"
S DIR("A")="Do you want to Edit or Delete this entry? "
S DIR("B")="E"
D ^DIR
I $D(DUOUT) G LOOP
I $D(DTOUT) G EXIT
D @($S(Y="D":"DELETE",1:"EDIT")) I STOP G LOOP
;D EDIT I STOP G LOOP ; edit the entry values
; IB*595 End
D CONFIRM ; display a confirmation message
G LOOP ; repeat
EXIT ;
Q
;
;
INIT ; clear the screen; display the purpose of this option
W @IOF
W !?14,"Enter/Edit Insurance Company Name Auto Match Entries"
W !!,"This option will allow you to enter, edit, and manage the entries in the"
W !,"Insurance Company Auto Match file. This file will aid in the proper selection"
W !,"of Insurance Companies by associating together a valid, correct Insurance"
W !,"Company name with an incorrect entry that a clerk may enter during data entry."
W !
INITX ;
Q
;
LOOKUP(DEFAULT) ; Procedure to look-up or add an entry
;
; Optional input parameter DEFAULT will be set if calling this
; procedure from routine IBCNEAMC. Otherwise it will be undefined.
;
NEW DA,DIC,DILN,DISYS,X,Y,DTOUT,DUOUT,DLAYGO
S STOP=0
S (AMIEN,NEWENTRY)=""
S DIC="^IBCN(365.11,",DLAYGO=365.11
S DIC(0)="AELMVZ"
S DIC("A")="Select an Auto Match Entry: "
I $G(DEFAULT)'="" S DIC("B")=DEFAULT
S DIC("W")="D LIST^IBCNEAME(Y)"
D ^DIC
I Y=-1!$D(DTOUT)!$D(DUOUT) S STOP=1 G LOOKX
S AMIEN=+Y
I $P(Y,U,3) S NEWENTRY=1
LOOKX ;
Q
;
EDIT ; Procedure to Edit the fields for this entry
NEW DIE,DA,DR,DTOUT,D,D0,DDH,DI,DIC,DISYS,DQ,DZ,X,Y
S DIE=365.11
S DA=AMIEN
S DR=".01;.02;.05////"_$$NOW^XLFDT_";.06////"_DUZ
I NEWENTRY D
. ; if this is a new entry, then stuff in all of these fields
. ; without user interaction
. S DR=".03////"_$$NOW^XLFDT_";.04////"_DUZ
. S DR=DR_";.05////"_$$NOW^XLFDT_";.06////"_DUZ
. S DR=DR_";.07////"_$P($G(^IBCN(365.11,DA,0)),U,1)
. S DR=DR_";.08////"_$P($G(^IBCN(365.11,DA,0)),U,2)
. Q
D ^DIE
I $D(Y) W ! S STOP=1 G EDITX ; user entered up arrow
I '$D(DA) W !!?3,"This entry has been deleted.",! S STOP=1 G EDITX
EDITX ;
Q
;
CONFIRM ; Display a confirmation message indicating what was filed
NEW DATA
I 'AMIEN G CONFX
S DATA=$G(^IBCN(365.11,AMIEN,0))
W !!?3,$P(DATA,U,1)," is now associated with ",$P(DATA,U,2),".",!
CONFX ;
Q
;
LIST(IEN) ; FileMan lister display
NEW DATA,D1,D2
; DATA=^IBCN(365.11,IEN,0)
S DATA=^(0)
S D1=$P(DATA,U,1),D2=$P(DATA,U,2)
W $$FO^IBCNEUT1("",12-$L(D1))," is associated with ",D2
LISTX ;
Q
;
DELETE ; Verify Delete
N DIK,DIR
S DIR(0)="Y"
S DIR("A")="Are you sure you want to delete <"_$P(^IBCN(365.11,AMIEN,0),"^")_">: "
S DIR("B")="N"
D ^DIR
I $G(Y(0))'="YES" G DELETEX
S DIK="^IBCN(365.11,",DA=AMIEN D ^DIK
W !,"This entry has been deleted.",!
DELETEX ;
S STOP=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEAME 3341 printed Dec 13, 2024@02:14:21 Page 2
IBCNEAME ;DAOU/ESG - IIV AUTO MATCH ENTRY/EDIT ;29-APR-2002
+1 ;;2.0;INTEGRATED BILLING;**184,252,595**;21-MAR-94;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
ENTER ;
+1 NEW STOP,AMIEN,NEWENTRY,DUOUT,DTOUT
+2 DO INIT
LOOP ;
+1 NEW DIR
+2 ; lookup or add an entry
DO LOOKUP()
IF STOP
GOTO EXIT
+3 ; IB*595/HN Updates Add New Question and Delete logic
+4 IF $GET(NEWENTRY)=1
WRITE !,$PIECE(^IBCN(365.11,AMIEN,0),"^",1)_" is now associated with "_$PIECE(^IBCN(365.11,AMIEN,0),"^",2),!
GOTO LOOP
+5 SET DIR(0)="SA^E:Edit;D:Delete"
+6 SET DIR("A")="Do you want to Edit or Delete this entry? "
+7 SET DIR("B")="E"
+8 DO ^DIR
+9 IF $DATA(DUOUT)
GOTO LOOP
+10 IF $DATA(DTOUT)
GOTO EXIT
+11 DO @($SELECT(Y="D":"DELETE",1:"EDIT"))
IF STOP
GOTO LOOP
+12 ;D EDIT I STOP G LOOP ; edit the entry values
+13 ; IB*595 End
+14 ; display a confirmation message
DO CONFIRM
+15 ; repeat
GOTO LOOP
EXIT ;
+1 QUIT
+2 ;
+3 ;
INIT ; clear the screen; display the purpose of this option
+1 WRITE @IOF
+2 WRITE !?14,"Enter/Edit Insurance Company Name Auto Match Entries"
+3 WRITE !!,"This option will allow you to enter, edit, and manage the entries in the"
+4 WRITE !,"Insurance Company Auto Match file. This file will aid in the proper selection"
+5 WRITE !,"of Insurance Companies by associating together a valid, correct Insurance"
+6 WRITE !,"Company name with an incorrect entry that a clerk may enter during data entry."
+7 WRITE !
INITX ;
+1 QUIT
+2 ;
LOOKUP(DEFAULT) ; Procedure to look-up or add an entry
+1 ;
+2 ; Optional input parameter DEFAULT will be set if calling this
+3 ; procedure from routine IBCNEAMC. Otherwise it will be undefined.
+4 ;
+5 NEW DA,DIC,DILN,DISYS,X,Y,DTOUT,DUOUT,DLAYGO
+6 SET STOP=0
+7 SET (AMIEN,NEWENTRY)=""
+8 SET DIC="^IBCN(365.11,"
SET DLAYGO=365.11
+9 SET DIC(0)="AELMVZ"
+10 SET DIC("A")="Select an Auto Match Entry: "
+11 IF $GET(DEFAULT)'=""
SET DIC("B")=DEFAULT
+12 SET DIC("W")="D LIST^IBCNEAME(Y)"
+13 DO ^DIC
+14 IF Y=-1!$DATA(DTOUT)!$DATA(DUOUT)
SET STOP=1
GOTO LOOKX
+15 SET AMIEN=+Y
+16 IF $PIECE(Y,U,3)
SET NEWENTRY=1
LOOKX ;
+1 QUIT
+2 ;
EDIT ; Procedure to Edit the fields for this entry
+1 NEW DIE,DA,DR,DTOUT,D,D0,DDH,DI,DIC,DISYS,DQ,DZ,X,Y
+2 SET DIE=365.11
+3 SET DA=AMIEN
+4 SET DR=".01;.02;.05////"_$$NOW^XLFDT_";.06////"_DUZ
+5 IF NEWENTRY
Begin DoDot:1
+6 ; if this is a new entry, then stuff in all of these fields
+7 ; without user interaction
+8 SET DR=".03////"_$$NOW^XLFDT_";.04////"_DUZ
+9 SET DR=DR_";.05////"_$$NOW^XLFDT_";.06////"_DUZ
+10 SET DR=DR_";.07////"_$PIECE($GET(^IBCN(365.11,DA,0)),U,1)
+11 SET DR=DR_";.08////"_$PIECE($GET(^IBCN(365.11,DA,0)),U,2)
+12 QUIT
End DoDot:1
+13 DO ^DIE
+14 ; user entered up arrow
IF $DATA(Y)
WRITE !
SET STOP=1
GOTO EDITX
+15 IF '$DATA(DA)
WRITE !!?3,"This entry has been deleted.",!
SET STOP=1
GOTO EDITX
EDITX ;
+1 QUIT
+2 ;
CONFIRM ; Display a confirmation message indicating what was filed
+1 NEW DATA
+2 IF 'AMIEN
GOTO CONFX
+3 SET DATA=$GET(^IBCN(365.11,AMIEN,0))
+4 WRITE !!?3,$PIECE(DATA,U,1)," is now associated with ",$PIECE(DATA,U,2),".",!
CONFX ;
+1 QUIT
+2 ;
LIST(IEN) ; FileMan lister display
+1 NEW DATA,D1,D2
+2 ; DATA=^IBCN(365.11,IEN,0)
+3 SET DATA=^(0)
+4 SET D1=$PIECE(DATA,U,1)
SET D2=$PIECE(DATA,U,2)
+5 WRITE $$FO^IBCNEUT1("",12-$LENGTH(D1))," is associated with ",D2
LISTX ;
+1 QUIT
+2 ;
DELETE ; Verify Delete
+1 NEW DIK,DIR
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Are you sure you want to delete <"_$PIECE(^IBCN(365.11,AMIEN,0),"^")_">: "
+4 SET DIR("B")="N"
+5 DO ^DIR
+6 IF $GET(Y(0))'="YES"
GOTO DELETEX
+7 SET DIK="^IBCN(365.11,"
SET DA=AMIEN
DO ^DIK
+8 WRITE !,"This entry has been deleted.",!
DELETEX ;
+1 SET STOP=1
+2 QUIT
