Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUHL

PSUHL.m

Go to the documentation of this file.
  1. PSUHL ;BIR/RDC - DYNAMIC CAPTURE OF PATIENT DEMOGRAPHICS ;05 MAR 2004
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;**5**;MARCH, 2005;Build 22
  1. ;
  1. ;DBIA's
  1. ; Reference to file 55 supported by DBIA 3502
  1. ; Reference to file 2 (for protocol PSU PATIENT DEMOGRAPHIC CHANGE)
  1. ; supported by DBIA 3344
  1. ;
  1. CHNG ; THIS TAG WILL EXECUTE UPON ANY MODIFICATION TO THE PATIENT FILE #2
  1. ; CHANGES TO ANY FIELDS OTHER THAN THOSE INHERANT TO THE
  1. ; PATIENT DEMOGRAPHIC EXTRACT (^PSUDEM1) WILL BE IGNORED
  1. ; SUCCESSFUL EXECUTION OF THIS TAG WILL RESULT IN THE DATE AND
  1. ; DFN BEING LOGGED IN THE PBM PATIENT DEMOGRAPHICS file #59.9
  1. ;
  1. N FIELD
  1. ; ; ** loop thru pertinent fields **
  1. ;
  1. 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
  1. I DGFILE=2.02,$G(DGFIELD)=.01 D LOGDFN(DGDA(1))
  1. I DGFILE=2.06,$G(DGFIELD)=.01 D LOGDFN(DGDA(1))
  1. ;
  1. Q
  1. ;
  1. LOGDFN(DFN) ; This tag will log the date & dfn to file #59.9
  1. ;
  1. Q:+$G(DFN)=0 ; no patient pointer to log ***
  1. Q:$D(^PSUDEM("C",DFN,DT)) ; patient already logged for today
  1. N PSSDA
  1. S PSSDA(59.9,"+1,",.01)=DT
  1. S PSSDA(59.9,"+1,",.02)=DFN
  1. D UPDATE^DIE("","PSSDA")
  1. Q
  1. ;
  1. PHARM ;
  1. ; THIS TAG IS TRIGGERED BY A CROSS REFERENCE ON THE
  1. ; PHARMACY PATIENT FILE (#55); FIRST SERVICE DATE (#.07)
  1. ;
  1. D LOGDFN(DA) ;log change of patient demographics
  1. Q
  1. ;
  1. CLEANUP ; THIS TAG CLEANS UP DATA IN ^PSUDEM >75 DAYS
  1. ;
  1. N MIN,DAY,DFN,DIK,X1,X2,X
  1. S X1=DT,X2=-75
  1. D C^%DTC S MIN=X ;today-75 days
  1. S DIK="^PSUDEM(" ;file root to kill
  1. S DAY=""
  1. F S DAY=$O(^PSUDEM("B",DAY)) Q:DAY="" Q:DAY>MIN D ;loop thru days
  1. . S DFN="" ;older than 75 days
  1. . F S DFN=$O(^PSUDEM("B",DAY,DFN)) Q:DFN="" D ;get the dfn
  1. .. S DA=DFN D ^DIK ; and have Fileman kill the dfn
  1. ;
  1. Q
  1. ;