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

IBCNEAMC.m

Go to the documentation of this file.
  1. IBCNEAMC ;DAOU/ESG - IIV AUTO MATCH BUFFER LISTING ;11-JUN-2002
  1. ;;2.0;INTEGRATED BILLING;**184,252,566,687**;21-MAR-94;Build 88
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; IA 10076 - to access ^XUSEC global for checking security key.
  1. ;
  1. EN ; -- main entry point for IBCNE AUTO MATCH BUFFER LIST
  1. NEW IBCNENIL,COL,CTRLCOL,FINISH,POP,VALMBCK,X,%DT
  1. D EN^VALM("IBCNE AUTO MATCH BUFFER LIST")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="These are Insurance Company names from the Insurance Buffer file that do not"
  1. S VALMHDR(2)="exist in the Insurance Company file (either as Names or as Synonyms). They"
  1. S VALMHDR(3)="also do not exist or pattern match with any entry in the Auto Match file."
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. NEW ENTDATE,IBBUFDA,BUFFNAME
  1. KILL ^TMP($J,"IBCNEAMC")
  1. S IBCNENIL=0 ; initialize the no data flag
  1. S ENTDATE=0
  1. F S ENTDATE=$O(^IBA(355.33,"AEST","E",ENTDATE)) Q:'ENTDATE S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",ENTDATE,IBBUFDA)) Q:'IBBUFDA D
  1. . S BUFFNAME=$$TRIM($P($G(^IBA(355.33,IBBUFDA,20)),U,1))
  1. . I BUFFNAME="" Q ; no name in buffer file
  1. . I $D(^DIC(36,"B",BUFFNAME)) Q ; insurance company name
  1. . I $D(^DIC(36,"C",BUFFNAME)) Q ; insurance company synonym
  1. . I $$AMLOOK^IBCNEUT1(BUFFNAME) Q ; Auto Match file lookup
  1. . S ^TMP($J,"IBCNEAMC",2,BUFFNAME)="" ; name not found so add it
  1. . Q
  1. ; Now build the ListMan array for display
  1. S BUFFNAME="",VALMCNT=0
  1. F S BUFFNAME=$O(^TMP($J,"IBCNEAMC",2,BUFFNAME)) Q:BUFFNAME="" D
  1. . S VALMCNT=VALMCNT+1
  1. . S ^TMP($J,"IBCNEAMC",1,VALMCNT,0)=$J(VALMCNT,4)_" "_BUFFNAME
  1. . S ^TMP($J,"IBCNEAMC",3,VALMCNT)=BUFFNAME
  1. . Q
  1. ;
  1. ; Check to see if there's no data
  1. I 'VALMCNT D
  1. . S IBCNENIL=1 ; no data flag is true
  1. . S ^TMP($J,"IBCNEAMC",1,1,0)=""
  1. . S ^TMP($J,"IBCNEAMC",1,2,0)=""
  1. . S ^TMP($J,"IBCNEAMC",1,3,0)=" There is no data to display."
  1. . S VALMCNT=3
  1. . Q
  1. INITX ;
  1. Q
  1. ;
  1. ; For speed reasons, code taken from TRIM^XLFSTR
  1. TRIM(X,SIDE,CHAR) ; Trim chars from left/right of string
  1. NEW LEFT,RIGHT
  1. I X="" Q X
  1. S SIDE=$G(SIDE,"LR"),CHAR=$G(CHAR," "),LEFT=1,RIGHT=$L(X)
  1. I X=CHAR Q ""
  1. I SIDE["R" F RIGHT=$L(X):-1:1 Q:$E(X,RIGHT)'=CHAR
  1. I SIDE["L" F LEFT=1:1:$L(X) Q:$E(X,LEFT)'=CHAR
  1. Q $E(X,LEFT,RIGHT)
  1. ;
  1. ;
  1. HELP ; -- help code
  1. D FULL^VALM1
  1. W !!," There are three main actions you may take on this screen."
  1. W !," You may select an action by typing in the first character of the action."
  1. W !!," Select Entry"
  1. W !," You choose a single insurance company name from the list."
  1. W !," This name becomes the default Auto Match value for a new"
  1. W !," Auto Match entry. You may then associate this Auto Match value"
  1. W !," with a valid insurance company name."
  1. W !!," Auto Match Enter/Edit"
  1. W !," This action will take you to the Enter/Edit Auto Match Entries"
  1. W !," option. You may add, edit, or delete multiple Auto Match"
  1. W !," entries in this option."
  1. W !!," Exit"
  1. W !," Exit out of this option."
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. HELPX ;
  1. Q
  1. ;
  1. ;
  1. EXIT ; -- exit code
  1. KILL ^TMP($J,"IBCNEAMC")
  1. Q
  1. ;
  1. ;
  1. SELECT ; -- select an entry from the list
  1. NEW STOP,AMIEN,NEWENTRY,BUFFNAME,INSNM
  1. NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. D FULL^VALM1
  1. ;
  1. ; Check for Auto Match security key before allowing selection
  1. ;/vd-IB*2.0*687 - The following lines of code were changed to address the renaming of the Security Key.
  1. ;I '$$KCHK^XUSRB("IBCNE EIV MAINTENANCE") D G SELECTX
  1. ;. W !!?5,"You don't hold the proper security key to access this function."
  1. ;. W !?5,"The necessary key is IBCNE EIV MAINTENANCE. Please see your manager."
  1. ;. D PAUSE^VALM1
  1. I '$D(^XUSEC("IBCNE EIV IIU MAINTENANCE",DUZ)) D G SELECTX
  1. . W !!?5,"You don't hold the proper security key to access this function."
  1. . W !?5,"The necessary key is IBCNE EIV IIU MAINTENANCE. Please see your manager."
  1. . D PAUSE^VALM1
  1. . Q
  1. ;
  1. ; Make sure there is something there
  1. I IBCNENIL D G SELECTX
  1. . W !!?5,"There are no entries in the list."
  1. . D PAUSE^VALM1
  1. . Q
  1. ;
  1. S DIR(0)="NO^1:"_VALMCNT_":0"
  1. S DIR("A")="Select Entry"
  1. S DIR("?",1)=" Please enter the line number corresponding to the insurance company name."
  1. S DIR("?",2)=" The valid range of line numbers is displayed in the prompt."
  1. S DIR("?",3)=" "
  1. S DIR("?",4)=" The insurance company name you select will be used as the default response for"
  1. S DIR("?",5)=" a new Auto Match entry. You may either accept this entry as is or you may"
  1. S DIR("?")=" modify it by changing the spelling or by adding wildcard characters."
  1. D ^DIR K DIR
  1. I 'Y G SELECTX
  1. S BUFFNAME=$G(^TMP($J,"IBCNEAMC",3,Y))
  1. I BUFFNAME="" W ! G SELECTX
  1. W " ",BUFFNAME,!
  1. ;
  1. D LOOKUP I STOP G SELECTX ;Prompt user for Insurance Co.
  1. I $D(^IBCN(365.11,"B",BUFFNAME)) D G SELECTX ; has entry been added?
  1. . W !!,BUFFNAME," has already been added to the Auto Match file."
  1. . S DIR(0)="E" D ^DIR K DIR
  1. . D INIT ; refresh listing
  1. D AMADD^IBCNEUT6(INSNM,BUFFNAME)
  1. D INIT
  1. SELECTX ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. LOOKUP ; Prompt for associated Insurance Company
  1. S STOP=0
  1. S DIC=36,DIC(0)="AEMVZ"
  1. D ^DIC
  1. I Y<1!$D(DTOUT)!$D(DUOUT) S STOP=1 G LOOKX
  1. S INSNM=$P(Y(0),U)
  1. LOOKX Q
  1. ;
  1. D FULL^VALM1
  1. ;
  1. ; Check for Auto Match security key before allowing selection
  1. ;/vd-IB*2.0*687 - The following lines of code were changed to address the renaming of the Security Key.
  1. ;I '$$KCHK^XUSRB("IBCNE EIV MAINTENANCE") D G LINKX
  1. ;. W !!?5,"You don't hold the proper security key to access this function."
  1. ;. W !?5,"The necessary key is IBCNE EIV MAINTENANCE. Please see your manager."
  1. ;. D PAUSE^VALM1
  1. I '$D(^XUSEC("IBCNE EIV IIU MAINTENANCE",DUZ)) D G LINKX
  1. . W !!?5,"You don't hold the proper security key to access this function."
  1. . W !?5,"The necessary key is IBCNE EIV IIU MAINTENANCE. Please see your manager."
  1. . D PAUSE^VALM1
  1. . Q
  1. ;
  1. D ENTER^IBCNEAME
  1. LINKX ;
  1. D INIT S VALMBCK="R"
  1. Q
  1. ;