PXPXRM1 ;SLC/PKR - APIs for Clinical Reminder indexes, cont. ;02/14/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
;
; Reference to NAME in file .85 is supported by ICR #6062.
;
Q
;
;====================
VIMM2(DA,DATA) ; Internal function
; Works off ^TMP global instead of ^AUPNVIMM;
; this way it can also return data for deletes and edits.
;
N DU,IND,PXCS,PXCSIEN,PXCDIEN,PXCODE,PXIEN,PXTEMP,PXVIMM,PXVISIT,PXX
N TEMP
;
S PXTEMP=^TMP("PXVIMM",$J,DA,0)
S PXVIMM=$P(PXTEMP,U,1)
S PXVISIT=$P(PXTEMP,U,3)
S DATA("VISIT")=PXVISIT
S (DATA("SERIES"),DATA("VALUE"))=$P(PXTEMP,U,4)
S DATA("REACTION")=$P(PXTEMP,U,6)
;CONTRAINDICATED removed in PX*1.0*217, it is no longer used.
;S DATA("CONTRAINDICATED")=$P(PXTEMP,U,7)
S DATA("COMMENTS")=$G(^TMP("PXVIMM",$J,DA,811))
;
S PXTEMP=$G(^AUPNVSIT(+PXVISIT,0))
S DATA("VISIT DATE TIME")=$P(PXTEMP,U,1)
S PXX=+$P(PXTEMP,U,22),TEMP=""
I PXX>0 S TEMP=$P($G(^SC(PXX,0)),U,1)
I TEMP="" S TEMP="Invalid Location"
S DATA("LOCATION")=PXX_U_TEMP
S PXX=$P(PXTEMP,U,6)
S DATA("FACILITY")=PXX_$S(PXX:(U_$$NS^XUAF4(PXX)),1:"")
;
S PXTEMP=$G(^TMP("PXVIMM",$J,DA,12))
S DATA("EVENT DATE AND TIME")=$P(PXTEMP,U,1)
S PXX=$P(PXTEMP,U,2)
S DATA("ORDERING PROVIDER")=PXX_$S(PXX:(U_$P($G(^VA(200,+PXX,0)),U,1)),1:"")
S PXX=$P(PXTEMP,U,4)
S DATA("ENCOUNTER PROVIDER")=PXX_$S(PXX:(U_$P($G(^VA(200,+PXX,0)),U,1)),1:"")
S DATA("DATE RECORDED")=$P(PXTEMP,U,5)
S PXX=$P(PXTEMP,U,6)
S DATA("DOCUMENTER")=PXX_$S(PXX:(U_$P($G(^VA(200,+PXX,0)),U,1)),1:"")
S PXX=+$P(PXTEMP,U,7)
I PXX>0 D
. S DATA("LOT NUMBER")=PXX_U_$P($G(^AUTTIML(PXX,0)),U,1)
. S DATA("NDC CODE (VA)")=$P($G(^AUTTIML(PXX,0)),U,18)
E S DATA("LOT NUMBER")=""
S DATA("WARNING ACK")=$P(PXTEMP,U,20)
S DATA("ORDERED BY POLICY")=$P(PXTEMP,U,22)
;
S PXTEMP=$G(^AUTTIML(+$P(PXTEMP,U,7),0))
S PXX=$P(PXTEMP,U,2)
S DATA("MANUFACTURER")=PXX_$S(PXX:(U_$P($G(^AUTTIMAN(+PXX,0)),U,1)),1:"")
S DATA("EXPIRATION DATE")=$P(PXTEMP,U,9)
;
S PXTEMP=$G(^TMP("PXVIMM",$J,DA,13))
S PXX=$P(PXTEMP,U,1)
S DATA("INFO SOURCE")=PXX_$S(PXX:(U_$P($G(^PXV(920.1,+PXX,0)),U,2)_U_$P($G(^PXV(920.1,+PXX,0)),U,1)),1:"")
S PXX=$P(PXTEMP,U,2)
S DATA("ADMIN ROUTE")=PXX_$S(PXX:(U_$P($G(^PXV(920.2,+PXX,0)),U,2)_U_$P($G(^PXV(920.2,+PXX,0)),U,1)),1:"")
S PXX=$P(PXTEMP,U,3)
S DATA("ADMIN SITE")=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("DOSE")=$$EXTERNAL^DILFD(9000010.11,1312,"",$P(PXTEMP,U,12))
S DU=$P(PXTEMP,U,13)
S DATA("DOSE UNITS")=$S(DU="":"",1:$$UCUMCODE^LEXMUCUM(DU))
;
S PXTEMP=$G(^TMP("PXVIMM",$J,DA,14))
S DATA("RESULTS")=$P(PXTEMP,U,1)
S DATA("READING")=$P(PXTEMP,U,2)
S DATA("DATE READ")=$P(PXTEMP,U,3)
S PXX=$P(PXTEMP,U,4)
S DATA("READER")=PXX_$S(PXX:(U_$P($G(^VA(200,PXX,0)),U,1)),1:"")
S DATA("D/T READING RECORDED")=$P(PXTEMP,U,5)
S DATA("HOURS READ")=$P(PXTEMP,U,6)
S DATA("READING COMMENTS")=$G(^TMP("PXVIMM",$J,DA,15))
;
S DATA("OVERRIDE REASON")=$G(^TMP("PXVIMM",$J,DA,16))
;
S PXTEMP=$G(^AUTTIMM(+PXVIMM,0))
S DATA("IMMUNIZATION")=PXVIMM_$S(PXVIMM:(U_$P(PXTEMP,U,1)),1:"")
S DATA("CVX")=$P(PXTEMP,U,3)
S DATA("MAX # IN SERIES")=$P(PXTEMP,U,5)
;CDC Full Vaccine Name is a word-processing field, return as a string.
S IND=0,PXTEMP=""
F S IND=+$O(^AUTTIMM(PXVIMM,2,IND)) Q:IND=0 S PXTEMP=PXTEMP_^AUTTIMM(PXVIMM,2,IND,0)
S DATA("CDC FULL VACCINE NAME")=PXTEMP
;
S PXIEN=0
F S PXIEN=$O(^AUTTIMM(PXVIMM,7,PXIEN)) Q:'PXIEN D
. S PXTEMP=$P($G(^AUTTIMM(PXVIMM,7,PXIEN,0)),U,1)
. I PXTEMP="" Q
. S DATA("VACCINE GROUP",PXIEN,0)=PXTEMP
;
;S DATA("CODES",Coding System Name)=Code 1 ^ Code 2 ^ ... Code x
S PXCSIEN=0
F S PXCSIEN=$O(^AUTTIMM(PXVIMM,3,PXCSIEN)) Q:'PXCSIEN D
. S PXCS=$P($G(^AUTTIMM(PXVIMM,3,PXCSIEN,0)),U,1)
. I PXCS="" Q
. S PXCDIEN=0
. F S PXCDIEN=$O(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN)) Q:'PXCDIEN D
. . S PXCODE=$P($G(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN,0)),U,1)
. . I PXCODE="" Q
. . I '$D(DATA("CODES",PXCS)) S DATA("CODES",PXCS)=PXCODE Q
. . S DATA("CODES",PXCS)=DATA("CODES",PXCS)_U_PXCODE
;
;DATA("VIS OFFERED",n,0)=IEN ^ Date Offered ^ Name ^ Edition Date ^ Language
S PXIEN=0
F S PXIEN=$O(^TMP("PXVIMM",$J,DA,2,PXIEN)) Q:'PXIEN D
. S PXTEMP=$G(^TMP("PXVIMM",$J,DA,2,PXIEN,0))
. I 'PXTEMP Q
. ;Use this in case Date Offered is missing.
. S DATA("VIS OFFERED",PXIEN,0)=$P(PXTEMP,U,1)_U_$P(PXTEMP,U,2)
. S PXTEMP=$G(^AUTTIVIS(+PXTEMP,0))
. S DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$P(PXTEMP,U,1)_U_$P(PXTEMP,U,2)
. S PXX=$P(PXTEMP,U,4)
. I PXX S DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$$GET1^DIQ(.85,PXX_",","NAME") ;ICR 6062
;
;DATA("REMARKS",n,0)=Free text
M DATA("REMARKS")=^TMP("PXVIMM",$J,DA,11)
K DATA("REMARKS",0)
;
S PXTEMP=$G(^TMP("PXVIMM",$J,DA,812))
D SETPKGDS^PXPXRM(PXTEMP,.DATA)
;
Q
;
;====================
VIMMCR(DA,DATA) ;Return data for a specified V Immunization entry. This
;version does not return Visit data and external values. It is
;optimized for use by Clinical Reminders.
;
N DU,PXCS,PXCSIEN,PXCDIEN,PXCODE,PXIEN,PXTEMP,PXVIMM,PXVISIT,PXX
S PXTEMP=^AUPNVIMM(DA,0)
S PXVIMM=$P(PXTEMP,U,1)
S PXVISIT=$P(PXTEMP,U,3)
S DATA("VISIT")=PXVISIT
S (DATA("SERIES"),DATA("VALUE"))=$P(PXTEMP,U,4)
S DATA("REACTION")=$P(PXTEMP,U,6)
;CONTRAINDICATED removed in PX*1.0*217, it is no longer used.
;S DATA("CONTRAINDICATED")=$P(PXTEMP,U,7)
S DATA("COMMENTS")=$G(^AUPNVIMM(DA,811))
;
S PXTEMP=$G(^AUPNVIMM(DA,12))
S DATA("EVENT DATE AND TIME")=$P(PXTEMP,U,1)
S DATA("ORDERING PROVIDER")=$P(PXTEMP,U,2)
S DATA("ENCOUNTER PROVIDER")=$P(PXTEMP,U,4)
S DATA("DATE RECORDED")=$P(PXTEMP,U,5)
S DATA("DOCUMENTER")=$P(PXTEMP,U,6)
S PXX=+$P(PXTEMP,U,7)
S DATA("LOT NUMBER")=$S(PXX>0:($P($G(^AUTTIML(PXX,0)),U,1)),1:"")
S DATA("WARNING ACK")=$P(PXTEMP,U,20)
S DATA("ORDERED BY POLICY")=$P(PXTEMP,U,22)
;
S PXTEMP=$G(^AUTTIML(PXX,0))
S PXX=+$P(PXTEMP,U,2)
S DATA("MANUFACTURER")=$S(PXX>0:$P($G(^AUTTIMAN(PXX,0)),U,1),1:"")
S DATA("EXPIRATION DATE")=$P(PXTEMP,U,9)
;
S PXTEMP=$G(^AUPNVIMM(DA,13))
S PXX=+$P(PXTEMP,U,1)
S DATA("INFO SOURCE")=$S(PXX>0:$P($G(^PXV(920.1,PXX,0)),U,1),1:"")
S PXX=+$P(PXTEMP,U,2)
S DATA("ADMIN ROUTE")=$S(PXX>0:($P($G(^PXV(920.2,PXX,0)),U,2)_U_$P($G(^PXV(920.2,PXX,0)),U,1)),1:"")
S PXX=+$P(PXTEMP,U,3)
S DATA("ADMIN SITE")=$S(PXX>0:($P($G(^PXV(920.3,PXX,0)),U,2)_U_$P($G(^PXV(920.3,PXX,0)),U,1)),1:"")
S PXX=+$P(PXTEMP,U,12)
S DATA("DOSE")=$S(PXX>0:PXX,1:"")
S DU=$P(PXTEMP,U,13)
S DATA("DOSE UNITS")=$S(DU="":"",1:$$UCUMCODE^LEXMUCUM(DU))
;
S PXTEMP=$G(^AUPNVIMM(DA,14))
S DATA("RESULTS")=$P(PXTEMP,U,1)
S DATA("READING")=$P(PXTEMP,U,2)
S DATA("DATE READ")=$P(PXTEMP,U,3)
S PXX=$P(PXTEMP,U,4)
S DATA("READER")=PXX_$S(PXX:(U_$P($G(^VA(200,PXX,0)),U,1)),1:"")
S DATA("D/T READING RECORDED")=$P(PXTEMP,U,5)
S DATA("HOURS READ")=$P(PXTEMP,U,6)
S DATA("READING COMMENTS")=$G(^AUPNVIMM(DA,15))
;
S DATA("OVERRIDE REASON")=$G(^AUPNVIMM(DA,16))
;
S PXTEMP=$G(^AUTTIMM(+PXVIMM,0))
S DATA("IMM NAME")=$P(PXTEMP,U,1)
S DATA("IMMUNIZATION")=PXVIMM_U_DATA("IMM NAME")
S DATA("CVX")=$P(PXTEMP,U,3)
;
S PXTEMP=$G(^AUPNVIMM(DA,812))
D SETPKGDS^PXPXRM(PXTEMP,.DATA)
;
S PXIEN=0
F S PXIEN=$O(^AUTTIMM(PXVIMM,7,PXIEN)) Q:'PXIEN D
. S PXTEMP=$P($G(^AUTTIMM(PXVIMM,7,PXIEN,0)),U,1)
. I PXTEMP="" Q
. S DATA("VACCINE GROUP",PXIEN,0)=PXTEMP
;
;S DATA("CODES",Coding System Name)=Code 1 ^ Code 2 ^ ... Code x
S PXCSIEN=0
F S PXCSIEN=$O(^AUTTIMM(PXVIMM,3,PXCSIEN)) Q:'PXCSIEN D
. S PXCS=$P($G(^AUTTIMM(PXVIMM,3,PXCSIEN,0)),U,1)
. I PXCS="" Q
. S PXCDIEN=0
. F S PXCDIEN=$O(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN)) Q:'PXCDIEN D
. . S PXCODE=$P($G(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN,0)),U,1)
. . I PXCODE="" Q
. . I '$D(DATA("CODES",PXCS)) S DATA("CODES",PXCS)=PXCODE Q
. . S DATA("CODES",PXCS)=DATA("CODES",PXCS)_U_PXCODE
;
;DATA("VIS OFFERED",n,0)=IEN ^ Date Offered ^ Name ^ Edition Date ^ Language
S PXIEN=0
F S PXIEN=$O(^AUPNVIMM(DA,2,PXIEN)) Q:'PXIEN D
. S PXTEMP=$G(^AUPNVIMM(DA,2,PXIEN,0))
. I 'PXTEMP Q
. ;Use this in case Date Offered is missing.
. S DATA("VIS OFFERED",PXIEN,0)=$P(PXTEMP,U,1)_U_$P(PXTEMP,U,2)
. S PXTEMP=$G(^AUTTIVIS(+PXTEMP,0))
. S DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$P(PXTEMP,U,1)_U_$P(PXTEMP,U,2)
. S PXX=$P(PXTEMP,U,4)
. I PXX S DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$$GET1^DIQ(.85,PXX_",","NAME") ;ICR 6062
;
;DATA("REMARKS",n,0)=Free text
M DATA("REMARKS")=^AUPNVIMM(DA,11)
K DATA("REMARKS",0)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXPXRM1 8727 printed Oct 16, 2024@18:30:31 Page 2
PXPXRM1 ;SLC/PKR - APIs for Clinical Reminder indexes, cont. ;02/14/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
+2 ;
+3 ; Reference to NAME in file .85 is supported by ICR #6062.
+4 ;
+5 QUIT
+6 ;
+7 ;====================
VIMM2(DA,DATA) ; Internal function
+1 ; Works off ^TMP global instead of ^AUPNVIMM;
+2 ; this way it can also return data for deletes and edits.
+3 ;
+4 NEW DU,IND,PXCS,PXCSIEN,PXCDIEN,PXCODE,PXIEN,PXTEMP,PXVIMM,PXVISIT,PXX
+5 NEW TEMP
+6 ;
+7 SET PXTEMP=^TMP("PXVIMM",$JOB,DA,0)
+8 SET PXVIMM=$PIECE(PXTEMP,U,1)
+9 SET PXVISIT=$PIECE(PXTEMP,U,3)
+10 SET DATA("VISIT")=PXVISIT
+11 SET (DATA("SERIES"),DATA("VALUE"))=$PIECE(PXTEMP,U,4)
+12 SET DATA("REACTION")=$PIECE(PXTEMP,U,6)
+13 ;CONTRAINDICATED removed in PX*1.0*217, it is no longer used.
+14 ;S DATA("CONTRAINDICATED")=$P(PXTEMP,U,7)
+15 SET DATA("COMMENTS")=$GET(^TMP("PXVIMM",$JOB,DA,811))
+16 ;
+17 SET PXTEMP=$GET(^AUPNVSIT(+PXVISIT,0))
+18 SET DATA("VISIT DATE TIME")=$PIECE(PXTEMP,U,1)
+19 SET PXX=+$PIECE(PXTEMP,U,22)
SET TEMP=""
+20 IF PXX>0
SET TEMP=$PIECE($GET(^SC(PXX,0)),U,1)
+21 IF TEMP=""
SET TEMP="Invalid Location"
+22 SET DATA("LOCATION")=PXX_U_TEMP
+23 SET PXX=$PIECE(PXTEMP,U,6)
+24 SET DATA("FACILITY")=PXX_$SELECT(PXX:(U_$$NS^XUAF4(PXX)),1:"")
+25 ;
+26 SET PXTEMP=$GET(^TMP("PXVIMM",$JOB,DA,12))
+27 SET DATA("EVENT DATE AND TIME")=$PIECE(PXTEMP,U,1)
+28 SET PXX=$PIECE(PXTEMP,U,2)
+29 SET DATA("ORDERING PROVIDER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,+PXX,0)),U,1)),1:"")
+30 SET PXX=$PIECE(PXTEMP,U,4)
+31 SET DATA("ENCOUNTER PROVIDER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,+PXX,0)),U,1)),1:"")
+32 SET DATA("DATE RECORDED")=$PIECE(PXTEMP,U,5)
+33 SET PXX=$PIECE(PXTEMP,U,6)
+34 SET DATA("DOCUMENTER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,+PXX,0)),U,1)),1:"")
+35 SET PXX=+$PIECE(PXTEMP,U,7)
+36 IF PXX>0
Begin DoDot:1
+37 SET DATA("LOT NUMBER")=PXX_U_$PIECE($GET(^AUTTIML(PXX,0)),U,1)
+38 SET DATA("NDC CODE (VA)")=$PIECE($GET(^AUTTIML(PXX,0)),U,18)
End DoDot:1
+39 IF '$TEST
SET DATA("LOT NUMBER")=""
+40 SET DATA("WARNING ACK")=$PIECE(PXTEMP,U,20)
+41 SET DATA("ORDERED BY POLICY")=$PIECE(PXTEMP,U,22)
+42 ;
+43 SET PXTEMP=$GET(^AUTTIML(+$PIECE(PXTEMP,U,7),0))
+44 SET PXX=$PIECE(PXTEMP,U,2)
+45 SET DATA("MANUFACTURER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^AUTTIMAN(+PXX,0)),U,1)),1:"")
+46 SET DATA("EXPIRATION DATE")=$PIECE(PXTEMP,U,9)
+47 ;
+48 SET PXTEMP=$GET(^TMP("PXVIMM",$JOB,DA,13))
+49 SET PXX=$PIECE(PXTEMP,U,1)
+50 SET DATA("INFO SOURCE")=PXX_$SELECT(PXX:(U_$PIECE($GET(^PXV(920.1,+PXX,0)),U,2)_U_$PIECE($GET(^PXV(920.1,+PXX,0)),U,1)),1:"")
+51 SET PXX=$PIECE(PXTEMP,U,2)
+52 SET DATA("ADMIN ROUTE")=PXX_$SELECT(PXX:(U_$PIECE($GET(^PXV(920.2,+PXX,0)),U,2)_U_$PIECE($GET(^PXV(920.2,+PXX,0)),U,1)),1:"")
+53 SET PXX=$PIECE(PXTEMP,U,3)
+54 SET DATA("ADMIN SITE")=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 SET DATA("DOSE")=$$EXTERNAL^DILFD(9000010.11,1312,"",$PIECE(PXTEMP,U,12))
+56 SET DU=$PIECE(PXTEMP,U,13)
+57 SET DATA("DOSE UNITS")=$SELECT(DU="":"",1:$$UCUMCODE^LEXMUCUM(DU))
+58 ;
+59 SET PXTEMP=$GET(^TMP("PXVIMM",$JOB,DA,14))
+60 SET DATA("RESULTS")=$PIECE(PXTEMP,U,1)
+61 SET DATA("READING")=$PIECE(PXTEMP,U,2)
+62 SET DATA("DATE READ")=$PIECE(PXTEMP,U,3)
+63 SET PXX=$PIECE(PXTEMP,U,4)
+64 SET DATA("READER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,PXX,0)),U,1)),1:"")
+65 SET DATA("D/T READING RECORDED")=$PIECE(PXTEMP,U,5)
+66 SET DATA("HOURS READ")=$PIECE(PXTEMP,U,6)
+67 SET DATA("READING COMMENTS")=$GET(^TMP("PXVIMM",$JOB,DA,15))
+68 ;
+69 SET DATA("OVERRIDE REASON")=$GET(^TMP("PXVIMM",$JOB,DA,16))
+70 ;
+71 SET PXTEMP=$GET(^AUTTIMM(+PXVIMM,0))
+72 SET DATA("IMMUNIZATION")=PXVIMM_$SELECT(PXVIMM:(U_$PIECE(PXTEMP,U,1)),1:"")
+73 SET DATA("CVX")=$PIECE(PXTEMP,U,3)
+74 SET DATA("MAX # IN SERIES")=$PIECE(PXTEMP,U,5)
+75 ;CDC Full Vaccine Name is a word-processing field, return as a string.
+76 SET IND=0
SET PXTEMP=""
+77 FOR
SET IND=+$ORDER(^AUTTIMM(PXVIMM,2,IND))
if IND=0
QUIT
SET PXTEMP=PXTEMP_^AUTTIMM(PXVIMM,2,IND,0)
+78 SET DATA("CDC FULL VACCINE NAME")=PXTEMP
+79 ;
+80 SET PXIEN=0
+81 FOR
SET PXIEN=$ORDER(^AUTTIMM(PXVIMM,7,PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+82 SET PXTEMP=$PIECE($GET(^AUTTIMM(PXVIMM,7,PXIEN,0)),U,1)
+83 IF PXTEMP=""
QUIT
+84 SET DATA("VACCINE GROUP",PXIEN,0)=PXTEMP
End DoDot:1
+85 ;
+86 ;S DATA("CODES",Coding System Name)=Code 1 ^ Code 2 ^ ... Code x
+87 SET PXCSIEN=0
+88 FOR
SET PXCSIEN=$ORDER(^AUTTIMM(PXVIMM,3,PXCSIEN))
if 'PXCSIEN
QUIT
Begin DoDot:1
+89 SET PXCS=$PIECE($GET(^AUTTIMM(PXVIMM,3,PXCSIEN,0)),U,1)
+90 IF PXCS=""
QUIT
+91 SET PXCDIEN=0
+92 FOR
SET PXCDIEN=$ORDER(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN))
if 'PXCDIEN
QUIT
Begin DoDot:2
+93 SET PXCODE=$PIECE($GET(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN,0)),U,1)
+94 IF PXCODE=""
QUIT
+95 IF '$DATA(DATA("CODES",PXCS))
SET DATA("CODES",PXCS)=PXCODE
QUIT
+96 SET DATA("CODES",PXCS)=DATA("CODES",PXCS)_U_PXCODE
End DoDot:2
End DoDot:1
+97 ;
+98 ;DATA("VIS OFFERED",n,0)=IEN ^ Date Offered ^ Name ^ Edition Date ^ Language
+99 SET PXIEN=0
+100 FOR
SET PXIEN=$ORDER(^TMP("PXVIMM",$JOB,DA,2,PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+101 SET PXTEMP=$GET(^TMP("PXVIMM",$JOB,DA,2,PXIEN,0))
+102 IF 'PXTEMP
QUIT
+103 ;Use this in case Date Offered is missing.
+104 SET DATA("VIS OFFERED",PXIEN,0)=$PIECE(PXTEMP,U,1)_U_$PIECE(PXTEMP,U,2)
+105 SET PXTEMP=$GET(^AUTTIVIS(+PXTEMP,0))
+106 SET DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$PIECE(PXTEMP,U,1)_U_$PIECE(PXTEMP,U,2)
+107 SET PXX=$PIECE(PXTEMP,U,4)
+108 ;ICR 6062
IF PXX
SET DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$$GET1^DIQ(.85,PXX_",","NAME")
End DoDot:1
+109 ;
+110 ;DATA("REMARKS",n,0)=Free text
+111 MERGE DATA("REMARKS")=^TMP("PXVIMM",$JOB,DA,11)
+112 KILL DATA("REMARKS",0)
+113 ;
+114 SET PXTEMP=$GET(^TMP("PXVIMM",$JOB,DA,812))
+115 DO SETPKGDS^PXPXRM(PXTEMP,.DATA)
+116 ;
+117 QUIT
+118 ;
+119 ;====================
VIMMCR(DA,DATA) ;Return data for a specified V Immunization entry. This
+1 ;version does not return Visit data and external values. It is
+2 ;optimized for use by Clinical Reminders.
+3 ;
+4 NEW DU,PXCS,PXCSIEN,PXCDIEN,PXCODE,PXIEN,PXTEMP,PXVIMM,PXVISIT,PXX
+5 SET PXTEMP=^AUPNVIMM(DA,0)
+6 SET PXVIMM=$PIECE(PXTEMP,U,1)
+7 SET PXVISIT=$PIECE(PXTEMP,U,3)
+8 SET DATA("VISIT")=PXVISIT
+9 SET (DATA("SERIES"),DATA("VALUE"))=$PIECE(PXTEMP,U,4)
+10 SET DATA("REACTION")=$PIECE(PXTEMP,U,6)
+11 ;CONTRAINDICATED removed in PX*1.0*217, it is no longer used.
+12 ;S DATA("CONTRAINDICATED")=$P(PXTEMP,U,7)
+13 SET DATA("COMMENTS")=$GET(^AUPNVIMM(DA,811))
+14 ;
+15 SET PXTEMP=$GET(^AUPNVIMM(DA,12))
+16 SET DATA("EVENT DATE AND TIME")=$PIECE(PXTEMP,U,1)
+17 SET DATA("ORDERING PROVIDER")=$PIECE(PXTEMP,U,2)
+18 SET DATA("ENCOUNTER PROVIDER")=$PIECE(PXTEMP,U,4)
+19 SET DATA("DATE RECORDED")=$PIECE(PXTEMP,U,5)
+20 SET DATA("DOCUMENTER")=$PIECE(PXTEMP,U,6)
+21 SET PXX=+$PIECE(PXTEMP,U,7)
+22 SET DATA("LOT NUMBER")=$SELECT(PXX>0:($PIECE($GET(^AUTTIML(PXX,0)),U,1)),1:"")
+23 SET DATA("WARNING ACK")=$PIECE(PXTEMP,U,20)
+24 SET DATA("ORDERED BY POLICY")=$PIECE(PXTEMP,U,22)
+25 ;
+26 SET PXTEMP=$GET(^AUTTIML(PXX,0))
+27 SET PXX=+$PIECE(PXTEMP,U,2)
+28 SET DATA("MANUFACTURER")=$SELECT(PXX>0:$PIECE($GET(^AUTTIMAN(PXX,0)),U,1),1:"")
+29 SET DATA("EXPIRATION DATE")=$PIECE(PXTEMP,U,9)
+30 ;
+31 SET PXTEMP=$GET(^AUPNVIMM(DA,13))
+32 SET PXX=+$PIECE(PXTEMP,U,1)
+33 SET DATA("INFO SOURCE")=$SELECT(PXX>0:$PIECE($GET(^PXV(920.1,PXX,0)),U,1),1:"")
+34 SET PXX=+$PIECE(PXTEMP,U,2)
+35 SET DATA("ADMIN ROUTE")=$SELECT(PXX>0:($PIECE($GET(^PXV(920.2,PXX,0)),U,2)_U_$PIECE($GET(^PXV(920.2,PXX,0)),U,1)),1:"")
+36 SET PXX=+$PIECE(PXTEMP,U,3)
+37 SET DATA("ADMIN SITE")=$SELECT(PXX>0:($PIECE($GET(^PXV(920.3,PXX,0)),U,2)_U_$PIECE($GET(^PXV(920.3,PXX,0)),U,1)),1:"")
+38 SET PXX=+$PIECE(PXTEMP,U,12)
+39 SET DATA("DOSE")=$SELECT(PXX>0:PXX,1:"")
+40 SET DU=$PIECE(PXTEMP,U,13)
+41 SET DATA("DOSE UNITS")=$SELECT(DU="":"",1:$$UCUMCODE^LEXMUCUM(DU))
+42 ;
+43 SET PXTEMP=$GET(^AUPNVIMM(DA,14))
+44 SET DATA("RESULTS")=$PIECE(PXTEMP,U,1)
+45 SET DATA("READING")=$PIECE(PXTEMP,U,2)
+46 SET DATA("DATE READ")=$PIECE(PXTEMP,U,3)
+47 SET PXX=$PIECE(PXTEMP,U,4)
+48 SET DATA("READER")=PXX_$SELECT(PXX:(U_$PIECE($GET(^VA(200,PXX,0)),U,1)),1:"")
+49 SET DATA("D/T READING RECORDED")=$PIECE(PXTEMP,U,5)
+50 SET DATA("HOURS READ")=$PIECE(PXTEMP,U,6)
+51 SET DATA("READING COMMENTS")=$GET(^AUPNVIMM(DA,15))
+52 ;
+53 SET DATA("OVERRIDE REASON")=$GET(^AUPNVIMM(DA,16))
+54 ;
+55 SET PXTEMP=$GET(^AUTTIMM(+PXVIMM,0))
+56 SET DATA("IMM NAME")=$PIECE(PXTEMP,U,1)
+57 SET DATA("IMMUNIZATION")=PXVIMM_U_DATA("IMM NAME")
+58 SET DATA("CVX")=$PIECE(PXTEMP,U,3)
+59 ;
+60 SET PXTEMP=$GET(^AUPNVIMM(DA,812))
+61 DO SETPKGDS^PXPXRM(PXTEMP,.DATA)
+62 ;
+63 SET PXIEN=0
+64 FOR
SET PXIEN=$ORDER(^AUTTIMM(PXVIMM,7,PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+65 SET PXTEMP=$PIECE($GET(^AUTTIMM(PXVIMM,7,PXIEN,0)),U,1)
+66 IF PXTEMP=""
QUIT
+67 SET DATA("VACCINE GROUP",PXIEN,0)=PXTEMP
End DoDot:1
+68 ;
+69 ;S DATA("CODES",Coding System Name)=Code 1 ^ Code 2 ^ ... Code x
+70 SET PXCSIEN=0
+71 FOR
SET PXCSIEN=$ORDER(^AUTTIMM(PXVIMM,3,PXCSIEN))
if 'PXCSIEN
QUIT
Begin DoDot:1
+72 SET PXCS=$PIECE($GET(^AUTTIMM(PXVIMM,3,PXCSIEN,0)),U,1)
+73 IF PXCS=""
QUIT
+74 SET PXCDIEN=0
+75 FOR
SET PXCDIEN=$ORDER(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN))
if 'PXCDIEN
QUIT
Begin DoDot:2
+76 SET PXCODE=$PIECE($GET(^AUTTIMM(PXVIMM,3,PXCSIEN,1,PXCDIEN,0)),U,1)
+77 IF PXCODE=""
QUIT
+78 IF '$DATA(DATA("CODES",PXCS))
SET DATA("CODES",PXCS)=PXCODE
QUIT
+79 SET DATA("CODES",PXCS)=DATA("CODES",PXCS)_U_PXCODE
End DoDot:2
End DoDot:1
+80 ;
+81 ;DATA("VIS OFFERED",n,0)=IEN ^ Date Offered ^ Name ^ Edition Date ^ Language
+82 SET PXIEN=0
+83 FOR
SET PXIEN=$ORDER(^AUPNVIMM(DA,2,PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+84 SET PXTEMP=$GET(^AUPNVIMM(DA,2,PXIEN,0))
+85 IF 'PXTEMP
QUIT
+86 ;Use this in case Date Offered is missing.
+87 SET DATA("VIS OFFERED",PXIEN,0)=$PIECE(PXTEMP,U,1)_U_$PIECE(PXTEMP,U,2)
+88 SET PXTEMP=$GET(^AUTTIVIS(+PXTEMP,0))
+89 SET DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$PIECE(PXTEMP,U,1)_U_$PIECE(PXTEMP,U,2)
+90 SET PXX=$PIECE(PXTEMP,U,4)
+91 ;ICR 6062
IF PXX
SET DATA("VIS OFFERED",PXIEN,0)=DATA("VIS OFFERED",PXIEN,0)_U_$$GET1^DIQ(.85,PXX_",","NAME")
End DoDot:1
+92 ;
+93 ;DATA("REMARKS",n,0)=Free text
+94 MERGE DATA("REMARKS")=^AUPNVIMM(DA,11)
+95 KILL DATA("REMARKS",0)
+96 QUIT
+97 ;
