- 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 Jan 18, 2025@03:30: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 ;