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

PXPXRMI1.m

Go to the documentation of this file. 
  1. PXPXRMI1 ; SLC/PKR,SCK - Build indexes for the V files. ;08/11/2017
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**119,194,210,215,211**;Aug 12, 1996;Build 454
  1.  ;DBIA 4113 supports PXRMSXRM entry points.
  1.  ;DBIA 4114 supports setting and killing ^PXRMINDX
  1.  ;===============================================================
  1. VCPT ;Build the indexes for V CPT.
  1.  N CPT,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.18)
  1.  S GLOBAL=$$GET1^DID(9000010.18,"","","GLOBAL NAME")
  1.  S ENTRIES=$P(^AUPNVCPT(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 CPT")
  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(^AUPNVCPT(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=^AUPNVCPT(DAS,0)
  1.  . S CPT=$P(TEMP,U,1)
  1.  . I CPT="" D  Q
  1.  .. S ETEXT=DAS_" missing CPT"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . ;I '$D(^ICPT(CPT)) D  Q
  1.  . I $$CPT^ICPTCOD(CPT)<0 D  Q
  1.  .. S ETEXT=DAS_" invalid CPT"
  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(^AUPNVCPT(DAS,12)),U,1)
  1.  . I DATE="" S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
  1.  . I DATE="" D  Q
  1.  .. S ETEXT=DAS_" missing 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.18,"IPP",CPT,PP,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V CPT 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.18,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.18,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.18,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VHF ;Build the indexes for V HEALTH FACTORS.
  1.  N CAT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,HF,IND,NE,NERROR
  1.  N START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.23)
  1.  S GLOBAL=$$GET1^DID(9000010.23,"","","GLOBAL NAME")
  1.  S ENTRIES=$P(^AUPNVHF(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 HEALTH FACTORS")
  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(^AUPNVHF(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=^AUPNVHF(DAS,0)
  1.  . S HF=$P(TEMP,U,1)
  1.  . I HF="" D  Q
  1.  .. S ETEXT=DAS_" missing HF"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUTTHF(HF)) D  Q
  1.  .. S ETEXT=DAS_" invalid HF"
  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 CAT=$P(^AUTTHF(HF,0),U,3)
  1.  . I CAT="" D  Q
  1.  .. S ETEXT=DAS_" HF "_HF_" missing category"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I HF=CAT D  Q
  1.  .. S ETEXT=DAS_" HF "_HF_" is a category"
  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(^AUPNVHF(DAS,12)),U,1)
  1.  . S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
  1.  . I DATE="" D  Q
  1.  .. S ETEXT=DAS_" missing date"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S NE=NE+1
  1.  . S ^PXRMINDX(9000010.23,"IP",HF,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.23,"PI",DFN,HF,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V HEALTH FACTOR 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.23,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.23,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.23,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VICR ;Build the indexes for V IMM CONTRA/REFUSAL EVENTS.
  1.  N DAS,DFN,DONE,END,ENTRIES,ETEXT,EVENTDT,GLOBAL,ICR,IMM,IND,NE
  1.  N NERROR,PXFILE,PXSTART,PXSTOP,START,TEMP,TENP,TEXT,VDATE,VISIT,WARNDT
  1.  S PXFILE=9000010.707
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(PXFILE)
  1.  S GLOBAL=$$GET1^DID(PXFILE,"","","GLOBAL NAME")
  1.  S ENTRIES=$P(^AUPNVICR(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 IMM CONTRA/REFUSAL EVENTS")
  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(^AUPNVICR(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=$G(^AUPNVICR(DAS,0))
  1.  . S ICR=$P(TEMP,U,1)
  1.  . I ICR="" D  Q
  1.  .. S ETEXT=DAS_" missing contraindication/refusal"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^PXV(+$P(ICR,"(",2),+ICR)) D  Q
  1.  .. S ETEXT=DAS_" invalid contraindication/refusal"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S IMM=$P(TEMP,U,4)
  1.  . I IMM="" D  Q
  1.  .. S ETEXT=DAS_" missing immunization"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUTTIMM(IMM)) D  Q
  1.  .. S ETEXT=DAS_" invalid immunization"
  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 VDATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)
  1.  . I VDATE="" D  Q
  1.  .. S ETEXT=DAS_" missing date"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S WARNDT=$P(TEMP,U,5)
  1.  . S EVENTDT=$P($G(^AUPNVICR(DAS,12)),U,1)
  1.  . S PXSTART=VDATE
  1.  . I EVENTDT S PXSTART=EVENTDT
  1.  . S PXSTOP=9999999
  1.  . I WARNDT S PXSTOP=WARNDT
  1.  . S NE=NE+1
  1.  . S ^PXRMINDX(PXFILE,"ICP",IMM,ICR,DFN,PXSTART,PXSTOP,DAS)=""
  1.  . S ^PXRMINDX(PXFILE,"PIC",DFN,IMM,ICR,PXSTART,PXSTOP,DAS)=""
  1.  . S ^PXRMINDX(PXFILE,"CIP",ICR,IMM,DFN,PXSTART,PXSTOP,DAS)=""
  1.  . S ^PXRMINDX(PXFILE,"PCI",DFN,ICR,IMM,PXSTART,PXSTOP,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V IMM CONTRA/REFUSAL EVENTS 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(PXFILE,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(PXFILE,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(PXFILE,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VIMM ;Build the indexes for V IMMUNIZATION.
  1.  N CVX,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IMM
  1.  N IND,NE,NERROR,START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.11)
  1.  S GLOBAL=$$GET1^DID(9000010.11,"","","GLOBAL NAME")
  1.  S ENTRIES=$P(^AUPNVIMM(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 IMMUNIZATION")
  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(^AUPNVIMM(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=^AUPNVIMM(DAS,0)
  1.  . S IMM=$P(TEMP,U,1)
  1.  . I IMM="" D  Q
  1.  .. S ETEXT=DAS_" missing immunization"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUTTIMM(IMM)) D  Q
  1.  .. S ETEXT=DAS_" invalid immunization"
  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(^AUPNVIMM(DAS,12)),U,1)
  1.  . I DATE="" S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
  1.  . I DATE="" D  Q
  1.  .. S ETEXT=DAS_" missing date"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S NE=NE+1
  1.  . S ^PXRMINDX(9000010.11,"IP",IMM,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.11,"PI",DFN,IMM,DATE,DAS)=""
  1.  . S CVX=$P($G(^AUTTIMM(IMM,0)),U,3)
  1.  . I CVX'="" D
  1.  .. S ^PXRMINDX(9000010.11,"CVX","IP",CVX,DFN,DATE,DAS)=""
  1.  .. S ^PXRMINDX(9000010.11,"CVX","PI",DFN,CVX,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V IMMUNIZATION 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.11,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.11,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.11,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;