source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPATDAT.m@ 1556

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1FBPATDAT ;WOIFO/SS-NOTIFICATION ABOUT PATIENT DATA CHANGE ;4/7/2003
2 ;;3.5;FEE BASIS;**57,70**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4CHNG ;entry point
5 I $G(DGFILE)=2.141 D UPDADR($G(DGDA)) Q ;CONFIDENTIAL ADDRESS CATEGORY subfile fields
6 Q:$G(DGFILE)'=2
7 N FBFLAG S FBFLAG=0
8 N FBFLD
9 F FBFLD=.351,.03,.111,.112,.113,.114,.115,.116,.1112,.1411,.1412,.1413,.1414,.1415,.1416,.1417,.1418,2.141 I $G(DGFIELD)=FBFLD S FBFLAG=1 Q
10 Q:'FBFLAG
11 D UPDADR($G(DGDA))
12 Q
13 ;send patient MRA message to AAC
14 ;
15UPDADR(FBDFN) ;
16 Q:+$G(FBDFN)=0
17 N FBFRDT,FBTODT,FBTRTYP,FBZTH,FBDEL S (FBZTH,FBDEL)=""
18 N FBAUTH,FBARR,FBLIMDT,FBTODAY,FB1 S (FBFRDT,FBTODT,FBTRTYP,FBAUTH,FBARR,FBTODAY,FBLIMDT,FB1)=0
19 D ;limit date is TODAY - 2 year
20 . N X D NOW^%DTC S FBTODAY=X,FBLIMDT=+(($E(X,1,3)-2)_$E(X,4,7))
21 ;go thru all authorizations for this patient
22 ;and process all of them except SHORT TERM (i.e. only ID, HOME HEALTH and STATE HOME)
23 F S FBAUTH=$O(^FBAAA(FBDFN,1,FBAUTH)) Q:+FBAUTH=0 D
24 . ;get zeroth node
25 . S FBZTH=$G(^FBAAA(FBDFN,1,FBAUTH,0))
26 . ;TO DATE, FROM DATE, Treatment type
27 . S FBTODT=$P(FBZTH,"^",2),FBFRDT=$P(FBZTH,"^"),FBTRTYP=$P(FBZTH,"^",13)
28 . Q:FBTRTYP<1!(FBTRTYP>4)
29 . Q:FBTRTYP=1 ;short terms will be processed via file #161.26
30 . ;apply to different rules depend on treatment type
31 . Q:FBTODT<FBLIMDT&((FBTRTYP=2)!(FBTRTYP=3)) ;ID and HOME HEALTH
32 . Q:(FBTRTYP=4)&(FBTODT<FBTODAY) ;STATE HOME
33 . S FBDEL=$G(^FBAAA(FBDFN,1,FBAUTH,"ADEL"))
34 . Q:$P(FBDEL,"^")=1!($P(FBDEL,"^")="Y") ;the 'Delete MRA' was transmitted to Austin DPC.
35 . ;store AUTHORIZATION details in the local array
36 . S FB1=+$O(FBARR(FBTRTYP,0))
37 . I FB1 I FBTODT'>$P(FBARR(FBTRTYP,FB1),"^",4) Q ;more recent one already there
38 . I FB1 K FBARR(FBTRTYP,FB1) ;kill this one and then replace it (below)
39 . S FBARR(FBTRTYP,9999999-FBTODT)=FBDFN_"^"_FBAUTH_"^"_FBFRDT_"^"_FBTODT
40 ;add SHORT TERM authorizations to the local array from file #161.26
41 D DOSHORT(.FBARR,FBDFN,FBTODAY)
42 ;go thru all authorizations selected and saved in the local array
43 F FBTRTYP=1,2,3,4 D DOEACH(.FBARR,FBTRTYP)
44 Q
45 ;
46 ;SHORT-TERM (1) Authorizations
47DOSHORT(FBARR1,FBDFN,FBTODAY) ;
48 Q:+$G(FBDFN)=0
49 Q:'$D(FBARR1)
50 Q:+$G(FBTODAY)=0
51 N FBDT30 ;30 days back
52 D
53 . N X1,X2,X S X1=FBTODAY,X2=-30 D C^%DTC S FBDT30=X
54 ;go thru file #161.26
55 N FB1,FB2,FB3,FBDT S (FB2,FB1,FB3)=0
56 F S FB1=$O(^FBAA(161.26,"B",FBDFN,FB1)) Q:+FB1=0 D
57 . S FB2=^FBAA(161.26,FB1,0)
58 . Q:$P(FB2,"^",7)'="Y" ;only SHORT TERM
59 . Q:$P(FB2,"^",4)="D" ;we are not interested in DELETE transactions
60 . S FBDT=+$P(FB2,"^",5)
61 . Q:'FBDT ;no date
62 . ; store in local array
63 . I FBDT>FBDT30 D
64 . . S FB3=+$O(FBARR1(1,0))
65 . . I FB3 I FBDT'>$P(FBARR1(1,FB3),"^",4) Q
66 . . I FB1 K FBARR1(1,FB3)
67 . . S FBARR1(1,9999999-FBDT)=FBDFN_"^"_$P(FB2,"^",3)_"^^"_FBDT
68 Q
69 ;SHOR TERM (1)
70 ;ID CARD (3) Authorizations
71 ;HOME HEALTH (2) Authorizations
72 ;STATE HOME (4) Authorizations
73DOEACH(FBARR2,FBTYPE) ;
74 Q:'$D(FBARR2)
75 N FB1,FBAUTH,FBDFN
76 S FB1=$O(FBARR2(FBTYPE,0))
77 Q:+FB1=0
78 S FBDFN=$P($G(FBARR2(FBTYPE,FB1)),"^")
79 S FBAUTH=$P($G(FBARR2(FBTYPE,FB1)),"^",2)
80 ;check if there is a pending tramsmission in file
81 Q:$$ISPEND(FBDFN,FBAUTH) ;quit if it is there
82 ;send patient MRA to AAC
83 D SENDMRA(FBDFN,FBAUTH,FBTYPE)
84 Q
85 ;
86 ;returns 1 if pending or if it is "delete" transaction
87 ;returns 0 if was transmitted or there are no transmission at all
88ISPEND(FBDFN,FBAUTH) ;
89 N FB1,FB2,FBFLGP,FBFLGD S (FB2,FB1,FBFLGP,FBFLGD)=0
90 F S FB1=$O(^FBAA(161.26,"B",FBDFN,FB1)) Q:+FB1=0 D Q:FBFLGP!FBFLGD
91 . S FB2=$G(^FBAA(161.26,FB1,0))
92 . I +$P(FB2,"^",3)'=FBAUTH Q
93 . S:$P(FB2,"^",2)="P" FBFLGP=1
94 . S:$P(FB2,"^",4)="D" FBFLGD=1
95 Q:FBFLGP 1
96 Q:FBFLGD 1
97 Q 0
98 ;
99SENDMRA(FBDFN,FBAUTH,FBTRTYPE) ;
100 N DD,DO,DIC,DLAYGO,DDER,DA
101 ;SHORT TERM auth-tions:
102 I FBTRTYPE=1 D Q
103 . S DIC="^FBAA(161.26,",DIC(0)="L",DLAYGO=161.26,X=FBDFN
104 . S DIC("DR")="1///^S X=""P"";2///^S X=FBAUTH;3///^S X=""A"";6////^S X=""Y"""
105 . D FILE^DICN
106 ;all other types of auth-tions:
107 I $$QMRA^FBSHAUT(FBDFN,FBAUTH,"C")
108 Q
109 ;
110 ;FBPATDAT
Note: See TracBrowser for help on using the repository browser.