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

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBCEMSG2 ;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 ;
5BLD ; -- 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 ;
25SET(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 ;
32DEL ; -- 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)
40DELQ S VALMBCK="R"
41 Q
42 ;
43VPRT ; -- 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)
49PRTQ S VALMBCK="R"
50 Q
51 ;
52SEL(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 ;
Note: See TracBrowser for help on using the repository browser.