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

PXPXRMI2.m

Go to the documentation of this file. 
  1. PXPXRMI2 ; SLC/PKR,SCK - Build indexes for the V files (continued). ;03/16/2020
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**119,194,199,211,217**;Aug 12, 1996;Build 134
  1.  ;DBIA 4113 supports PXRMSXRM entry points.
  1.  ;DBIA 4114 supports setting and killing ^PXRMINDX
  1.  ; Reference to ICDEX supported by ICR #5747.
  1.  ;
  1.  ;===============================================================
  1. VPED ;Build the indexes for V PATIENT ED.
  1.  N DAS,DATE,DFN,DONE,EDU,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR
  1.  N START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.16)
  1.  S GLOBAL=$$GET1^DID(9000010.16,"","","GLOBAL NAME")
  1.  S ENTRIES=+$P(^AUPNVPED(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 PATIENT ED")
  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(^AUPNVPED(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=^AUPNVPED(DAS,0)
  1.  . S EDU=$P(TEMP,U,1)
  1.  . I EDU="" D  Q
  1.  .. S ETEXT=DAS_" missing education topic"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUTTEDT(EDU)) D  Q
  1.  .. S ETEXT=DAS_" invalid education topic"
  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(^AUPNVPED(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.16,"IP",EDU,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.16,"PI",DFN,EDU,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V PATIENT ED 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.16,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.16,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.16,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VPOV ;Build the indexes for V POV.
  1.  N CODE,DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE
  1.  N NERROR,POV,PS,PXCSYS,START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.07)
  1.  S GLOBAL=$$GET1^DID(9000010.07,"","","GLOBAL NAME")
  1.  S ENTRIES=+$P(^AUPNVPOV(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 POV")
  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(^AUPNVPOV(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=^AUPNVPOV(DAS,0)
  1.  . S POV=$P(TEMP,U,1)
  1.  . I POV="" D  Q
  1.  .. S ETEXT=DAS_" missing POV (ICD)"
  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 PS=$P(TEMP,U,12)
  1.  . I PS="" S PS="U"
  1.  . S DATE=$P($G(^AUPNVPOV(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.  . I $P($$ICDDATA^ICDXCODE("DIAG",POV,DATE,"I"),U,1)<0 D  Q
  1.  .. S ETEXT=DAS_" invalid ICD"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S NE=NE+1
  1.  . S PXCSYS=$P($$SINFO^ICDEX($$CSI^ICDEX(80,POV)),U,3)
  1.  . I PXCSYS="ICD" D  ; ICD-9 version
  1.  .. S ^PXRMINDX(9000010.07,"IPP",POV,PS,DFN,DATE,DAS)=""
  1.  .. S ^PXRMINDX(9000010.07,"PPI",DFN,PS,POV,DATE,DAS)=""
  1.  . E  D  ; ICD-10 and higher version
  1.  .. S CODE=$$CODEC^ICDEX(80,POV)
  1.  .. S ^PXRMINDX(9000010.07,PXCSYS,"IPP",CODE,PS,DFN,DATE,DAS)=""
  1.  .. S ^PXRMINDX(9000010.07,PXCSYS,"PPI",DFN,PS,CODE,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V POV 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.07,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.07,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.07,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VSC ;Build the indexes for V Standard Codes.
  1.  N CODE,CODESYS,DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE
  1.  N NERROR,START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.71)
  1.  S GLOBAL=$$GET1^DID(9000010.71,"","","GLOBAL NAME")
  1.  S ENTRIES=+$P(^AUPNVSC(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 Standard Codes.")
  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(^AUPNVSC(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=^AUPNVSC(DAS,0)
  1.  . S CODE=$P(TEMP,U,1)
  1.  . I CODE="" D  Q
  1.  .. S ETEXT=DAS_" missing CODE"
  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 CODESYS=$P(TEMP,U,5)
  1.  . I CODESYS="" D  Q
  1.  .. S ETEXT=DAS_" missing coding system"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$$VCODESYS^PXLEX(CODESYS,0) D  Q
  1.  .. S ETEXT=DAS_" "_CODESYS_" is not a valid coding system"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$$VCODE^PXLEX(CODESYS,CODE) D  Q
  1.  .. S ETEXT=DAS_" The coding system "_CODESYS_" code "_CODE_" pair is not valid"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . S DATE=$P($G(^AUPNVSC(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.71,"IP",CODESYS,CODE,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V Standard Codes 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.71,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.71,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.71,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VSK ;Build the indexes for V SKIN TEST.
  1.  N DAS,DATE,DFN,DONE,END,ENTRIES,GLOBAL,IND,NE,NERROR
  1.  N SK,START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.12)
  1.  S GLOBAL=$$GET1^DID(9000010.12,"","","GLOBAL NAME")
  1.  S ENTRIES=+$P(^AUPNVSK(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 SKIN TEST")
  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(^AUPNVSK(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.  . ; Don't index a placement skin test that is linked to a reading skin test
  1.  . I $D(^AUPNVSK("APT",DAS)) Q
  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=^AUPNVSK(DAS,0)
  1.  . S SK=$P(TEMP,U,1)
  1.  . I SK="" D  Q
  1.  .. S ETEXT=DAS_" missing skin test"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUTTSK(SK)) D  Q
  1.  .. S ETEXT=DAS_" invalid skin test"
  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(TEMP,U,6) ; Date Read
  1.  . I DATE="" S DATE=$P($G(^AUPNVSK(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.12,"IP",SK,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.12,"PI",DFN,SK,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V SKIN TEST 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.12,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.12,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.12,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. VXAM ;Build the indexes for V EXAM.
  1.  N DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,EXAM,GLOBAL,IND,NE,NERROR
  1.  N START,TEMP,TENP,TEXT,VISIT
  1.  ;Don't leave any old stuff around.
  1.  K ^PXRMINDX(9000010.13)
  1.  S GLOBAL=$$GET1^DID(9000010.13,"","","GLOBAL NAME")
  1.  S ENTRIES=+$P(^AUPNVXAM(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 EXAM")
  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(^AUPNVXAM(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=^AUPNVXAM(DAS,0)
  1.  . S EXAM=$P(TEMP,U,1)
  1.  . I EXAM="" D  Q
  1.  .. S ETEXT=DAS_" missing exam"
  1.  .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1.  . I '$D(^AUTTEXAM(EXAM)) D  Q
  1.  .. S ETEXT=DAS_" invalid exam"
  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(^AUPNVXAM(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.13,"IP",EXAM,DFN,DATE,DAS)=""
  1.  . S ^PXRMINDX(9000010.13,"PI",DFN,EXAM,DATE,DAS)=""
  1.  S END=$H
  1.  S TEXT=NE_" V EXAM 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.13,"GLOBAL NAME")=GLOBAL
  1.  S ^PXRMINDX(9000010.13,"BUILT BY")=DUZ
  1.  S ^PXRMINDX(9000010.13,"DATE BUILT")=$$NOW^XLFDT
  1.  Q
  1.  ;