| 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 |  ;
 | 
|---|