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