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

BPXRMDX1.m

Go to the documentation of this file. 
  1. BPXRMDX1 ;IHS/MSC/MGH - Build indexes for the IHS V files. ;23-Mar-2015 10:11;DU
  1.  ;;2.0;CLINICAL REMINDERS;**1001,1002,1005**;Feb 04, 2005;Build 23
  1.  ;===============================================================
  1. VPRC ;Build the indexes for V PROCEDURES.
  1.  N ICD,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR,PP
  1.  N START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.08)
  1.  S GLOBAL=$$GET1^DID(9000010.08,"","","GLOBAL NAME")
  1.  S ENTRIES=$P(^AUPNVPRC(0),U,4)
  1.  S TENP=ENTRIES/10
  1.  S TENP=+$P(TENP,".",1)
  1.  I TENP<1 S TENP=1
  1.  D BMES^XPDUTL("Building indexes for V PROCEDURE")
  1.  S TEXT="There are "_ENTRIES_" entries to process."
  1.  D MES^XPDUTL(TEXT)
  1.  S START=$H
  1.  S (DAS,DONE,IND,NE,NERROR)=0
  1.  F  S DAS=$O(^AUPNVPRC(DAS)) Q:DONE  D
  1.  . I +DAS=0 S DONE=1 Q
  1.  . I +DAS'=DAS D  Q
  1.  .. S DONE=1
  1.  .. S ETEXT="Bad ien: "_DAS_", cannot continue."
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S IND=IND+1
  1.  . I IND#TENP=0 D
  1.  .. S TEXT="Processing entry "_IND
  1.  .. D MES^XPDUTL(TEXT)
  1.  . I IND#10000=0 W "."
  1.  . S TEMP=^AUPNVPRC(DAS,0)
  1.  . S ICD=$P(TEMP,U,1)
  1.  . I ICD="" D  Q
  1.  .. S ETEXT=DAS_" missing ICD"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^ICD0(ICD)) D  Q
  1.  .. S ETEXT=DAS_" invalid ICD0"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S DFN=$P(TEMP,U,2)
  1.  . I DFN="" D  Q
  1.  .. S ETEXT=DAS_" missing DFN"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S VISIT=$P(TEMP,U,3)
  1.  . I VISIT="" D  Q
  1.  .. S ETEXT=DAS_" missing visit"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUPNVSIT(VISIT)) D  Q
  1.  .. S ETEXT=DAS_" invalid visit"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S DATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)
  1.  . I DATE="" D  Q
  1.  .. S ETEXT=DAS_" missing visit date"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S PP=$P(TEMP,U,7)
  1.  . I PP="" S PP="U"
  1.  . S NE=NE+1
  1.  . S ^PXRMINDX(9000010.08,"IPP",ICD,PP,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.08,"PPI",DFN,PP,ICD,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V PROCEDURE results indexed."
  1.  D MES^XPDUTL(TEXT)
  1.  D DETIME^PXRMSXRM(START,END)
  1.  ;If there were errors send a message.
  1.  I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
  1.  ;Send a MailMan message with the results.
  1.  D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
  1.  S ^PXRMINDX(9000010.08,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.08,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.08,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VMEA ;Build the indexes for V MEASUREMENTS.
  1.  N CAT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,MEA,IND,NE,NE2,NERROR
  1.  N START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.01)
  1.  S GLOBAL=$$GET1^DID(9000010.01,"","","GLOBAL NAME")
  1.  S ENTRIES=$P(^AUPNVMSR(0),U,4)
  1.  S TENP=ENTRIES/10
  1.  S TENP=+$P(TENP,".",1)
  1.  I TENP<1 S TENP=1
  1.  D BMES^XPDUTL("Building indexes for V MEASUREMENTS")
  1.  S TEXT="There are "_ENTRIES_" entries to process."
  1.  D MES^XPDUTL(TEXT)
  1.  S START=$H
  1.  S (DAS,DONE,IND,NE,NE2,NERROR)=0
  1.  F  S DAS=$O(^AUPNVMSR(DAS)) Q:DONE  D
  1.  . I +DAS=0 S DONE=1 Q
  1.  . I +DAS'=DAS D  Q
  1.  .. S DONE=1
  1.  .. S ETEXT="Bad ien: "_DAS_", cannot continue."
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S IND=IND+1
  1.  . I IND#TENP=0 D
  1.  .. S TEXT="Processing entry "_IND
  1.  .. D MES^XPDUTL(TEXT)
  1.  . I IND#10000=0 W "."
  1.  . S TEMP=^AUPNVMSR(DAS,0)
  1.  . S MEA=$P(TEMP,U,1)
  1.  . I MEA="" D  Q
  1.  .. S ETEXT=DAS_" missing MEASUREMENT"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUTTMSR(MEA)) D  Q
  1.  .. S ETEXT=DAS_" invalid MEASUREMENT"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S DFN=$P(TEMP,U,2)
  1.  . I DFN="" D  Q
  1.  .. S ETEXT=DAS_" missing DFN"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S VISIT=$P(TEMP,U,3)
  1.  . S DATE=$P($G(^AUPNVMSR(DAS,12)),U,1)
  1.  . I DATE="" D
  1.  . .I VISIT="" D  Q
  1.  ... S ETEXT=DAS_" missing visit"
  1.  ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . .I '$D(^AUPNVSIT(VISIT)) D  Q
  1.  ... S ETEXT=DAS_" invalid visit"
  1.  ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . .S DATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)
  1.  . .I DATE="" D  Q
  1.  ... S ETEXT=DAS_" missing visit date"
  1.  ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . Q:DATE=""
  1.  . ;if this entry is marked as entered-in-error do not index it
  1.  . I $P($G(^AUPNVMSR(DAS,2)),U,1) S NE2=NE2+1 Q
  1.  . S NE=NE+1
  1.  . S ^PXRMINDX(9000010.01,"IP",MEA,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.01,"PI",DFN,MEA,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V MEASUREMENTS results indexed."
  1.  D MES^XPDUTL(TEXT)
  1.  D DETIME^PXRMSXRM(START,END)
  1.  ;If there were errors send a message.
  1.  I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
  1.  ;Send a MailMan message with the results.
  1.  D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
  1.  S ^PXRMINDX(9000010.01,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.01,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.01,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;