PSUHL.m

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 ---PSUHL   2074     printed  Apr 09, 2024@21:31:09                                                                                                                                                                                                       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      ;