source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEMSG1.m@ 711

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1IBCEMSG1 ;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 ;
5EN ; - main entry
6 N IBDELDT,IBIEN,IBMSG,IBSORT,IBQUIT,IBFNR,IBFRD,IBREC,IBNUM,IBSEV,IB0,IBK
7 D EN^VALM("IBCEM STATUS MESSAGE")
8 Q
9HDR ; -- header code
10 S VALMHDR(1)="Selected by "_$S(IBSORT="A":"Auto Filed/No Review",IBSORT="B":"Bill Number: "_IBNUM,IBSORT="S":"Message Severity: "_IBSEV,1:"Message Text containing word or phrase "_IBMSG)
11 S VALMHDR(2)="Reviewed Prior to: "_$$FMTE^XLFDT(IBDELDT,"2D")
12 Q
13 ;
14INIT ; -- set up variables
15 N DIR,X,Y
16 K ^TMP("IBCEMSGA",$J)
17 S DIR("A")="Select messages based on"
18 S DIR(0)="S^A:Auto Filed/No Review Only;B:Bill Number;S:Message Severity;T:Specific Message Text"
19 D ^DIR K DIR
20 I $D(DTOUT)!$D(DUOUT)!(Y<0) S VALMQUIT=1 G INITQ
21 S IBSORT=Y
22 I IBSORT="B" D G:$G(VALMQUIT) INITQ
23 . S DIR("A")="Enter Bill Number"
24 . S DIR(0)="P^361:AEMQZ"
25 . D ^DIR K DIR
26 . I $D(DTOUT)!$D(DUOUT)!(Y<0) S VALMQUIT=1 Q
27 . S IBIEN=$P(Y,U,2),IBNUM=$$BN1^PRCAFN(IBIEN)
28 I IBSORT="S" D G:$G(VALMQUIT) INITQ
29 . S DIR("A")="(I)nformation/Warning or (R)ejection"
30 . S DIR(0)="SB^I:Information/Warning;R:Rejection"
31 . D ^DIR K DIR
32 . I $D(DUOUT)!$D(DTOUT)!(Y<0) S VALMQUIT=1 Q
33 . S IBSEV=Y
34 I IBSORT="T" D G:$G(VALMQUIT) INITQ
35 . S DIR("A")="Enter specific word or phrase the message should contain to be deleted"
36 . S DIR(0)="F^5:15^K:X'?.U X"
37 . D ^DIR K DIR
38 . I $D(DUOUT)!$D(DTOUT)!(Y<0) S VALMQUIT=1 Q
39 . S IBMSG=Y
40 S DIR("A")="INCLUDE STATUS MESSAGES REVIEWED PRIOR TO"
41 S DIR(0)="D^:DTP:EX" W ! D ^DIR K DIR
42 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 Q
43 S IBDELDT=Y
44 D @IBSORT
45 D BLD^IBCEMSG2
46INITQ ;
47 Q
48HELP ; -- help code
49 S X="?" D DISP^XQORM1 W !!
50 Q
51EXIT ; -- clean up and exit
52 K ^TMP("IBCEMSGA",$J),^TMP("IBCEMSGB",$J)
53 D CLEAN^VALM10
54 Q
55A ; -- sort by auto filed
56 S IBK=0 F S IBK=$O(^IBM(361,"ANR",1,IBK)) Q:'IBK S IB0=$G(^IBM(361,IBK,0)) D
57 . I '$P(IB0,U,13)!($P(IB0,U,13)>IBDELDT) Q
58 . D SET
59 Q
60 ;
61B ; -- sort by bill number
62 S IBK=0 F S IBK=$O(^IBM(361,"B",IBIEN,IBK)) Q:'IBK S IB0=$G(^IBM(361,IBK,0)) D
63 . I '$P(IB0,U,13)!($P(IB0,U,13)>IBDELDT) Q
64 . D SET
65 Q
66 ;
67S ; -- sort by message severity
68 S IBK=0 F S IBK=$O(^IBM(361,"ASV",IBSEV,IBK)) Q:'IBK S IB0=$G(^IBM(361,IBK,0)) D
69 . I '$P(IB0,U,13)!($P(IB0,U,13)>IBDELDT) Q
70 . D SET
71 Q
72 ;
73T ; -- sort by message text
74 N Z,IBTXT,IB,IBDT
75 S IBDT=0 F S IBDT=$O(^IBM(361,"AFR",IBDT)) Q:'IBDT!(IBDT>IBDELDT) S IBK=0 F S IBK=$O(^IBM(361,"AFR",IBDT,IBK)) Q:'IBK S IB0=$G(^IBM(361,IBK,0)) D
76 . I '$O(^IBM(361,IBK,1,0)) Q
77 . S IB=0 F S IB=$O(^IBM(361,IBK,1,IB)) Q:'IB S Z=$G(^IBM(361,IBK,1,IB,0)) I $$UPPER^VALM1(Z)[IBMSG S IBTXT=$E(Z,1,60) D
78 .. D SET
79 .. S ^TMP("IBCEMSGA",$J,IBK)=^TMP("IBCEMSGA",$J,IBK)_U_IBTXT
80 Q
81 ;
82SET S IBNUM=$$BN1^PRCAFN($P(IB0,U))
83 S IBSEV=$$EXPAND^IBTRE(361,.03,$P(IB0,U,3))
84 S IBFNR=$$EXPAND^IBTRE(361,.1,$P(IB0,U,10))
85 S IBFRD=$$DAT1^IBOUTL($P(IB0,U,13))
86 S IBAUTO=$$EXPAND^IBTRE(361,.14,$P(IB0,U,14))
87 S ^TMP("IBCEMSGA",$J,IBK)=IBNUM_U_IBSEV_U_IBFNR_U_IBFRD_U_IBAUTO
88 Q
Note: See TracBrowser for help on using the repository browser.