1 | PSUHL ;BIR/RDC - DYNAMIC CAPTURE OF PATIENT DEMOGRAPHICS ; 05 MAR 2004
|
---|
2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
---|
3 | ;
|
---|
4 | ;DBIA's
|
---|
5 | ; Reference to file 55 supported by DBIA 3502
|
---|
6 | ; Reference to file 2 supported by DBIA 3344
|
---|
7 | ;
|
---|
8 | CHNG ; THIS TAG WILL EXECUTE UPON ANY MODIFICATION TO THE PATIENT FILE #2
|
---|
9 | ; CHANGES TO ANY FIELDS OTHER THAN THOSE INHERANT TO THE
|
---|
10 | ; PATIENT DEMOGRAPHIC EXTRACT (^PSUDEM1) WILL BE IGNORED
|
---|
11 | ; SUCCESSFUL EXECUTION OF THIS TAG WILL RESULT IN THE DATE AND
|
---|
12 | ; DFN BEING LOGGED IN THE PBM PATIENT DEMOGRAPHICS file #59.9
|
---|
13 | ;
|
---|
14 | Q:DGFILE'=2 ;The modified file is not the PATIENT file(#2)
|
---|
15 | N FIELD,CHANGED
|
---|
16 | S CHANGED=0
|
---|
17 | ; ; ** loop thru pertinent fields **
|
---|
18 | ;
|
---|
19 | F FIELD=.351,.03,.06,.02,.361,.14,27.01,.09,991.01,.104,.097,2.02,2.06 I $G(DGFIELD)=FIELD S CHANGED=1 Q ; flag if one of our fields changes
|
---|
20 | ;
|
---|
21 | Q:'CHANGED ; irrelevant field changed - quit
|
---|
22 | D LOGDFN(DGDA) ; log demographic change in ^PSUDEM
|
---|
23 | Q
|
---|
24 | ;
|
---|
25 | LOGDFN(DFN) ; This tag will log the date & dfn to file #59.9
|
---|
26 | ;
|
---|
27 | Q:+$G(DFN)=0 ; no patient pointer to log ***
|
---|
28 | Q:$D(^PSUDEM("C",DFN,DT)) ; patient already logged for today
|
---|
29 | S X=DT ; load date into .01 field
|
---|
30 | S DIC("DR")=".02///"_DFN ; stuff dfn into .02 field
|
---|
31 | S DLAYGO=59.9 ; override no new entry flag
|
---|
32 | S DIC="^PSUDEM(" ; point to global for #59.9
|
---|
33 | S DIC(0)="LF" ; set laygo & forget flags
|
---|
34 | D FILE^DICN ; call Fileman to build file
|
---|
35 | K DIC,DLAYGO,X,DFN
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | PHARM ;
|
---|
39 | ; THIS TAG IS TRIGGERED BY A CROSS REFERENCE ON THE
|
---|
40 | ; PHARMACY PATIENT FILE (#55); FIRST SERVICE DATE (#.07)
|
---|
41 | ;
|
---|
42 | D LOGDFN(DA) ;log change of patient demographics
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | CLEANUP ; THIS TAG CLEANS UP DATA IN ^PSUDEM >75 DAYS
|
---|
46 | ;
|
---|
47 | N MIN,DAY,DFN
|
---|
48 | S X1=DT,X2=-75
|
---|
49 | D C^%DTC S MIN=X ;today-75 days
|
---|
50 | S DIK="^PSUDEM(" ;file root to kill
|
---|
51 | S DAY=""
|
---|
52 | F S DAY=$O(^PSUDEM("B",DAY)) Q:DAY>MIN D ;loop thru days
|
---|
53 | . S DFN="" ;older than 75 days
|
---|
54 | . F S DFN=$O(^PSUDEM("B",DAY,DFN)) Q:DFN="" D ;get the dfn
|
---|
55 | .. S DA=DFN D ^DIK ; and have Fileman kill the dfn
|
---|
56 | ;
|
---|
57 | K DIK
|
---|
58 | Q
|
---|
59 | ;
|
---|