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 | ;
|
---|