- 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 Jan 18, 2025@03:08 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