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

IBCERPT1.m

Go to the documentation of this file.
  1. IBCERPT1 ;ALB/JEH - ELECTRONIC REPORT DISPOSITION ;21-FEB-01
  1. ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; -- main entry
  1. D EN^VALM("IBCE ELEC REPORT DISP")
  1. Q
  1. ;
  1. INIT ; -- set up variables
  1. S U="^"
  1. D BLD
  1. Q
  1. ;
  1. BLD ; -- build list of reports
  1. N IBI,IBREC,IBDESC,IBDISP,IBREP,NUMBER,IBCNT,IBIEN,X
  1. S VALMCNT=0
  1. K ^TMP("IBREP DISP",$J),^TMP("IBREP DISP1",$J)
  1. S IBI=0,IBREP="",IBCNT=0
  1. F S IBREP=$O(^IBE(361.2,"B",IBREP)) Q:IBREP="" F S IBI=$O(^IBE(361.2,"B",IBREP,IBI)) Q:'IBI S IBCNT=IBCNT+1,IBREC=$G(^IBE(361.2,IBI,0)),^TMP("IBREP DISP",$J,IBCNT)=IBI_U_$P(IBREC,U)_U_$P(IBREC,U,2)_U_$P(IBREC,U,3)
  1. ;
  1. S IBCNT=0
  1. I '$D(^TMP("IBREP DISP",$J)) D
  1. . S (IBCNT,VALMCNT)=2
  1. . S ^TMP("IBREP DISP1",$J,1,0)=" "
  1. . S ^TMP("IBREP DISP1",$J,2,0)="No reports available for dispositioning"
  1. S IBI=0 F S IBI=$O(^TMP("IBREP DISP",$J,IBI)) Q:'IBI S IBREC=^(IBI) D
  1. . S IBCNT=IBCNT+1,X=""
  1. . S IBIEN=+$P(IBREC,U)
  1. . S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
  1. . S X=$$SETFLD^VALM1($P(IBREC,U,2),X,"REPORT")
  1. . S X=$$SETFLD^VALM1($P(IBREC,U,4),X,"DESC")
  1. . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(361.2,.02,+$P(IBREC,U,3)),X,"DISP")
  1. . D SET(X)
  1. Q
  1. ;
  1. SET(X) ;list manager screen
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("IBREP DISP1",$J,VALMCNT,0)=X
  1. S ^TMP("IBREP DISP1",$J,"IDX",VALMCNT,IBCNT)=""
  1. S ^TMP("IBREP DISP1",$J,IBCNT)=VALMCNT_U_IBIEN
  1. Q
  1. EDIT ;
  1. N IBDA,DIE,DA,DR,Y
  1. D FULL^VALM1
  1. S IBDA=$$SEL(.IBDA)
  1. I 'IBDA G EDITQ
  1. S DIE="^IBE(361.2,",DR=".02"
  1. S IBDA=0 F S IBDA=$O(IBDA(IBDA)) Q:'IBDA!($D(Y)>0) D
  1. . S DA=$P(IBDA(IBDA),U) W !,"REPORT: "_$P(^IBE(361.2,DA,0),U)_"//"
  1. . D ^DIE W !
  1. D BLD
  1. EDITQ S VALMBCK="R"
  1. Q
  1. EXIT ; -- clean up and exit
  1. K ^TMP("IBREP DISP",$J),^TMP("IBREP DISP1",$J)
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. HDR ;
  1. Q
  1. SEL(IBDA) ;Select entry from list
  1. N IBZ,VALMY
  1. D EN^VALM2($G(XQORNOD(0)))
  1. S (IBZ,IBDA)=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBZ=IBZ+1,IBDA(IBDA)=$P($G(^TMP("IBREP DISP1",$J,IBDA)),U,2)
  1. Q IBZ
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q