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

IBCEMSG.m

Go to the documentation of this file.
  1. IBCEMSG ;ALB/JEH - EDI PURGE STATUS MESSAGES ;10-APR-01
  1. ;;2.0;INTEGRATED BILLING:**137**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. EN ;
  1. N IBDELDT,IBSEL,IBQUIT,IBPRT,DTOUT,DUOUT,DIRUT,X,Y
  1. K ^TMP("IBCEMSGA",$J)
  1. I '$D(^XUSEC("IB SUPERVISOR",DUZ)) W !!,"You do not have the appropriate authority to delete status messages. See your supervisor for assistance." G MSGQ
  1. W !,"This option will delete status messages in one of the Final Review statuses",!,"prior to a selected date",!!
  1. S DIR("A")="DELETE (A)LL OR (S)ELECTED STATUS MESSAGES? ",DIR("B")="SELECTED"
  1. S DIR(0)="SAXB^A:ALL STATUS MESSAGES;S:SELECTED STATUS MESSAGES"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) G MSGQ
  1. S IBSEL=Y
  1. ;
  1. W !
  1. I IBSEL="A" D G:IBQUIT MSGQ
  1. . S IBQUIT=0
  1. . S DIR("A")="DELETE STATUS MESSAGES REVIEWED PRIOR TO"
  1. . S DIR(0)="D^:DTP:EX" W ! D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S IBQUIT=1 Q
  1. . S IBDELDT=Y
  1. . S DIR("A",1)="This action will delete all status messages with a"
  1. . S DIR("A",2)="final review action dated before "_$$FMTE^XLFDT(IBDELDT)
  1. . S DIR("A",3)=""
  1. . S DIR("A")="ARE YOU SURE THIS IS WHAT YOU WANT TO DO",DIR("B")="YES"
  1. . S DIR(0)="Y" D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT)!(+Y=0) S IBQUIT=1 Q
  1. . S DIR("A")="DO YOU WANT TO PRINT STATUS MESSAGES BEFORE DELETION"
  1. . S DIR(0)="Y",DIR("B")="YES"
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S IBQUIT=1 Q
  1. . S IBPRT=Y
  1. I IBSEL="A" D SET,PRT:IBPRT,DEL
  1. I IBSEL="S" D EN^IBCEMSG1
  1. MSGQ ;
  1. Q
  1. SET ;set up tmp global
  1. N IBDT,IBIEN,IB0,IBNUM,IBSEV,IBFNR,IBFRD,IBQUIT,IBAUTO
  1. S (IBDT,IBQUIT)=0 F S IBDT=$O(^IBM(361,"AFR",IBDT)) Q:'IBDT!(IBQUIT) S IBIEN=0 F S IBIEN=$O(^IBM(361,"AFR",IBDT,IBIEN)) Q:'IBIEN!(IBQUIT) D
  1. . I IBDT>IBDELDT S IBQUIT=1 Q
  1. . S IB0=$G(^IBM(361,IBIEN,0))
  1. . S IBNUM=$$BN1^PRCAFN($P($G(IB0),U))
  1. . S IBSEV=$$EXPAND^IBTRE(361,.03,$P($G(IB0),U,3))
  1. . S IBFNR=$$EXPAND^IBTRE(361,.1,$P($G(IB0),U,10))
  1. . S IBFRD=$$DAT1^IBOUTL($P($G(IB0),U,13))
  1. . S IBAUTO=$$EXPAND^IBTRE(361,.14,$P(IB0,U,5))
  1. . S ^TMP("IBCEMSGA",$J,IBIEN)=IBNUM_U_IBSEV_U_IBFNR_U_IBFRD
  1. Q
  1. ;
  1. PRT ;print status message list
  1. N IBPG,%ZIS
  1. S IBPG=0
  1. S %ZIS="M" D ^%ZIS G:POP MSGQ
  1. U IO
  1. PRT1 ;
  1. N IBIEN,IB0 D HDR
  1. S IBIEN=0 F S IBIEN=$O(^TMP("IBCEMSGA",$J,IBIEN)) Q:'IBIEN S IB0=^(IBIEN) D
  1. .I ($Y+5)>IOSL D Q:IBQUIT
  1. .. D ASK Q:IBQUIT D HDR
  1. . W !,$P(IB0,U),?13,$P(IB0,U,2),?34,$P(IB0,U,3),?71,$P(IB0,U,4)
  1. W !
  1. D ^%ZISC
  1. Q
  1. ASK ;
  1. I $E(IOST,1,2)'["C-" Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="E" D ^DIR
  1. I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1 Q
  1. Q
  1. ;
  1. HDR ; - report header
  1. I $E(IOST,1,2)="C-" W @IOF,*13
  1. S IBPG=IBPG+1
  1. W !!,"Status Messages Selected for Deletion",?57,$$FMTE^XLFDT(DT),?71,"Page: ",IBPG,!
  1. W !,?13,"Message",?34,"Final Review",?67,"Final Review",!,"Bill #",?13,"Severity",?37,"Action",?72,"Date"
  1. W !,$TR($J("",IOM)," ","=")
  1. Q
  1. DEL ;Delete status messages in final review status
  1. N DIK,DA,Y,IBIEN,IBCNT
  1. W !
  1. S DIR("A")="ARE YOU SURE YOU WANT TO DELETE STATUS MESSAGES",DIR("B")="YES"
  1. S DIR(0)="Y" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!(Y=0) G DELQ
  1. S IBCNT=0,DIK="^IBM(361,"
  1. S IBIEN=0 F S IBIEN=$O(^TMP("IBCEMSGA",$J,IBIEN)) Q:'IBIEN S DA=IBIEN D ^DIK S IBCNT=IBCNT+1
  1. W !!,IBCNT_$S(IBCNT>1:" Messages",1:" Message")_" deleted"
  1. DELQ Q
  1. ;