PSUHL ;BIR/RDC - DYNAMIC CAPTURE OF PATIENT DEMOGRAPHICS ;05 MAR 2004
;;4.0;PHARMACY BENEFITS MANAGEMENT;**5**;MARCH, 2005;Build 22
;
;DBIA's
; Reference to file 55 supported by DBIA 3502
; Reference to file 2 (for protocol PSU PATIENT DEMOGRAPHIC CHANGE)
; supported by DBIA 3344
;
CHNG ; THIS TAG WILL EXECUTE UPON ANY MODIFICATION TO THE PATIENT FILE #2
; CHANGES TO ANY FIELDS OTHER THAN THOSE INHERANT TO THE
; PATIENT DEMOGRAPHIC EXTRACT (^PSUDEM1) WILL BE IGNORED
; SUCCESSFUL EXECUTION OF THIS TAG WILL RESULT IN THE DATE AND
; DFN BEING LOGGED IN THE PBM PATIENT DEMOGRAPHICS file #59.9
;
N FIELD
; ; ** loop thru pertinent fields **
;
I DGFILE=2 F FIELD=.351,.03,.02,.361,.14,27.01,.09,991.01,.104,.097,2.02,2.06 I $G(DGFIELD)=FIELD D LOGDFN(DGDA) Q ; flag if one of our fields changes
I DGFILE=2.02,$G(DGFIELD)=.01 D LOGDFN(DGDA(1))
I DGFILE=2.06,$G(DGFIELD)=.01 D LOGDFN(DGDA(1))
;
Q
;
LOGDFN(DFN) ; This tag will log the date & dfn to file #59.9
;
Q:+$G(DFN)=0 ; no patient pointer to log ***
Q:$D(^PSUDEM("C",DFN,DT)) ; patient already logged for today
N PSSDA
S PSSDA(59.9,"+1,",.01)=DT
S PSSDA(59.9,"+1,",.02)=DFN
D UPDATE^DIE("","PSSDA")
Q
;
PHARM ;
; THIS TAG IS TRIGGERED BY A CROSS REFERENCE ON THE
; PHARMACY PATIENT FILE (#55); FIRST SERVICE DATE (#.07)
;
D LOGDFN(DA) ;log change of patient demographics
Q
;
CLEANUP ; THIS TAG CLEANS UP DATA IN ^PSUDEM >75 DAYS
;
N MIN,DAY,DFN,DIK,X1,X2,X
S X1=DT,X2=-75
D C^%DTC S MIN=X ;today-75 days
S DIK="^PSUDEM(" ;file root to kill
S DAY=""
F S DAY=$O(^PSUDEM("B",DAY)) Q:DAY="" Q:DAY>MIN D ;loop thru days
. S DFN="" ;older than 75 days
. F S DFN=$O(^PSUDEM("B",DAY,DFN)) Q:DFN="" D ;get the dfn
.. S DA=DFN D ^DIK ; and have Fileman kill the dfn
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUHL 2074 printed Sep 23, 2025@20:03:32 Page 2
PSUHL ;BIR/RDC - DYNAMIC CAPTURE OF PATIENT DEMOGRAPHICS ;05 MAR 2004
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**5**;MARCH, 2005;Build 22
+2 ;
+3 ;DBIA's
+4 ; Reference to file 55 supported by DBIA 3502
+5 ; Reference to file 2 (for protocol PSU PATIENT DEMOGRAPHIC CHANGE)
+6 ; supported by DBIA 3344
+7 ;
CHNG ; THIS TAG WILL EXECUTE UPON ANY MODIFICATION TO THE PATIENT FILE #2
+1 ; CHANGES TO ANY FIELDS OTHER THAN THOSE INHERANT TO THE
+2 ; PATIENT DEMOGRAPHIC EXTRACT (^PSUDEM1) WILL BE IGNORED
+3 ; SUCCESSFUL EXECUTION OF THIS TAG WILL RESULT IN THE DATE AND
+4 ; DFN BEING LOGGED IN THE PBM PATIENT DEMOGRAPHICS file #59.9
+5 ;
+6 NEW FIELD
+7 ; ; ** loop thru pertinent fields **
+8 ;
+9 ; flag if one of our fields changes
IF DGFILE=2
FOR FIELD=.351,.03,.02,.361,.14,27.01,.09,991.01,.104,.097,2.02,2.06
IF $GET(DGFIELD)=FIELD
DO LOGDFN(DGDA)
QUIT
+10 IF DGFILE=2.02
IF $GET(DGFIELD)=.01
DO LOGDFN(DGDA(1))
+11 IF DGFILE=2.06
IF $GET(DGFIELD)=.01
DO LOGDFN(DGDA(1))
+12 ;
+13 QUIT
+14 ;
LOGDFN(DFN) ; This tag will log the date & dfn to file #59.9
+1 ;
+2 ; no patient pointer to log ***
if +$GET(DFN)=0
QUIT
+3 ; patient already logged for today
if $DATA(^PSUDEM("C",DFN,DT))
QUIT
+4 NEW PSSDA
+5 SET PSSDA(59.9,"+1,",.01)=DT
+6 SET PSSDA(59.9,"+1,",.02)=DFN
+7 DO UPDATE^DIE("","PSSDA")
+8 QUIT
+9 ;
PHARM ;
+1 ; THIS TAG IS TRIGGERED BY A CROSS REFERENCE ON THE
+2 ; PHARMACY PATIENT FILE (#55); FIRST SERVICE DATE (#.07)
+3 ;
+4 ;log change of patient demographics
DO LOGDFN(DA)
+5 QUIT
+6 ;
CLEANUP ; THIS TAG CLEANS UP DATA IN ^PSUDEM >75 DAYS
+1 ;
+2 NEW MIN,DAY,DFN,DIK,X1,X2,X
+3 SET X1=DT
SET X2=-75
+4 ;today-75 days
DO C^%DTC
SET MIN=X
+5 ;file root to kill
SET DIK="^PSUDEM("
+6 SET DAY=""
+7 ;loop thru days
FOR
SET DAY=$ORDER(^PSUDEM("B",DAY))
if DAY=""
QUIT
if DAY>MIN
QUIT
Begin DoDot:1
+8 ;older than 75 days
SET DFN=""
+9 ;get the dfn
FOR
SET DFN=$ORDER(^PSUDEM("B",DAY,DFN))
if DFN=""
QUIT
Begin DoDot:2
+10 ; and have Fileman kill the dfn
SET DA=DFN
DO ^DIK
End DoDot:2
End DoDot:1
+11 ;
+12 QUIT
+13 ;
