IBCNBLA ;ALB/ARH - Ins Buffer: LM action calls ;1 Jun 97
;;2.0;INTEGRATED BILLING;**82,149,153,184,271,416,506,601,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
NEWSCRN(TEMPLAT,TMPARR,IBBUFDA) ; open a new screen for a specific buffer entry, pass in LM template and the array to select from
; if temp array is defined then user selects the buffer entry, otherwise use entry passed in
;
I $G(TMPARR)'="" N IBBUFDA S IBBUFDA=$$SEL(TMPARR)
I +$G(IBBUFDA),$G(TEMPLAT)'="",+$$LOCK^IBCNBU1(IBBUFDA,1) D EN^VALM(TEMPLAT) D UNLOCK^IBCNBU1(IBBUFDA)
S VALMBCK="R"
Q
;
SEL(TMPARR) ; user selects one of the items from the list on the screen
;
N VALMY,IBX,IBY,IBSELN S IBX=""
I $G(TMPARR)'="",'$O(^TMP(TMPARR,$J,0)) D G SELQ
. W !!,"There are no '",$S($G(VALM("ENTITY"))'="":VALM("ENTITY"),1:"record"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR
;
D EN^VALM2($G(XQORNOD(0)),"OS")
I $D(VALMY),$G(TMPARR)'="" S IBSELN=0 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D
. S IBX=$P($G(^TMP(TMPARR,$J,IBSELN)),U,2,99)
. ;
. I TMPARR="IBCNBLLX" S IBY=$P($G(^IBA(355.33,+IBX,0)),U,4) I IBY'="E" D S IBX=""
.. W !!," >>> Selected entry has been ",$S(IBY="A":"ACCEPTED",IBY="R":"REJECTED",1:"UNKNOWN STATUS")
.. W " and may no longer be edited or modified.",! S DIR(0)="E" D ^DIR K DIR
;
SELQ Q IBX
;
PNXTSCRN(TEMPLAT,IBBUFDA) ; open a new screen for a buffer entry, rebuild the process screen on return since it may have changed
D NEWSCRN^IBCNBLA(TEMPLAT,"",IBBUFDA)
D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R"
Q
;
LNXTSCRN(TEMPLAT,TMPARR,AVIEW) ; select entries from list to process/expand
;
; This procedure is called from the ListMan action protocols for
; processing and expanding buffer entries.
; TEMPLAT - list template name for associated action
; TMPARR - subscript in scratch global
;
NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
NEW ACT,REMAIN,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
D FULL^VALM1
D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
I '$D(IBCNEZAR) G LNXTX
;
; loop through the list of selected buffer entries
S IBCNEZEN=0,IBCNEZCT=0
F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
. I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
. S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3) ; buffer ien
. S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
. S IBCNEZCT=IBCNEZCT+1
. I '$D(IBCNEZQ) D
.. D EN^VALM(TEMPLAT) ; invoke list template
.. I $G(IBFASTXT) S IBCNEZQ=1 Q ; Fast Exit processing
.. S ACT="expand"
.. I TEMPLAT["PROCESS" S ACT="process"
.. S REMAIN=IBCNEZGD-IBCNEZCT
.. I 'REMAIN Q
.. W @IOF
.. W !!!,"You are ",ACT,"ing multiple insurance buffer entries."
.. W !,"You just completed entry number ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,")."
.. S DIR(0)="Y"
.. S DIR("A")="Do you want to "_ACT_" the remaining entry"
.. I REMAIN>1 S DIR("A")="Do you want to "_ACT_" the remaining "_REMAIN_" entries"
.. S DIR("B")="YES"
.. W ! D ^DIR K DIR
.. I 'Y S IBCNEZQ=1 ; User said NO so set the Quitting variable
.. Q
. ;
. ; Make sure to unlock the buffer entry in all cases when finished,
. ; even if the user wants to quit out of this loop
. D UNLOCK^IBCNBU1(IBCNEZBF)
. Q
LNXTX ;
S VALMBCK="R"
Q
;
LREJECT(TMPARR) ; user select entries from list then reject/delete them
;
; This procedure is called from the ListMan action protocol for
; rejecting buffer entries.
; TMPARR - subscript in scratch global
;
NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
D FULL^VALM1
D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
I '$D(IBCNEZAR) G LREJX
;
; loop through the list of selected buffer entries
S IBCNEZEN=0,IBCNEZCT=0
F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
. I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
. S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3)
. S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
. S IBCNEZCT=IBCNEZCT+1
. I '$D(IBCNEZQ) D
.. W @IOF,!?2,$G(IORVON)
.. W " Entry ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,") "
.. W $G(IORVOFF)
.. D REJECT^IBCNBLA1(IBCNEZBF,.IBCNEZQ)
.. ;
.. ; If the user wants to stop and we're not processing the last one,
.. ; then determine if we should process the remaining entries
.. ;
.. I $D(IBCNEZQ),IBCNEZCT<IBCNEZGD D
... NEW REMAIN,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
... S REMAIN=IBCNEZGD-IBCNEZCT
... S DIR(0)="Y"
... S DIR("A")="Do you want to process the remaining entry"
... I REMAIN>1 S DIR("A")="Do you want to process the remaining "_REMAIN_" entries"
... S DIR("B")="NO"
... W ! D ^DIR K DIR
... ; if user wants to continue, then kill the quitting variable
... I Y KILL IBCNEZQ
... Q
.. Q
. ;
. ; Make sure to unlock the buffer entry in all cases when finished,
. ; even if the user wants to quit out of this loop
. D UNLOCK^IBCNBU1(IBCNEZBF)
. Q
LREJX ;
S VALMBCK="R"
Q
;
;
FASTEXIT ; sets flag signaling system should be exited
N DIR,DIRUT,X,Y
S VALMBCK="Q"
D FULL^VALM1
S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
I +Y S IBFASTXT=1
Q
;
SELSORT ; select the way to sort the list screen
N DIR,DIRUT,X,Y,DTOUT,DUOUT,DIROUT,ST,STDES
;
D FULL^VALM1 W !
W !,"Select the item to sort the buffer records on the buffer list screen."
; IB*2*737/DTG remove verify action reference
; S DIR(0)="SO^1:Patient Name;2:Insurance Company;3:Source of Information;4:Date Entered;5:Inpatients;6:Means Test;7:On Hold;8:Verified;9:eIV Status;10:Positive Response"
S DIR(0)="SO^1:Patient Name;2:Insurance Company;3:Source of Information;4:Date Entered;5:Inpatients;6:Means Test;7:On Hold;8:eIV Status;9:Positive Response"
S DIR("A")="Sort the list by",DIR("B")=$P($G(IBCNSORT),"^",2)
D ^DIR K DIR
I 'Y G SELSORTX
S IBCNSORT=Y_"^"_Y(0)
;
; ESG - 6/7/02 - SDD 5.1.1
; If the user wants to sort by symbol, then ask them which
; symbol should appear first and process accordingly.
;
KILL IBCNSORT(1) ; initialize the symbol sort array
; I +IBCNSORT=9 D I $D(DIRUT)!('Y) G SELSORTX
I +IBCNSORT=8 D I $D(DIRUT)!('Y) G SELSORTX ; IB*2*737
. ;
. ; build the array of default sort order
. S IBCNSORT(1,"+")=10
. S IBCNSORT(1,"$")=15 ; Added dollar sign to sort criteria
. S IBCNSORT(1,"%")=18 ; IB*2*601/DM added %
. S IBCNSORT(1,"-")=20
. S IBCNSORT(1,"#")=25 ; Added pound to sort criteria
. S IBCNSORT(1,"!")=30
. S IBCNSORT(1," ")=40
. S IBCNSORT(1,"?")=50
. ; S IBCNSORT(1,"*")=60 ; IB*2*737 drop *
. ;
. ; build the DIR array to ask the question
. S DIR(0)="SO^"
. ; removed blanks ; replaced tilde w/apostrophe and added pound as option 3, IB*506 added $ as option 2 and adjusted all following.
. ; IB*2*601/DM added % as option 3 and adjusted all following.
. F ST="1:+'A1","2:$'E1","3:%'M1","4:-'D1","5:#'U1","6:!'B1","7: '","8:?'Q1" D
.. I ST="7: '" S STDES="No Problems Identified, Awaiting Electronic Processing" ; removed blanks
.. E S STDES=$$GET1^DIQ(365.15,$$FIND1^DIC(365.15,"","X",$P(ST,"'",2)),.01,"E")
.. S DIR(0)=DIR(0)_$P(ST,"'")_" "_STDES_$S(ST="7:?'Q1":"",1:";")
. S DIR("A")="Which eIV Status do you want to appear first?"
. S DIR("B")=1
. S DIR("?",1)=" Please identify the eIV status that you want to appear first in the Insurance"
. S DIR("?",2)=" Buffer listing. The symbol appears immediately to the left of the patient"
. S DIR("?",3)=" name in the list. The default sort order for statuses is the same as"
. S DIR("?",4)=" they are presented in this list below. You may choose which status will appear"
. S DIR("?",5)=" first in the list. The remaining statuses will be sorted according to this"
. S DIR("?",6)=" default sort order. When sorting by eIV status, the secondary sort"
. S DIR("?",7)=" is the entered date and the final sort is by patient name."
. S DIR("?")=" "
. D ^DIR K DIR
. I $D(DIRUT) Q
. I 'Y Q
. ;
. ; update the sort order array with the chosen symbol
. S IBCNSORT(1,$E(Y(0)))=1
. S $P(IBCNSORT,U,3)=$E(Y(0))
. Q
;
; rebuild and resort the list and update the list header
D INIT^IBCNBLL,HDR^IBCNBLL
;
SELSORTX ;
S VALMBCK="R",VALMBG=1
Q
;
TGLSCRN(IBBUFDA) ; toggle process screen from policy to insurance info, glbal variable IBCNSCRN contains ins co chosen
Q:'$G(IBBUFDA)
D FULL^VALM1
W !!,"Enter an Insurance Company to display the Groups/Plans for that company or ",!,"enter Return to display a patient's policies.",!!
S IBCNSCRN=+$$SELINS^IBCNBU1
;
D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R",VALMBG=1
Q
;
AMCHK ; This procedure is called from the main buffer screen as an action
; to check the insurance company names in the buffer file. This will
; invoke another ListMan screen that shows a list of all insurance
; company names that do not exist in File 36 either as names or as
; synonyms and also they do not exist in the Auto Match file. These
; are bad insurance company names that need to be corrected before
; electronic insurance verification attempts can be made.
; esg - 6/20/02 - SDD 5.1.11 - Add an action on the main buffer
; screen to call the buffer names check option
;
D EN^IBCNEAMC
S VALMBCK="R"
AMCHKX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBLA 9394 printed Dec 13, 2024@02:13:59 Page 2
IBCNBLA ;ALB/ARH - Ins Buffer: LM action calls ;1 Jun 97
+1 ;;2.0;INTEGRATED BILLING;**82,149,153,184,271,416,506,601,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
NEWSCRN(TEMPLAT,TMPARR,IBBUFDA) ; open a new screen for a specific buffer entry, pass in LM template and the array to select from
+1 ; if temp array is defined then user selects the buffer entry, otherwise use entry passed in
+2 ;
+3 IF $GET(TMPARR)'=""
NEW IBBUFDA
SET IBBUFDA=$$SEL(TMPARR)
+4 IF +$GET(IBBUFDA)
IF $GET(TEMPLAT)'=""
IF +$$LOCK^IBCNBU1(IBBUFDA,1)
DO EN^VALM(TEMPLAT)
DO UNLOCK^IBCNBU1(IBBUFDA)
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
SEL(TMPARR) ; user selects one of the items from the list on the screen
+1 ;
+2 NEW VALMY,IBX,IBY,IBSELN
SET IBX=""
+3 IF $GET(TMPARR)'=""
IF '$ORDER(^TMP(TMPARR,$JOB,0))
Begin DoDot:1
+4 WRITE !!,"There are no '",$SELECT($GET(VALM("ENTITY"))'="":VALM("ENTITY"),1:"record"),"s' to select.",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
GOTO SELQ
+5 ;
+6 DO EN^VALM2($GET(XQORNOD(0)),"OS")
+7 IF $DATA(VALMY)
IF $GET(TMPARR)'=""
SET IBSELN=0
FOR
SET IBSELN=$ORDER(VALMY(IBSELN))
if 'IBSELN
QUIT
Begin DoDot:1
+8 SET IBX=$PIECE($GET(^TMP(TMPARR,$JOB,IBSELN)),U,2,99)
+9 ;
+10 IF TMPARR="IBCNBLLX"
SET IBY=$PIECE($GET(^IBA(355.33,+IBX,0)),U,4)
IF IBY'="E"
Begin DoDot:2
+11 WRITE !!," >>> Selected entry has been ",$SELECT(IBY="A":"ACCEPTED",IBY="R":"REJECTED",1:"UNKNOWN STATUS")
+12 WRITE " and may no longer be edited or modified.",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:2
SET IBX=""
End DoDot:1
+13 ;
SELQ QUIT IBX
+1 ;
PNXTSCRN(TEMPLAT,IBBUFDA) ; open a new screen for a buffer entry, rebuild the process screen on return since it may have changed
+1 DO NEWSCRN^IBCNBLA(TEMPLAT,"",IBBUFDA)
+2 DO CLEAN^VALM10
DO INIT^IBCNBLP
DO HDR^IBCNBLP
SET VALMBCK="R"
+3 QUIT
+4 ;
LNXTSCRN(TEMPLAT,TMPARR,AVIEW) ; select entries from list to process/expand
+1 ;
+2 ; This procedure is called from the ListMan action protocols for
+3 ; processing and expanding buffer entries.
+4 ; TEMPLAT - list template name for associated action
+5 ; TMPARR - subscript in scratch global
+6 ;
+7 NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
+8 NEW ACT,REMAIN,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
+9 DO FULL^VALM1
+10 DO MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
+11 IF '$DATA(IBCNEZAR)
GOTO LNXTX
+12 ;
+13 ; loop through the list of selected buffer entries
+14 SET IBCNEZEN=0
SET IBCNEZCT=0
+15 FOR
SET IBCNEZEN=$ORDER(IBCNEZAR(IBCNEZEN))
if 'IBCNEZEN
QUIT
Begin DoDot:1
+16 ; user could not get this one
IF 'IBCNEZAR(IBCNEZEN)
QUIT
+17 ; buffer ien
SET IBCNEZBF=$PIECE(IBCNEZAR(IBCNEZEN),U,3)
+18 ; just in case IB rtns need this
SET IBBUFDA=IBCNEZBF
+19 SET IBCNEZCT=IBCNEZCT+1
+20 IF '$DATA(IBCNEZQ)
Begin DoDot:2
+21 ; invoke list template
DO EN^VALM(TEMPLAT)
+22 ; Fast Exit processing
IF $GET(IBFASTXT)
SET IBCNEZQ=1
QUIT
+23 SET ACT="expand"
+24 IF TEMPLAT["PROCESS"
SET ACT="process"
+25 SET REMAIN=IBCNEZGD-IBCNEZCT
+26 IF 'REMAIN
QUIT
+27 WRITE @IOF
+28 WRITE !!!,"You are ",ACT,"ing multiple insurance buffer entries."
+29 WRITE !,"You just completed entry number ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,")."
+30 SET DIR(0)="Y"
+31 SET DIR("A")="Do you want to "_ACT_" the remaining entry"
+32 IF REMAIN>1
SET DIR("A")="Do you want to "_ACT_" the remaining "_REMAIN_" entries"
+33 SET DIR("B")="YES"
+34 WRITE !
DO ^DIR
KILL DIR
+35 ; User said NO so set the Quitting variable
IF 'Y
SET IBCNEZQ=1
+36 QUIT
End DoDot:2
+37 ;
+38 ; Make sure to unlock the buffer entry in all cases when finished,
+39 ; even if the user wants to quit out of this loop
+40 DO UNLOCK^IBCNBU1(IBCNEZBF)
+41 QUIT
End DoDot:1
LNXTX ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
LREJECT(TMPARR) ; user select entries from list then reject/delete them
+1 ;
+2 ; This procedure is called from the ListMan action protocol for
+3 ; rejecting buffer entries.
+4 ; TMPARR - subscript in scratch global
+5 ;
+6 NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
+7 DO FULL^VALM1
+8 DO MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
+9 IF '$DATA(IBCNEZAR)
GOTO LREJX
+10 ;
+11 ; loop through the list of selected buffer entries
+12 SET IBCNEZEN=0
SET IBCNEZCT=0
+13 FOR
SET IBCNEZEN=$ORDER(IBCNEZAR(IBCNEZEN))
if 'IBCNEZEN
QUIT
Begin DoDot:1
+14 ; user could not get this one
IF 'IBCNEZAR(IBCNEZEN)
QUIT
+15 SET IBCNEZBF=$PIECE(IBCNEZAR(IBCNEZEN),U,3)
+16 ; just in case IB rtns need this
SET IBBUFDA=IBCNEZBF
+17 SET IBCNEZCT=IBCNEZCT+1
+18 IF '$DATA(IBCNEZQ)
Begin DoDot:2
+19 WRITE @IOF,!?2,$GET(IORVON)
+20 WRITE " Entry ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,") "
+21 WRITE $GET(IORVOFF)
+22 DO REJECT^IBCNBLA1(IBCNEZBF,.IBCNEZQ)
+23 ;
+24 ; If the user wants to stop and we're not processing the last one,
+25 ; then determine if we should process the remaining entries
+26 ;
+27 IF $DATA(IBCNEZQ)
IF IBCNEZCT<IBCNEZGD
Begin DoDot:3
+28 NEW REMAIN,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+29 SET REMAIN=IBCNEZGD-IBCNEZCT
+30 SET DIR(0)="Y"
+31 SET DIR("A")="Do you want to process the remaining entry"
+32 IF REMAIN>1
SET DIR("A")="Do you want to process the remaining "_REMAIN_" entries"
+33 SET DIR("B")="NO"
+34 WRITE !
DO ^DIR
KILL DIR
+35 ; if user wants to continue, then kill the quitting variable
+36 IF Y
KILL IBCNEZQ
+37 QUIT
End DoDot:3
+38 QUIT
End DoDot:2
+39 ;
+40 ; Make sure to unlock the buffer entry in all cases when finished,
+41 ; even if the user wants to quit out of this loop
+42 DO UNLOCK^IBCNBU1(IBCNEZBF)
+43 QUIT
End DoDot:1
LREJX ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
+4 ;
FASTEXIT ; sets flag signaling system should be exited
+1 NEW DIR,DIRUT,X,Y
+2 SET VALMBCK="Q"
+3 DO FULL^VALM1
+4 SET DIR(0)="Y"
SET DIR("A")="Exit option entirely"
SET DIR("B")="NO"
DO ^DIR
+5 IF +Y
SET IBFASTXT=1
+6 QUIT
+7 ;
SELSORT ; select the way to sort the list screen
+1 NEW DIR,DIRUT,X,Y,DTOUT,DUOUT,DIROUT,ST,STDES
+2 ;
+3 DO FULL^VALM1
WRITE !
+4 WRITE !,"Select the item to sort the buffer records on the buffer list screen."
+5 ; IB*2*737/DTG remove verify action reference
+6 ; S DIR(0)="SO^1:Patient Name;2:Insurance Company;3:Source of Information;4:Date Entered;5:Inpatients;6:Means Test;7:On Hold;8:Verified;9:eIV Status;10:Positive Response"
+7 SET DIR(0)="SO^1:Patient Name;2:Insurance Company;3:Source of Information;4:Date Entered;5:Inpatients;6:Means Test;7:On Hold;8:eIV Status;9:Positive Response"
+8 SET DIR("A")="Sort the list by"
SET DIR("B")=$PIECE($GET(IBCNSORT),"^",2)
+9 DO ^DIR
KILL DIR
+10 IF 'Y
GOTO SELSORTX
+11 SET IBCNSORT=Y_"^"_Y(0)
+12 ;
+13 ; ESG - 6/7/02 - SDD 5.1.1
+14 ; If the user wants to sort by symbol, then ask them which
+15 ; symbol should appear first and process accordingly.
+16 ;
+17 ; initialize the symbol sort array
KILL IBCNSORT(1)
+18 ; I +IBCNSORT=9 D I $D(DIRUT)!('Y) G SELSORTX
+19 ; IB*2*737
IF +IBCNSORT=8
Begin DoDot:1
+20 ;
+21 ; build the array of default sort order
+22 SET IBCNSORT(1,"+")=10
+23 ; Added dollar sign to sort criteria
SET IBCNSORT(1,"$")=15
+24 ; IB*2*601/DM added %
SET IBCNSORT(1,"%")=18
+25 SET IBCNSORT(1,"-")=20
+26 ; Added pound to sort criteria
SET IBCNSORT(1,"#")=25
+27 SET IBCNSORT(1,"!")=30
+28 SET IBCNSORT(1," ")=40
+29 SET IBCNSORT(1,"?")=50
+30 ; S IBCNSORT(1,"*")=60 ; IB*2*737 drop *
+31 ;
+32 ; build the DIR array to ask the question
+33 SET DIR(0)="SO^"
+34 ; removed blanks ; replaced tilde w/apostrophe and added pound as option 3, IB*506 added $ as option 2 and adjusted all following.
+35 ; IB*2*601/DM added % as option 3 and adjusted all following.
+36 FOR ST="1:+'A1","2:$'E1","3:%'M1","4:-'D1","5:#'U1","6:!'B1","7: '","8:?'Q1"
Begin DoDot:2
+37 ; removed blanks
IF ST="7: '"
SET STDES="No Problems Identified, Awaiting Electronic Processing"
+38 IF '$TEST
SET STDES=$$GET1^DIQ(365.15,$$FIND1^DIC(365.15,"","X",$PIECE(ST,"'",2)),.01,"E")
+39 SET DIR(0)=DIR(0)_$PIECE(ST,"'")_" "_STDES_$SELECT(ST="7:?'Q1":"",1:";")
End DoDot:2
+40 SET DIR("A")="Which eIV Status do you want to appear first?"
+41 SET DIR("B")=1
+42 SET DIR("?",1)=" Please identify the eIV status that you want to appear first in the Insurance"
+43 SET DIR("?",2)=" Buffer listing. The symbol appears immediately to the left of the patient"
+44 SET DIR("?",3)=" name in the list. The default sort order for statuses is the same as"
+45 SET DIR("?",4)=" they are presented in this list below. You may choose which status will appear"
+46 SET DIR("?",5)=" first in the list. The remaining statuses will be sorted according to this"
+47 SET DIR("?",6)=" default sort order. When sorting by eIV status, the secondary sort"
+48 SET DIR("?",7)=" is the entered date and the final sort is by patient name."
+49 SET DIR("?")=" "
+50 DO ^DIR
KILL DIR
+51 IF $DATA(DIRUT)
QUIT
+52 IF 'Y
QUIT
+53 ;
+54 ; update the sort order array with the chosen symbol
+55 SET IBCNSORT(1,$EXTRACT(Y(0)))=1
+56 SET $PIECE(IBCNSORT,U,3)=$EXTRACT(Y(0))
+57 QUIT
End DoDot:1
IF $DATA(DIRUT)!('Y)
GOTO SELSORTX
+58 ;
+59 ; rebuild and resort the list and update the list header
+60 DO INIT^IBCNBLL
DO HDR^IBCNBLL
+61 ;
SELSORTX ;
+1 SET VALMBCK="R"
SET VALMBG=1
+2 QUIT
+3 ;
TGLSCRN(IBBUFDA) ; toggle process screen from policy to insurance info, glbal variable IBCNSCRN contains ins co chosen
+1 if '$GET(IBBUFDA)
QUIT
+2 DO FULL^VALM1
+3 WRITE !!,"Enter an Insurance Company to display the Groups/Plans for that company or ",!,"enter Return to display a patient's policies.",!!
+4 SET IBCNSCRN=+$$SELINS^IBCNBU1
+5 ;
+6 DO CLEAN^VALM10
DO INIT^IBCNBLP
DO HDR^IBCNBLP
SET VALMBCK="R"
SET VALMBG=1
+7 QUIT
+8 ;
AMCHK ; This procedure is called from the main buffer screen as an action
+1 ; to check the insurance company names in the buffer file. This will
+2 ; invoke another ListMan screen that shows a list of all insurance
+3 ; company names that do not exist in File 36 either as names or as
+4 ; synonyms and also they do not exist in the Auto Match file. These
+5 ; are bad insurance company names that need to be corrected before
+6 ; electronic insurance verification attempts can be made.
+7 ; esg - 6/20/02 - SDD 5.1.11 - Add an action on the main buffer
+8 ; screen to call the buffer names check option
+9 ;
+10 DO EN^IBCNEAMC
+11 SET VALMBCK="R"
AMCHKX ;
+1 QUIT
+2 ;
