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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1IBARXMU ;LL/ELZ-PHARMACY COPAY CAP UTILITIES ;17-NOV-2000
2 ;;2.0;INTEGRATED BILLING;**150,158,156,178,186**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PRIORITY(DFN) ; returns the patient's priority level, ia #2918 for DGENA
6 Q +$$PRIORITY^DGENA(DFN)
7 ;
8FAC(X) ; returns facility information ia #2171
9 Q $$NNT^XUAF4(X)
10 ;
11SITE() ; returns site number and info
12 Q $$SITE^VASITE
13 ;
14TFL(DFN,IBT) ; returns treating facility list (pass IBT by reference)
15 ; supported references ia #2990 and #10112, value returned is count
16 ; needed to N Y because VAFCTFU1 will kill it
17 N IBC,IBZ,IBS,IBFT,Y
18 ;
19 D TFL^VAFCTFU1(.IBZ,DFN) Q:-$G(IBZ(1))=1 0
20 S IBS=+$P($$SITE,"^",3),(IBZ,IBC)=0
21 ; Return only remote facilities of certain types:
22 S IBFT="^VAMC^M&ROC^RO-OC^"
23 F S IBZ=$O(IBZ(IBZ)) Q:IBZ<1 I +IBZ(IBZ)>0,+IBZ(IBZ)'=IBS,IBFT[("^"_$P(IBZ(IBZ),U,5)_"^") S IBT(+IBZ(IBZ))=IBZ(IBZ),IBC=IBC+1
24 Q IBC
25 ;
26ADD(X) ; adds patient to 354.7
27 N DO,DIC,DINUM,DA,Y
28 Q:$G(^IBAM(354.7,X,0))
29 L +^IBAM(354.7,X):10 I '$T S Y="-1^IB319" Q
30 S DIC="^IBAM(354.7,",DIC(0)="",DINUM=X D FILE^DICN
31 L -^IBAM(354.7,X)
32 Q
33QUERY(DFN,IBM,IBF,IBD) ; looks up copay billing info from remote facility
34 ; IBM is the month and year for the query
35 ; IBF is the remote facility to query
36 ; IBD is the place where to return (pass by ref)
37 ; ia #3144
38 N IBICN,Y,DA,HLDOM,HLECH,HLFS,HLINSTN,HLNEXT,HLNODE,HLPARAM,HLQ,HLQUIT,PHONE,RPCIEN,IO,IOBS,IOCPU,IOF,IOHG,IOM,ION,IOPAR,IOUPAR,IOS,IOSL,IOST,IOT,IOXY,POP
39 D
40 . S IBICN=$$ICN(DFN) Q:'IBICN
41 . D DIRECT^XWB2HL7(.IBD,IBF,"IBARXM QUERY ONLY","",IBICN,IBM)
42 Q
43 ;
44UQUERY(DFN,IBM,IBF,IBD) ; looks up copay billing info from remote facility
45 ; this is just like the QUERY tag except it is only for background
46 ; info only and user information is not logged into the remote site's
47 ; new person file.
48 ; IBM is the month and year for the query
49 ; IBF is the remote facility to query
50 ; IBD is the place where to return (pass by ref)
51 ; ia #3144
52 N IBICN,Y,DA,HLDOM,HLECH,HLFS,HLINSTN,HLNEXT,HLNODE,HLPARAM,HLQ,HLQUIT,PHONE,RPCIEN,IO,IOBS,IOCPU,IOF,IOHG,IOM,ION,IOPAR,IOUPAR,IOS,IOSL,IOST,IOT,IOXY,POP
53 D
54 . S IBICN=$$ICN(DFN) Q:'IBICN
55 . D DIRECT^XWB2HL7(.IBD,IBF,"IBARXM QUERY SUPPRESS USER","",IBICN,IBM)
56 Q
57 ;
58SEND(DFN,IBF,IBD) ; notifies a remote facility of new or updated data
59 ; IBF is the remote facility to query
60 ; IBD is the data to send
61 ; return is accepted or not
62 ; ia #3144
63 N IBR,IBICN,IBH,IBC,IBZ,Y,DA,DIC,HLECH,HLFS,HLHDR,HLN,HLQ,HLSAN,HLTYPE,HLX,PTR,ROUTINE,ZMID,%
64 ;
65 D
66 . I DUZ=.5 N DUZ S DUZ=$P(IBD,"^",16),DUZ(2)=+$$SITE
67 . S IBICN=$$ICN(DFN) I 'IBICN S IBR="-1^No ICN for patient" Q
68 . ;
69 . D SENDF(.IBD)
70 . D EN1^XWB2HL7(.IBH,IBF,"IBARXM TRANS DATA","",IBICN,IBD)
71 . I $G(IBH(0))="" S IBR="-1^No handle returned from RPC" Q
72 . ; wait a second then start looking for Done flag.
73 . H 1
74 . F IBC=1:1:10 D RPCCHK^XWB2HL7(.IBR,IBH(0)) Q:$G(IBR(0))["Done" H 2
75 . ; if done get data.
76 . I $G(IBR(0))["Done" D
77 .. K IBR
78 .. D RTNDATA^XWBDRPC(.IBR,IBH(0)),CLEAR^XWBDRPC(.IBZ,IBH(0))
79 ;
80 Q $S(-1=+$G(IBR):IBR,$G(IBR(0))="":$G(IBR(1)),1:$G(IBR(0)))
81 ;
82DFN(IBICN) ; returns dfn for icn ia #2701
83 N DFN ; check to see if mpi software installed
84 S DFN=$S($L($T(GETDFN^MPIF001)):+$$GETDFN^MPIF001(+IBICN),1:0)
85 Q $S(DFN>0:DFN,1:0)
86 ;
87ICN(DFN) ; returns icn for dfn ia #2701 and #2702
88 N IBICN
89 I '$L($T(GETICN^MPIF001)) Q 0 ; mpi not installed
90 S IBICN=$$MPINODE^MPIFAPI(+DFN) Q:$P(IBICN,"^",4) 0 ; local icn
91 S IBICN=$$GETICN^MPIF001(+DFN)
92 Q $S(IBICN>0:IBICN,1:0)
93 ;
94SENDF(IBD) ; formats data for sending 354.71 data
95 ; call with raw data from 354.71 by ref to reformat it for transmission
96 S $P(IBD,"^",4,5)=U_$S($P(IBD,"^",5)="P"!($P(IBD,"^",5)="C"):"C",1:"X")
97 S:$P(IBD,"^",10) $P(IBD,"^",10)=$P(^IBAM(354.71,$P(IBD,"^",10),0),"^")
98 S $P(IBD,"^",13)=$P($$FAC($P(IBD,"^",13)),"^",2)
99 S IBD=$P(IBD,"^",1,13)
100 Q
101 ;
102EFDT(X,Y) ; sets in Y the effective date to be used for updates
103 N Z S Z=$P($G(^IBAM(354.71,+$P($G(^IB(+X,0)),"^",19),0)),"^",3)
104 S:Z Y(X)=Z
105 Q
Note: See TracBrowser for help on using the repository browser.