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