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

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1IBCERPT1 ;ALB/JEH - ELECTRONIC REPORT DISPOSITION ;21-FEB-01
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry
6 D EN^VALM("IBCE ELEC REPORT DISP")
7 Q
8 ;
9INIT ; -- set up variables
10 S U="^"
11 D BLD
12 Q
13 ;
14BLD ; -- build list of reports
15 N IBI,IBREC,IBDESC,IBDISP,IBREP,NUMBER,IBCNT,IBIEN,X
16 S VALMCNT=0
17 K ^TMP("IBREP DISP",$J),^TMP("IBREP DISP1",$J)
18 S IBI=0,IBREP="",IBCNT=0
19 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)
20 ;
21 S IBCNT=0
22 I '$D(^TMP("IBREP DISP",$J)) D
23 . S (IBCNT,VALMCNT)=2
24 . S ^TMP("IBREP DISP1",$J,1,0)=" "
25 . S ^TMP("IBREP DISP1",$J,2,0)="No reports available for dispositioning"
26 S IBI=0 F S IBI=$O(^TMP("IBREP DISP",$J,IBI)) Q:'IBI S IBREC=^(IBI) D
27 . S IBCNT=IBCNT+1,X=""
28 . S IBIEN=+$P(IBREC,U)
29 . S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
30 . S X=$$SETFLD^VALM1($P(IBREC,U,2),X,"REPORT")
31 . S X=$$SETFLD^VALM1($P(IBREC,U,4),X,"DESC")
32 . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(361.2,.02,+$P(IBREC,U,3)),X,"DISP")
33 . D SET(X)
34 Q
35 ;
36SET(X) ;list manager screen
37 S VALMCNT=VALMCNT+1
38 S ^TMP("IBREP DISP1",$J,VALMCNT,0)=X
39 S ^TMP("IBREP DISP1",$J,"IDX",VALMCNT,IBCNT)=""
40 S ^TMP("IBREP DISP1",$J,IBCNT)=VALMCNT_U_IBIEN
41 Q
42EDIT ;
43 N IBDA,DIE,DA,DR,Y
44 D FULL^VALM1
45 S IBDA=$$SEL(.IBDA)
46 I 'IBDA G EDITQ
47 S DIE="^IBE(361.2,",DR=".02"
48 S IBDA=0 F S IBDA=$O(IBDA(IBDA)) Q:'IBDA!($D(Y)>0) D
49 . S DA=$P(IBDA(IBDA),U) W !,"REPORT: "_$P(^IBE(361.2,DA,0),U)_"//"
50 . D ^DIE W !
51 D BLD
52EDITQ S VALMBCK="R"
53 Q
54EXIT ; -- clean up and exit
55 K ^TMP("IBREP DISP",$J),^TMP("IBREP DISP1",$J)
56 D CLEAN^VALM10
57 Q
58 ;
59HDR ;
60 Q
61SEL(IBDA) ;Select entry from list
62 N IBZ,VALMY
63 D EN^VALM2($G(XQORNOD(0)))
64 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)
65 Q IBZ
66 ;
67HELP ; -- help code
68 S X="?" D DISP^XQORM1 W !!
69 Q
Note: See TracBrowser for help on using the repository browser.