- 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 Jan 18, 2025@03:15:33 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 ;