source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEX31.m@ 794

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

initial load of WorldVistAEHR
File size: 6.4 KB
Line 
1RCDPEX31 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;10-OCT-02
2 ;;4.5;Accounts Receivable;**173,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5UPD ; Try to update the IB EOB file from exception in 344.41
6 N RCDA,RCTDA,RCTDA1,RCWHY,Z,DA,DIE,DR
7 D FULL^VALM1
8 D SEL^RCDPEX3(.RCDA,1)
9 S RCDA=$O(RCDA(0)) G:'RCDA UPDQ
10 S RCTDA=+RCDA(RCDA),RCTDA1=+$P(RCDA(RCDA),U,2)
11 I '$$LOCK(RCTDA,RCTDA1,0) G UPDQ
12 I $P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,7)'=2 D G UPDQ
13 . W !,"EEOB cannot be filed in IB"_$S($P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,7)=1:" - the bill # is invalid",1:"")
14 . D PAUSE^VALM1
15 I RCTDA,RCTDA1 D UPDEOB^RCDPESR2(RCTDA_";"_RCTDA1,4)
16 S Z=$P($G(^RCY(344.4,RCTDA,1,RCTDA1,0)),U,2)
17 I Z D ; Update file 344.41 record
18 . S DA(1)=RCTDA,DA=RCTDA1,DR=".07///@;.13////1;.02////"_Z,DIE="^RCY(344.4,"_DA(1)_",1," D ^DIE
19 W !,"EEOB DETAIL UPDATE ",$S(Z:"WAS SUCCESSFUL",1:"ENCOUNTERED ERRORS")
20 S RCWHY(1)="Update IB with EEOB detail",RCWHY(2)="Update EEOB detail was "_$S('Z:"NOT",1:"")_" successful"
21 D STORACT(RCTDA,RCTDA1,.RCWHY)
22 D PAUSE^VALM1
23 D BLD^RCDPEX2
24 ;
25UPDQ S VALMBCK="R"
26 Q
27 ;
28DEL ; Delete exception conditions from EOB detail list - file 344.4
29 N DIR,X,Y,Z,RCDA,RCOK,RCTDA,RCTDA1,RCWHY,DA,DR,DIE,RC0,RC00,RCDIQ,RCE,RCT,RCX,RCWHYTXT,XMDUZ,XMSUBJ,XMZ,XMER,XMBODY,XMTO,RCDIQ1,DTOUT,DUOUT
30 D FULL^VALM1
31 D SEL^RCDPEX3(.RCDA,1)
32 S RCDA=$O(RCDA(""))
33 I RCDA="" G DELQ
34 S RCTDA=+RCDA(RCDA),RCTDA1=$P(RCDA(RCDA),U,2)
35 I '$$LOCK(RCTDA,RCTDA1,0) G DELQ
36 W !
37 S DIR(0)="YA",DIR("A",1)="This action will mark this EEOB detail record so it no longer appears as an",DIR("A",2)="exception. A bulletin will be sent to report this action",DIR("A",3)=" "
38 S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO"
39 D ^DIR K DIR
40 G:Y'=1 DELQ
41 S DIR(0)="FA;3:60",DIR("A")="ENTER A REASON FOR THIS ACTION: ",DIR("?",1)="Enter the reason why this EEOB exception is being removed from the",DIR("?")=" exception list (3-60 characters are REQUIRED)"
42 D ^DIR K DIR
43 I $D(DUOUT)!$D(DTOUT) G DELQ
44 S RCWHY(1)="Removal of EEOB detail entry from the exception list",RCWHY(2)=" Reason Entered: "_Y,RCWHYTXT=Y
45 S RC0=$G(^RCY(344.4,RCTDA,0)),RC00=$G(^(1,RCTDA1,0))
46 ;
47 D GETS^DIQ(344.4,RCTDA_",","*","IEN","RCDIQ")
48 D GETS^DIQ(344.41,RCTDA1_","_RCTDA_",","*","IEN","RCDIQ1")
49 S RCE=0
50 D TXT0(RCTDA,.RCDIQ,.RCX,.RCE)
51 S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:"
52 D TXT00(RCTDA,RCTDA1,.RCDIQ1,.RCX,.RCE)
53 S DA=RCTDA1,DA(1)=RCTDA,DR=".07///@;.13////0",DIE="^RCY(344.4,"_DA(1)_",1," D ^DIE
54 D STORACT(RCTDA,RCTDA1,.RCWHY)
55 ;
56 S RCT(1)="The electronic EEOB detail for Trace #: "_$P(RC0,U,2)_" and Seq #"_$P(RC00,U),RCT(2)=" is no longer flagged for an exception condition"
57 S RCT(3)="PAYMENT FROM: "_$P(RC0,U,6)_" on "_$$FMTE^XLFDT($P(RC0,U,4),2)
58 S RCT(4)=" "
59 S RCT(5)="REASON: "_RCWHYTXT
60 S RCT(6)="ACTION PERFORMED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2)
61 S RCT(7)=" ",RCE=+$O(RCT(""),-1)
62 S Z=0 F S Z=$O(RCX(Z)) Q:'Z S RCE=RCE+1,RCT(RCE)=RCX(Z)
63 S RCE=RCE+1,RCT(RCE)=" "
64 S XMSUBJ="EDI LBOX EEOB DETAIL EXCEPTION REMOVED",XMBODY="RCT",XMDUZ="",XMTO("G.RCDPE PAYMENTS")=""
65 D ;
66 . N DUZ S DUZ=.5,DUZ(0)="@"
67 . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ)
68 ;
69 W !,"A bulletin has been sent to report this action",!
70 D PAUSE^VALM1
71 D BLD^RCDPEX2
72 ;
73DELQ I $G(RCTDA),$G(RCTDA1) L -^RCY(344.4,RCTDA,1,RCTDA1,0)
74 S VALMBCK="R"
75 Q
76 ;
77TXT0(RCTDA,RCDIQ,RCXM1,RC) ; Append 0-node captioned data to array RCXM1
78 ;
79 N LINE,DAT,Z,Z0,Z1
80 S LINE="",RC=+$G(RC)
81 S RC=RC+1,RCXM1(RC)=" **ERA SUMMARY DATA**"
82 F Z=.02:.01 D S Z1=+$O(RCDIQ(344.4,RCTDA_",",Z)) Q:Z1'<1!'Z1
83 . I $G(RCDIQ(344.4,RCTDA_",",Z,"E"))="" Q
84 . S Z0=$$GET1^DID(344.4,Z,,"LABEL")
85 . S DAT=Z0_": "_$G(RCDIQ(344.4,RCTDA_",",Z,"E"))
86 . I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
87 . I $L(LINE) D Q:LINE="" ; Left side exists
88 .. I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
89 .. S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
90 . S LINE=$E(DAT_$J("",39),1,39)
91 I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
92 S:RC RC=RC+1,RCXM1(RC)=" "
93 Q
94 ;
95TXT00(RCTDA,RCTDA1,RCDIQ1,RCXM1,RC) ; Extract 0-node data for file 344.41
96 ;
97 N RCT,LINE,DAT,Z,Z0,Z1
98 S LINE="",RC=+$G(RC)
99 S RC=RC+1,RCXM1(RC)=" **EEOB DETAIL DATA**",RCT=RCTDA1_","_RCTDA_","
100 F Z=.01:.01 D S Z1=+$O(RCDIQ1(344.41,RCT,Z)) Q:Z1'<1!'Z1
101 . I $G(RCDIQ1(344.41,RCT,Z,"E"))="" Q
102 . S Z0=$$GET1^DID(344.41,Z,,"LABEL")
103 . S DAT=Z0_": "_$G(RCDIQ1(344.41,RCT,Z,"E"))
104 . I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
105 . I $L(LINE) D Q:LINE="" ; Left side exists
106 .. I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
107 .. S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
108 . S LINE=$E(DAT_$J("",39),1,39)
109 I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
110 S:RC RC=RC+1,RCXM1(RC)=" "
111 Q
112 ;
113TXT2(RCTDA,RCTDA1,RCDIQ2,RCXM1,RC) ; Extract all data for file 344.42
114 ;
115 N RCT,LINE,DAT,Z,Z0
116 S LINE="",RC=+$G(RC)
117 S RCT=RCTDA1_","_RCTDA_","
118 S Z=0 F S Z=$O(RCDIQ2(344.42,RCT,Z)) Q:'Z D
119 . I $G(RCDIQ2(344.42,RCT,Z,"E"))="" Q
120 . S Z0=$$GET1^DID(344.42,Z,,"LABEL")
121 . S DAT=Z0_": "_$G(RCDIQ2(344.42,RCT,Z,"E"))
122 . I $L(DAT)>39 S:$L(LINE) RC=RC+1,RCXM1(RC)=LINE S RC=RC+1,RCXM1(RC)=DAT,LINE="" Q
123 . I $L(LINE) D Q:LINE="" ; Left side exists
124 .. I $L(LINE)+$L(DAT)>75 S RC=RC+1,RCXM1(RC)=LINE,LINE=DAT Q
125 .. S LINE=LINE_" "_DAT,RC=RC+1,RCXM1(RC)=LINE,LINE=""
126 . S LINE=$E(DAT_$J("",39),1,39)
127 I $L(LINE) S RC=RC+1,RCXM1(RC)=LINE
128 S:RC RC=RC+1,RCXM1(RC)=" "
129 Q
130 ;
131LOCK(RCTDA,RCTDA1,RCSHH) ; Attempt to lock file entry in file 344.41
132 ; Return 1 if successful, 0 if not able to lock
133 ; RCSHH = 1 if there should be no direct writes
134 ;
135 N OK
136 S OK=1
137 L +^RCY(344.4,RCTDA,1,RCTDA1,0):5
138 I '$T D
139 . I '$D(DIQUIET),'$G(RCSHH) W !,*7,"Another user is editing this entry ... please try again later" D PAUSE^VALM1
140 . S OK=0
141 Q OK
142 ;
143STORACT(RCTDA,RCTDA1,RCWHY) ; Store the detail for the action taken for
144 ; the exception record at ^RCY(344.4,RCTDA,1,RCTDA,0)
145 ; RCWHY(#) = lines containing the reason/explanation for the action
146 ; RCWHY(1) should contain the description of the action taken
147 ; It will be appended to the first line of the message after
148 ; the date and user who made the change.
149 ;
150 N RCDA,RCTXT,RC,Z
151 S RCDA(1)=RCTDA,RCDA=RCTDA1
152 S RCTXT(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$P($G(^VA(200,+DUZ,0)),U)_" "_$G(RCWHY(1))
153 S (RC,Z)=1
154 F S Z=$O(RCWHY(Z)) Q:'Z S RC=RC+1,RCTXT(RC)=" "_RCWHY(Z)
155 D WP^DIE(344.41,$$IENS^DILF(.RCDA),2,"A","RCTXT")
156 Q
157 ;
Note: See TracBrowser for help on using the repository browser.