| 1 | IBCNBLA ;ALB/ARH - Ins Buffer: LM action calls ;1 Jun 97
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**82,149,153,184,271**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | NEWSCRN(TEMPLAT,TMPARR,IBBUFDA) ; open a new screen for a specific buffer entry, pass in LM template and the array to select from
|
|---|
| 6 | ; if temp array is defined then user selects the buffer entry, otherwise use entry passed in
|
|---|
| 7 | ;
|
|---|
| 8 | I $G(TMPARR)'="" N IBBUFDA S IBBUFDA=$$SEL(TMPARR)
|
|---|
| 9 | I +$G(IBBUFDA),$G(TEMPLAT)'="",+$$LOCK^IBCNBU1(IBBUFDA,1) D EN^VALM(TEMPLAT) D UNLOCK^IBCNBU1(IBBUFDA)
|
|---|
| 10 | S VALMBCK="R"
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | SEL(TMPARR) ; user selects one of the items from the list on the screen
|
|---|
| 14 | ;
|
|---|
| 15 | N VALMY,IBX,IBY,IBSELN S IBX=""
|
|---|
| 16 | I $G(TMPARR)'="",'$O(^TMP(TMPARR,$J,0)) D G SELQ
|
|---|
| 17 | . W !!,"There are no '",$S($G(VALM("ENTITY"))'="":VALM("ENTITY"),1:"record"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR
|
|---|
| 18 | ;
|
|---|
| 19 | D EN^VALM2($G(XQORNOD(0)),"OS")
|
|---|
| 20 | I $D(VALMY),$G(TMPARR)'="" S IBSELN=0 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D
|
|---|
| 21 | . S IBX=$P($G(^TMP(TMPARR,$J,IBSELN)),U,2,99)
|
|---|
| 22 | . ;
|
|---|
| 23 | . I TMPARR="IBCNBLLX" S IBY=$P($G(^IBA(355.33,+IBX,0)),U,4) I IBY'="E" D S IBX=""
|
|---|
| 24 | .. W !!," >>> Selected entry has been ",$S(IBY="A":"ACCEPTED",IBY="R":"REJECTED",1:"UNKNOWN STATUS")
|
|---|
| 25 | .. W " and may no longer be edited or modified.",! S DIR(0)="E" D ^DIR K DIR
|
|---|
| 26 | ;
|
|---|
| 27 | SELQ Q IBX
|
|---|
| 28 | ;
|
|---|
| 29 | PNXTSCRN(TEMPLAT,IBBUFDA) ; open a new screen for a buffer entry, rebuild the process screen on return since it may have changed
|
|---|
| 30 | D NEWSCRN^IBCNBLA(TEMPLAT,"",IBBUFDA)
|
|---|
| 31 | D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R"
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | LNXTSCRN(TEMPLAT,TMPARR) ; select entries from list to process/expand
|
|---|
| 35 | ;
|
|---|
| 36 | ; This procedure is called from the ListMan action protocols for
|
|---|
| 37 | ; processing and expanding buffer entries.
|
|---|
| 38 | ; TEMPLAT - list template name for associated action
|
|---|
| 39 | ; TMPARR - subscript in scratch global
|
|---|
| 40 | ;
|
|---|
| 41 | NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
|
|---|
| 42 | NEW ACT,REMAIN,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
|
|---|
| 43 | D FULL^VALM1
|
|---|
| 44 | D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
|
|---|
| 45 | I '$D(IBCNEZAR) G LNXTX
|
|---|
| 46 | ;
|
|---|
| 47 | ; loop through the list of selected buffer entries
|
|---|
| 48 | S IBCNEZEN=0,IBCNEZCT=0
|
|---|
| 49 | F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
|
|---|
| 50 | . I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
|
|---|
| 51 | . S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3) ; buffer ien
|
|---|
| 52 | . S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
|
|---|
| 53 | . S IBCNEZCT=IBCNEZCT+1
|
|---|
| 54 | . I '$D(IBCNEZQ) D
|
|---|
| 55 | .. D EN^VALM(TEMPLAT) ; invoke list template
|
|---|
| 56 | .. I $G(IBFASTXT) S IBCNEZQ=1 Q ; Fast Exit processing
|
|---|
| 57 | .. S ACT="expand"
|
|---|
| 58 | .. I TEMPLAT["PROCESS" S ACT="process"
|
|---|
| 59 | .. S REMAIN=IBCNEZGD-IBCNEZCT
|
|---|
| 60 | .. I 'REMAIN Q
|
|---|
| 61 | .. W @IOF
|
|---|
| 62 | .. W !!!,"You are ",ACT,"ing multiple insurance buffer entries."
|
|---|
| 63 | .. W !,"You just completed entry number ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,")."
|
|---|
| 64 | .. S DIR(0)="Y"
|
|---|
| 65 | .. S DIR("A")="Do you want to "_ACT_" the remaining entry"
|
|---|
| 66 | .. I REMAIN>1 S DIR("A")="Do you want to "_ACT_" the remaining "_REMAIN_" entries"
|
|---|
| 67 | .. S DIR("B")="YES"
|
|---|
| 68 | .. W ! D ^DIR K DIR
|
|---|
| 69 | .. I 'Y S IBCNEZQ=1 ; User said NO so set the Quitting variable
|
|---|
| 70 | .. Q
|
|---|
| 71 | . ;
|
|---|
| 72 | . ; Make sure to unlock the buffer entry in all cases when finished,
|
|---|
| 73 | . ; even if the user wants to quit out of this loop
|
|---|
| 74 | . D UNLOCK^IBCNBU1(IBCNEZBF)
|
|---|
| 75 | . Q
|
|---|
| 76 | LNXTX ;
|
|---|
| 77 | S VALMBCK="R"
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | LREJECT(TMPARR) ; user select entries from list then reject/delete them
|
|---|
| 81 | ;
|
|---|
| 82 | ; This procedure is called from the ListMan action protocol for
|
|---|
| 83 | ; rejecting buffer entries.
|
|---|
| 84 | ; TMPARR - subscript in scratch global
|
|---|
| 85 | ;
|
|---|
| 86 | NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
|
|---|
| 87 | D FULL^VALM1
|
|---|
| 88 | D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
|
|---|
| 89 | I '$D(IBCNEZAR) G LREJX
|
|---|
| 90 | ;
|
|---|
| 91 | ; loop through the list of selected buffer entries
|
|---|
| 92 | S IBCNEZEN=0,IBCNEZCT=0
|
|---|
| 93 | F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
|
|---|
| 94 | . I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
|
|---|
| 95 | . S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3)
|
|---|
| 96 | . S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
|
|---|
| 97 | . S IBCNEZCT=IBCNEZCT+1
|
|---|
| 98 | . I '$D(IBCNEZQ) D
|
|---|
| 99 | .. W @IOF,!?2,$G(IORVON)
|
|---|
| 100 | .. W " Entry ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,") "
|
|---|
| 101 | .. W $G(IORVOFF)
|
|---|
| 102 | .. D REJECT^IBCNBLA1(IBCNEZBF,.IBCNEZQ)
|
|---|
| 103 | .. ;
|
|---|
| 104 | .. ; If the user wants to stop and we're not processing the last one,
|
|---|
| 105 | .. ; then determine if we should process the remaining entries
|
|---|
| 106 | .. ;
|
|---|
| 107 | .. I $D(IBCNEZQ),IBCNEZCT<IBCNEZGD D
|
|---|
| 108 | ... NEW REMAIN,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 109 | ... S REMAIN=IBCNEZGD-IBCNEZCT
|
|---|
| 110 | ... S DIR(0)="Y"
|
|---|
| 111 | ... S DIR("A")="Do you want to process the remaining entry"
|
|---|
| 112 | ... I REMAIN>1 S DIR("A")="Do you want to process the remaining "_REMAIN_" entries"
|
|---|
| 113 | ... S DIR("B")="NO"
|
|---|
| 114 | ... W ! D ^DIR K DIR
|
|---|
| 115 | ... ; if user wants to continue, then kill the quitting variable
|
|---|
| 116 | ... I Y KILL IBCNEZQ
|
|---|
| 117 | ... Q
|
|---|
| 118 | .. Q
|
|---|
| 119 | . ;
|
|---|
| 120 | . ; Make sure to unlock the buffer entry in all cases when finished,
|
|---|
| 121 | . ; even if the user wants to quit out of this loop
|
|---|
| 122 | . D UNLOCK^IBCNBU1(IBCNEZBF)
|
|---|
| 123 | . Q
|
|---|
| 124 | LREJX ;
|
|---|
| 125 | S VALMBCK="R"
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | ;
|
|---|
| 129 | FASTEXIT ; sets flag signaling system should be exited
|
|---|
| 130 | N DIR,DIRUT,X,Y
|
|---|
| 131 | S VALMBCK="Q"
|
|---|
| 132 | D FULL^VALM1
|
|---|
| 133 | S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
|
|---|
| 134 | I +Y S IBFASTXT=1
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | SELSORT ; select the way to sort the list screen
|
|---|
| 138 | N DIR,DIRUT,X,Y,DTOUT,DUOUT,DIROUT,ST,STDES
|
|---|
| 139 | ;
|
|---|
| 140 | D FULL^VALM1 W !
|
|---|
| 141 | W !,"Select the item to sort the buffer records on the buffer list screen."
|
|---|
| 142 | 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:IIV Status"
|
|---|
| 143 | S DIR("A")="Sort the list by",DIR("B")=$P($G(IBCNSORT),"^",2)
|
|---|
| 144 | D ^DIR K DIR
|
|---|
| 145 | I 'Y G SELSORTX
|
|---|
| 146 | S IBCNSORT=Y_"^"_Y(0)
|
|---|
| 147 | ;
|
|---|
| 148 | ; ESG - 6/7/02 - SDD 5.1.1
|
|---|
| 149 | ; If the user wants to sort by symbol, then ask them which
|
|---|
| 150 | ; symbol should appear first and process accordingly.
|
|---|
| 151 | ;
|
|---|
| 152 | KILL IBCNSORT(1) ; initialize the symbol sort array
|
|---|
| 153 | I +IBCNSORT=9 D I $D(DIRUT)!('Y) G SELSORTX
|
|---|
| 154 | . ;
|
|---|
| 155 | . ; build the array of default sort order
|
|---|
| 156 | . S IBCNSORT(1,"+")=10
|
|---|
| 157 | . S IBCNSORT(1,"-")=20
|
|---|
| 158 | . S IBCNSORT(1,"#")=25 ; Added pound to sort criteria
|
|---|
| 159 | . S IBCNSORT(1,"!")=30
|
|---|
| 160 | . S IBCNSORT(1," ")=40
|
|---|
| 161 | . S IBCNSORT(1,"?")=50
|
|---|
| 162 | . S IBCNSORT(1,"*")=60
|
|---|
| 163 | . ;
|
|---|
| 164 | . ; build the DIR array to ask the question
|
|---|
| 165 | . S DIR(0)="SO^"
|
|---|
| 166 | . F ST="1:+'A1","2:-'D1","3:#'U1","4:!'B1","5: '","6:?'Q1" D ; removed blanks ; replaced tilde w/apostrophe and added pound as option 3
|
|---|
| 167 | .. I ST="5: '" S STDES="No Problems Identified, Awaiting Electronic Processing" ; removed blanks
|
|---|
| 168 | .. E S STDES=$$GET1^DIQ(365.15,$$FIND1^DIC(365.15,"","X",$P(ST,"'",2)),.01,"E")
|
|---|
| 169 | .. S DIR(0)=DIR(0)_$P(ST,"'")_" "_STDES_$S(ST="6:?'Q1":"",1:";")
|
|---|
| 170 | . S DIR("A")="Which IIV Status do you want to appear first?"
|
|---|
| 171 | . S DIR("B")=1
|
|---|
| 172 | . S DIR("?",1)=" Please identify the IIV status that you want to appear first in the Insurance"
|
|---|
| 173 | . S DIR("?",2)=" Buffer listing. The symbol appears immediately to the left of the patient"
|
|---|
| 174 | . S DIR("?",3)=" name in the list. The default sort order for statuses is the same as"
|
|---|
| 175 | . S DIR("?",4)=" they are presented in this list below. You may choose which status will appear"
|
|---|
| 176 | . S DIR("?",5)=" first in the list. The remaining statuses will be sorted according to this"
|
|---|
| 177 | . S DIR("?",6)=" default sort order. When sorting by IIV status, the secondary sort"
|
|---|
| 178 | . S DIR("?",7)=" is the entered date and the final sort is by patient name."
|
|---|
| 179 | . S DIR("?")=" "
|
|---|
| 180 | . D ^DIR K DIR
|
|---|
| 181 | . I $D(DIRUT) Q
|
|---|
| 182 | . I 'Y Q
|
|---|
| 183 | . ;
|
|---|
| 184 | . ; update the sort order array with the chosen symbol
|
|---|
| 185 | . S IBCNSORT(1,$E(Y(0)))=1
|
|---|
| 186 | . S $P(IBCNSORT,U,3)=$E(Y(0))
|
|---|
| 187 | . Q
|
|---|
| 188 | ;
|
|---|
| 189 | ; rebuild and resort the list and update the list header
|
|---|
| 190 | D INIT^IBCNBLL,HDR^IBCNBLL
|
|---|
| 191 | ;
|
|---|
| 192 | SELSORTX ;
|
|---|
| 193 | S VALMBCK="R",VALMBG=1
|
|---|
| 194 | Q
|
|---|
| 195 | ;
|
|---|
| 196 | TGLSCRN(IBBUFDA) ; toggle process screen from policy to insurance info, glbal variable IBCNSCRN contains ins co chosen
|
|---|
| 197 | Q:'$G(IBBUFDA)
|
|---|
| 198 | D FULL^VALM1
|
|---|
| 199 | W !!,"Enter an Insurance Company to display the Groups/Plans for that company or ",!,"enter Return to display a patient's policies.",!!
|
|---|
| 200 | S IBCNSCRN=+$$SELINS^IBCNBU1
|
|---|
| 201 | ;
|
|---|
| 202 | D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R",VALMBG=1
|
|---|
| 203 | Q
|
|---|
| 204 | ;
|
|---|
| 205 | AMCHK ; This procedure is called from the main buffer screen as an action
|
|---|
| 206 | ; to check the insurance company names in the buffer file. This will
|
|---|
| 207 | ; invoke another ListMan screen that shows a list of all insurance
|
|---|
| 208 | ; company names that do not exist in File 36 either as names or as
|
|---|
| 209 | ; synonyms and also they do not exist in the Auto Match file. These
|
|---|
| 210 | ; are bad insurance company names that need to be corrected before
|
|---|
| 211 | ; electronic insurance verification attempts can be made.
|
|---|
| 212 | ; esg - 6/20/02 - SDD 5.1.11 - Add an action on the main buffer
|
|---|
| 213 | ; screen to call the buffer names check option
|
|---|
| 214 | ;
|
|---|
| 215 | D EN^IBCNEAMC
|
|---|
| 216 | S VALMBCK="R"
|
|---|
| 217 | AMCHKX ;
|
|---|
| 218 | Q
|
|---|
| 219 | ;
|
|---|
