Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEAME

IBCNEAME.m

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