source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUHL.m@ 1661

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1PSUHL ;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 ;
8CHNG ; 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 ;
25LOGDFN(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 ;
38PHARM ;
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 ;
45CLEANUP ; 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 ;
Note: See TracBrowser for help on using the repository browser.