PXPXRMI2 ; SLC/PKR,SCK - Build indexes for the V files (continued). ;03/16/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**119,194,199,211,217**;Aug 12, 1996;Build 134
;DBIA 4113 supports PXRMSXRM entry points.
;DBIA 4114 supports setting and killing ^PXRMINDX
; Reference to ICDEX supported by ICR #5747.
;
;===============================================================
VPED ;Build the indexes for V PATIENT ED.
N DAS,DATE,DFN,DONE,EDU,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR
N START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.16)
S GLOBAL=$$GET1^DID(9000010.16,"","","GLOBAL NAME")
S ENTRIES=+$P(^AUPNVPED(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 PATIENT ED")
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(^AUPNVPED(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=^AUPNVPED(DAS,0)
. S EDU=$P(TEMP,U,1)
. I EDU="" D Q
.. S ETEXT=DAS_" missing education topic"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUTTEDT(EDU)) D Q
.. S ETEXT=DAS_" invalid education topic"
.. 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(^AUPNVPED(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.16,"IP",EDU,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.16,"PI",DFN,EDU,DATE,DAS)=""
S END=$H
S TEXT=NE_" V PATIENT ED 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.16,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.16,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.16,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VPOV ;Build the indexes for V POV.
N CODE,DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE
N NERROR,POV,PS,PXCSYS,START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.07)
S GLOBAL=$$GET1^DID(9000010.07,"","","GLOBAL NAME")
S ENTRIES=+$P(^AUPNVPOV(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 POV")
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(^AUPNVPOV(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=^AUPNVPOV(DAS,0)
. S POV=$P(TEMP,U,1)
. I POV="" D Q
.. S ETEXT=DAS_" missing POV (ICD)"
.. 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 PS=$P(TEMP,U,12)
. I PS="" S PS="U"
. S DATE=$P($G(^AUPNVPOV(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)
. I $P($$ICDDATA^ICDXCODE("DIAG",POV,DATE,"I"),U,1)<0 D Q
.. S ETEXT=DAS_" invalid ICD"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S NE=NE+1
. S PXCSYS=$P($$SINFO^ICDEX($$CSI^ICDEX(80,POV)),U,3)
. I PXCSYS="ICD" D ; ICD-9 version
.. S ^PXRMINDX(9000010.07,"IPP",POV,PS,DFN,DATE,DAS)=""
.. S ^PXRMINDX(9000010.07,"PPI",DFN,PS,POV,DATE,DAS)=""
. E D ; ICD-10 and higher version
.. S CODE=$$CODEC^ICDEX(80,POV)
.. S ^PXRMINDX(9000010.07,PXCSYS,"IPP",CODE,PS,DFN,DATE,DAS)=""
.. S ^PXRMINDX(9000010.07,PXCSYS,"PPI",DFN,PS,CODE,DATE,DAS)=""
S END=$H
S TEXT=NE_" V POV 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.07,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.07,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.07,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VSC ;Build the indexes for V Standard Codes.
N CODE,CODESYS,DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE
N NERROR,START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.71)
S GLOBAL=$$GET1^DID(9000010.71,"","","GLOBAL NAME")
S ENTRIES=+$P(^AUPNVSC(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 Standard Codes.")
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(^AUPNVSC(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=^AUPNVSC(DAS,0)
. S CODE=$P(TEMP,U,1)
. I CODE="" D Q
.. S ETEXT=DAS_" missing CODE"
.. 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 CODESYS=$P(TEMP,U,5)
. I CODESYS="" D Q
.. S ETEXT=DAS_" missing coding system"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$$VCODESYS^PXLEX(CODESYS,0) D Q
.. S ETEXT=DAS_" "_CODESYS_" is not a valid coding system"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$$VCODE^PXLEX(CODESYS,CODE) D Q
.. S ETEXT=DAS_" The coding system "_CODESYS_" code "_CODE_" pair is not valid"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. S DATE=$P($G(^AUPNVSC(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.71,"IP",CODESYS,CODE,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE,DAS)=""
S END=$H
S TEXT=NE_" V Standard Codes 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.71,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.71,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.71,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VSK ;Build the indexes for V SKIN TEST.
N DAS,DATE,DFN,DONE,END,ENTRIES,GLOBAL,IND,NE,NERROR
N SK,START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.12)
S GLOBAL=$$GET1^DID(9000010.12,"","","GLOBAL NAME")
S ENTRIES=+$P(^AUPNVSK(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 SKIN TEST")
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(^AUPNVSK(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)
. ; Don't index a placement skin test that is linked to a reading skin test
. I $D(^AUPNVSK("APT",DAS)) Q
. 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=^AUPNVSK(DAS,0)
. S SK=$P(TEMP,U,1)
. I SK="" D Q
.. S ETEXT=DAS_" missing skin test"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUTTSK(SK)) D Q
.. S ETEXT=DAS_" invalid skin test"
.. 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(TEMP,U,6) ; Date Read
. I DATE="" S DATE=$P($G(^AUPNVSK(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.12,"IP",SK,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.12,"PI",DFN,SK,DATE,DAS)=""
S END=$H
S TEXT=NE_" V SKIN TEST 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.12,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.12,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.12,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
VXAM ;Build the indexes for V EXAM.
N DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,EXAM,GLOBAL,IND,NE,NERROR
N START,TEMP,TENP,TEXT,VISIT
;Don't leave any old stuff around.
K ^PXRMINDX(9000010.13)
S GLOBAL=$$GET1^DID(9000010.13,"","","GLOBAL NAME")
S ENTRIES=+$P(^AUPNVXAM(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 EXAM")
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(^AUPNVXAM(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=^AUPNVXAM(DAS,0)
. S EXAM=$P(TEMP,U,1)
. I EXAM="" D Q
.. S ETEXT=DAS_" missing exam"
.. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
. I '$D(^AUTTEXAM(EXAM)) D Q
.. S ETEXT=DAS_" invalid exam"
.. 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(^AUPNVXAM(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.13,"IP",EXAM,DFN,DATE,DAS)=""
. S ^PXRMINDX(9000010.13,"PI",DFN,EXAM,DATE,DAS)=""
S END=$H
S TEXT=NE_" V EXAM 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.13,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(9000010.13,"BUILT BY")=DUZ
S ^PXRMINDX(9000010.13,"DATE BUILT")=$$NOW^XLFDT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXPXRMI2 12570 printed Dec 13, 2024@02:29:56 Page 2
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
+2 ;DBIA 4113 supports PXRMSXRM entry points.
+3 ;DBIA 4114 supports setting and killing ^PXRMINDX
+4 ; Reference to ICDEX supported by ICR #5747.
+5 ;
+6 ;===============================================================
VPED ;Build the indexes for V PATIENT ED.
+1 NEW DAS,DATE,DFN,DONE,EDU,END,ENTRIES,ETEXT,GLOBAL,IND,NE,NERROR
+2 NEW START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.16)
+5 SET GLOBAL=$$GET1^DID(9000010.16,"","","GLOBAL NAME")
+6 SET ENTRIES=+$PIECE(^AUPNVPED(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 PATIENT ED")
+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(^AUPNVPED(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=^AUPNVPED(DAS,0)
+27 SET EDU=$PIECE(TEMP,U,1)
+28 IF EDU=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing education topic"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 IF '$DATA(^AUTTEDT(EDU))
Begin DoDot:2
+32 SET ETEXT=DAS_" invalid education topic"
+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(^AUPNVPED(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.16,"IP",EDU,DFN,DATE,DAS)=""
+52 SET ^PXRMINDX(9000010.16,"PI",DFN,EDU,DATE,DAS)=""
End DoDot:1
+53 SET END=$HOROLOG
+54 SET TEXT=NE_" V PATIENT ED results indexed."
+55 DO MES^XPDUTL(TEXT)
+56 DO DETIME^PXRMSXRM(START,END)
+57 ;If there were errors send a message.
+58 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+59 ;Send a MailMan message with the results.
+60 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+61 SET ^PXRMINDX(9000010.16,"GLOBAL NAME")=GLOBAL
+62 SET ^PXRMINDX(9000010.16,"BUILT BY")=DUZ
+63 SET ^PXRMINDX(9000010.16,"DATE BUILT")=$$NOW^XLFDT
+64 QUIT
+65 ;
+66 ;===============================================================
VPOV ;Build the indexes for V POV.
+1 NEW CODE,DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE
+2 NEW NERROR,POV,PS,PXCSYS,START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.07)
+5 SET GLOBAL=$$GET1^DID(9000010.07,"","","GLOBAL NAME")
+6 SET ENTRIES=+$PIECE(^AUPNVPOV(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 POV")
+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(^AUPNVPOV(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=^AUPNVPOV(DAS,0)
+27 SET POV=$PIECE(TEMP,U,1)
+28 IF POV=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing POV (ICD)"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 SET DFN=$PIECE(TEMP,U,2)
+32 IF DFN=""
Begin DoDot:2
+33 SET ETEXT=DAS_" missing DFN"
+34 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+35 SET VISIT=$PIECE(TEMP,U,3)
+36 IF VISIT=""
Begin DoDot:2
+37 SET ETEXT=DAS_" missing visit"
+38 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+39 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:2
+40 SET ETEXT=DAS_" invalid visit"
+41 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+42 SET PS=$PIECE(TEMP,U,12)
+43 IF PS=""
SET PS="U"
+44 SET DATE=$PIECE($GET(^AUPNVPOV(DAS,12)),U,1)
+45 IF DATE=""
SET DATE=$PIECE(^AUPNVSIT(VISIT,0),U,1)
+46 IF DATE=""
Begin DoDot:2
+47 SET ETEXT=DAS_" missing date"
+48 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+49 IF $PIECE($$ICDDATA^ICDXCODE("DIAG",POV,DATE,"I"),U,1)<0
Begin DoDot:2
+50 SET ETEXT=DAS_" invalid ICD"
+51 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+52 SET NE=NE+1
+53 SET PXCSYS=$PIECE($$SINFO^ICDEX($$CSI^ICDEX(80,POV)),U,3)
+54 ; ICD-9 version
IF PXCSYS="ICD"
Begin DoDot:2
+55 SET ^PXRMINDX(9000010.07,"IPP",POV,PS,DFN,DATE,DAS)=""
+56 SET ^PXRMINDX(9000010.07,"PPI",DFN,PS,POV,DATE,DAS)=""
End DoDot:2
+57 ; ICD-10 and higher version
IF '$TEST
Begin DoDot:2
+58 SET CODE=$$CODEC^ICDEX(80,POV)
+59 SET ^PXRMINDX(9000010.07,PXCSYS,"IPP",CODE,PS,DFN,DATE,DAS)=""
+60 SET ^PXRMINDX(9000010.07,PXCSYS,"PPI",DFN,PS,CODE,DATE,DAS)=""
End DoDot:2
End DoDot:1
+61 SET END=$HOROLOG
+62 SET TEXT=NE_" V POV results indexed."
+63 DO MES^XPDUTL(TEXT)
+64 DO DETIME^PXRMSXRM(START,END)
+65 ;If there were errors send a message.
+66 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+67 ;Send a MailMan message with the results.
+68 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+69 SET ^PXRMINDX(9000010.07,"GLOBAL NAME")=GLOBAL
+70 SET ^PXRMINDX(9000010.07,"BUILT BY")=DUZ
+71 SET ^PXRMINDX(9000010.07,"DATE BUILT")=$$NOW^XLFDT
+72 QUIT
+73 ;
+74 ;===============================================================
VSC ;Build the indexes for V Standard Codes.
+1 NEW CODE,CODESYS,DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,GLOBAL,IND,NE
+2 NEW NERROR,START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.71)
+5 SET GLOBAL=$$GET1^DID(9000010.71,"","","GLOBAL NAME")
+6 SET ENTRIES=+$PIECE(^AUPNVSC(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 Standard Codes.")
+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(^AUPNVSC(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=^AUPNVSC(DAS,0)
+27 SET CODE=$PIECE(TEMP,U,1)
+28 IF CODE=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing CODE"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 SET DFN=$PIECE(TEMP,U,2)
+32 IF DFN=""
Begin DoDot:2
+33 SET ETEXT=DAS_" missing DFN"
+34 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+35 SET VISIT=$PIECE(TEMP,U,3)
+36 IF VISIT=""
Begin DoDot:2
+37 SET ETEXT=DAS_" missing visit"
+38 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+39 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:2
+40 SET ETEXT=DAS_" invalid visit"
+41 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+42 SET CODESYS=$PIECE(TEMP,U,5)
+43 IF CODESYS=""
Begin DoDot:2
+44 SET ETEXT=DAS_" missing coding system"
+45 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+46 IF '$$VCODESYS^PXLEX(CODESYS,0)
Begin DoDot:2
+47 SET ETEXT=DAS_" "_CODESYS_" is not a valid coding system"
+48 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+49 IF '$$VCODE^PXLEX(CODESYS,CODE)
Begin DoDot:2
+50 SET ETEXT=DAS_" The coding system "_CODESYS_" code "_CODE_" pair is not valid"
+51 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+52 SET DATE=$PIECE($GET(^AUPNVSC(DAS,12)),U,1)
+53 IF DATE=""
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.71,"IP",CODESYS,CODE,DFN,DATE,DAS)=""
+59 SET ^PXRMINDX(9000010.71,"PI",DFN,CODESYS,CODE,DATE,DAS)=""
End DoDot:1
+60 SET END=$HOROLOG
+61 SET TEXT=NE_" V Standard Codes 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.71,"GLOBAL NAME")=GLOBAL
+69 SET ^PXRMINDX(9000010.71,"BUILT BY")=DUZ
+70 SET ^PXRMINDX(9000010.71,"DATE BUILT")=$$NOW^XLFDT
+71 QUIT
+72 ;
+73 ;===============================================================
VSK ;Build the indexes for V SKIN TEST.
+1 NEW DAS,DATE,DFN,DONE,END,ENTRIES,GLOBAL,IND,NE,NERROR
+2 NEW SK,START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.12)
+5 SET GLOBAL=$$GET1^DID(9000010.12,"","","GLOBAL NAME")
+6 SET ENTRIES=+$PIECE(^AUPNVSK(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 SKIN TEST")
+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(^AUPNVSK(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 ; Don't index a placement skin test that is linked to a reading skin test
+22 IF $DATA(^AUPNVSK("APT",DAS))
QUIT
+23 SET IND=IND+1
+24 IF IND#TENP=0
Begin DoDot:2
+25 SET TEXT="Processing entry "_IND
+26 DO MES^XPDUTL(TEXT)
End DoDot:2
+27 IF IND#10000=0
WRITE "."
+28 SET TEMP=^AUPNVSK(DAS,0)
+29 SET SK=$PIECE(TEMP,U,1)
+30 IF SK=""
Begin DoDot:2
+31 SET ETEXT=DAS_" missing skin test"
+32 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+33 IF '$DATA(^AUTTSK(SK))
Begin DoDot:2
+34 SET ETEXT=DAS_" invalid skin test"
+35 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+36 SET DFN=$PIECE(TEMP,U,2)
+37 IF DFN=""
Begin DoDot:2
+38 SET ETEXT=DAS_" missing DFN"
+39 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+40 SET VISIT=$PIECE(TEMP,U,3)
+41 IF VISIT=""
Begin DoDot:2
+42 SET ETEXT=DAS_" missing visit"
+43 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+44 IF '$DATA(^AUPNVSIT(VISIT))
Begin DoDot:2
+45 SET ETEXT=DAS_" invalid visit"
+46 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+47 ; Date Read
SET DATE=$PIECE(TEMP,U,6)
+48 IF DATE=""
SET DATE=$PIECE($GET(^AUPNVSK(DAS,12)),U,1)
+49 IF DATE=""
SET DATE=$PIECE(^AUPNVSIT(VISIT,0),U,1)
+50 IF DATE=""
Begin DoDot:2
+51 SET ETEXT=DAS_" missing date"
+52 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+53 SET NE=NE+1
+54 SET ^PXRMINDX(9000010.12,"IP",SK,DFN,DATE,DAS)=""
+55 SET ^PXRMINDX(9000010.12,"PI",DFN,SK,DATE,DAS)=""
End DoDot:1
+56 SET END=$HOROLOG
+57 SET TEXT=NE_" V SKIN TEST 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.12,"GLOBAL NAME")=GLOBAL
+65 SET ^PXRMINDX(9000010.12,"BUILT BY")=DUZ
+66 SET ^PXRMINDX(9000010.12,"DATE BUILT")=$$NOW^XLFDT
+67 QUIT
+68 ;
+69 ;===============================================================
VXAM ;Build the indexes for V EXAM.
+1 NEW DAS,DATE,DFN,DONE,END,ENTRIES,ETEXT,EXAM,GLOBAL,IND,NE,NERROR
+2 NEW START,TEMP,TENP,TEXT,VISIT
+3 ;Don't leave any old stuff around.
+4 KILL ^PXRMINDX(9000010.13)
+5 SET GLOBAL=$$GET1^DID(9000010.13,"","","GLOBAL NAME")
+6 SET ENTRIES=+$PIECE(^AUPNVXAM(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 EXAM")
+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(^AUPNVXAM(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=^AUPNVXAM(DAS,0)
+27 SET EXAM=$PIECE(TEMP,U,1)
+28 IF EXAM=""
Begin DoDot:2
+29 SET ETEXT=DAS_" missing exam"
+30 DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
End DoDot:2
QUIT
+31 IF '$DATA(^AUTTEXAM(EXAM))
Begin DoDot:2
+32 SET ETEXT=DAS_" invalid exam"
+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(^AUPNVXAM(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.13,"IP",EXAM,DFN,DATE,DAS)=""
+52 SET ^PXRMINDX(9000010.13,"PI",DFN,EXAM,DATE,DAS)=""
End DoDot:1
+53 SET END=$HOROLOG
+54 SET TEXT=NE_" V EXAM results indexed."
+55 DO MES^XPDUTL(TEXT)
+56 DO DETIME^PXRMSXRM(START,END)
+57 ;If there were errors send a message.
+58 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+59 ;Send a MailMan message with the results.
+60 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+61 SET ^PXRMINDX(9000010.13,"GLOBAL NAME")=GLOBAL
+62 SET ^PXRMINDX(9000010.13,"BUILT BY")=DUZ
+63 SET ^PXRMINDX(9000010.13,"DATE BUILT")=$$NOW^XLFDT
+64 QUIT
+65 ;
