- 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 Feb 18, 2025@23:40:45 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