PXPXRM ;SLC/PKR - APIs for Clinical Reminder indexes. ;May 28, 2021@08:51:37
;;1.0;PCE PATIENT CARE ENCOUNTER;**119,199,210,215,216,211,217**;Aug 12, 1996;Build 134
;
;Reference to ICDEX supported by ICR #5747.
;
Q
;====================
KVFILE(FILENUM,X,DA) ;Delete indexes for a regular V File.
;X(1)=ITEM, X(2)=DFN, X(3)=VISIT IEN, X(4)=EVENT DATE AND TIME
N CVX,VDATE,VISIT
S VISIT=$G(^AUPNVSIT(X(3),0))
I VISIT="" D NOVISITMSG("KVFILE^PXPXRM",FILENUM,.X,DA) Q
; For skin tests, set placement index when linked reading entry is deleted
I FILENUM=9000010.12 D
. N PXPLACESK,PXX
. S PXPLACESK=$P($G(^AUPNVSK(DA,12)),U,8)
. I 'PXPLACESK Q
. S PXX(1)=X(1)
. S PXX(2)=X(2)
. S PXX(3)=$P($G(^AUPNVSK(PXPLACESK,0)),U,3)
. I 'PXX(3) Q
. S PXX(4)=$P($G(^AUPNVSK(PXPLACESK,12)),U,1)
. D SVFILE(FILENUM,.PXX,PXPLACESK)
; For skin tests, use Date Read
I FILENUM=9000010.12 S VDATE=$G(X(5))
I $G(VDATE)="" S VDATE=$G(X(4))
I VDATE="" S VDATE=$P(VISIT,U,1)
;
I FILENUM=9000010.11 D
.;If V IMMUNIZATION: kill CVX index.
. S CVX=$P($G(^AUTTIMM(X(1),0)),U,3)
. I CVX'="" D
. . K ^PXRMINDX(FILENUM,"CVX","IP",CVX,X(2),VDATE,DA)
. . K ^PXRMINDX(FILENUM,"CVX","PI",X(2),CVX,VDATE,DA)
;
K ^PXRMINDX(FILENUM,"IP",X(1),X(2),VDATE,DA)
K ^PXRMINDX(FILENUM,"PI",X(2),X(1),VDATE,DA)
Q
;
;====================
KVFILEC(FILENUM,X,DA) ;Delete indexes for V Files with coded entries.
; FILENUM = file number, e.g. 9000010.07
; X = Array of fields
; X(1)=Item pointer: Dx for V POV, CPT for V CPT
; X(2)=PATIENT NAME (DFN)
; X(3)=VISIT (ptr to 9000010)
; X(4)=PRIMARY/SECONDARY for V POV
; or PRINCIPAL PROCEDURE FOR V CPT
; X(5)=EVENT DATE AND TIME
; DA = IEN into FILENUM file
;
N CODE,CTYPE,PXCSYS,VDATE,VISIT
S VISIT=$G(^AUPNVSIT(X(3),0))
I VISIT="" D NOVISITMSG("KVFILEC^PXPXRM",FILENUM,.X,DA) Q
S CTYPE=$S(X(4)="":"U",1:X(4))
S VDATE=$G(X(5))
I VDATE="" S VDATE=$P(VISIT,U,1)
S PXCSYS="ICD"
;If V POV get coding system.
I FILENUM=9000010.07 S PXCSYS=$P($$SINFO^ICDEX($$CSI^ICDEX(80,X(1))),U,3) ; coding system abbreviation
;I PXCSYS'="ICD" D KVFILEV Q ; if not ICD-9, use alternate format and Quit
I PXCSYS'="ICD" D Q
.;Coding system code format
. S CODE=$$CODEC^ICDEX(80,X(1)) ; convert IEN to Dx code
. K ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),VDATE,DA)
. K ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,VDATE,DA)
;Original format used for V CPT and ICD-9 diagnoses
K ^PXRMINDX(FILENUM,"IPP",X(1),CTYPE,X(2),VDATE,DA)
K ^PXRMINDX(FILENUM,"PPI",X(2),CTYPE,X(1),VDATE,DA)
Q
;
;====================
KVFILEV ; alternate index format for ICD-10 and higher, added with PX*1.0*199
S CODE=$$CODEC^ICDEX(80,X(1)) ; convert IEN to Dx code
K ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),VDATE,DA)
K ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,VDATE,DA)
Q
;
;====================
NOVISITMSG(ROUTINE,FILENUM,X,DA) ;Send a message when there is no visit file entry.
N IND,NL,NODE,SUBJECT
S NODE="PXNOVISIT"
K ^TMP(NODE,$J)
S ^TMP(NODE,$J,1,0)="ROUTINE: "_ROUTINE
S ^TMP(NODE,$J,2,0)="File Number: "_FILENUM
S ^TMP(NODE,$J,3,0)="DA="_DA
S IND=0,NL=3
F S IND=$O(X(IND)) Q:IND="" S NL=NL+1,^TMP(NODE,$J,NL,0)="X("_IND_")="_X(IND)
S NL=NL+1,^TMP(NODE,$J,NL,0)="An error has been generated to save the Stack in the Error Trap"
S NL=NL+1,^TMP(NODE,$J,NL,0)="Date and Time: "_$$FMTE^XLFDT($$NOW^XLFDT,2)
S SUBJECT="PROBLEM SETTING/KILLING REMINDERS INDEX - NO VISIT"
D SEND^PXMSG(NODE,SUBJECT)
;Generate an error to save the Stack.
N $ESTACK,$ETRAP,UNDEFINED
S $ETRAP="D SAVESTACK^PXPXRM"
S SUBJECT=UNDEFINED
Q
;
;====================
SAVESTACK ;Save the Stack in the Error Trap.
D ^%ZTER
D UNWIND^%ZTER
Q
;
;====================
SETPKGDS(TEMP,DATA) ;Set the Package and Data Source.
N PTEMP
S PTEMP=$P(TEMP,U,2)
S DATA("PACKAGE")=PTEMP_$S(PTEMP:U_$$GET1^DIQ(9.4,PTEMP,.01),1:"")
S PTEMP=$P(TEMP,U,3)
S DATA("DATA SOURCE")=PTEMP_$S(PTEMP:(U_$P($G(^PX(839.7,PTEMP,0)),U,1)),1:"")
Q
;
;====================
SVFILE(FILENUM,X,DA) ;Set indexes for a regular V File.
;X(1)=ITEM, X(2)=DFN, X(3)=VISIT IEN, X(4)=EVENT DATE AND TIME
;for skin tests X(5)=DATE READ
N CVX,DATE,VISIT
;
; Don't index a placement skin test that is linked to a reading skin test
I FILENUM=9000010.12,$D(^AUPNVSK("APT",DA)) Q
; If this is a reading skin test, delete linked placement skin test index
I FILENUM=9000010.12 D
. N PXPLACESK,PXX
. S PXPLACESK=$P($G(^AUPNVSK(DA,12)),U,8)
. I 'PXPLACESK Q
. S PXX(1)=X(1)
. S PXX(2)=X(2)
. S PXX(3)=$P($G(^AUPNVSK(PXPLACESK,0)),U,3)
. I 'PXX(3) Q
. S PXX(4)=$P($G(^AUPNVSK(PXPLACESK,12)),U,1)
. D KVFILE(FILENUM,.PXX,PXPLACESK)
;
S VISIT=$G(^AUPNVSIT(X(3),0))
I VISIT="" D NOVISITMSG("SVFILE^PXPXRM",FILENUM,.X,DA) Q
; For skin tests, use Date Read
I FILENUM=9000010.12 S DATE=$G(X(5))
I $G(DATE)="" S DATE=$G(X(4))
I DATE="" S DATE=$P(VISIT,U,1)
;
I FILENUM=9000010.11 D
.; If V IMMUNIZATION: set CVX index.
. S CVX=$P($G(^AUTTIMM(X(1),0)),U,3)
. I CVX'="" D
. . S ^PXRMINDX(FILENUM,"CVX","IP",CVX,X(2),DATE,DA)=""
. . S ^PXRMINDX(FILENUM,"CVX","PI",X(2),CVX,DATE,DA)=""
;
S ^PXRMINDX(FILENUM,"IP",X(1),X(2),DATE,DA)=""
S ^PXRMINDX(FILENUM,"PI",X(2),X(1),DATE,DA)=""
Q
;
;====================
SVFILEC(FILENUM,X,DA) ;Set indexes for V Files with coded entries. These
;are V CPT and VPOV.
;X(1)=ITEM, X(2)=DFN, X(3)=VISIT IEN,
; for V CPT X(4)=PRINCIPAL PROCEDURE
; for V POV X(4)=PRIMARY/SECONDARY
;X(5)=EVENT DATE AND TIME
N CODE,CTYPE,DATE,PXCSYS,VISIT
S VISIT=$G(^AUPNVSIT(X(3),0))
I VISIT="" D NOVISITMSG("SVFILEC^PXPXRM",FILENUM,.X,DA) Q
S CTYPE=$S(X(4)="":"U",1:X(4))
S DATE=$G(X(5))
I DATE="" S DATE=$P(VISIT,U,1)
S PXCSYS="ICD"
;If V POV get coding system.
I FILENUM=9000010.07 S PXCSYS=$P($$SINFO^ICDEX($$CSI^ICDEX(80,X(1))),U,3) ; coding system abbreviation
;I PXCSYS'="ICD" D SVFILEV Q ; if not ICD-9 use alternate format and Quit
I PXCSYS'="ICD" D Q
.;Coding system code format
. S CODE=$$CODEC^ICDEX(80,X(1))
. S ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),DATE,DA)=""
. S ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,DATE,DA)=""
;Original format used for V CPT and ICD-9 diagnoses
S ^PXRMINDX(FILENUM,"IPP",X(1),CTYPE,X(2),DATE,DA)=""
S ^PXRMINDX(FILENUM,"PPI",X(2),CTYPE,X(1),DATE,DA)=""
Q
;
;====================
SVFILEV ; alternate index format for ICD-10 and higher, added with PX*1.0*199
S CODE=$$CODEC^ICDEX(80,X(1)) ; convert IEN to Dx code
S ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),VDATE,DA)=""
S ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,VDATE,DA)=""
Q
;
;====================
VICRFILE(X,DA,PXACTION) ;Set/Kill indexes for V Imm Contra/Refusal Events.
;
; Inputs:
; X - X(1)=Contra/Refusal, X(2)=DFN, X(3)=Visit
; X(4)=Immunization, X(5)=Event Date and Time
; X(6)=Warn Until Date
; DA - V Imm Contra/Refusal Events IEN
; PXACTION - "S": Set index
; "K": Kill index
;
N FILENUM,VISIT,VDATE,START,STOP
;
S FILENUM=9000010.707
S VISIT=$G(^AUPNVSIT(X(3),0))
I VISIT="" D NOVISITMSG("VICRFILE^PXPXRM",9000010.707,.X,DA) Q
S VDATE=$P(VISIT,U,1)
;
S START=VDATE
I $G(X(5)) S START=X(5)
;
S STOP=9999999
I $G(X(6)) S STOP=X(6)
;
I PXACTION="S" D
. S ^PXRMINDX(FILENUM,"ICP",X(4),X(1),X(2),START,STOP,DA)=""
. S ^PXRMINDX(FILENUM,"PIC",X(2),X(4),X(1),START,STOP,DA)=""
. S ^PXRMINDX(FILENUM,"CIP",X(1),X(4),X(2),START,STOP,DA)=""
. S ^PXRMINDX(FILENUM,"PCI",X(2),X(1),X(4),START,STOP,DA)=""
I PXACTION="K" D
. K ^PXRMINDX(FILENUM,"ICP",X(4),X(1),X(2),START,STOP,DA)
. K ^PXRMINDX(FILENUM,"PIC",X(2),X(4),X(1),START,STOP,DA)
. K ^PXRMINDX(FILENUM,"CIP",X(1),X(4),X(2),START,STOP,DA)
. K ^PXRMINDX(FILENUM,"PCI",X(2),X(1),X(4),START,STOP,DA)
Q
;
;====================
UPDCVX(IMM,CVXOLD,CVXNEW) ;
; Update CVX Index on V Immunization file
; Called from ACR cross-reference on Immunization file
N DA,PXDESC,PXRTN,PXTASK,PXVAR,PXVOTH,X,X1,X2
I CVXOLD=CVXNEW Q
S PXRTN="UPDCVXT^PXPXRM"
S PXDESC="Clinical Reminders CVX index update for V IMMUNIZATION"
S PXVAR="IMM;CVXOLD;CVXNEW"
S PXVOTH("ZTDTH")=$$NOW^XLFDT
S PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,PXVAR,.PXVOTH)
I PXTASK=-1 D UPDCVXT^PXPXRM
Q
;
;====================
UPDCVXT ;Tasked from UPDCVX.
;Variables IMM, CVXOLD, and CVXNEW passed in via task
S ZTREQ="@"
N DATE,DFN,EDATE,VIMM,VISIT
S VIMM=0
F S VIMM=$O(^AUPNVIMM("B",IMM,VIMM)) Q:'VIMM D
. S DFN=$P($G(^AUPNVIMM(VIMM,0)),U,2)
. I 'DFN Q
. S VISIT=$P($G(^AUPNVIMM(VIMM,0)),U,3)
. S VISIT=$G(^AUPNVSIT(+VISIT,0))
. I VISIT="" D NOVISITMSG("UPDCVXT^PXPXRM",9000010.11,.X,DA) Q
. S DATE=$P(VISIT,U,1)
. S EDATE=$P($G(^AUPNVIMM(VIMM,12)),U,1)
. I EDATE S DATE=EDATE
. I 'DATE Q
. I CVXOLD'="" D
. . K ^PXRMINDX(9000010.11,"CVX","IP",CVXOLD,DFN,DATE,VIMM)
. . K ^PXRMINDX(9000010.11,"CVX","PI",DFN,CVXOLD,DATE,VIMM)
. I CVXNEW'="" D
. . S ^PXRMINDX(9000010.11,"CVX","IP",CVXNEW,DFN,DATE,VIMM)=""
. . S ^PXRMINDX(9000010.11,"CVX","PI",DFN,CVXNEW,DATE,VIMM)=""
Q
;
;====================
VCPT(DA,DATA) ;Return data for a specified V CPT entry.
N TEMP
S TEMP=^AUPNVCPT(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S DATA("PROVIDER NARRATIVE")=$P(TEMP,U,4)
S DATA("DIAGNOSIS")=$P(TEMP,U,5)
S DATA("DIAGNOSIS 2")=$P(TEMP,U,9)
S DATA("DIAGNOSIS 3")=$P(TEMP,U,10)
S DATA("DIAGNOSIS 4")=$P(TEMP,U,11)
S DATA("DIAGNOSIS 5")=$P(TEMP,U,12)
S DATA("DIAGNOSIS 6")=$P(TEMP,U,13)
S DATA("DIAGNOSIS 7")=$P(TEMP,U,14)
S DATA("DIAGNOSIS 8")=$P(TEMP,U,15)
S DATA("PRINCIPAL PROCEDURE")=$P(TEMP,U,7)
S DATA("QUANTITY")=$P(TEMP,U,16)
S TEMP=$G(^AUPNVCPT(DA,12))
S DATA("EVENT DATE AND TIME")=$P(TEMP,U,1)
S DATA("ORDERING PROVIDER")=$P(TEMP,U,2)
S DATA("ENCOUNTER PROVIDER")=$P(TEMP,U,4)
S DATA("COMMENTS")=$G(^AUPNVCPT(DA,811))
S TEMP=$G(^AUPNVCPT(DA,812))
D SETPKGDS(TEMP,.DATA)
Q
;
;====================
VHF(DA,DATA) ;Return data for a specified V Health Factor entry.
N TEMP
S TEMP=^AUPNVHF(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S (DATA("LEVEL/SEVERITY"),DATA("VALUE"))=$P(TEMP,U,4)
S TEMP=$G(^AUPNVHF(DA,12))
S DATA("EVENT DATE AND TIME")=$P(TEMP,U,1)
S DATA("ORDERING PROVIDER")=$P(TEMP,U,2)
S DATA("ENCOUNTER PROVIDER")=$P(TEMP,U,4)
S DATA("MEASUREMENT")=$G(^AUPNVHF(DA,220))
S DATA("COMMENTS")=$G(^AUPNVHF(DA,811))
S TEMP=$G(^AUPNVHF(DA,812))
D SETPKGDS(TEMP,.DATA)
Q
;
;====================
VICR(DA,DATA) ;Return data, for a specified V Imm Contra/Refusal Events entry.
N PXFILE,PXVIEN,PXX,TEMP
S TEMP=^AUPNVICR(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S PXX=$P(TEMP,U,1),PXFILE=+$P(PXX,"(",2),PXVIEN=$P(PXX,";",1)
S DATA("CONTRA/REFUSAL")=PXX_U_$P($G(^PXV(PXFILE,+PXX,0)),U,1)
S PXX=$P(TEMP,U,4)
S DATA("IMMUN")=PXX_U_$P($G(^AUTTIMM(+PXX,0)),U,1)
S DATA("WARN UNTIL DATE")=$P(TEMP,U,5)
S DATA("D/T RECORDED")=$P(TEMP,U,6)
;
S TEMP=$G(^AUPNVICR(DA,12))
S DATA("EVENT D/T")=$P(TEMP,U,1)
S PXX=$P(TEMP,U,4)
S DATA("ENC PROVIDER")=PXX_U_$P($G(^VA(200,+PXX,0)),U,1)
S PXX=$P(TEMP,U,5)
I PXFILE=920.5 S DATA("REFUSED VACCINE GROUP")=$S(PXX="":1,1:PXX)
S DATA("COMMENTS")=$G(^AUPNVICR(DA,811))
S TEMP=$G(^AUPNVICR(DA,812))
I PXFILE=920.4 S DATA("CONTRAINDICATION/PRECAUTION")=$P($G(^PXV(920.4,PXVIEN,0)),U,5)
D SETPKGDS(TEMP,.DATA)
Q
;
;====================
VIMM(DA,DATA,CR) ;Return data, for a specified V Immunization entry.
;
I $G(CR)=1 D VIMMCR^PXPXRM1(DA,.DATA) Q
K ^TMP("PXVIMM",$J)
M ^TMP("PXVIMM",$J,DA)=^AUPNVIMM(DA)
D VIMM2^PXPXRM1(DA,.DATA)
K ^TMP("PXVIMM",$J)
Q
;
;====================
VPEDU(DA,DATA) ;Return data, for a specified V Patient ED entry.
N TEMP
S TEMP=^AUPNVPED(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S (DATA("LEVEL OF UNDERSTANDING"),DATA("VALUE"))=$P(TEMP,U,6)
S TEMP=$G(^AUPNVPED(DA,12))
S DATA("EVENT DATE AND TIME")=$P(TEMP,U,1)
S DATA("ORDERING PROVIDER")=$P(TEMP,U,2)
S DATA("ENCOUNTER PROVIDER")=$P(TEMP,U,4)
S DATA("MEASUREMENT")=$G(^AUPNVPED(DA,220))
S DATA("COMMENTS")=$G(^AUPNVPED(DA,811))
S TEMP=$G(^AUPNVPED(DA,812))
D SETPKGDS(TEMP,.DATA)
Q
;
;====================
VPOV(DA,DATA) ;Return data for a specified V POV entry.
N TEMP
S TEMP=^AUPNVPOV(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S DATA("PROVIDER NARRATIVE")=$P(TEMP,U,4)
S DATA("MODIFIER")=$P(TEMP,U,6)
S DATA("PRIMARY/SECONDARY")=$P(TEMP,U,12)
S DATA("DATE OF INJURY")=$P(TEMP,U,13)
S DATA("CLINICAL TERM")=$P(TEMP,U,15)
S DATA("PROBLEM LIST ENTRY")=$P(TEMP,U,16)
S DATA("EVENT DATE AND TIME")=$P($G(^AUPNVPOV(DA,12)),U,1)
S DATA("COMMENTS")=$G(^AUPNVPOV(DA,811))
S TEMP=$G(^AUPNVPOV(DA,812))
D SETPKGDS(TEMP,.DATA)
Q
;
;====================
VSCDATA(DA,DATA) ;Return data for a specified V Standard Codes entry.
N TEMP
S TEMP=^AUPNVSC(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S DATA("PROVIDER NARRATIVE")=$P(TEMP,U,4)
S TEMP=$G(^AUPNVSC(DA,12))
S DATA("EVENT DATE AND TIME")=$P(TEMP,U,1)
S DATA("ORDERING PROVIDER")=$P(TEMP,U,2)
S DATA("ENCOUNTER PROVIDER")=$P(TEMP,U,4)
S DATA("COMMENTS")=$G(^AUPNVSC(DA,811))
S DATA("MEASUREMENT")=$G(^AUPNVSC(DA,220))
S TEMP=$G(^AUPNVSC(DA,812))
D SETPKGDS(TEMP,.DATA)
Q
;
;====================
VSKIN(DA,DATA) ;Return data for a specified V Skin Test entry.
N PXPLACEIEN,PXX,TEMP
S TEMP=^AUPNVSK(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S (DATA("RESULTS"),DATA("VALUE"))=$P(TEMP,U,4)
S DATA("READING")=$P(TEMP,U,5)
S DATA("DATE READ")=$P(TEMP,U,6)
S DATA("COMMENTS")=$G(^AUPNVSK(DA,811))
;
; Fields below added in PX*1*216
;
S PXX=$P(TEMP,U,1)
S DATA("SKIN TEST")=PXX_$S(PXX:(U_$P($G(^AUTTSK(PXX,0)),U,1)),1:"")
S PXX=$P(TEMP,U,7)
S DATA("READER")=PXX_$S(PXX:(U_$P($G(^VA(200,PXX,0)),U,1)),1:"")
;
S TEMP=$G(^AUPNVSIT(+DATA("VISIT"),0))
S DATA("VISIT DATE TIME")=$P(TEMP,U,1)
S PXX=$P(TEMP,U,22)
S DATA("LOCATION")=PXX_$S(PXX:(U_$P($G(^SC(PXX,0)),U,1)),1:"")
S PXX=$P(TEMP,U,6)
S DATA("FACILITY")=PXX_$S(PXX:(U_$$NS^XUAF4(PXX)),1:"")
;
S TEMP=$G(^AUPNVSK(DA,12))
S DATA("HOURS READ")=$P(TEMP,U,14)
S DATA("D/T READING RECORDED")=$P(TEMP,U,20)
; if there is a linked placement entry, pull placement fields from there
S DATA("PLACEMENT IEN")=""
S DATA("PLACEMENT VISIT")=""
S DATA("PLACEMENT VISIT DATE TIME")=""
S DATA("PLACEMENT LOCATION")=""
S DATA("PLACEMENT FACILITY")=""
S DATA("PLACEMENT DATA SOURCE")=""
S PXPLACEIEN=$P(TEMP,U,8)
I PXPLACEIEN D
. S DATA("COMMENTS")=$G(^AUPNVSK(PXPLACEIEN,811))
. S DATA("PLACEMENT IEN")=PXPLACEIEN
. S DATA("PLACEMENT VISIT")=$P($G(^AUPNVSK(PXPLACEIEN,0)),U,3)
. S TEMP=$G(^AUPNVSIT(+DATA("PLACEMENT VISIT"),0))
. S DATA("PLACEMENT VISIT DATE TIME")=$P(TEMP,U,1)
. S PXX=$P(TEMP,U,22)
. S DATA("PLACEMENT LOCATION")=PXX_$S(PXX:(U_$P($G(^SC(PXX,0)),U,1)),1:"")
. S PXX=$P(TEMP,U,6)
. S DATA("PLACEMENT FACILITY")=PXX_$S(PXX:(U_$$NS^XUAF4(PXX)),1:"")
. S PXX=$P($G(^AUPNVSK(PXPLACEIEN,812)),U,3)
. S DATA("PLACEMENT DATA SOURCE")=PXX_$S(PXX:(U_$P($G(^PX(839.7,PXX,0)),U,1)),1:"")
. S TEMP=$G(^AUPNVSK(PXPLACEIEN,12))
S DATA("EVENT DATE AND TIME")=$P(TEMP,U,1)
S PXX=$P(TEMP,U,2)
S DATA("ORDERING PROVIDER")=PXX_$S(PXX:(U_$P($G(^VA(200,PXX,0)),U,1)),1:"")
S PXX=$P(TEMP,U,4)
S DATA("ENCOUNTER PROVIDER")=PXX_$S(PXX:(U_$P($G(^VA(200,PXX,0)),U,1)),1:"")
S DATA("D/T PLACEMENT RECORDED")=$P(TEMP,U,11)
S PXX=$P(TEMP,U,12)
S DATA("ANATOMIC LOC")=PXX_$S(PXX:(U_$P($G(^PXV(920.3,PXX,0)),U,2)_U_$P($G(^PXV(920.3,PXX,0)),U,1)),1:"")
;
S DATA("READING COMMENTS")=$G(^AUPNVSK(DA,13))
;
S TEMP=$G(^AUPNVSK(DA,812))
D SETPKGDS(TEMP,.DATA)
Q
;
;====================
VXAM(DA,DATA) ;Return data, for a specified V Exam entry.
N TEMP
S TEMP=^AUPNVXAM(DA,0)
S DATA("VISIT")=$P(TEMP,U,3)
S (DATA("RESULT"),DATA("VALUE"))=$P(TEMP,U,4)
S TEMP=$G(^AUPNVXAM(DA,12))
S DATA("EVENT DATE AND TIME")=$P(TEMP,U,1)
S DATA("ORDERING PROVIDER")=$P(TEMP,U,2)
S DATA("ENCOUNTER PROVIDER")=$P(TEMP,U,4)
S DATA("MEASUREMENT")=$G(^AUPNVXAM(DA,220))
S DATA("COMMENTS")=$G(^AUPNVXAM(DA,811))
S TEMP=$G(^AUPNVXAM(DA,812))
D SETPKGDS(TEMP,.DATA)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXPXRM 16305 printed Dec 13, 2024@02:29:53 Page 2
PXPXRM ;SLC/PKR - APIs for Clinical Reminder indexes. ;May 28, 2021@08:51:37
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**119,199,210,215,216,211,217**;Aug 12, 1996;Build 134
+2 ;
+3 ;Reference to ICDEX supported by ICR #5747.
+4 ;
+5 QUIT
+6 ;====================
KVFILE(FILENUM,X,DA) ;Delete indexes for a regular V File.
+1 ;X(1)=ITEM, X(2)=DFN, X(3)=VISIT IEN, X(4)=EVENT DATE AND TIME
+2 NEW CVX,VDATE,VISIT
+3 SET VISIT=$GET(^AUPNVSIT(X(3),0))
+4 IF VISIT=""
DO NOVISITMSG("KVFILE^PXPXRM",FILENUM,.X,DA)
QUIT
+5 ; For skin tests, set placement index when linked reading entry is deleted
+6 IF FILENUM=9000010.12
Begin DoDot:1
+7 NEW PXPLACESK,PXX
+8 SET PXPLACESK=$PIECE($GET(^AUPNVSK(DA,12)),U,8)
+9 IF 'PXPLACESK
QUIT
+10 SET PXX(1)=X(1)
+11 SET PXX(2)=X(2)
+12 SET PXX(3)=$PIECE($GET(^AUPNVSK(PXPLACESK,0)),U,3)
+13 IF 'PXX(3)
QUIT
+14 SET PXX(4)=$PIECE($GET(^AUPNVSK(PXPLACESK,12)),U,1)
+15 DO SVFILE(FILENUM,.PXX,PXPLACESK)
End DoDot:1
+16 ; For skin tests, use Date Read
+17 IF FILENUM=9000010.12
SET VDATE=$GET(X(5))
+18 IF $GET(VDATE)=""
SET VDATE=$GET(X(4))
+19 IF VDATE=""
SET VDATE=$PIECE(VISIT,U,1)
+20 ;
+21 IF FILENUM=9000010.11
Begin DoDot:1
+22 ;If V IMMUNIZATION: kill CVX index.
+23 SET CVX=$PIECE($GET(^AUTTIMM(X(1),0)),U,3)
+24 IF CVX'=""
Begin DoDot:2
+25 KILL ^PXRMINDX(FILENUM,"CVX","IP",CVX,X(2),VDATE,DA)
+26 KILL ^PXRMINDX(FILENUM,"CVX","PI",X(2),CVX,VDATE,DA)
End DoDot:2
End DoDot:1
+27 ;
+28 KILL ^PXRMINDX(FILENUM,"IP",X(1),X(2),VDATE,DA)
+29 KILL ^PXRMINDX(FILENUM,"PI",X(2),X(1),VDATE,DA)
+30 QUIT
+31 ;
+32 ;====================
KVFILEC(FILENUM,X,DA) ;Delete indexes for V Files with coded entries.
+1 ; FILENUM = file number, e.g. 9000010.07
+2 ; X = Array of fields
+3 ; X(1)=Item pointer: Dx for V POV, CPT for V CPT
+4 ; X(2)=PATIENT NAME (DFN)
+5 ; X(3)=VISIT (ptr to 9000010)
+6 ; X(4)=PRIMARY/SECONDARY for V POV
+7 ; or PRINCIPAL PROCEDURE FOR V CPT
+8 ; X(5)=EVENT DATE AND TIME
+9 ; DA = IEN into FILENUM file
+10 ;
+11 NEW CODE,CTYPE,PXCSYS,VDATE,VISIT
+12 SET VISIT=$GET(^AUPNVSIT(X(3),0))
+13 IF VISIT=""
DO NOVISITMSG("KVFILEC^PXPXRM",FILENUM,.X,DA)
QUIT
+14 SET CTYPE=$SELECT(X(4)="":"U",1:X(4))
+15 SET VDATE=$GET(X(5))
+16 IF VDATE=""
SET VDATE=$PIECE(VISIT,U,1)
+17 SET PXCSYS="ICD"
+18 ;If V POV get coding system.
+19 ; coding system abbreviation
IF FILENUM=9000010.07
SET PXCSYS=$PIECE($$SINFO^ICDEX($$CSI^ICDEX(80,X(1))),U,3)
+20 ;I PXCSYS'="ICD" D KVFILEV Q ; if not ICD-9, use alternate format and Quit
+21 IF PXCSYS'="ICD"
Begin DoDot:1
+22 ;Coding system code format
+23 ; convert IEN to Dx code
SET CODE=$$CODEC^ICDEX(80,X(1))
+24 KILL ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),VDATE,DA)
+25 KILL ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,VDATE,DA)
End DoDot:1
QUIT
+26 ;Original format used for V CPT and ICD-9 diagnoses
+27 KILL ^PXRMINDX(FILENUM,"IPP",X(1),CTYPE,X(2),VDATE,DA)
+28 KILL ^PXRMINDX(FILENUM,"PPI",X(2),CTYPE,X(1),VDATE,DA)
+29 QUIT
+30 ;
+31 ;====================
KVFILEV ; alternate index format for ICD-10 and higher, added with PX*1.0*199
+1 ; convert IEN to Dx code
SET CODE=$$CODEC^ICDEX(80,X(1))
+2 KILL ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),VDATE,DA)
+3 KILL ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,VDATE,DA)
+4 QUIT
+5 ;
+6 ;====================
NOVISITMSG(ROUTINE,FILENUM,X,DA) ;Send a message when there is no visit file entry.
+1 NEW IND,NL,NODE,SUBJECT
+2 SET NODE="PXNOVISIT"
+3 KILL ^TMP(NODE,$JOB)
+4 SET ^TMP(NODE,$JOB,1,0)="ROUTINE: "_ROUTINE
+5 SET ^TMP(NODE,$JOB,2,0)="File Number: "_FILENUM
+6 SET ^TMP(NODE,$JOB,3,0)="DA="_DA
+7 SET IND=0
SET NL=3
+8 FOR
SET IND=$ORDER(X(IND))
if IND=""
QUIT
SET NL=NL+1
SET ^TMP(NODE,$JOB,NL,0)="X("_IND_")="_X(IND)
+9 SET NL=NL+1
SET ^TMP(NODE,$JOB,NL,0)="An error has been generated to save the Stack in the Error Trap"
+10 SET NL=NL+1
SET ^TMP(NODE,$JOB,NL,0)="Date and Time: "_$$FMTE^XLFDT($$NOW^XLFDT,2)
+11 SET SUBJECT="PROBLEM SETTING/KILLING REMINDERS INDEX - NO VISIT"
+12 DO SEND^PXMSG(NODE,SUBJECT)
+13 ;Generate an error to save the Stack.
+14 NEW $ESTACK,$ETRAP,UNDEFINED
+15 SET $ETRAP="D SAVESTACK^PXPXRM"
+16 SET SUBJECT=UNDEFINED
+17 QUIT
+18 ;
+19 ;====================
SAVESTACK ;Save the Stack in the Error Trap.
+1 DO ^%ZTER
+2 DO UNWIND^%ZTER
+3 QUIT
+4 ;
+5 ;====================
SETPKGDS(TEMP,DATA) ;Set the Package and Data Source.
+1 NEW PTEMP
+2 SET PTEMP=$PIECE(TEMP,U,2)
+3 SET DATA("PACKAGE")=PTEMP_$SELECT(PTEMP:U_$$GET1^DIQ(9.4,PTEMP,.01),1:"")
+4 SET PTEMP=$PIECE(TEMP,U,3)
+5 SET DATA("DATA SOURCE")=PTEMP_$SELECT(PTEMP:(U_$PIECE($GET(^PX(839.7,PTEMP,0)),U,1)),1:"")
+6 QUIT
+7 ;
+8 ;====================
SVFILE(FILENUM,X,DA) ;Set indexes for a regular V File.
+1 ;X(1)=ITEM, X(2)=DFN, X(3)=VISIT IEN, X(4)=EVENT DATE AND TIME
+2 ;for skin tests X(5)=DATE READ
+3 NEW CVX,DATE,VISIT
+4 ;
+5 ; Don't index a placement skin test that is linked to a reading skin test
+6 IF FILENUM=9000010.12
IF $DATA(^AUPNVSK("APT",DA))
QUIT
+7 ; If this is a reading skin test, delete linked placement skin test index
+8 IF FILENUM=9000010.12
Begin DoDot:1
+9 NEW PXPLACESK,PXX
+10 SET PXPLACESK=$PIECE($GET(^AUPNVSK(DA,12)),U,8)
+11 IF 'PXPLACESK
QUIT
+12 SET PXX(1)=X(1)
+13 SET PXX(2)=X(2)
+14 SET PXX(3)=$PIECE($GET(^AUPNVSK(PXPLACESK,0)),U,3)
+15 IF 'PXX(3)
QUIT
+16 SET PXX(4)=$PIECE($GET(^AUPNVSK(PXPLACESK,12)),U,1)
+17 DO KVFILE(FILENUM,.PXX,PXPLACESK)
End DoDot:1
+18 ;
+19 SET VISIT=$GET(^AUPNVSIT(X(3),0))
+20 IF VISIT=""
DO NOVISITMSG("SVFILE^PXPXRM",FILENUM,.X,DA)
QUIT
+21 ; For skin tests, use Date Read
+22 IF FILENUM=9000010.12
SET DATE=$GET(X(5))
+23 IF $GET(DATE)=""
SET DATE=$GET(X(4))
+24 IF DATE=""
SET DATE=$PIECE(VISIT,U,1)
+25 ;
+26 IF FILENUM=9000010.11
Begin DoDot:1
+27 ; If V IMMUNIZATION: set CVX index.
+28 SET CVX=$PIECE($GET(^AUTTIMM(X(1),0)),U,3)
+29 IF CVX'=""
Begin DoDot:2
+30 SET ^PXRMINDX(FILENUM,"CVX","IP",CVX,X(2),DATE,DA)=""
+31 SET ^PXRMINDX(FILENUM,"CVX","PI",X(2),CVX,DATE,DA)=""
End DoDot:2
End DoDot:1
+32 ;
+33 SET ^PXRMINDX(FILENUM,"IP",X(1),X(2),DATE,DA)=""
+34 SET ^PXRMINDX(FILENUM,"PI",X(2),X(1),DATE,DA)=""
+35 QUIT
+36 ;
+37 ;====================
SVFILEC(FILENUM,X,DA) ;Set indexes for V Files with coded entries. These
+1 ;are V CPT and VPOV.
+2 ;X(1)=ITEM, X(2)=DFN, X(3)=VISIT IEN,
+3 ; for V CPT X(4)=PRINCIPAL PROCEDURE
+4 ; for V POV X(4)=PRIMARY/SECONDARY
+5 ;X(5)=EVENT DATE AND TIME
+6 NEW CODE,CTYPE,DATE,PXCSYS,VISIT
+7 SET VISIT=$GET(^AUPNVSIT(X(3),0))
+8 IF VISIT=""
DO NOVISITMSG("SVFILEC^PXPXRM",FILENUM,.X,DA)
QUIT
+9 SET CTYPE=$SELECT(X(4)="":"U",1:X(4))
+10 SET DATE=$GET(X(5))
+11 IF DATE=""
SET DATE=$PIECE(VISIT,U,1)
+12 SET PXCSYS="ICD"
+13 ;If V POV get coding system.
+14 ; coding system abbreviation
IF FILENUM=9000010.07
SET PXCSYS=$PIECE($$SINFO^ICDEX($$CSI^ICDEX(80,X(1))),U,3)
+15 ;I PXCSYS'="ICD" D SVFILEV Q ; if not ICD-9 use alternate format and Quit
+16 IF PXCSYS'="ICD"
Begin DoDot:1
+17 ;Coding system code format
+18 SET CODE=$$CODEC^ICDEX(80,X(1))
+19 SET ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),DATE,DA)=""
+20 SET ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,DATE,DA)=""
End DoDot:1
QUIT
+21 ;Original format used for V CPT and ICD-9 diagnoses
+22 SET ^PXRMINDX(FILENUM,"IPP",X(1),CTYPE,X(2),DATE,DA)=""
+23 SET ^PXRMINDX(FILENUM,"PPI",X(2),CTYPE,X(1),DATE,DA)=""
+24 QUIT
+25 ;
+26 ;====================
SVFILEV ; alternate index format for ICD-10 and higher, added with PX*1.0*199
+1 ; convert IEN to Dx code
SET CODE=$$CODEC^ICDEX(80,X(1))
+2 SET ^PXRMINDX(FILENUM,PXCSYS,"IPP",CODE,CTYPE,X(2),VDATE,DA)=""
+3 SET ^PXRMINDX(FILENUM,PXCSYS,"PPI",X(2),CTYPE,CODE,VDATE,DA)=""
+4 QUIT
+5 ;
+6 ;====================
VICRFILE(X,DA,PXACTION) ;Set/Kill indexes for V Imm Contra/Refusal Events.
+1 ;
+2 ; Inputs:
+3 ; X - X(1)=Contra/Refusal, X(2)=DFN, X(3)=Visit
+4 ; X(4)=Immunization, X(5)=Event Date and Time
+5 ; X(6)=Warn Until Date
+6 ; DA - V Imm Contra/Refusal Events IEN
+7 ; PXACTION - "S": Set index
+8 ; "K": Kill index
+9 ;
+10 NEW FILENUM,VISIT,VDATE,START,STOP
+11 ;
+12 SET FILENUM=9000010.707
+13 SET VISIT=$GET(^AUPNVSIT(X(3),0))
+14 IF VISIT=""
DO NOVISITMSG("VICRFILE^PXPXRM",9000010.707,.X,DA)
QUIT
+15 SET VDATE=$PIECE(VISIT,U,1)
+16 ;
+17 SET START=VDATE
+18 IF $GET(X(5))
SET START=X(5)
+19 ;
+20 SET STOP=9999999
+21 IF $GET(X(6))
SET STOP=X(6)
+22 ;
+23 IF PXACTION="S"
Begin DoDot:1
+24 SET ^PXRMINDX(FILENUM,"ICP",X(4),X(1),X(2),START,STOP,DA)=""
+25 SET ^PXRMINDX(FILENUM,"PIC",X(2),X(4),X(1),START,STOP,DA)=""
+26 SET ^PXRMINDX(FILENUM,"CIP",X(1),X(4),X(2),START,STOP,DA)=""
+27 SET ^PXRMINDX(FILENUM,"PCI",X(2),X(1),X(4),START,STOP,DA)=""
End DoDot:1
+28 IF PXACTION="K"
Begin DoDot:1
+29 KILL ^PXRMINDX(FILENUM,"ICP",X(4),X(1),X(2),START,STOP,DA)
+30 KILL ^PXRMINDX(FILENUM,"PIC",X(2),X(4),X(1),START,STOP,DA)
+31 KILL ^PXRMINDX(FILENUM,"CIP",X(1),X(4),X(2),START,STOP,DA)
+32 KILL ^PXRMINDX(FILENUM,"PCI",X(2),X(1),X(4),START,STOP,DA)
End DoDot:1
+33 QUIT
+34 ;
+35 ;====================
UPDCVX(IMM,CVXOLD,CVXNEW) ;
+1 ; Update CVX Index on V Immunization file
+2 ; Called from ACR cross-reference on Immunization file
+3 NEW DA,PXDESC,PXRTN,PXTASK,PXVAR,PXVOTH,X,X1,X2
+4 IF CVXOLD=CVXNEW
QUIT
+5 SET PXRTN="UPDCVXT^PXPXRM"
+6 SET PXDESC="Clinical Reminders CVX index update for V IMMUNIZATION"
+7 SET PXVAR="IMM;CVXOLD;CVXNEW"
+8 SET PXVOTH("ZTDTH")=$$NOW^XLFDT
+9 SET PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,PXVAR,.PXVOTH)
+10 IF PXTASK=-1
DO UPDCVXT^PXPXRM
+11 QUIT
+12 ;
+13 ;====================
UPDCVXT ;Tasked from UPDCVX.
+1 ;Variables IMM, CVXOLD, and CVXNEW passed in via task
+2 SET ZTREQ="@"
+3 NEW DATE,DFN,EDATE,VIMM,VISIT
+4 SET VIMM=0
+5 FOR
SET VIMM=$ORDER(^AUPNVIMM("B",IMM,VIMM))
if 'VIMM
QUIT
Begin DoDot:1
+6 SET DFN=$PIECE($GET(^AUPNVIMM(VIMM,0)),U,2)
+7 IF 'DFN
QUIT
+8 SET VISIT=$PIECE($GET(^AUPNVIMM(VIMM,0)),U,3)
+9 SET VISIT=$GET(^AUPNVSIT(+VISIT,0))
+10 IF VISIT=""
DO NOVISITMSG("UPDCVXT^PXPXRM",9000010.11,.X,DA)
QUIT
+11 SET DATE=$PIECE(VISIT,U,1)
+12 SET EDATE=$PIECE($GET(^AUPNVIMM(VIMM,12)),U,1)
+13 IF EDATE
SET DATE=EDATE
+14 IF 'DATE
QUIT
+15 IF CVXOLD'=""
Begin DoDot:2
+16 KILL ^PXRMINDX(9000010.11,"CVX","IP",CVXOLD,DFN,DATE,VIMM)
+17 KILL ^PXRMINDX(9000010.11,"CVX","PI",DFN,CVXOLD,DATE,VIMM)
End DoDot:2
+18 IF CVXNEW'=""
Begin DoDot:2
+19 SET ^PXRMINDX(9000010.11,"CVX","IP",CVXNEW,DFN,DATE,VIMM)=""
+20 SET ^PXRMINDX(9000010.11,"CVX","PI",DFN,CVXNEW,DATE,VIMM)=""
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;====================
VCPT(DA,DATA) ;Return data for a specified V CPT entry.
+1 NEW TEMP
+2 SET TEMP=^AUPNVCPT(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET DATA("PROVIDER NARRATIVE")=$PIECE(TEMP,U,4)
+5 SET DATA("DIAGNOSIS")=$PIECE(TEMP,U,5)
+6 SET DATA("DIAGNOSIS 2")=$PIECE(TEMP,U,9)
+7 SET DATA("DIAGNOSIS 3")=$PIECE(TEMP,U,10)
+8 SET DATA("DIAGNOSIS 4")=$PIECE(TEMP,U,11)
+9 SET DATA("DIAGNOSIS 5")=$PIECE(TEMP,U,12)
+10 SET DATA("DIAGNOSIS 6")=$PIECE(TEMP,U,13)
+11 SET DATA("DIAGNOSIS 7")=$PIECE(TEMP,U,14)
+12 SET DATA("DIAGNOSIS 8")=$PIECE(TEMP,U,15)
+13 SET DATA("PRINCIPAL PROCEDURE")=$PIECE(TEMP,U,7)
+14 SET DATA("QUANTITY")=$PIECE(TEMP,U,16)
+15 SET TEMP=$GET(^AUPNVCPT(DA,12))
+16 SET DATA("EVENT DATE AND TIME")=$PIECE(TEMP,U,1)
+17 SET DATA("ORDERING PROVIDER")=$PIECE(TEMP,U,2)
+18 SET DATA("ENCOUNTER PROVIDER")=$PIECE(TEMP,U,4)
+19 SET DATA("COMMENTS")=$GET(^AUPNVCPT(DA,811))
+20 SET TEMP=$GET(^AUPNVCPT(DA,812))
+21 DO SETPKGDS(TEMP,.DATA)
+22 QUIT
+23 ;
+24 ;====================
VHF(DA,DATA) ;Return data for a specified V Health Factor entry.
+1 NEW TEMP
+2 SET TEMP=^AUPNVHF(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET (DATA("LEVEL/SEVERITY"),DATA("VALUE"))=$PIECE(TEMP,U,4)
+5 SET TEMP=$GET(^AUPNVHF(DA,12))
+6 SET DATA("EVENT DATE AND TIME")=$PIECE(TEMP,U,1)
+7 SET DATA("ORDERING PROVIDER")=$PIECE(TEMP,U,2)
+8 SET DATA("ENCOUNTER PROVIDER")=$PIECE(TEMP,U,4)
+9 SET DATA("MEASUREMENT")=$GET(^AUPNVHF(DA,220))
+10 SET DATA("COMMENTS")=$GET(^AUPNVHF(DA,811))
+11 SET TEMP=$GET(^AUPNVHF(DA,812))
+12 DO SETPKGDS(TEMP,.DATA)
+13 QUIT
+14 ;
+15 ;====================
VICR(DA,DATA) ;Return data, for a specified V Imm Contra/Refusal Events entry.
+1 NEW PXFILE,PXVIEN,PXX,TEMP
+2 SET TEMP=^AUPNVICR(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET PXX=$PIECE(TEMP,U,1)
SET PXFILE=+$PIECE(PXX,"(",2)
SET PXVIEN=$PIECE(PXX,";",1)
+5 SET DATA("CONTRA/REFUSAL")=PXX_U_$PIECE($GET(^PXV(PXFILE,+PXX,0)),U,1)
+6 SET PXX=$PIECE(TEMP,U,4)
+7 SET DATA("IMMUN")=PXX_U_$PIECE($GET(^AUTTIMM(+PXX,0)),U,1)
+8 SET DATA("WARN UNTIL DATE")=$PIECE(TEMP,U,5)
+9 SET DATA("D/T RECORDED")=$PIECE(TEMP,U,6)
+10 ;
+11 SET TEMP=$GET(^AUPNVICR(DA,12))
+12 SET DATA("EVENT D/T")=$PIECE(TEMP,U,1)
+13 SET PXX=$PIECE(TEMP,U,4)
+14 SET DATA("ENC PROVIDER")=PXX_U_$PIECE($GET(^VA(200,+PXX,0)),U,1)
+15 SET PXX=$PIECE(TEMP,U,5)
+16 IF PXFILE=920.5
SET DATA("REFUSED VACCINE GROUP")=$SELECT(PXX="":1,1:PXX)
+17 SET DATA("COMMENTS")=$GET(^AUPNVICR(DA,811))
+18 SET TEMP=$GET(^AUPNVICR(DA,812))
+19 IF PXFILE=920.4
SET DATA("CONTRAINDICATION/PRECAUTION")=$PIECE($GET(^PXV(920.4,PXVIEN,0)),U,5)
+20 DO SETPKGDS(TEMP,.DATA)
+21 QUIT
+22 ;
+23 ;====================
VIMM(DA,DATA,CR) ;Return data, for a specified V Immunization entry.
+1 ;
+2 IF $GET(CR)=1
DO VIMMCR^PXPXRM1(DA,.DATA)
QUIT
+3 KILL ^TMP("PXVIMM",$JOB)
+4 MERGE ^TMP("PXVIMM",$JOB,DA)=^AUPNVIMM(DA)
+5 DO VIMM2^PXPXRM1(DA,.DATA)
+6 KILL ^TMP("PXVIMM",$JOB)
+7 QUIT
+8 ;
+9 ;====================
VPEDU(DA,DATA) ;Return data, for a specified V Patient ED entry.
+1 NEW TEMP
+2 SET TEMP=^AUPNVPED(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET (DATA("LEVEL OF UNDERSTANDING"),DATA("VALUE"))=$PIECE(TEMP,U,6)
+5 SET TEMP=$GET(^AUPNVPED(DA,12))
+6 SET DATA("EVENT DATE AND TIME")=$PIECE(TEMP,U,1)
+7 SET DATA("ORDERING PROVIDER")=$PIECE(TEMP,U,2)
+8 SET DATA("ENCOUNTER PROVIDER")=$PIECE(TEMP,U,4)
+9 SET DATA("MEASUREMENT")=$GET(^AUPNVPED(DA,220))
+10 SET DATA("COMMENTS")=$GET(^AUPNVPED(DA,811))
+11 SET TEMP=$GET(^AUPNVPED(DA,812))
+12 DO SETPKGDS(TEMP,.DATA)
+13 QUIT
+14 ;
+15 ;====================
VPOV(DA,DATA) ;Return data for a specified V POV entry.
+1 NEW TEMP
+2 SET TEMP=^AUPNVPOV(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET DATA("PROVIDER NARRATIVE")=$PIECE(TEMP,U,4)
+5 SET DATA("MODIFIER")=$PIECE(TEMP,U,6)
+6 SET DATA("PRIMARY/SECONDARY")=$PIECE(TEMP,U,12)
+7 SET DATA("DATE OF INJURY")=$PIECE(TEMP,U,13)
+8 SET DATA("CLINICAL TERM")=$PIECE(TEMP,U,15)
+9 SET DATA("PROBLEM LIST ENTRY")=$PIECE(TEMP,U,16)
+10 SET DATA("EVENT DATE AND TIME")=$PIECE($GET(^AUPNVPOV(DA,12)),U,1)
+11 SET DATA("COMMENTS")=$GET(^AUPNVPOV(DA,811))
+12 SET TEMP=$GET(^AUPNVPOV(DA,812))
+13 DO SETPKGDS(TEMP,.DATA)
+14 QUIT
+15 ;
+16 ;====================
VSCDATA(DA,DATA) ;Return data for a specified V Standard Codes entry.
+1 NEW TEMP
+2 SET TEMP=^AUPNVSC(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET DATA("PROVIDER NARRATIVE")=$PIECE(TEMP,U,4)
+5 SET TEMP=$GET(^AUPNVSC(DA,12))
+6 SET DATA("EVENT DATE AND TIME")=$PIECE(TEMP,U,1)
+7 SET DATA("ORDERING PROVIDER")=$PIECE(TEMP,U,2)
+8 SET DATA("ENCOUNTER PROVIDER")=$PIECE(TEMP,U,4)
+9 SET DATA("COMMENTS")=$GET(^AUPNVSC(DA,811))
+10 SET DATA("MEASUREMENT")=$GET(^AUPNVSC(DA,220))
+11 SET TEMP=$GET(^AUPNVSC(DA,812))
+12 DO SETPKGDS(TEMP,.DATA)
+13 QUIT
+14 ;
+15 ;====================
VSKIN(DA,DATA) ;Return data for a specified V Skin Test entry.
+1 NEW PXPLACEIEN,PXX,TEMP
+2 SET TEMP=^AUPNVSK(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET (DATA("RESULTS"),DATA("VALUE"))=$PIECE(TEMP,U,4)
+5 SET DATA("READING")=$PIECE(TEMP,U,5)
+6 SET DATA("DATE READ")=$PIECE(TEMP,U,6)
+7 SET DATA("COMMENTS")=$GET(^AUPNVSK(DA,811))
+8 ;
+9 ; Fields below added in PX*1*216
+10 ;
+11 SET PXX=$PIECE(TEMP,U,1)
+12 SET DATA("SKIN TEST")=PXX_$SELECT(PXX:(U_$PIECE($GET(^AUTTSK(PXX,0)),U,1)),1:"")
+13 SET PXX=$PIECE(TEMP,U,7)
+14 SET DATA("READER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,PXX,0)),U,1)),1:"")
+15 ;
+16 SET TEMP=$GET(^AUPNVSIT(+DATA("VISIT"),0))
+17 SET DATA("VISIT DATE TIME")=$PIECE(TEMP,U,1)
+18 SET PXX=$PIECE(TEMP,U,22)
+19 SET DATA("LOCATION")=PXX_$SELECT(PXX:(U_$PIECE($GET(^SC(PXX,0)),U,1)),1:"")
+20 SET PXX=$PIECE(TEMP,U,6)
+21 SET DATA("FACILITY")=PXX_$SELECT(PXX:(U_$$NS^XUAF4(PXX)),1:"")
+22 ;
+23 SET TEMP=$GET(^AUPNVSK(DA,12))
+24 SET DATA("HOURS READ")=$PIECE(TEMP,U,14)
+25 SET DATA("D/T READING RECORDED")=$PIECE(TEMP,U,20)
+26 ; if there is a linked placement entry, pull placement fields from there
+27 SET DATA("PLACEMENT IEN")=""
+28 SET DATA("PLACEMENT VISIT")=""
+29 SET DATA("PLACEMENT VISIT DATE TIME")=""
+30 SET DATA("PLACEMENT LOCATION")=""
+31 SET DATA("PLACEMENT FACILITY")=""
+32 SET DATA("PLACEMENT DATA SOURCE")=""
+33 SET PXPLACEIEN=$PIECE(TEMP,U,8)
+34 IF PXPLACEIEN
Begin DoDot:1
+35 SET DATA("COMMENTS")=$GET(^AUPNVSK(PXPLACEIEN,811))
+36 SET DATA("PLACEMENT IEN")=PXPLACEIEN
+37 SET DATA("PLACEMENT VISIT")=$PIECE($GET(^AUPNVSK(PXPLACEIEN,0)),U,3)
+38 SET TEMP=$GET(^AUPNVSIT(+DATA("PLACEMENT VISIT"),0))
+39 SET DATA("PLACEMENT VISIT DATE TIME")=$PIECE(TEMP,U,1)
+40 SET PXX=$PIECE(TEMP,U,22)
+41 SET DATA("PLACEMENT LOCATION")=PXX_$SELECT(PXX:(U_$PIECE($GET(^SC(PXX,0)),U,1)),1:"")
+42 SET PXX=$PIECE(TEMP,U,6)
+43 SET DATA("PLACEMENT FACILITY")=PXX_$SELECT(PXX:(U_$$NS^XUAF4(PXX)),1:"")
+44 SET PXX=$PIECE($GET(^AUPNVSK(PXPLACEIEN,812)),U,3)
+45 SET DATA("PLACEMENT DATA SOURCE")=PXX_$SELECT(PXX:(U_$PIECE($GET(^PX(839.7,PXX,0)),U,1)),1:"")
+46 SET TEMP=$GET(^AUPNVSK(PXPLACEIEN,12))
End DoDot:1
+47 SET DATA("EVENT DATE AND TIME")=$PIECE(TEMP,U,1)
+48 SET PXX=$PIECE(TEMP,U,2)
+49 SET DATA("ORDERING PROVIDER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,PXX,0)),U,1)),1:"")
+50 SET PXX=$PIECE(TEMP,U,4)
+51 SET DATA("ENCOUNTER PROVIDER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,PXX,0)),U,1)),1:"")
+52 SET DATA("D/T PLACEMENT RECORDED")=$PIECE(TEMP,U,11)
+53 SET PXX=$PIECE(TEMP,U,12)
+54 SET DATA("ANATOMIC LOC")=PXX_$SELECT(PXX:(U_$PIECE($GET(^PXV(920.3,PXX,0)),U,2)_U_$PIECE($GET(^PXV(920.3,PXX,0)),U,1)),1:"")
+55 ;
+56 SET DATA("READING COMMENTS")=$GET(^AUPNVSK(DA,13))
+57 ;
+58 SET TEMP=$GET(^AUPNVSK(DA,812))
+59 DO SETPKGDS(TEMP,.DATA)
+60 QUIT
+61 ;
+62 ;====================
VXAM(DA,DATA) ;Return data, for a specified V Exam entry.
+1 NEW TEMP
+2 SET TEMP=^AUPNVXAM(DA,0)
+3 SET DATA("VISIT")=$PIECE(TEMP,U,3)
+4 SET (DATA("RESULT"),DATA("VALUE"))=$PIECE(TEMP,U,4)
+5 SET TEMP=$GET(^AUPNVXAM(DA,12))
+6 SET DATA("EVENT DATE AND TIME")=$PIECE(TEMP,U,1)
+7 SET DATA("ORDERING PROVIDER")=$PIECE(TEMP,U,2)
+8 SET DATA("ENCOUNTER PROVIDER")=$PIECE(TEMP,U,4)
+9 SET DATA("MEASUREMENT")=$GET(^AUPNVXAM(DA,220))
+10 SET DATA("COMMENTS")=$GET(^AUPNVXAM(DA,811))
+11 SET TEMP=$GET(^AUPNVXAM(DA,812))
+12 DO SETPKGDS(TEMP,.DATA)
+13 QUIT
+14 ;
