source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTV3.m@ 1582

Last change on this file since 1582 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1IBAMTV3 ;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 ;
5EN ; 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")
9ENQ K IBSITE,IBSERV,IBFAC
10 Q
11 ;
12HDR ; Build screen header.
13 S VALMHDR(1)="Release Charges 'Pending Review'"
14 S VALMHDR(2)=$J("",45)_"Date of MT Active"
15 Q
16 ;
17INIT ; 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 ;
37HELP ; Help code.
38 S X="?" D DISP^XQORM1 W !!
39 Q
40 ;
41EXIT ; Exit action.
42 K ^TMP("IBAMTV3",$J)
43 D FULL^VALM1,CLEAN^VALM10
44 Q
45 ;
46RELPR ; 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 ;
56RELQ 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
Note: See TracBrowser for help on using the repository browser.