| 1 | IBCERPT1 ;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 | ;
|
|---|
| 5 | EN ; -- main entry
|
|---|
| 6 | D EN^VALM("IBCE ELEC REPORT DISP")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | INIT ; -- set up variables
|
|---|
| 10 | S U="^"
|
|---|
| 11 | D BLD
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | BLD ; -- 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 | ;
|
|---|
| 36 | SET(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
|
|---|
| 42 | EDIT ;
|
|---|
| 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
|
|---|
| 52 | EDITQ S VALMBCK="R"
|
|---|
| 53 | Q
|
|---|
| 54 | EXIT ; -- clean up and exit
|
|---|
| 55 | K ^TMP("IBREP DISP",$J),^TMP("IBREP DISP1",$J)
|
|---|
| 56 | D CLEAN^VALM10
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | HDR ;
|
|---|
| 60 | Q
|
|---|
| 61 | SEL(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 | ;
|
|---|
| 67 | HELP ; -- help code
|
|---|
| 68 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 69 | Q
|
|---|
