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