- IBRREL ;ALB/CPM - RELEASE MEANS TEST CHARGES 'ON HOLD'; Sep 30, 2020@15:16:44
- ;;2.0;INTEGRATED BILLING;**95,153,199,347,452,651,663,675,677,630,760**;21-MAR-94;Build 25
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- EN ; Entry point for stand-alone 'release' option
- I '$D(^IB("AH")) W !!,"There are no patients with charges 'on hold' at this time.",! Q
- ;
- D HOME^%ZIS
- W !!,"This option is used to release Means Test charges which have been"
- W !,"placed 'on hold.' Please enter a patient with charges 'on hold,' and these"
- W !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
- ;
- ASK ;
- R !,"Select PATIENT NAME: ",X:DTIME G END:"^"[$E(X)
- I $E(X,1,2)="??" D HLP1 G ASK
- I $E(X)="?" D HLP G ASK
- N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
- S DIC="^DPT(",DIC(0)="QME" D ^DIC K DIC G ASK:Y<1 S DFN=+Y
- ;
- K IBA,PRCABN
- S IBI=0 F IBNUM=1:1 S IBI=$O(^IB("AH",DFN,IBI)) Q:'IBI S IBA(IBNUM)=IBI
- I '$D(IBA) W !!,"This patient does not have any charges 'on hold.'",! G ASK
- ;
- S IBPT=$$PT^IBEFUNC(DFN) W @IOF,$P(IBPT,"^")," Pt ID: ",$P(IBPT,"^",2),! S I="",$P(I,"-",80)="" W I K I
- ;
- RESUME ; - display header and list charges
- ;
- ; *** This tag is also called by ECME routine IBNCPDPR ***
- ; Special variable IBNCPDPR will be set to 1 when called from ECME.
- ; If this variable is set, then processing in this routine will GOTO tag END and quit rather than go back up
- ; and ask for another patient.
- ; Also, special variable IBNCPDPRDEF is the entry# in the list if a specific Rx# was chosen from the ECME screen.
- ;
- ;
- W !!,"The following IB Actions ",$S($D(PRCABN):"associated with this bill",1:"for this patient")," are ON HOLD:"
- D HDR
- ;
- ; display the list of IB charges on hold
- S IBQ=0 F IBNUM=1:1 Q:'$D(IBA(IBNUM))!IBQ D Q:IBQ
- . I $Y+5>IOSL D PAUSE^VALM1 S:$D(DIRUT) IBQ=1 Q:IBQ S $Y=0 D HDR
- . S IBN=IBA(IBNUM) D LST
- . Q
- ;
- ; - prompt user to select IB Actions
- S DIR(0)="LA^1:"_(IBNUM-1)_"^K:X[""."" X"
- S DIR("A")="Select IB Action"_$E("s",IBNUM>2)_" (REF #) to release (or '^' to exit): "
- I $G(IBNCPDPRDEF) S DIR("B")=IBNCPDPRDEF ; default value if coming in from ECME
- S DIR("?")="^D HELP^IBRREL"
- W ! D ^DIR K DIR
- I $D(DIRUT)!($D(DUOUT)) G END:($D(PRCABN)!$G(IBNCPDPR)) D END W ! G ASK
- ;
- S IBRANGE=Y,IBSEQNO=1,IBDUZ=DUZ
- ; IB*2.0*630 - Check for duplicate copays
- N IBDUPCPY,IBCNTR,IBIEN,IBIENS
- S IBIENS="",IBDUPCPY=0
- F IBCNTR=1:1 S IBIEN=$P(Y,",",IBCNTR) Q:'IBIEN S IBIENS=$G(IBA(IBIEN)) Q:'IBIENS D Q:IBDUPCPY
- . S IBDUPCPY=$$DUPCPYCHK^IBECEA1(IBIENS)
- . ; If duplicate copay, display message
- . I IBDUPCPY D CPYDISPLAY^IBECEA1(IBIENS,IBDUPCPY)
- . Q
- ; Send user back to selection prompt if duplicate copays exist
- Q:IBDUPCPY
- ; End of IB*2.0*630 changes
- ;
- S DIR(0)="Y",DIR("A")="OK to pass "_$S($P(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable"
- D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G END:($D(PRCABN)!$G(IBNCPDPR)) D END W ! G ASK
- ;
- ; - pass charges to Accounts Receivable
- W !!,"Passing charges to Accounts Receivable...",! D HDR
- F IBCTR=1:1 S IBNUM=$P(IBRANGE,",",IBCTR) Q:'IBNUM I $D(IBA(IBNUM)) S IBNOS=IBA(IBNUM) D ^IBR,ERR:Y<1 I Y>0 S IBN=IBA(IBNUM) D UPDUCDB(IBN),UPDMH(IBN),LST ; IB*2.0*760
- W !!,"The charge"_$E("s",$P(IBRANGE,",",2)>0)_" listed above "_$S($P(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable.",!
- ;
- I $G(IBNCPDPR) W !! S DIR(0)="E" D ^DIR K DIR G END ; exit for ECME
- ;
- I '$D(PRCABN) W !! S DIR(0)="E" D ^DIR K DIR D END W ! G ASK
- ;
- END K DIC,DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBCTR,IBN,IBDA,IBDUZ
- K IBFAC,IBI,IBIL,IBRANGE,IBNOS,IBNUM,IBPT,IBQ,IBSEQNO,IBSERV,IBSITE
- K IBTOTL,IBTRAN,IBWHER,VA,VAERR,VADM
- K:'$D(PRCABN) DFN
- Q
- ;
- ;
- HDR ; Display charge header.
- N IBLINE S $P(IBLINE,"=",81)=""
- W !,IBLINE,!," REF Action ID Bill Type",?42,"Bill #",?51,"Fr/Fl Dt",?61,"To/Rls Dt",?73,"Charge"
- W !,IBLINE Q
- ;
- LST ; Display individual IB Action.
- N IBND,IBND1,IBRXN,IBRX,IBRF,IBRDT,IENS,IBECME
- S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1)),(IBRXN,IBRX,IBRF,IBRDT,IBECME)=0
- I $P(IBND,"^",4)["52:" D
- . S IBRXN=+$P($P(IBND,"^",4),":",2) ; Rx ien
- . S IBRX=$P($P(IBND,"^",8),"-") ; external Rx#
- . S IBRF=+$P($P(IBND,"^",4),":",3) ; fill# or 0 for original fill
- . S IBECME=$P($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6) ; ecme# DBIA# 4719
- . I IBRF S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
- . I 'IBRF S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(+IENS,22)
- . Q
- ;
- W !?1,$J(IBNUM,2),?6,$J(+IBND,9)
- W ?19,$S(IBRXN>0:"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),1:$P(IBND,"^",8)) ;IB*2.0*651
- W ?42,$P($P(IBND,"^",11),"-",2)
- W ?51,$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",14)))
- W ?61,$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
- W ?70,$J(+$P(IBND,"^",7),9,2)
- I IBECME W !?19,"ECME #: ",IBECME
- Q
- ;
- ERR ; Display error message.
- W !?1,$J(IBNUM,2),?7,"Error encountered - a separate bulletin has been posted"
- Q
- ;
- HLP ; Display basic help message.
- W !!,"Enter: the name of a patient with charges 'on hold,' or"
- W !?10,"'??' -- to see all patients with charges 'on hold,' or"
- W !?10,"'^' -- to quit this option.",!
- Q
- ;
- HLP1 ; Display all patients with charges 'on hold.'
- N DFN,I,IBQ,PID
- W !!,"The following patients have charges 'on hold:'"
- S (DFN,IBQ)=0 F I=1:1 S DFN=$O(^IB("AH",DFN)) Q:'DFN D:'(I#15) Q:IBQ S PID=$$PT^IBEFUNC(DFN) W !?3,$P(PID,"^"),$J("",10),$P(PID,"^",2)
- . R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
- W ! Q
- ;
- HELP ; Help for the 'Select' prompt.
- W !!?4,"Please enter a list or range of IB Actions (i.e. 1,3,5 or 2-4,8), none"
- W !?4,"greater than ",IBNUM-1,", to be passed to Accounts Receivable, or '^' to quit."
- Q
- ;
- AR ; Accounts Receivable entry point to release charges.
- ; Input: PRCABN -- ien of Bill/Accounts Receivable
- Q:$D(PRCABN)[0 Q:'$$IB^IBRUTL(PRCABN,1) G RESUME
- ;
- ;Start - IB*2.0*663
- UPDUCDB(IBN) ;Update the Visit Tracking DB with the bill Number
- N IBND,IBVSTIEN
- Q:IBN=""
- S IBND=$G(^IB(IBN,0))
- ;IB*2.0*663 If charge successfully passed, extract the bill number and update the visit tracking database if this is a CC URGENT CARE Charge
- I $P(IBND,U,11)'="",$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["CC URGENT CARE" D
- . ; send update to the Visit Tracking file.
- . S IBVSTIEN=$$FNDVST^IBECEA4("ON HOLD",$P(IBND,U,14),$P(IBND,U,2))
- . ;ADD THE NOT FOUND MESSAGE HERE?
- . D:+IBVSTIEN UPDATE^IBECEA38(IBVSTIEN,2,$P(IBND,U,11),"",1,.IBERROR)
- Q
- ;End IB*2.0*663
- UPDMH(IBN) ; update MH Visit tracking DB IB*2.0*760
- N IBATYPE,IBBLNO,IBCDCHK,IBERROR,IBFR,IBMHVST,IBND,IBSTOPDA,Z
- I +$G(IBN)'>0 Q
- S IBND=^IB(IBN,0)
- S IBSTOPDA=$P(IBND,U,20),IBCDCHK=0,IBATYPE=+$P(IBND,U,3),IBFR=+$P(IBND,U,14),IBBLNO=$P(IBND,U,11)
- I $P($G(^IBE(350.1,IBATYPE,0)),U)["CC MH" S IBCDCHK=1
- I 'IBCDCHK,$$CDCHK^IBECEAMH($$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E"),IBFR) S IBCDCHK=1
- I IBBLNO'="",IBCDCHK D
- .S IBMHVST=$O(^IBMH(351.83,"D",IBN,"")) Q:'IBMHVST
- .D MESS2B^IBECEAMH S Z=$$UPDATE^IBECEAMH(0,IBMHVST,2,IBBLNO,"",1,.IBERROR)
- .Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRREL 7237 printed Jan 18, 2025@03:28:09 Page 2
- IBRREL ;ALB/CPM - RELEASE MEANS TEST CHARGES 'ON HOLD'; Sep 30, 2020@15:16:44
- +1 ;;2.0;INTEGRATED BILLING;**95,153,199,347,452,651,663,675,677,630,760**;21-MAR-94;Build 25
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- EN ; Entry point for stand-alone 'release' option
- +1 IF '$DATA(^IB("AH"))
- WRITE !!,"There are no patients with charges 'on hold' at this time.",!
- QUIT
- +2 ;
- +3 DO HOME^%ZIS
- +4 WRITE !!,"This option is used to release Means Test charges which have been"
- +5 WRITE !,"placed 'on hold.' Please enter a patient with charges 'on hold,' and these"
- +6 WRITE !,"charges will be displayed and may be selected to be released to Accounts",!,"Receivable.",!
- +7 ;
- ASK ;
- +1 READ !,"Select PATIENT NAME: ",X:DTIME
- if "^"[$EXTRACT(X)
- GOTO END
- +2 IF $EXTRACT(X,1,2)="??"
- DO HLP1
- GOTO ASK
- +3 IF $EXTRACT(X)="?"
- DO HLP
- GOTO ASK
- +4 ;Suppress PATIENT file fuzzy lookups
- NEW DPTNOFZY
- SET DPTNOFZY=1
- +5 SET DIC="^DPT("
- SET DIC(0)="QME"
- DO ^DIC
- KILL DIC
- if Y<1
- GOTO ASK
- SET DFN=+Y
- +6 ;
- +7 KILL IBA,PRCABN
- +8 SET IBI=0
- FOR IBNUM=1:1
- SET IBI=$ORDER(^IB("AH",DFN,IBI))
- if 'IBI
- QUIT
- SET IBA(IBNUM)=IBI
- +9 IF '$DATA(IBA)
- WRITE !!,"This patient does not have any charges 'on hold.'",!
- GOTO ASK
- +10 ;
- +11 SET IBPT=$$PT^IBEFUNC(DFN)
- WRITE @IOF,$PIECE(IBPT,"^")," Pt ID: ",$PIECE(IBPT,"^",2),!
- SET I=""
- SET $PIECE(I,"-",80)=""
- WRITE I
- KILL I
- +12 ;
- RESUME ; - display header and list charges
- +1 ;
- +2 ; *** This tag is also called by ECME routine IBNCPDPR ***
- +3 ; Special variable IBNCPDPR will be set to 1 when called from ECME.
- +4 ; If this variable is set, then processing in this routine will GOTO tag END and quit rather than go back up
- +5 ; and ask for another patient.
- +6 ; Also, special variable IBNCPDPRDEF is the entry# in the list if a specific Rx# was chosen from the ECME screen.
- +7 ;
- +8 ;
- +9 WRITE !!,"The following IB Actions ",$SELECT($DATA(PRCABN):"associated with this bill",1:"for this patient")," are ON HOLD:"
- +10 DO HDR
- +11 ;
- +12 ; display the list of IB charges on hold
- +13 SET IBQ=0
- FOR IBNUM=1:1
- if '$DATA(IBA(IBNUM))!IBQ
- QUIT
- Begin DoDot:1
- +14 IF $Y+5>IOSL
- DO PAUSE^VALM1
- if $DATA(DIRUT)
- SET IBQ=1
- if IBQ
- QUIT
- SET $Y=0
- DO HDR
- +15 SET IBN=IBA(IBNUM)
- DO LST
- +16 QUIT
- End DoDot:1
- if IBQ
- QUIT
- +17 ;
- +18 ; - prompt user to select IB Actions
- +19 SET DIR(0)="LA^1:"_(IBNUM-1)_"^K:X[""."" X"
- +20 SET DIR("A")="Select IB Action"_$EXTRACT("s",IBNUM>2)_" (REF #) to release (or '^' to exit): "
- +21 ; default value if coming in from ECME
- IF $GET(IBNCPDPRDEF)
- SET DIR("B")=IBNCPDPRDEF
- +22 SET DIR("?")="^D HELP^IBRREL"
- +23 WRITE !
- DO ^DIR
- KILL DIR
- +24 IF $DATA(DIRUT)!($DATA(DUOUT))
- if ($DATA(PRCABN)!$GET(IBNCPDPR))
- GOTO END
- DO END
- WRITE !
- GOTO ASK
- +25 ;
- +26 SET IBRANGE=Y
- SET IBSEQNO=1
- SET IBDUZ=DUZ
- +27 ; IB*2.0*630 - Check for duplicate copays
- +28 NEW IBDUPCPY,IBCNTR,IBIEN,IBIENS
- +29 SET IBIENS=""
- SET IBDUPCPY=0
- +30 FOR IBCNTR=1:1
- SET IBIEN=$PIECE(Y,",",IBCNTR)
- if 'IBIEN
- QUIT
- SET IBIENS=$GET(IBA(IBIEN))
- if 'IBIENS
- QUIT
- Begin DoDot:1
- +31 SET IBDUPCPY=$$DUPCPYCHK^IBECEA1(IBIENS)
- +32 ; If duplicate copay, display message
- +33 IF IBDUPCPY
- DO CPYDISPLAY^IBECEA1(IBIENS,IBDUPCPY)
- +34 QUIT
- End DoDot:1
- if IBDUPCPY
- QUIT
- +35 ; Send user back to selection prompt if duplicate copays exist
- +36 if IBDUPCPY
- QUIT
- +37 ; End of IB*2.0*630 changes
- +38 ;
- +39 SET DIR(0)="Y"
- SET DIR("A")="OK to pass "_$SELECT($PIECE(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable"
- +40 DO ^DIR
- KILL DIR
- IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
- if ($DATA(PRCABN)!$GET(IBNCPDPR))
- GOTO END
- DO END
- WRITE !
- GOTO ASK
- +41 ;
- +42 ; - pass charges to Accounts Receivable
- +43 WRITE !!,"Passing charges to Accounts Receivable...",!
- DO HDR
- +44 ; IB*2.0*760
- FOR IBCTR=1:1
- SET IBNUM=$PIECE(IBRANGE,",",IBCTR)
- if 'IBNUM
- QUIT
- IF $DATA(IBA(IBNUM))
- SET IBNOS=IBA(IBNUM)
- DO ^IBR
- if Y<1
- DO ERR
- IF Y>0
- SET IBN=IBA(IBNUM)
- DO UPDUCDB(IBN)
- DO UPDMH(IBN)
- DO LST
- +45 WRITE !!,"The charge"_$EXTRACT("s",$PIECE(IBRANGE,",",2)>0)_" listed above "_$SELECT($PIECE(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable.",!
- +46 ;
- +47 ; exit for ECME
- IF $GET(IBNCPDPR)
- WRITE !!
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- GOTO END
- +48 ;
- +49 IF '$DATA(PRCABN)
- WRITE !!
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- DO END
- WRITE !
- GOTO ASK
- +50 ;
- END KILL DIC,DIRUT,DUOUT,DTOUT,IBA,IBAFY,IBARTYP,IBATYP,IBCTR,IBN,IBDA,IBDUZ
- +1 KILL IBFAC,IBI,IBIL,IBRANGE,IBNOS,IBNUM,IBPT,IBQ,IBSEQNO,IBSERV,IBSITE
- +2 KILL IBTOTL,IBTRAN,IBWHER,VA,VAERR,VADM
- +3 if '$DATA(PRCABN)
- KILL DFN
- +4 QUIT
- +5 ;
- +6 ;
- HDR ; Display charge header.
- +1 NEW IBLINE
- SET $PIECE(IBLINE,"=",81)=""
- +2 WRITE !,IBLINE,!," REF Action ID Bill Type",?42,"Bill #",?51,"Fr/Fl Dt",?61,"To/Rls Dt",?73,"Charge"
- +3 WRITE !,IBLINE
- QUIT
- +4 ;
- LST ; Display individual IB Action.
- +1 NEW IBND,IBND1,IBRXN,IBRX,IBRF,IBRDT,IENS,IBECME
- +2 SET IBND=$GET(^IB(IBN,0))
- SET IBND1=$GET(^IB(IBN,1))
- SET (IBRXN,IBRX,IBRF,IBRDT,IBECME)=0
- +3 IF $PIECE(IBND,"^",4)["52:"
- Begin DoDot:1
- +4 ; Rx ien
- SET IBRXN=+$PIECE($PIECE(IBND,"^",4),":",2)
- +5 ; external Rx#
- SET IBRX=$PIECE($PIECE(IBND,"^",8),"-")
- +6 ; fill# or 0 for original fill
- SET IBRF=+$PIECE($PIECE(IBND,"^",4),":",3)
- +7 ; ecme# DBIA# 4719
- SET IBECME=$PIECE($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6)
- +8 IF IBRF
- SET IENS=+IBRF
- SET IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
- +9 IF 'IBRF
- SET IENS=+IBRXN
- SET IBRDT=$$FILE^IBRXUTL(+IENS,22)
- +10 QUIT
- End DoDot:1
- +11 ;
- +12 WRITE !?1,$JUSTIFY(IBNUM,2),?6,$JUSTIFY(+IBND,9)
- +13 ;IB*2.0*651
- WRITE ?19,$SELECT(IBRXN>0:"Rx #: "_IBRX_$SELECT(IBRF>0:"("_IBRF_")",1:""),1:$PIECE(IBND,"^",8))
- +14 WRITE ?42,$PIECE($PIECE(IBND,"^",11),"-",2)
- +15 WRITE ?51,$$DAT1^IBOUTL($SELECT(IBRXN>0:IBRDT,1:$PIECE(IBND,"^",14)))
- +16 WRITE ?61,$$DAT1^IBOUTL($SELECT($PIECE(IBND,"^",15)'="":($PIECE(IBND,"^",15)),1:$PIECE(IBND1,"^",2)))
- +17 WRITE ?70,$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
- +18 IF IBECME
- WRITE !?19,"ECME #: ",IBECME
- +19 QUIT
- +20 ;
- ERR ; Display error message.
- +1 WRITE !?1,$JUSTIFY(IBNUM,2),?7,"Error encountered - a separate bulletin has been posted"
- +2 QUIT
- +3 ;
- HLP ; Display basic help message.
- +1 WRITE !!,"Enter: the name of a patient with charges 'on hold,' or"
- +2 WRITE !?10,"'??' -- to see all patients with charges 'on hold,' or"
- +3 WRITE !?10,"'^' -- to quit this option.",!
- +4 QUIT
- +5 ;
- HLP1 ; Display all patients with charges 'on hold.'
- +1 NEW DFN,I,IBQ,PID
- +2 WRITE !!,"The following patients have charges 'on hold:'"
- +3 SET (DFN,IBQ)=0
- FOR I=1:1
- SET DFN=$ORDER(^IB("AH",DFN))
- if 'DFN
- QUIT
- if '(I#15)
- Begin DoDot:1
- +4 READ !,"Enter RETURN to continue or '^' to stop: ",X:DTIME
- if X["^"!('$TEST)
- SET IBQ=1
- QUIT
- End DoDot:1
- if IBQ
- QUIT
- SET PID=$$PT^IBEFUNC(DFN)
- WRITE !?3,$PIECE(PID,"^"),$JUSTIFY("",10),$PIECE(PID,"^",2)
- +5 WRITE !
- QUIT
- +6 ;
- HELP ; Help for the 'Select' prompt.
- +1 WRITE !!?4,"Please enter a list or range of IB Actions (i.e. 1,3,5 or 2-4,8), none"
- +2 WRITE !?4,"greater than ",IBNUM-1,", to be passed to Accounts Receivable, or '^' to quit."
- +3 QUIT
- +4 ;
- AR ; Accounts Receivable entry point to release charges.
- +1 ; Input: PRCABN -- ien of Bill/Accounts Receivable
- +2 if $DATA(PRCABN)[0
- QUIT
- if '$$IB^IBRUTL(PRCABN,1)
- QUIT
- GOTO RESUME
- +3 ;
- +4 ;Start - IB*2.0*663
- UPDUCDB(IBN) ;Update the Visit Tracking DB with the bill Number
- +1 NEW IBND,IBVSTIEN
- +2 if IBN=""
- QUIT
- +3 SET IBND=$GET(^IB(IBN,0))
- +4 ;IB*2.0*663 If charge successfully passed, extract the bill number and update the visit tracking database if this is a CC URGENT CARE Charge
- +5 IF $PIECE(IBND,U,11)'=""
- IF $PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")["CC URGENT CARE"
- Begin DoDot:1
- +6 ; send update to the Visit Tracking file.
- +7 SET IBVSTIEN=$$FNDVST^IBECEA4("ON HOLD",$PIECE(IBND,U,14),$PIECE(IBND,U,2))
- +8 ;ADD THE NOT FOUND MESSAGE HERE?
- +9 if +IBVSTIEN
- DO UPDATE^IBECEA38(IBVSTIEN,2,$PIECE(IBND,U,11),"",1,.IBERROR)
- End DoDot:1
- +10 QUIT
- +11 ;End IB*2.0*663
- UPDMH(IBN) ; update MH Visit tracking DB IB*2.0*760
- +1 NEW IBATYPE,IBBLNO,IBCDCHK,IBERROR,IBFR,IBMHVST,IBND,IBSTOPDA,Z
- +2 IF +$GET(IBN)'>0
- QUIT
- +3 SET IBND=^IB(IBN,0)
- +4 SET IBSTOPDA=$PIECE(IBND,U,20)
- SET IBCDCHK=0
- SET IBATYPE=+$PIECE(IBND,U,3)
- SET IBFR=+$PIECE(IBND,U,14)
- SET IBBLNO=$PIECE(IBND,U,11)
- +5 IF $PIECE($GET(^IBE(350.1,IBATYPE,0)),U)["CC MH"
- SET IBCDCHK=1
- +6 IF 'IBCDCHK
- IF $$CDCHK^IBECEAMH($$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E"),IBFR)
- SET IBCDCHK=1
- +7 IF IBBLNO'=""
- IF IBCDCHK
- Begin DoDot:1
- +8 SET IBMHVST=$ORDER(^IBMH(351.83,"D",IBN,""))
- if 'IBMHVST
- QUIT
- +9 DO MESS2B^IBECEAMH
- SET Z=$$UPDATE^IBECEAMH(0,IBMHVST,2,IBBLNO,"",1,.IBERROR)
- +10 QUIT
- End DoDot:1
- +11 QUIT