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

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1IBARXMA ;LL/ELZ - PHARMCAY COPAY BACKGROUND PROCESSES ;19-JAN-2001
2 ;;2.0;INTEGRATED BILLING;**150,158**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5FILER(IBA) ; This label is called by the IB background filer to
6 ; notify other facilities that a transaction has occurred on the current
7 ; facility. It will then update the status in 354.71 assuming that the
8 ; transaction was accepted at all the subscribing facilities.
9 ;
10 ; IBA would be the IEN of file 350 to process.
11 ;
12 N IBZ,IBY,Y,IBER
13 ;
14 S IBZ=$P($G(^IB(+IBA,0)),"^",19) I 'IBZ Q
15 S $P(^IBAM(354.71,IBZ,0),"^",4)=+IBA ; set reference back
16 ;
17 S IBY=1 D FOUND(.IBY,IBZ)
18 ;
19 I -1=+$G(IBY) S Y=IBY D ^IBAERR
20 ;
21 Q
22 ;
23FOUND(IBY,IBZ) ; come in here to do the work
24 ;
25 ; ien in 354.71 stored in IBZ, assumes DFN is defined
26 ;
27 N IBTFL,IBX,IBT,X,Y,DIE,DA,DR,DIC,IBS
28 ;
29 ; get treating facility list
30 S IBTFL=$$TFL^IBARXMU(DFN,.IBTFL)
31 ;
32 ; no other facilities, i'm done
33 I 'IBTFL D STATUS(.IBY,IBZ,0) Q
34 ;
35 ; ok lets do some talking to other VA's
36 S IBX=0 F S IBX=$O(IBTFL(IBX)) Q:IBX<1!(IBY<1) D
37 . ;
38 . ; have I already completed transmission here?
39 . S IBS=$$LKUP^XUAF4(IBX) I IBS>0,$P($G(^IBAM(354.71,IBZ,1,+$O(^IBAM(354.71,IBZ,1,"B",+IBS,0)),0)),"^",2),'$G(IBONE) Q
40 . ;
41 . I '$D(ZTQUEUED) U IO W !,"Now transmitting to ",$P(IBTFL(IBX),"^",2)," ..."
42 . S IBT=$$SEND^IBARXMU(DFN,IBX,^IBAM(354.71,IBZ,0))
43 . ;
44 . ; update 354.71 transmission record
45 . S DA=$O(^IBAM(354.71,IBZ,1,"B",IBS,0)),DA(1)=IBZ
46 . ;
47 . ; save of error(s) for message
48 . S:IBT<1 IBER(IBX)=IBT
49 . ;
50 . I DA D Q
51 .. S DIE="^IBAM(354.71,"_IBZ_",1,",DR=".02////"_$S(+IBT>0:1,1:0)
52 .. L +^IBAM(354.71,IBZ,1,DA):10 I '$T S IBY="-1^IB318" Q
53 .. D ^DIE L -^IBAM(354.71,IBZ,1,DA)
54 . S DIC="^IBAM(354.71,"_IBZ_",1,",DIC(0)="",X=IBS
55 . S DIC("DR")=".02////"_$S(IBT>0:1,1:0) D FILE^DICN
56 ;
57 D STATUS(.IBY,IBZ,IBTFL):IBY>0
58 ;
59 Q
60 ;
61NIGHT ; queue off job to do nightly processing
62 N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
63 S ZTIO="",ZTRTN="NIGHTQ^IBARXMA",ZTDTH=$H,ZTDESC="RX Copay Cap Follow-up Transmissions"
64 D ^%ZTLOAD
65 Q
66 ;
67NIGHTQ ; called from nightly background job for transmissions
68 ;
69 N IBX,IBS,X
70 ;
71 F IBS="P","Y" S IBX=0 F S IBX=$O(^IBAM(354.71,"AC",IBS,IBX)) Q:IBX<1 D
72 . N IBY,IBZ,IBM,XMZ,XMY,XMDUZ,XMSUB,IBL,IBF,IBT,DFN,IBA,IBN,IBER S IBY=1
73 . ;
74 . S DFN=$P($G(^IBAM(354.71,+IBX,0)),"^",2) Q:'DFN
75 . S IBY=1 D FOUND(.IBY,IBX)
76 . ;
77 . ; if it is successful, quit and move on to next one
78 . S IBZ=^IBAM(354.71,IBX,0)
79 . I IBY>0,($P(IBZ,"^",5)="C"!($P(IBZ,"^",5)="X")) Q
80 . ;
81 . ; is the transaction < 2 days old, quit
82 . I $$FMADD^XLFDT($P(IBZ,"^",15),2)>DT Q
83 . ;
84 . ; send message to mail group of old transaction notification
85 . D DEM^VADPT
86 . S XMSUB="Rx Copay Transmission Error",XMDUZ="INTEGRATED BILLING PACKAGE" D XMZ^XMA2 I XMZ<1 Q
87 . S IBL=0
88 . D M("A medication co-payment transaction could not be sent to one or more of"),M("the patient's treating facilities for at least 2 days. After verifying that")
89 . D M("the HL7 Logical Links are working correctly to the sites listed below, you"),M("can use the option 'Push Rx Copay Cap Transactions' to transmit this")
90 . D M("transaction immediately or the IB software will try to transmit this"),M("transaction when the IB MT NIGHT COMP job runs.")
91 . D M(" "),M(" Patient: "_VADM(1)),M(" SSN: "_VA("PID")),M("Transaction: "_$P(IBZ,"^")),M(" ")
92 . D M("Facility Status"),M("----------------------------------- --------------------")
93 . S IBF=0 F S IBF=$O(^IBAM(354.71,IBX,1,IBF)) Q:IBF<1 S IBT=^IBAM(354.71,IBX,1,IBF,0),IBN=$$FAC^IBARXMU(+IBT),IBN=$P(IBN,"^")_" ("_$P(IBN,"^",2)_")" D
94 .. D M($$SP(IBN,39)_$$EXTERNAL^DILFD(354.711,.02,"",$P(IBT,"^",2)))
95 . ;
96 . ; include errors in message
97 . I $D(IBER) D M(" "),M("Errors:") S X=0 F S X=$O(IBER(X)) Q:X<1 D M(X_" = "_IBER(X))
98 . ;
99 . S ^XMB(3.9,XMZ,2,0)="^3.92^"_IBL_"^"_IBL_"^"_DT
100 . S XMY("G.IB RX COPAY CAP ERROR")=""
101 . D ENT1^XMD
102 Q
103 ;
104SP(X,Y) ; makes X be Y space long
105 F Q:$L(X)>(Y-1) S X=X_" "
106 Q $E(X,1,Y)
107 ;
108STATUS(IBY,IBZ,IBT) ; update status in 354.71 if applicable
109 ; IBY is return error if applicable
110 ; IBZ is the entry number in 354.71
111 ; IBT indicates number of treating facilities
112 ;
113 N IBS,IBX,DA,DIE,DR,X,Y,IBD
114 ;
115 S IBS=1,IBX=0 I IBT F S IBX=$O(^IBAM(354.71,IBZ,1,IBX)) Q:IBX<1 S:$P(^IBAM(354.71,IBZ,1,IBX,0),"^",2)'=1 IBS=0
116 ;
117 I IBS S IBD=$P(^IBAM(354.71,IBZ,0),"^",5) D
118 . S DIE="^IBAM(354.71,",DA=IBZ
119 . S DR=".05///"_$S(IBD="Y":"X",IBD="X":IBD,1:"C")
120 . L +^IBAM(354.71,IBZ):10 I '$T S IBY="-1^IB318" Q
121 . D ^DIE L -^IBAM(354.71,IBZ)
122 ;
123 I $G(IBY)<1 S IBY=1 ; success flag
124 ;
125 Q
126M(T) ; used to set text in mail message
127 ; assumes XMZ and IBL
128 S IBL=IBL+1,^XMB(3.9,XMZ,2,IBL,0)=T
Note: See TracBrowser for help on using the repository browser.