Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBAMTV3

IBAMTV3.m

Go to the documentation of this file.
  1. IBAMTV3 ;ALB/CPM-RELEASE CHARGES PENDING REVIEW ;03-JUN-94
  1. ;;2.0;INTEGRATED BILLING;**15,153,183,215**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; Release Charges 'Pending Review' -- invoke the List Manager.
  1. I '$$CHECK^IBECEAU(1) G ENQ
  1. I '$D(^IB("AJ")) W !!,"There are no patients with charges pending review.",! G ENQ
  1. D EN^VALM("IB MT REVIEW PATIENT")
  1. ENQ K IBSITE,IBSERV,IBFAC
  1. Q
  1. ;
  1. HDR ; Build screen header.
  1. S VALMHDR(1)="Release Charges 'Pending Review'"
  1. S VALMHDR(2)=$J("",45)_"Date of MT Active"
  1. Q
  1. ;
  1. INIT ; Build list.
  1. N DFN,IBAX,IBMTS,IBPT,IBN,IBDT
  1. S VALMBG=1,VALMCNT=0,VALMBCK="R"
  1. K ^TMP("IBAMTV3",$J)
  1. S DFN=0 F S DFN=$O(^IB("AJ",DFN)) Q:'DFN D
  1. .S IBPT=$$PT^IBEFUNC(DFN) Q:IBPT=""
  1. .S IBN=$O(^IB("AJ",DFN,0)) Q:'IBN
  1. .S IBDT=$P($G(^IB(IBN,0)),"^",14) Q:'IBDT
  1. .S VALMCNT=VALMCNT+1
  1. .S IBAX=$$SETSTR^VALM1($P(IBPT,"^"),VALMCNT,+$P(VALMDDF("PATIENT"),"^",2),+$P(VALMDDF("PATIENT"),"^",3))
  1. .S IBAX=$$SETSTR^VALM1($E(IBPT)_$P(IBPT,"^",3),IBAX,+$P(VALMDDF("PID"),"^",2),+$P(VALMDDF("PID"),"^",3))
  1. .S IBAX=$$SETSTR^VALM1($$DAT1^IBOUTL($P($$LST^DGMTU(DFN,IBDT),"^",2)),IBAX,+$P(VALMDDF("MT DATE"),"^",2),+$P(VALMDDF("MT DATE"),"^",3))
  1. .S IBMTS=$P($$LST^DGMTU(DFN),"^",4),IBMTS=$S(IBMTS="P":"PEN",IBMTS="G":"GMT",IBMTS="C":"YES",IBMTS="R":"REQ",1:"NO")
  1. .S IBAX=$$SETSTR^VALM1(IBMTS,IBAX,+$P(VALMDDF("MT STAT"),"^",2),+$P(VALMDDF("MT STAT"),"^",3))
  1. .S IBAX=$$SETSTR^VALM1($S($$INSURED^IBCNS1(DFN):"YES",1:" NO"),IBAX,+$P(VALMDDF("INS"),"^",2),+$P(VALMDDF("INS"),"^",3))
  1. .S ^TMP("IBAMTV3",$J,VALMCNT,0)=IBAX
  1. .S ^TMP("IBAMTV3",$J,"IDX",VALMCNT,VALMCNT)=DFN
  1. 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
  1. Q
  1. ;
  1. HELP ; Help code.
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; Exit action.
  1. K ^TMP("IBAMTV3",$J)
  1. D FULL^VALM1,CLEAN^VALM10
  1. Q
  1. ;
  1. RELPR ; Release charges on hold at least 60 days old.
  1. K ^TMP($J,"IBHOLD") D NOW^%DTC S TDY=%
  1. S IBN=0 F S IBN=$O(^IB("AC",21,IBN)) Q:'IBN D
  1. .S DFN=+$P($G(^IB(IBN,0)),U,2),X2=+$P($G(^IB(IBN,1)),U,4) Q:'DFN!('X2)
  1. .S X1=TDY D ^%DTC Q:X<60 S ^TMP($J,"IBHOLD",DFN,IBN)=""
  1. ;
  1. I '$D(^TMP($J,"IBHOLD")) G RELQ
  1. S IBR60=1 D REL^IBOHRL ; Release charges
  1. S IBSTJB=$$DAT2^IBOUTL(TDY) D MAIL^IBOHRL ; Send bullletin
  1. ;
  1. RELQ K DFN,IBDUZ,IBEND,IBN,IBDIFROM,IBNOS,IBNUM,IBRCOUNT,IBR60,IBSEQNO,IBSTJB
  1. K IBT,TDY,XMDUZ,XMGRP,XMSUB,XMTEXT,XMY,X,X1,X2,%,^TMP($J,"IBHOLD")
  1. Q