[613] | 1 | IBCEMSG2 ;ALB/JEH - EDI PURGE STATUS MESSAGES CONT. ;04-MAY-01
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | BLD ; -- build list
|
---|
| 6 | K ^TMP("IBCEMSGB",$J)
|
---|
| 7 | N IBI,IB0,IBREC,IBCNT
|
---|
| 8 | S (IBCNT,VALMCNT)=0
|
---|
| 9 | I '$D(^TMP("IBCEMSGA",$J)) D
|
---|
| 10 | . S (IBCNT,VALMCNT)=2
|
---|
| 11 | . S ^TMP("IBCEMSGB",$J,1,0)=""
|
---|
| 12 | . S ^TMP("IBCEMSGB",$J,2,0)="No status messages matching selection criteria were found"
|
---|
| 13 | S IBI=0 F S IBI=$O(^TMP("IBCEMSGA",$J,IBI)) Q:'IBI S IBREC=^(IBI) D
|
---|
| 14 | . S IBCNT=IBCNT+1,X=""
|
---|
| 15 | . S X=$$SETFLD^VALM1(IBCNT,"","NUMBER")
|
---|
| 16 | . S X=$$SETFLD^VALM1($P(IBREC,U),X,"BILL")
|
---|
| 17 | . S X=$$SETFLD^VALM1($P(IBREC,U,2),X,"SEV")
|
---|
| 18 | . S X=$$SETFLD^VALM1($P(IBREC,U,3),X,"FNR")
|
---|
| 19 | . S X=$$SETFLD^VALM1($P(IBREC,U,4),X,"FRD")
|
---|
| 20 | . S X=$$SETFLD^VALM1($P(IBREC,U,5),X,"AUTO")
|
---|
| 21 | . D SET(X)
|
---|
| 22 | . I $P(IBREC,U,6)'="" S X=$$SETSTR^VALM1($P(IBREC,U,6),"",5,200) D SET(X)
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | SET(X) ; -- list manager screen
|
---|
| 26 | S VALMCNT=VALMCNT+1
|
---|
| 27 | S ^TMP("IBCEMSGB",$J,VALMCNT,0)=X
|
---|
| 28 | S ^TMP("IBCEMSGB",$J,"IDX",VALMCNT,IBCNT)=""
|
---|
| 29 | S ^TMP("IBCEMSGB",$J,IBCNT)=VALMCNT_U_IBI
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | DEL ; -- entry point to delete status message
|
---|
| 33 | N IBDA,DA,DIK,IBCNT
|
---|
| 34 | D SEL(.IBDA)
|
---|
| 35 | G:'$O(IBDA(0)) DELQ
|
---|
| 36 | S (DA,IBCNT)=0,DIK="^IBM(361," F S IBDA=$O(IBDA(IBDA)) Q:'IBDA S DA=IBDA(IBDA) D ^DIK K ^TMP("IBCEMSGA",$J,DA) S IBCNT=IBCNT+1
|
---|
| 37 | W !!,IBCNT_$S(IBCNT>1:" Messages",1:" Message")_" deleted"
|
---|
| 38 | D PAUSE^VALM1,BLD
|
---|
| 39 | K ^TMP("IBDA",$J)
|
---|
| 40 | DELQ S VALMBCK="R"
|
---|
| 41 | Q
|
---|
| 42 | ;
|
---|
| 43 | VPRT ; -- entry point to view/print status messages
|
---|
| 44 | D SEL(.IBDA)
|
---|
| 45 | G:'$O(IBDA(0)) PRTQ
|
---|
| 46 | S DIC="^IBM(361,",L=0,DHD="Status Messages Selected for Deletion",FLDS="[CAPTION]",DIOBEG="I $E(IOST,1,2)=""C-"" W @IOF",BY(0)="^TMP(""IBDA"",$J,",L(0)=1 D EN1^DIP
|
---|
| 47 | D PAUSE^VALM1
|
---|
| 48 | K ^TMP("IBDA",$J)
|
---|
| 49 | PRTQ S VALMBCK="R"
|
---|
| 50 | Q
|
---|
| 51 | ;
|
---|
| 52 | SEL(IBDA) ; -- select entry from list
|
---|
| 53 | D FULL^VALM1
|
---|
| 54 | D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
|
---|
| 55 | S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=$P($G(^TMP("IBCEMSGB",$J,IBDA)),U,2) I IBDA(IBDA) S ^TMP("IBDA",$J,IBDA(IBDA))=""
|
---|
| 56 | Q
|
---|
| 57 | ;
|
---|