- 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 Feb 18, 2025@23:53:55 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 ;