Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNBLA

IBCNBLA.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. 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
  1. ;
  1. I $G(TMPARR)'="" N IBBUFDA S IBBUFDA=$$SEL(TMPARR)
  1. I +$G(IBBUFDA),$G(TEMPLAT)'="",+$$LOCK^IBCNBU1(IBBUFDA,1) D EN^VALM(TEMPLAT) D UNLOCK^IBCNBU1(IBBUFDA)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. SEL(TMPARR) ; user selects one of the items from the list on the screen
  1. ;
  1. N VALMY,IBX,IBY,IBSELN S IBX=""
  1. I $G(TMPARR)'="",'$O(^TMP(TMPARR,$J,0)) D G SELQ
  1. . W !!,"There are no '",$S($G(VALM("ENTITY"))'="":VALM("ENTITY"),1:"record"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR
  1. ;
  1. D EN^VALM2($G(XQORNOD(0)),"OS")
  1. I $D(VALMY),$G(TMPARR)'="" S IBSELN=0 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D
  1. . S IBX=$P($G(^TMP(TMPARR,$J,IBSELN)),U,2,99)
  1. . ;
  1. . I TMPARR="IBCNBLLX" S IBY=$P($G(^IBA(355.33,+IBX,0)),U,4) I IBY'="E" D S IBX=""
  1. .. W !!," >>> Selected entry has been ",$S(IBY="A":"ACCEPTED",IBY="R":"REJECTED",1:"UNKNOWN STATUS")
  1. .. W " and may no longer be edited or modified.",! S DIR(0)="E" D ^DIR K DIR
  1. ;
  1. SELQ Q IBX
  1. ;
  1. PNXTSCRN(TEMPLAT,IBBUFDA) ; open a new screen for a buffer entry, rebuild the process screen on return since it may have changed
  1. D NEWSCRN^IBCNBLA(TEMPLAT,"",IBBUFDA)
  1. D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R"
  1. Q
  1. ;
  1. LNXTSCRN(TEMPLAT,TMPARR,AVIEW) ; select entries from list to process/expand
  1. ;
  1. ; This procedure is called from the ListMan action protocols for
  1. ; processing and expanding buffer entries.
  1. ; TEMPLAT - list template name for associated action
  1. ; TMPARR - subscript in scratch global
  1. ;
  1. NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
  1. NEW ACT,REMAIN,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
  1. D FULL^VALM1
  1. D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
  1. I '$D(IBCNEZAR) G LNXTX
  1. ;
  1. ; loop through the list of selected buffer entries
  1. S IBCNEZEN=0,IBCNEZCT=0
  1. F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
  1. . I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
  1. . S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3) ; buffer ien
  1. . S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
  1. . S IBCNEZCT=IBCNEZCT+1
  1. . I '$D(IBCNEZQ) D
  1. .. D EN^VALM(TEMPLAT) ; invoke list template
  1. .. I $G(IBFASTXT) S IBCNEZQ=1 Q ; Fast Exit processing
  1. .. S ACT="expand"
  1. .. I TEMPLAT["PROCESS" S ACT="process"
  1. .. S REMAIN=IBCNEZGD-IBCNEZCT
  1. .. I 'REMAIN Q
  1. .. W @IOF
  1. .. W !!!,"You are ",ACT,"ing multiple insurance buffer entries."
  1. .. W !,"You just completed entry number ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,")."
  1. .. S DIR(0)="Y"
  1. .. S DIR("A")="Do you want to "_ACT_" the remaining entry"
  1. .. I REMAIN>1 S DIR("A")="Do you want to "_ACT_" the remaining "_REMAIN_" entries"
  1. .. S DIR("B")="YES"
  1. .. W ! D ^DIR K DIR
  1. .. I 'Y S IBCNEZQ=1 ; User said NO so set the Quitting variable
  1. .. Q
  1. . ;
  1. . ; Make sure to unlock the buffer entry in all cases when finished,
  1. . ; even if the user wants to quit out of this loop
  1. . D UNLOCK^IBCNBU1(IBCNEZBF)
  1. . Q
  1. LNXTX ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. LREJECT(TMPARR) ; user select entries from list then reject/delete them
  1. ;
  1. ; This procedure is called from the ListMan action protocol for
  1. ; rejecting buffer entries.
  1. ; TMPARR - subscript in scratch global
  1. ;
  1. NEW IBCNEZAR,IBCNEZEN,IBCNEZCT,IBCNEZGD,IBCNEZBF,IBCNEZQ,IBBUFDA
  1. D FULL^VALM1
  1. D MULSEL^IBCNBLA2(TMPARR,.IBCNEZAR,.IBCNEZGD)
  1. I '$D(IBCNEZAR) G LREJX
  1. ;
  1. ; loop through the list of selected buffer entries
  1. S IBCNEZEN=0,IBCNEZCT=0
  1. F S IBCNEZEN=$O(IBCNEZAR(IBCNEZEN)) Q:'IBCNEZEN D
  1. . I 'IBCNEZAR(IBCNEZEN) Q ; user could not get this one
  1. . S IBCNEZBF=$P(IBCNEZAR(IBCNEZEN),U,3)
  1. . S IBBUFDA=IBCNEZBF ; just in case IB rtns need this
  1. . S IBCNEZCT=IBCNEZCT+1
  1. . I '$D(IBCNEZQ) D
  1. .. W @IOF,!?2,$G(IORVON)
  1. .. W " Entry ",IBCNEZEN," (",IBCNEZCT," of ",IBCNEZGD,") "
  1. .. W $G(IORVOFF)
  1. .. D REJECT^IBCNBLA1(IBCNEZBF,.IBCNEZQ)
  1. .. ;
  1. .. ; If the user wants to stop and we're not processing the last one,
  1. .. ; then determine if we should process the remaining entries
  1. .. ;
  1. .. I $D(IBCNEZQ),IBCNEZCT<IBCNEZGD D
  1. ... NEW REMAIN,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. ... S REMAIN=IBCNEZGD-IBCNEZCT
  1. ... S DIR(0)="Y"
  1. ... S DIR("A")="Do you want to process the remaining entry"
  1. ... I REMAIN>1 S DIR("A")="Do you want to process the remaining "_REMAIN_" entries"
  1. ... S DIR("B")="NO"
  1. ... W ! D ^DIR K DIR
  1. ... ; if user wants to continue, then kill the quitting variable
  1. ... I Y KILL IBCNEZQ
  1. ... Q
  1. .. Q
  1. . ;
  1. . ; Make sure to unlock the buffer entry in all cases when finished,
  1. . ; even if the user wants to quit out of this loop
  1. . D UNLOCK^IBCNBU1(IBCNEZBF)
  1. . Q
  1. LREJX ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;
  1. FASTEXIT ; sets flag signaling system should be exited
  1. N DIR,DIRUT,X,Y
  1. S VALMBCK="Q"
  1. D FULL^VALM1
  1. S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
  1. I +Y S IBFASTXT=1
  1. Q
  1. ;
  1. SELSORT ; select the way to sort the list screen
  1. N DIR,DIRUT,X,Y,DTOUT,DUOUT,DIROUT,ST,STDES
  1. ;
  1. D FULL^VALM1 W !
  1. W !,"Select the item to sort the buffer records on the buffer list screen."
  1. ; IB*2*737/DTG remove verify action reference
  1. ; 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"
  1. 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"
  1. S DIR("A")="Sort the list by",DIR("B")=$P($G(IBCNSORT),"^",2)
  1. D ^DIR K DIR
  1. I 'Y G SELSORTX
  1. S IBCNSORT=Y_"^"_Y(0)
  1. ;
  1. ; ESG - 6/7/02 - SDD 5.1.1
  1. ; If the user wants to sort by symbol, then ask them which
  1. ; symbol should appear first and process accordingly.
  1. ;
  1. KILL IBCNSORT(1) ; initialize the symbol sort array
  1. ; I +IBCNSORT=9 D I $D(DIRUT)!('Y) G SELSORTX
  1. I +IBCNSORT=8 D I $D(DIRUT)!('Y) G SELSORTX ; IB*2*737
  1. . ;
  1. . ; build the array of default sort order
  1. . S IBCNSORT(1,"+")=10
  1. . S IBCNSORT(1,"$")=15 ; Added dollar sign to sort criteria
  1. . S IBCNSORT(1,"%")=18 ; IB*2*601/DM added %
  1. . S IBCNSORT(1,"-")=20
  1. . S IBCNSORT(1,"#")=25 ; Added pound to sort criteria
  1. . S IBCNSORT(1,"!")=30
  1. . S IBCNSORT(1," ")=40
  1. . S IBCNSORT(1,"?")=50
  1. . ; S IBCNSORT(1,"*")=60 ; IB*2*737 drop *
  1. . ;
  1. . ; build the DIR array to ask the question
  1. . S DIR(0)="SO^"
  1. . ; removed blanks ; replaced tilde w/apostrophe and added pound as option 3, IB*506 added $ as option 2 and adjusted all following.
  1. . ; IB*2*601/DM added % as option 3 and adjusted all following.
  1. . F ST="1:+'A1","2:$'E1","3:%'M1","4:-'D1","5:#'U1","6:!'B1","7: '","8:?'Q1" D
  1. .. I ST="7: '" S STDES="No Problems Identified, Awaiting Electronic Processing" ; removed blanks
  1. .. E S STDES=$$GET1^DIQ(365.15,$$FIND1^DIC(365.15,"","X",$P(ST,"'",2)),.01,"E")
  1. .. S DIR(0)=DIR(0)_$P(ST,"'")_" "_STDES_$S(ST="7:?'Q1":"",1:";")
  1. . S DIR("A")="Which eIV Status do you want to appear first?"
  1. . S DIR("B")=1
  1. . S DIR("?",1)=" Please identify the eIV status that you want to appear first in the Insurance"
  1. . S DIR("?",2)=" Buffer listing. The symbol appears immediately to the left of the patient"
  1. . S DIR("?",3)=" name in the list. The default sort order for statuses is the same as"
  1. . S DIR("?",4)=" they are presented in this list below. You may choose which status will appear"
  1. . S DIR("?",5)=" first in the list. The remaining statuses will be sorted according to this"
  1. . S DIR("?",6)=" default sort order. When sorting by eIV status, the secondary sort"
  1. . S DIR("?",7)=" is the entered date and the final sort is by patient name."
  1. . S DIR("?")=" "
  1. . D ^DIR K DIR
  1. . I $D(DIRUT) Q
  1. . I 'Y Q
  1. . ;
  1. . ; update the sort order array with the chosen symbol
  1. . S IBCNSORT(1,$E(Y(0)))=1
  1. . S $P(IBCNSORT,U,3)=$E(Y(0))
  1. . Q
  1. ;
  1. ; rebuild and resort the list and update the list header
  1. D INIT^IBCNBLL,HDR^IBCNBLL
  1. ;
  1. SELSORTX ;
  1. S VALMBCK="R",VALMBG=1
  1. Q
  1. ;
  1. TGLSCRN(IBBUFDA) ; toggle process screen from policy to insurance info, glbal variable IBCNSCRN contains ins co chosen
  1. Q:'$G(IBBUFDA)
  1. D FULL^VALM1
  1. W !!,"Enter an Insurance Company to display the Groups/Plans for that company or ",!,"enter Return to display a patient's policies.",!!
  1. S IBCNSCRN=+$$SELINS^IBCNBU1
  1. ;
  1. D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R",VALMBG=1
  1. Q
  1. ;
  1. 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
  1. ; invoke another ListMan screen that shows a list of all insurance
  1. ; company names that do not exist in File 36 either as names or as
  1. ; synonyms and also they do not exist in the Auto Match file. These
  1. ; are bad insurance company names that need to be corrected before
  1. ; electronic insurance verification attempts can be made.
  1. ; esg - 6/20/02 - SDD 5.1.11 - Add an action on the main buffer
  1. ; screen to call the buffer names check option
  1. ;
  1. D EN^IBCNEAMC
  1. S VALMBCK="R"
  1. AMCHKX ;
  1. Q
  1. ;