BPXRMDX1 ;IHS/MSC/MGH - Build indexes for the IHS V files. ;23-Mar-2015 10:11;DU
;;2.0;CLINICAL REMINDERS;**1001,1002,1005**;Feb 04, 2005;Build 23
;===============================================================
VPRC ;Build the indexes for V PROCEDURES.
N ICD,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR,PP
N START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.08)
S GLOBAL=$$GET1^DID(9000010.08,"","","GLOBAL NAME")
S ENTRIES=$P(^AUPNVPRC(0),U,4)
S TENP=ENTRIES/10
S TENP=+$P(TENP,".",1)
I TENP<1 S TENP=1
D BMES^XPDUTL("Building indexes for V PROCEDURE")
S TEXT="There are "_ENTRIES_" entries to process."
D MES^XPDUTL(TEXT)
S START=$H
S (DAS,DONE,IND,NE,NERROR)=0
F S DAS=$O(^AUPNVPRC(DAS)) Q:DONE D
. I +DAS=0 S DONE=1 Q
. I +DAS'=DAS D Q
.. S DONE=1
.. S ETEXT="Bad ien: "_DAS_", cannot continue."
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S IND=IND+1
. I IND#TENP=0 D
.. S TEXT="Processing entry "_IND
.. D MES^XPDUTL(TEXT)
. I IND#10000=0 W "."
. S TEMP=^AUPNVPRC(DAS,0)
. S ICD=$P(TEMP,U,1)
. I ICD="" D Q
.. S ETEXT=DAS_" missing ICD"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^ICD0(ICD)) D Q
.. S ETEXT=DAS_" invalid ICD0"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S DFN=$P(TEMP,U,2)
. I DFN="" D Q
.. S ETEXT=DAS_" missing DFN"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S VISIT=$P(TEMP,U,3)
. I VISIT="" D Q
.. S ETEXT=DAS_" missing visit"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUPNVSIT(VISIT)) D Q
.. S ETEXT=DAS_" invalid visit"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S DATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)
. I DATE="" D Q
.. S ETEXT=DAS_" missing visit date"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S PP=$P(TEMP,U,7)
. I PP="" S PP="U"
. S NE=NE+1
. S ^PXRMINDX(9000010.08,"IPP",ICD,PP,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.08,"PPI",DFN,PP,ICD,DATE,DAS)=""
S END=$H
S TEXT=NE_" V PROCEDURE results indexed."
D MES^XPDUTL(TEXT)
D DETIME^PXRMSXRM(START,END)
;If there were errors send a message.
I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
;Send a MailMan message with the results.
D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
S ^PXRMINDX(9000010.08,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.08,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.08,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VMEA ;Build the indexes for V MEASUREMENTS.
N CAT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,MEA,IND,NE,NE2,NERROR
N START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.01)
S GLOBAL=$$GET1^DID(9000010.01,"","","GLOBAL NAME")
S ENTRIES=$P(^AUPNVMSR(0),U,4)
S TENP=ENTRIES/10
S TENP=+$P(TENP,".",1)
I TENP<1 S TENP=1
D BMES^XPDUTL("Building indexes for V MEASUREMENTS")
S TEXT="There are "_ENTRIES_" entries to process."
D MES^XPDUTL(TEXT)
S START=$H
S (DAS,DONE,IND,NE,NE2,NERROR)=0
F S DAS=$O(^AUPNVMSR(DAS)) Q:DONE D
. I +DAS=0 S DONE=1 Q
. I +DAS'=DAS D Q
.. S DONE=1
.. S ETEXT="Bad ien: "_DAS_", cannot continue."
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S IND=IND+1
. I IND#TENP=0 D
.. S TEXT="Processing entry "_IND
.. D MES^XPDUTL(TEXT)
. I IND#10000=0 W "."
. S TEMP=^AUPNVMSR(DAS,0)
. S MEA=$P(TEMP,U,1)
. I MEA="" D Q
.. S ETEXT=DAS_" missing MEASUREMENT"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUTTMSR(MEA)) D Q
.. S ETEXT=DAS_" invalid MEASUREMENT"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S DFN=$P(TEMP,U,2)
. I DFN="" D Q
.. S ETEXT=DAS_" missing DFN"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S VISIT=$P(TEMP,U,3)
. S DATE=$P($G(^AUPNVMSR(DAS,12)),U,1)
. I DATE="" D
. .I VISIT="" D Q
... S ETEXT=DAS_" missing visit"
... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. .I '$D(^AUPNVSIT(VISIT)) D Q
... S ETEXT=DAS_" invalid visit"
... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. .S DATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)
. .I DATE="" D Q
... S ETEXT=DAS_" missing visit date"
... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. Q:DATE=""
. ;if this entry is marked as entered-in-error do not index it
. I $P($G(^AUPNVMSR(DAS,2)),U,1) S NE2=NE2+1 Q
. S NE=NE+1
. S ^PXRMINDX(9000010.01,"IP",MEA,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.01,"PI",DFN,MEA,DATE,DAS)=""
S END=$H
S TEXT=NE_" V MEASUREMENTS results indexed."
D MES^XPDUTL(TEXT)
D DETIME^PXRMSXRM(START,END)
;If there were errors send a message.
I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
;Send a MailMan message with the results.
D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
S ^PXRMINDX(9000010.01,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.01,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.01,"DATE BUILT")=$$NOW^XLFDT
Q
;
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
+2 ;===============================================================
VPRC ;Build the indexes for V PROCEDURES.
+1 NEW ICD,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR,PP
+2 NEW START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.08)
+5 SET GLOBAL=$$GET1^DID(9000010.08,"","","GLOBAL NAME")
+6 SET ENTRIES=$PIECE(^AUPNVPRC(0),U,4)
+7 SET TENP=ENTRIES/10
+8 SET TENP=+$PIECE(TENP,".",1)
+9 IF TENP<1
SET TENP=1
+10 DO BMES^XPDUTL("Building indexes for V PROCEDURE")
+11 SET TEXT="There are "_ENTRIES_" entries to process."
+12 DO MES^XPDUTL(TEXT)
+13 SET START=$HOROLOG
+14 SET (DAS,DONE,IND,NE,NERROR)=0
+15 FOR
SET DAS=$ORDER(^AUPNVPRC(DAS))
IF DONE
QUIT
Begin DoDot:1
+16 IF +DAS=0
SET DONE=1
QUIT
+17 IF +DAS'=DAS
Begin DoDot:2
+18 SET DONE=1
+19 SET ETEXT="Bad ien: "_DAS_", cannot continue."
+20 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+21 SET IND=IND+1
+22 IF IND#TENP=0
Begin DoDot:2
+23 SET TEXT="Processing entry "_IND
+24 DO MES^XPDUTL(TEXT)
End DoDot:2
+25 IF IND#10000=0
WRITE "."
+26 SET TEMP=^AUPNVPRC(DAS,0)
+27 SET ICD=$PIECE(TEMP,U,1)
+28 IF ICD=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing ICD"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 IF '$DATA(^ICD0(ICD))
Begin DoDot:2
+32 SET ETEXT=DAS_" invalid ICD0"
+33 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+34 SET DFN=$PIECE(TEMP,U,2)
+35 IF DFN=""
Begin DoDot:2
+36 SET ETEXT=DAS_" missing DFN"
+37 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+38 SET VISIT=$PIECE(TEMP,U,3)
+39 IF VISIT=""
Begin DoDot:2
+40 SET ETEXT=DAS_" missing visit"
+41 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+42 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:2
+43 SET ETEXT=DAS_" invalid visit"
+44 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+45 SET DATE=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)
+46 IF DATE=""
Begin DoDot:2
+47 SET ETEXT=DAS_" missing visit date"
+48 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+49 SET PP=$PIECE(TEMP,U,7)
+50 IF PP=""
SET PP="U"
+51 SET NE=NE+1
+52 SET ^PXRMINDX(9000010.08,"IPP",ICD,PP,DFN,DATE,DAS)=""
+53 SET ^PXRMINDX(9000010.08,"PPI",DFN,PP,ICD,DATE,DAS)=""
End DoDot:1
+54 SET END=$HOROLOG
+55 SET TEXT=NE_" V PROCEDURE results indexed."
+56 DO MES^XPDUTL(TEXT)
+57 DO DETIME^PXRMSXRM(START,END)
+58 ;If there were errors send a message.
+59 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+60 ;Send a MailMan message with the results.
+61 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+62 SET ^PXRMINDX(9000010.08,"GLOBAL NAME")=GLOBAL
+63 SET ^PXRMINDX(9000010.08,"BUILT BY")=DUZ
+64 SET ^PXRMINDX(9000010.08,"DATE BUILT")=$$NOW^XLFDT
+65 QUIT
+66 ;
+67 ;===============================================================
VMEA ;Build the indexes for V MEASUREMENTS.
+1 NEW CAT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,MEA,IND,NE,NE2,NERROR
+2 NEW START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.01)
+5 SET GLOBAL=$$GET1^DID(9000010.01,"","","GLOBAL NAME")
+6 SET ENTRIES=$PIECE(^AUPNVMSR(0),U,4)
+7 SET TENP=ENTRIES/10
+8 SET TENP=+$PIECE(TENP,".",1)
+9 IF TENP<1
SET TENP=1
+10 DO BMES^XPDUTL("Building indexes for V MEASUREMENTS")
+11 SET TEXT="There are "_ENTRIES_" entries to process."
+12 DO MES^XPDUTL(TEXT)
+13 SET START=$HOROLOG
+14 SET (DAS,DONE,IND,NE,NE2,NERROR)=0
+15 FOR
SET DAS=$ORDER(^AUPNVMSR(DAS))
IF DONE
QUIT
Begin DoDot:1
+16 IF +DAS=0
SET DONE=1
QUIT
+17 IF +DAS'=DAS
Begin DoDot:2
+18 SET DONE=1
+19 SET ETEXT="Bad ien: "_DAS_", cannot continue."
+20 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+21 SET IND=IND+1
+22 IF IND#TENP=0
Begin DoDot:2
+23 SET TEXT="Processing entry "_IND
+24 DO MES^XPDUTL(TEXT)
End DoDot:2
+25 IF IND#10000=0
WRITE "."
+26 SET TEMP=^AUPNVMSR(DAS,0)
+27 SET MEA=$PIECE(TEMP,U,1)
+28 IF MEA=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing MEASUREMENT"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 IF '$DATA(^AUTTMSR(MEA))
Begin DoDot:2
+32 SET ETEXT=DAS_" invalid MEASUREMENT"
+33 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+34 SET DFN=$PIECE(TEMP,U,2)
+35 IF DFN=""
Begin DoDot:2
+36 SET ETEXT=DAS_" missing DFN"
+37 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+38 SET VISIT=$PIECE(TEMP,U,3)
+39 SET DATE=$PIECE($GET(^AUPNVMSR(DAS,12)),U,1)
+40 IF DATE=""
Begin DoDot:2
+41 IF VISIT=""
Begin DoDot:3
+42 SET ETEXT=DAS_" missing visit"
+43 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:3
QUIT
+44 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:3
+45 SET ETEXT=DAS_" invalid visit"
+46 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:3
QUIT
+47 SET DATE=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)
+48 IF DATE=""
Begin DoDot:3
+49 SET ETEXT=DAS_" missing visit date"
+50 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:3
QUIT
End DoDot:2
+51 IF DATE=""
QUIT
+52 ;if this entry is marked as entered-in-error do not index it
+53 IF $PIECE($GET(^AUPNVMSR(DAS,2)),U,1)
SET NE2=NE2+1
QUIT
+54 SET NE=NE+1
+55 SET ^PXRMINDX(9000010.01,"IP",MEA,DFN,DATE,DAS)=""
+56 SET ^PXRMINDX(9000010.01,"PI",DFN,MEA,DATE,DAS)=""
End DoDot:1
+57 SET END=$HOROLOG
+58 SET TEXT=NE_" V MEASUREMENTS results indexed."
+59 DO MES^XPDUTL(TEXT)
+60 DO DETIME^PXRMSXRM(START,END)
+61 ;If there were errors send a message.
+62 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+63 ;Send a MailMan message with the results.
+64 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+65 SET ^PXRMINDX(9000010.01,"GLOBAL NAME")=GLOBAL
+66 SET ^PXRMINDX(9000010.01,"BUILT BY")=DUZ
+67 SET ^PXRMINDX(9000010.01,"DATE BUILT")=$$NOW^XLFDT
+68 QUIT
+69 ;
