[613] | 1 | IBAMTV3 ;ALB/CPM-RELEASE CHARGES PENDING REVIEW ;03-JUN-94
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**15,153,183,215**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | EN ; Release Charges 'Pending Review' -- invoke the List Manager.
|
---|
| 6 | I '$$CHECK^IBECEAU(1) G ENQ
|
---|
| 7 | I '$D(^IB("AJ")) W !!,"There are no patients with charges pending review.",! G ENQ
|
---|
| 8 | D EN^VALM("IB MT REVIEW PATIENT")
|
---|
| 9 | ENQ K IBSITE,IBSERV,IBFAC
|
---|
| 10 | Q
|
---|
| 11 | ;
|
---|
| 12 | HDR ; Build screen header.
|
---|
| 13 | S VALMHDR(1)="Release Charges 'Pending Review'"
|
---|
| 14 | S VALMHDR(2)=$J("",45)_"Date of MT Active"
|
---|
| 15 | Q
|
---|
| 16 | ;
|
---|
| 17 | INIT ; Build list.
|
---|
| 18 | N DFN,IBAX,IBMTS,IBPT,IBN,IBDT
|
---|
| 19 | S VALMBG=1,VALMCNT=0,VALMBCK="R"
|
---|
| 20 | K ^TMP("IBAMTV3",$J)
|
---|
| 21 | S DFN=0 F S DFN=$O(^IB("AJ",DFN)) Q:'DFN D
|
---|
| 22 | .S IBPT=$$PT^IBEFUNC(DFN) Q:IBPT=""
|
---|
| 23 | .S IBN=$O(^IB("AJ",DFN,0)) Q:'IBN
|
---|
| 24 | .S IBDT=$P($G(^IB(IBN,0)),"^",14) Q:'IBDT
|
---|
| 25 | .S VALMCNT=VALMCNT+1
|
---|
| 26 | .S IBAX=$$SETSTR^VALM1($P(IBPT,"^"),VALMCNT,+$P(VALMDDF("PATIENT"),"^",2),+$P(VALMDDF("PATIENT"),"^",3))
|
---|
| 27 | .S IBAX=$$SETSTR^VALM1($E(IBPT)_$P(IBPT,"^",3),IBAX,+$P(VALMDDF("PID"),"^",2),+$P(VALMDDF("PID"),"^",3))
|
---|
| 28 | .S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P($$LST^DGMTU(DFN,IBDT),"^",2)),IBAX,+$P(VALMDDF("MT DATE"),"^",2),+$P(VALMDDF("MT DATE"),"^",3))
|
---|
| 29 | .S IBMTS=$P($$LST^DGMTU(DFN),"^",4),IBMTS=$S(IBMTS="P":"PEN",IBMTS="G":"GMT",IBMTS="C":"YES",IBMTS="R":"REQ",1:"NO")
|
---|
| 30 | .S IBAX=$$SETSTR^VALM1(IBMTS,IBAX,+$P(VALMDDF("MT STAT"),"^",2),+$P(VALMDDF("MT STAT"),"^",3))
|
---|
| 31 | .S IBAX=$$SETSTR^VALM1($S($$INSURED^IBCNS1(DFN):"YES",1:" NO"),IBAX,+$P(VALMDDF("INS"),"^",2),+$P(VALMDDF("INS"),"^",3))
|
---|
| 32 | .S ^TMP("IBAMTV3",$J,VALMCNT,0)=IBAX
|
---|
| 33 | .S ^TMP("IBAMTV3",$J,"IDX",VALMCNT,VALMCNT)=DFN
|
---|
| 34 | 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
|
---|
| 35 | Q
|
---|
| 36 | ;
|
---|
| 37 | HELP ; Help code.
|
---|
| 38 | S X="?" D DISP^XQORM1 W !!
|
---|
| 39 | Q
|
---|
| 40 | ;
|
---|
| 41 | EXIT ; Exit action.
|
---|
| 42 | K ^TMP("IBAMTV3",$J)
|
---|
| 43 | D FULL^VALM1,CLEAN^VALM10
|
---|
| 44 | Q
|
---|
| 45 | ;
|
---|
| 46 | RELPR ; Release charges on hold at least 60 days old.
|
---|
| 47 | K ^TMP($J,"IBHOLD") D NOW^%DTC S TDY=%
|
---|
| 48 | S IBN=0 F S IBN=$O(^IB("AC",21,IBN)) Q:'IBN D
|
---|
| 49 | .S DFN=+$P($G(^IB(IBN,0)),U,2),X2=+$P($G(^IB(IBN,1)),U,4) Q:'DFN!('X2)
|
---|
| 50 | .S X1=TDY D ^%DTC Q:X<60 S ^TMP($J,"IBHOLD",DFN,IBN)=""
|
---|
| 51 | ;
|
---|
| 52 | I '$D(^TMP($J,"IBHOLD")) G RELQ
|
---|
| 53 | S IBR60=1 D REL^IBOHRL ; Release charges
|
---|
| 54 | S IBSTJB=$$DAT2^IBOUTL(TDY) D MAIL^IBOHRL ; Send bullletin
|
---|
| 55 | ;
|
---|
| 56 | RELQ K DFN,IBDUZ,IBEND,IBN,IBDIFROM,IBNOS,IBNUM,IBRCOUNT,IBR60,IBSEQNO,IBSTJB
|
---|
| 57 | K IBT,TDY,XMDUZ,XMGRP,XMSUB,XMTEXT,XMY,X,X1,X2,%,^TMP($J,"IBHOLD")
|
---|
| 58 | Q
|
---|