IBAMTV3 ;ALB/CPM-RELEASE CHARGES PENDING REVIEW ;03-JUN-94
;;2.0;INTEGRATED BILLING;**15,153,183,215**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; Release Charges 'Pending Review' -- invoke the List Manager.
I '$$CHECK^IBECEAU(1) G ENQ
I '$D(^IB("AJ")) W !!,"There are no patients with charges pending review.",! G ENQ
D EN^VALM("IB MT REVIEW PATIENT")
ENQ K IBSITE,IBSERV,IBFAC
Q
;
HDR ; Build screen header.
S VALMHDR(1)="Release Charges 'Pending Review'"
S VALMHDR(2)=$J("",45)_"Date of MT Active"
Q
;
INIT ; Build list.
N DFN,IBAX,IBMTS,IBPT,IBN,IBDT
S VALMBG=1,VALMCNT=0,VALMBCK="R"
K ^TMP("IBAMTV3",$J)
S DFN=0 F S DFN=$O(^IB("AJ",DFN)) Q:'DFN D
.S IBPT=$$PT^IBEFUNC(DFN) Q:IBPT=""
.S IBN=$O(^IB("AJ",DFN,0)) Q:'IBN
.S IBDT=$P($G(^IB(IBN,0)),"^",14) Q:'IBDT
.S VALMCNT=VALMCNT+1
.S IBAX=$$SETSTR^VALM1($P(IBPT,"^"),VALMCNT,+$P(VALMDDF("PATIENT"),"^",2),+$P(VALMDDF("PATIENT"),"^",3))
.S IBAX=$$SETSTR^VALM1($E(IBPT)_$P(IBPT,"^",3),IBAX,+$P(VALMDDF("PID"),"^",2),+$P(VALMDDF("PID"),"^",3))
.S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P($$LST^DGMTU(DFN,IBDT),"^",2)),IBAX,+$P(VALMDDF("MT DATE"),"^",2),+$P(VALMDDF("MT DATE"),"^",3))
.S IBMTS=$P($$LST^DGMTU(DFN),"^",4),IBMTS=$S(IBMTS="P":"PEN",IBMTS="G":"GMT",IBMTS="C":"YES",IBMTS="R":"REQ",1:"NO")
.S IBAX=$$SETSTR^VALM1(IBMTS,IBAX,+$P(VALMDDF("MT STAT"),"^",2),+$P(VALMDDF("MT STAT"),"^",3))
.S IBAX=$$SETSTR^VALM1($S($$INSURED^IBCNS1(DFN):"YES",1:" NO"),IBAX,+$P(VALMDDF("INS"),"^",2),+$P(VALMDDF("INS"),"^",3))
.S ^TMP("IBAMTV3",$J,VALMCNT,0)=IBAX
.S ^TMP("IBAMTV3",$J,"IDX",VALMCNT,VALMCNT)=DFN
I '$D(^TMP("IBAMTV3",$J)) S ^TMP("IBAMTV3",$J,1,0)=" ",^TMP("IBAMTV3",$J,2,0)=" There are no patients with charges pending review.",VALMCNT=2 ; ,@VALMIDX@(1)=1,@VALMIDX@(2)=2
Q
;
HELP ; Help code.
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; Exit action.
K ^TMP("IBAMTV3",$J)
D FULL^VALM1,CLEAN^VALM10
Q
;
RELPR ; Release charges on hold at least 60 days old.
K ^TMP($J,"IBHOLD") D NOW^%DTC S TDY=%
S IBN=0 F S IBN=$O(^IB("AC",21,IBN)) Q:'IBN D
.S DFN=+$P($G(^IB(IBN,0)),U,2),X2=+$P($G(^IB(IBN,1)),U,4) Q:'DFN!('X2)
.S X1=TDY D ^%DTC Q:X<60 S ^TMP($J,"IBHOLD",DFN,IBN)=""
;
I '$D(^TMP($J,"IBHOLD")) G RELQ
S IBR60=1 D REL^IBOHRL ; Release charges
S IBSTJB=$$DAT2^IBOUTL(TDY) D MAIL^IBOHRL ; Send bullletin
;
RELQ K DFN,IBDUZ,IBEND,IBN,IBDIFROM,IBNOS,IBNUM,IBRCOUNT,IBR60,IBSEQNO,IBSTJB
K IBT,TDY,XMDUZ,XMGRP,XMSUB,XMTEXT,XMY,X,X1,X2,%,^TMP($J,"IBHOLD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTV3 2585 printed Oct 16, 2024@18:07:28 Page 2
IBAMTV3 ;ALB/CPM-RELEASE CHARGES PENDING REVIEW ;03-JUN-94
+1 ;;2.0;INTEGRATED BILLING;**15,153,183,215**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; Release Charges 'Pending Review' -- invoke the List Manager.
+1 IF '$$CHECK^IBECEAU(1)
GOTO ENQ
+2 IF '$DATA(^IB("AJ"))
WRITE !!,"There are no patients with charges pending review.",!
GOTO ENQ
+3 DO EN^VALM("IB MT REVIEW PATIENT")
ENQ KILL IBSITE,IBSERV,IBFAC
+1 QUIT
+2 ;
HDR ; Build screen header.
+1 SET VALMHDR(1)="Release Charges 'Pending Review'"
+2 SET VALMHDR(2)=$JUSTIFY("",45)_"Date of MT Active"
+3 QUIT
+4 ;
INIT ; Build list.
+1 NEW DFN,IBAX,IBMTS,IBPT,IBN,IBDT
+2 SET VALMBG=1
SET VALMCNT=0
SET VALMBCK="R"
+3 KILL ^TMP("IBAMTV3",$JOB)
+4 SET DFN=0
FOR
SET DFN=$ORDER(^IB("AJ",DFN))
if 'DFN
QUIT
Begin DoDot:1
+5 SET IBPT=$$PT^IBEFUNC(DFN)
if IBPT=""
QUIT
+6 SET IBN=$ORDER(^IB("AJ",DFN,0))
if 'IBN
QUIT
+7 SET IBDT=$PIECE($GET(^IB(IBN,0)),"^",14)
if 'IBDT
QUIT
+8 SET VALMCNT=VALMCNT+1
+9 SET IBAX=$$SETSTR^VALM1($PIECE(IBPT,"^"),VALMCNT,+$PIECE(VALMDDF("PATIENT"),"^",2),+$PIECE(VALMDDF("PATIENT"),"^",3))
+10 SET IBAX=$$SETSTR^VALM1($EXTRACT(IBPT)_$PIECE(IBPT,"^",3),IBAX,+$PIECE(VALMDDF("PID"),"^",2),+$PIECE(VALMDDF("PID"),"^",3))
+11 SET IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($PIECE($$LST^DGMTU(DFN,IBDT),"^",2)),IBAX,+$PIECE(VALMDDF("MT DATE"),"^",2),+$PIECE(VALMDDF("MT DATE"),"^",3))
+12 SET IBMTS=$PIECE($$LST^DGMTU(DFN),"^",4)
SET IBMTS=$SELECT(IBMTS="P":"PEN",IBMTS="G":"GMT",IBMTS="C":"YES",IBMTS="R":"REQ",1:"NO")
+13 SET IBAX=$$SETSTR^VALM1(IBMTS,IBAX,+$PIECE(VALMDDF("MT STAT"),"^",2),+$PIECE(VALMDDF("MT STAT"),"^",3))
+14 SET IBAX=$$SETSTR^VALM1($SELECT($$INSURED^IBCNS1(DFN):"YES",1:" NO"),IBAX,+$PIECE(VALMDDF("INS"),"^",2),+$PIECE(VALMDDF("INS"),"^",3))
+15 SET ^TMP("IBAMTV3",$JOB,VALMCNT,0)=IBAX
+16 SET ^TMP("IBAMTV3",$JOB,"IDX",VALMCNT,VALMCNT)=DFN
End DoDot:1
+17 ; ,@VALMIDX@(1)=1,@VALMIDX@(2)=2
IF '$DATA(^TMP("IBAMTV3",$JOB))
SET ^TMP("IBAMTV3",$JOB,1,0)=" "
SET ^TMP("IBAMTV3",$JOB,2,0)=" There are no patients with charges pending review."
SET VALMCNT=2
+18 QUIT
+19 ;
HELP ; Help code.
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; Exit action.
+1 KILL ^TMP("IBAMTV3",$JOB)
+2 DO FULL^VALM1
DO CLEAN^VALM10
+3 QUIT
+4 ;
RELPR ; Release charges on hold at least 60 days old.
+1 KILL ^TMP($JOB,"IBHOLD")
DO NOW^%DTC
SET TDY=%
+2 SET IBN=0
FOR
SET IBN=$ORDER(^IB("AC",21,IBN))
if 'IBN
QUIT
Begin DoDot:1
+3 SET DFN=+$PIECE($GET(^IB(IBN,0)),U,2)
SET X2=+$PIECE($GET(^IB(IBN,1)),U,4)
if 'DFN!('X2)
QUIT
+4 SET X1=TDY
DO ^%DTC
if X<60
QUIT
SET ^TMP($JOB,"IBHOLD",DFN,IBN)=""
End DoDot:1
+5 ;
+6 IF '$DATA(^TMP($JOB,"IBHOLD"))
GOTO RELQ
+7 ; Release charges
SET IBR60=1
DO REL^IBOHRL
+8 ; Send bullletin
SET IBSTJB=$$DAT2^IBOUTL(TDY)
DO MAIL^IBOHRL
+9 ;
RELQ KILL DFN,IBDUZ,IBEND,IBN,IBDIFROM,IBNOS,IBNUM,IBRCOUNT,IBR60,IBSEQNO,IBSTJB
+1 KILL IBT,TDY,XMDUZ,XMGRP,XMSUB,XMTEXT,XMY,X,X1,X2,%,^TMP($JOB,"IBHOLD")
+2 QUIT
