PXPXRMI1 ; SLC/PKR,SCK - Build indexes for the V files. ;08/11/2017
;;1.0;PCE PATIENT CARE ENCOUNTER;**119,194,210,215,211**;Aug 12, 1996;Build 454
;DBIA 4113 supports PXRMSXRM entry points.
;DBIA 4114 supports setting and killing ^PXRMINDX
;===============================================================
VCPT ;Build the indexes for V CPT.
N CPT,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.18)
S GLOBAL=$$GET1^DID(9000010.18,"","","GLOBAL NAME")
S ENTRIES=$P(^AUPNVCPT(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 CPT")
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(^AUPNVCPT(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=^AUPNVCPT(DAS,0)
. S CPT=$P(TEMP,U,1)
. I CPT="" D Q
.. S ETEXT=DAS_" missing CPT"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. ;I '$D(^ICPT(CPT)) D Q
. I $$CPT^ICPTCOD(CPT)<0 D Q
.. S ETEXT=DAS_" invalid CPT"
.. 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(^AUPNVCPT(DAS,12)),U,1)
. I DATE="" S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
. I DATE="" D Q
.. S ETEXT=DAS_" missing 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.18,"IPP",CPT,PP,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,DAS)=""
S END=$H
S TEXT=NE_" V CPT 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.18,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.18,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.18,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VHF ;Build the indexes for V HEALTH FACTORS.
N CAT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,HF,IND,NE,NERROR
N START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.23)
S GLOBAL=$$GET1^DID(9000010.23,"","","GLOBAL NAME")
S ENTRIES=$P(^AUPNVHF(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 HEALTH FACTORS")
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(^AUPNVHF(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=^AUPNVHF(DAS,0)
. S HF=$P(TEMP,U,1)
. I HF="" D Q
.. S ETEXT=DAS_" missing HF"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUTTHF(HF)) D Q
.. S ETEXT=DAS_" invalid HF"
.. 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 CAT=$P(^AUTTHF(HF,0),U,3)
. I CAT="" D Q
.. S ETEXT=DAS_" HF "_HF_" missing category"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I HF=CAT D Q
.. S ETEXT=DAS_" HF "_HF_" is a category"
.. 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(^AUPNVHF(DAS,12)),U,1)
. S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
. I DATE="" D Q
.. S ETEXT=DAS_" missing date"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S NE=NE+1
. S ^PXRMINDX(9000010.23,"IP",HF,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.23,"PI",DFN,HF,DATE,DAS)=""
S END=$H
S TEXT=NE_" V HEALTH FACTOR 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.23,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.23,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.23,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VICR ;Build the indexes for V IMM CONTRA/REFUSAL EVENTS.
N DAS,DFN,DONE,END,ENTRIES,ETEXT,EVENTDT,GLOBAL,ICR,IMM,IND,NE
N NERROR,PXFILE,PXSTART,PXSTOP,START,TEMP,TENP,TEXT,VDATE,VISIT,WARNDT
S PXFILE=9000010.707
;Don't leave any old stuff around.
K ^PXRMINDX(PXFILE)
S GLOBAL=$$GET1^DID(PXFILE,"","","GLOBAL NAME")
S ENTRIES=$P(^AUPNVICR(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 IMM CONTRA/REFUSAL EVENTS")
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(^AUPNVICR(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=$G(^AUPNVICR(DAS,0))
. S ICR=$P(TEMP,U,1)
. I ICR="" D Q
.. S ETEXT=DAS_" missing contraindication/refusal"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^PXV(+$P(ICR,"(",2),+ICR)) D Q
.. S ETEXT=DAS_" invalid contraindication/refusal"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S IMM=$P(TEMP,U,4)
. I IMM="" D Q
.. S ETEXT=DAS_" missing immunization"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUTTIMM(IMM)) D Q
.. S ETEXT=DAS_" invalid immunization"
.. 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 VDATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)
. I VDATE="" D Q
.. S ETEXT=DAS_" missing date"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S WARNDT=$P(TEMP,U,5)
. S EVENTDT=$P($G(^AUPNVICR(DAS,12)),U,1)
. S PXSTART=VDATE
. I EVENTDT S PXSTART=EVENTDT
. S PXSTOP=9999999
. I WARNDT S PXSTOP=WARNDT
. S NE=NE+1
. S ^PXRMINDX(PXFILE,"ICP",IMM,ICR,DFN,PXSTART,PXSTOP,DAS)=""
. S ^PXRMINDX(PXFILE,"PIC",DFN,IMM,ICR,PXSTART,PXSTOP,DAS)=""
. S ^PXRMINDX(PXFILE,"CIP",ICR,IMM,DFN,PXSTART,PXSTOP,DAS)=""
. S ^PXRMINDX(PXFILE,"PCI",DFN,ICR,IMM,PXSTART,PXSTOP,DAS)=""
S END=$H
S TEXT=NE_" V IMM CONTRA/REFUSAL EVENTS 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(PXFILE,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(PXFILE,"BUILT BY")=DUZ
S ^PXRMINDX(PXFILE,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VIMM ;Build the indexes for V IMMUNIZATION.
N CVX,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IMM
N IND,NE,NERROR,START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.11)
S GLOBAL=$$GET1^DID(9000010.11,"","","GLOBAL NAME")
S ENTRIES=$P(^AUPNVIMM(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 IMMUNIZATION")
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(^AUPNVIMM(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=^AUPNVIMM(DAS,0)
. S IMM=$P(TEMP,U,1)
. I IMM="" D Q
.. S ETEXT=DAS_" missing immunization"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUTTIMM(IMM)) D Q
.. S ETEXT=DAS_" invalid immunization"
.. 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(^AUPNVIMM(DAS,12)),U,1)
. I DATE="" S DATE=$P(^AUPNVSIT(VISIT,0),U,1)
. I DATE="" D Q
.. S ETEXT=DAS_" missing date"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S NE=NE+1
. S ^PXRMINDX(9000010.11,"IP",IMM,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.11,"PI",DFN,IMM,DATE,DAS)=""
. S CVX=$P($G(^AUTTIMM(IMM,0)),U,3)
. I CVX'="" D
.. S ^PXRMINDX(9000010.11,"CVX","IP",CVX,DFN,DATE,DAS)=""
.. S ^PXRMINDX(9000010.11,"CVX","PI",DFN,CVX,DATE,DAS)=""
S END=$H
S TEXT=NE_" V IMMUNIZATION 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.11,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.11,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.11,"DATE BUILT")=$$NOW^XLFDT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXPXRMI1 10504 printed Dec 13, 2024@02:29:55 Page 2
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
+2 ;DBIA 4113 supports PXRMSXRM entry points.
+3 ;DBIA 4114 supports setting and killing ^PXRMINDX
+4 ;===============================================================
VCPT ;Build the indexes for V CPT.
+1 NEW CPT,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.18)
+5 SET GLOBAL=$$GET1^DID(9000010.18,"","","GLOBAL NAME")
+6 SET ENTRIES=$PIECE(^AUPNVCPT(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 CPT")
+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(^AUPNVCPT(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=^AUPNVCPT(DAS,0)
+27 SET CPT=$PIECE(TEMP,U,1)
+28 IF CPT=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing CPT"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 ;I '$D(^ICPT(CPT)) D Q
+32 IF $$CPT^ICPTCOD(CPT)<0
Begin DoDot:2
+33 SET ETEXT=DAS_" invalid CPT"
+34 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+35 SET DFN=$PIECE(TEMP,U,2)
+36 IF DFN=""
Begin DoDot:2
+37 SET ETEXT=DAS_" missing DFN"
+38 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+39 SET VISIT=$PIECE(TEMP,U,3)
+40 IF VISIT=""
Begin DoDot:2
+41 SET ETEXT=DAS_" missing visit"
+42 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+43 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:2
+44 SET ETEXT=DAS_" invalid visit"
+45 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+46 SET DATE=$PIECE($GET(^AUPNVCPT(DAS,12)),U,1)
+47 IF DATE=""
SET DATE=$PIECE(^AUPNVSIT(VISIT,0),U,1)
+48 IF DATE=""
Begin DoDot:2
+49 SET ETEXT=DAS_" missing date"
+50 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+51 SET PP=$PIECE(TEMP,U,7)
+52 IF PP=""
SET PP="U"
+53 SET NE=NE+1
+54 SET ^PXRMINDX(9000010.18,"IPP",CPT,PP,DFN,DATE,DAS)=""
+55 SET ^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,DAS)=""
End DoDot:1
+56 SET END=$HOROLOG
+57 SET TEXT=NE_" V CPT results indexed."
+58 DO MES^XPDUTL(TEXT)
+59 DO DETIME^PXRMSXRM(START,END)
+60 ;If there were errors send a message.
+61 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+62 ;Send a MailMan message with the results.
+63 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+64 SET ^PXRMINDX(9000010.18,"GLOBAL NAME")=GLOBAL
+65 SET ^PXRMINDX(9000010.18,"BUILT BY")=DUZ
+66 SET ^PXRMINDX(9000010.18,"DATE BUILT")=$$NOW^XLFDT
+67 QUIT
+68 ;
+69 ;===============================================================
VHF ;Build the indexes for V HEALTH FACTORS.
+1 NEW CAT,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,HF,IND,NE,NERROR
+2 NEW START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.23)
+5 SET GLOBAL=$$GET1^DID(9000010.23,"","","GLOBAL NAME")
+6 SET ENTRIES=$PIECE(^AUPNVHF(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 HEALTH FACTORS")
+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(^AUPNVHF(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=^AUPNVHF(DAS,0)
+27 SET HF=$PIECE(TEMP,U,1)
+28 IF HF=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing HF"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 IF '$DATA(^AUTTHF(HF))
Begin DoDot:2
+32 SET ETEXT=DAS_" invalid HF"
+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 CAT=$PIECE(^AUTTHF(HF,0),U,3)
+39 IF CAT=""
Begin DoDot:2
+40 SET ETEXT=DAS_" HF "_HF_" missing category"
+41 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+42 IF HF=CAT
Begin DoDot:2
+43 SET ETEXT=DAS_" HF "_HF_" is a category"
+44 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+45 SET VISIT=$PIECE(TEMP,U,3)
+46 IF VISIT=""
Begin DoDot:2
+47 SET ETEXT=DAS_" missing visit"
+48 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+49 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:2
+50 SET ETEXT=DAS_" invalid visit"
+51 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+52 SET DATE=$PIECE($GET(^AUPNVHF(DAS,12)),U,1)
+53 SET DATE=$PIECE(^AUPNVSIT(VISIT,0),U,1)
+54 IF DATE=""
Begin DoDot:2
+55 SET ETEXT=DAS_" missing date"
+56 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+57 SET NE=NE+1
+58 SET ^PXRMINDX(9000010.23,"IP",HF,DFN,DATE,DAS)=""
+59 SET ^PXRMINDX(9000010.23,"PI",DFN,HF,DATE,DAS)=""
End DoDot:1
+60 SET END=$HOROLOG
+61 SET TEXT=NE_" V HEALTH FACTOR results indexed."
+62 DO MES^XPDUTL(TEXT)
+63 DO DETIME^PXRMSXRM(START,END)
+64 ;If there were errors send a message.
+65 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+66 ;Send a MailMan message with the results.
+67 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+68 SET ^PXRMINDX(9000010.23,"GLOBAL NAME")=GLOBAL
+69 SET ^PXRMINDX(9000010.23,"BUILT BY")=DUZ
+70 SET ^PXRMINDX(9000010.23,"DATE BUILT")=$$NOW^XLFDT
+71 QUIT
+72 ;
+73 ;===============================================================
VICR ;Build the indexes for V IMM CONTRA/REFUSAL EVENTS.
+1 NEW DAS,DFN,DONE,END,ENTRIES,ETEXT,EVENTDT,GLOBAL,ICR,IMM,IND,NE
+2 NEW NERROR,PXFILE,PXSTART,PXSTOP,START,TEMP,TENP,TEXT,VDATE,VISIT,WARNDT
+3 SET PXFILE=9000010.707
+4 ;Don't leave any old stuff around.
+5 KILL ^PXRMINDX(PXFILE)
+6 SET GLOBAL=$$GET1^DID(PXFILE,"","","GLOBAL NAME")
+7 SET ENTRIES=$PIECE(^AUPNVICR(0),U,4)
+8 SET TENP=ENTRIES/10
+9 SET TENP=+$PIECE(TENP,".",1)
+10 IF TENP<1
SET TENP=1
+11 DO BMES^XPDUTL("Building indexes for V IMM CONTRA/REFUSAL EVENTS")
+12 SET TEXT="There are "_ENTRIES_" entries to process."
+13 DO MES^XPDUTL(TEXT)
+14 SET START=$HOROLOG
+15 SET (DAS,DONE,IND,NE,NERROR)=0
+16 FOR
SET DAS=$ORDER(^AUPNVICR(DAS))
if DONE
QUIT
Begin DoDot:1
+17 IF +DAS=0
SET DONE=1
QUIT
+18 IF +DAS'=DAS
Begin DoDot:2
+19 SET DONE=1
+20 SET ETEXT="Bad IEN: "_DAS_", cannot continue."
+21 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+22 SET IND=IND+1
+23 IF IND#TENP=0
Begin DoDot:2
+24 SET TEXT="Processing entry "_IND
+25 DO MES^XPDUTL(TEXT)
End DoDot:2
+26 IF IND#10000=0
WRITE "."
+27 SET TEMP=$GET(^AUPNVICR(DAS,0))
+28 SET ICR=$PIECE(TEMP,U,1)
+29 IF ICR=""
Begin DoDot:2
+30 SET ETEXT=DAS_" missing contraindication/refusal"
+31 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+32 IF '$DATA(^PXV(+$PIECE(ICR,"(",2),+ICR))
Begin DoDot:2
+33 SET ETEXT=DAS_" invalid contraindication/refusal"
+34 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+35 SET IMM=$PIECE(TEMP,U,4)
+36 IF IMM=""
Begin DoDot:2
+37 SET ETEXT=DAS_" missing immunization"
+38 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+39 IF '$DATA(^AUTTIMM(IMM))
Begin DoDot:2
+40 SET ETEXT=DAS_" invalid immunization"
+41 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+42 SET DFN=$PIECE(TEMP,U,2)
+43 IF DFN=""
Begin DoDot:2
+44 SET ETEXT=DAS_" missing DFN"
+45 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+46 SET VISIT=$PIECE(TEMP,U,3)
+47 IF VISIT=""
Begin DoDot:2
+48 SET ETEXT=DAS_" missing visit"
+49 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+50 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:2
+51 SET ETEXT=DAS_" invalid visit"
+52 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+53 SET VDATE=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)
+54 IF VDATE=""
Begin DoDot:2
+55 SET ETEXT=DAS_" missing date"
+56 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+57 SET WARNDT=$PIECE(TEMP,U,5)
+58 SET EVENTDT=$PIECE($GET(^AUPNVICR(DAS,12)),U,1)
+59 SET PXSTART=VDATE
+60 IF EVENTDT
SET PXSTART=EVENTDT
+61 SET PXSTOP=9999999
+62 IF WARNDT
SET PXSTOP=WARNDT
+63 SET NE=NE+1
+64 SET ^PXRMINDX(PXFILE,"ICP",IMM,ICR,DFN,PXSTART,PXSTOP,DAS)=""
+65 SET ^PXRMINDX(PXFILE,"PIC",DFN,IMM,ICR,PXSTART,PXSTOP,DAS)=""
+66 SET ^PXRMINDX(PXFILE,"CIP",ICR,IMM,DFN,PXSTART,PXSTOP,DAS)=""
+67 SET ^PXRMINDX(PXFILE,"PCI",DFN,ICR,IMM,PXSTART,PXSTOP,DAS)=""
End DoDot:1
+68 SET END=$HOROLOG
+69 SET TEXT=NE_" V IMM CONTRA/REFUSAL EVENTS results indexed."
+70 DO MES^XPDUTL(TEXT)
+71 DO DETIME^PXRMSXRM(START,END)
+72 ;If there were errors send a message.
+73 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+74 ;Send a MailMan message with the results.
+75 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+76 SET ^PXRMINDX(PXFILE,"GLOBAL NAME")=GLOBAL
+77 SET ^PXRMINDX(PXFILE,"BUILT BY")=DUZ
+78 SET ^PXRMINDX(PXFILE,"DATE BUILT")=$$NOW^XLFDT
+79 QUIT
+80 ;
+81 ;===============================================================
VIMM ;Build the indexes for V IMMUNIZATION.
+1 NEW CVX,DAS,DATE,DFN,DIFF,DONE,END,ENTRIES,ETEXT,GLOBAL,IMM
+2 NEW IND,NE,NERROR,START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.11)
+5 SET GLOBAL=$$GET1^DID(9000010.11,"","","GLOBAL NAME")
+6 SET ENTRIES=$PIECE(^AUPNVIMM(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 IMMUNIZATION")
+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(^AUPNVIMM(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=^AUPNVIMM(DAS,0)
+27 SET IMM=$PIECE(TEMP,U,1)
+28 IF IMM=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing immunization"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 IF '$DATA(^AUTTIMM(IMM))
Begin DoDot:2
+32 SET ETEXT=DAS_" invalid immunization"
+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(^AUPNVIMM(DAS,12)),U,1)
+46 IF DATE=""
SET DATE=$PIECE(^AUPNVSIT(VISIT,0),U,1)
+47 IF DATE=""
Begin DoDot:2
+48 SET ETEXT=DAS_" missing date"
+49 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+50 SET NE=NE+1
+51 SET ^PXRMINDX(9000010.11,"IP",IMM,DFN,DATE,DAS)=""
+52 SET ^PXRMINDX(9000010.11,"PI",DFN,IMM,DATE,DAS)=""
+53 SET CVX=$PIECE($GET(^AUTTIMM(IMM,0)),U,3)
+54 IF CVX'=""
Begin DoDot:2
+55 SET ^PXRMINDX(9000010.11,"CVX","IP",CVX,DFN,DATE,DAS)=""
+56 SET ^PXRMINDX(9000010.11,"CVX","PI",DFN,CVX,DATE,DAS)=""
End DoDot:2
End DoDot:1
+57 SET END=$HOROLOG
+58 SET TEXT=NE_" V IMMUNIZATION 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.11,"GLOBAL NAME")=GLOBAL
+66 SET ^PXRMINDX(9000010.11,"BUILT BY")=DUZ
+67 SET ^PXRMINDX(9000010.11,"DATE BUILT")=$$NOW^XLFDT
+68 QUIT
+69 ;
