PXVUTIL ;BIR/ADM - VIMM UTILITY ROUTINE ;04/16/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**201,210,215,216,211**;Aug 12, 1996;Build 454
;
; Reference to UCUMCODE^LEXMUCUM supported by ICR #6225
;
VIS ; display VIS name with identifiers
N C,PXVNAME,PXVDATE,PXVSTAT,PXVLANG,X
S X=$G(^AUTTIVIS(Y,0))
S PXVNAME=$P(X,"^"),PXVDATE=$P(X,"^",2),PXVSTAT=$P(X,"^",3),PXVLANG=$P(X,"^",4)
S X=PXVDATE,PXVDATE=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
S Y=PXVSTAT,C=$P(^DD(920,.03,0),"^",2) D:Y'="" Y^DIQ S PXVSTAT=Y
S Y=PXVLANG,C=$P(^DD(920,.04,0),"^",2) D:Y'="" Y^DIQ S PXVLANG=Y
S Y=PXVNAME_" "_PXVDATE_" "_PXVSTAT_" "_PXVLANG
Q
;;
DUPDX(PXVIEN,PXVDX) ; extrinsic function to check for duplicate diagnoses
; PXVIEN - Internal Entry Number of the event, pointing to the
; V IMMUNIZATION file (9000010.11)
; PXVDX is the diagnosis entered and used to check for duplicates
;
; this code is called by the input transforms of:
; ^DD(9000010.11,1304,0) & ^DD(9000010.113,.01,0)
;
; RETURNS a 1 if the diagnosis already exists for this
; entry, 0 if not
;
N TXT K TXT S TXT(2)=" ",TXT(1,"F")="?5"
I PXVDX=$P($G(^AUPNVIMM(PXVIEN,13)),"^",4) S TXT(1)="Selected diagnosis exists as the Primary Diagnosis for this event." D EN^DDIOL(.TXT,"","") Q 1
I $D(^AUPNVIMM(PXVIEN,3,"B",PXVDX)) S TXT(1)="Selected diagnosis exists for this event." D EN^DDIOL(.TXT,"","") Q 1
Q 0
;;
RSETDA ; code needed for the routine AUPNSICD to have the correct value in
; DA, as AUPNSICD is not designed to be called from a multiple.
N DA S DA=D0
D ^AUPNSICD
Q
HRS ; called by AH new style x-ref in V IMMUNIZATION file
; set number of hours between administration and reading of results
N PXVX,X1,X2,X3
S X1=$P($G(^AUPNVIMM(DA,14)),"^",3) ; DATE/TIME READ
S X2=$P($G(^AUPNVIMM(DA,12)),"^") ; EVENT DATE AND TIME
S X3=2 ; return difference in seconds
S PXVX=""
I $G(X1),$L(X1)>7,$G(X2),$L(X2)>7,$G(X2)'>$G(X1) S PXVX=$$FMDIFF^XLFDT(X1,X2,X3)\3600
S $P(^AUPNVIMM(DA,14),"^",6)=PXVX
Q
;
DOSAGE(PXIEN) ; Used to compute Dosage (9000010.11,1312.5)
;Input:
; PXIEN = (Required) Pointer to #9000010.11
;Returns:
; Concatenation of DOSE_" "_DOSE UNITS (e.g., ".5 mL")
N PXDOSE,PXUNITS
I $G(PXIEN)="" Q ""
S PXDOSE=$P($G(^AUPNVIMM(PXIEN,13)),U,12)
I PXDOSE="" Q ""
S PXDOSE=$FN(PXDOSE,",")
S PXUNITS=$P($G(^AUPNVIMM(PXIEN,13)),U,13)
I PXUNITS S PXUNITS=$P($$UCUMCODE^LEXMUCUM(PXUNITS),U) ; ICR 6225
Q PXDOSE_$S(PXUNITS'="":" "_PXUNITS,1:"")
;
OFFER() ; called from screen on VIS OFFERED/GIVEN TO PATIENT field (#.01) in
; VIS OFFERED/GIVEN TO PATIENT multiple field (#2) in file #9000010.11
;
; PXD is defined by immunization edit process in PCE and is the value of
; Y from the DIR call to select an immunization.
;
N PXVIS,PXDA
S PXVIS=0
I $G(DA),$D(^AUTTIMM($P(^AUPNVIMM(DA,0),"^"),4,"B",Y)),'$D(^AUPNVIMM(DA,2,"B",Y)) S PXVIS=1
I '$G(DA),$G(PXD) S PXDA=+PXD I PXDA,$D(^AUTTIMM(PXDA,4,"B",Y)),'$D(^AUPNVIMM(PXDA,2,"B",Y)) S PXVIS=1
Q PXVIS
;
IMMSEL(PXVIMM,PXVISIT,EVENTDT) ; Immunization screen for V Immunization file
;
; Input:
; PXVIMM: Immunization IEN (#9999999.14)
; PXVISIT: Visit IEN (#9000010)
;
; Return:
; 0: Entry is not selectable
; 1: Entry is selectable
;
N PXVHIST,PXVSC,PXVISITDT,TEMP
;
I '$G(PXVIMM) Q 0
I $G(PXVISIT)="" Q 0
S TEMP=$G(^AUPNVSIT(PXVISIT,0))
I TEMP="" Q 0
;
S PXVISITDT=$G(EVENTDT)
I PXVISITDT="" S PXVISITDT=$P(TEMP,U,1)
;
S PXVSC=$P(TEMP,U,7)
S PXVHIST=$S(PXVSC="E":1,1:0)
;
; For non-historical, only allow active entries
I 'PXVHIST,'$$SCREEN^XTID(9999999.14,,PXVIMM_",",PXVISITDT) Q 1
;
; For historical, only allow SELECTABLE FOR HISTORIC entries
I PXVHIST,$P($G(^AUTTIMM(PXVIMM,6)),U,1)="Y" Q 1
;
Q 0
;
IMMCRSEL(PXVICR,PXVIMM) ; Immunization screen for V Imm Contra/Refusal Events file
;
; Input:
; PXVICR: Contraindication/Refusal Variable Pointer (#9000010.707, #.01)
; PXVIMM: Immunization IEN (#9999999.14)
;
; Return:
; 0: Entry is not selectable
; 1: Entry is selectable
;
N PXCONTRA,PXRSLT
;
S PXRSLT=0
;
I '$G(PXVICR) Q PXRSLT
I '$G(PXVIMM) Q PXRSLT
;
I PXVICR[920.5 D Q PXRSLT
. I $$IMMSTAT^PXAPIIM(PXVIMM)?1(1"A",1"H") S PXRSLT=1
;
S PXCONTRA=+PXVICR
;
; Immunizations Limited To multiple is null
I '$O(^PXV(920.4,PXCONTRA,3,0)) D Q PXRSLT
. I $$IMMSTAT^PXAPIIM(PXVIMM)?1(1"A",1"H") S PXRSLT=1
;
; PXVIMM is an entry in the Immunizations Limited To multiple
I $O(^PXV(920.4,PXCONTRA,3,"B",PXVIMM,0)) S PXRSLT=1
;
Q PXRSLT
ARTAPI(PXALERGY) ; extrinsic function returns whether allergy ; PX*1*216
; Input:
; PXALERGY - (required) Pointer to IMM CONTRAINDICATION REASONS file (#920.4) ; PX*1*216
;
; Returns:
; 1: Entry is an allergy ; PX*1*216
; 0: Entry is not an allergy ; PX*1*216
;
I '$G(PXALERGY) Q "" ; PX*1*216
I '$D(^PXV(920.4,PXALERGY)) Q "" ; PX*1*216
I $P($G(^PXV(920.4,PXALERGY,0)),U)["ALLERGY" Q 1 ; PX*1*216
I $P($G(^PXV(920.4,PXALERGY,0)),U)="SEVERE REACTION PREVIOUS DOSE" Q 1 ; PX*1*216
Q 0 ; PX*1*216
;
INST(PXVIN) ; Return Institution based off input
; Input:
; PXVIN - Possible values are:
; "I:X": Institution (#4) IEN #X
; "V:X": Visit (#9000010) IEN #X
; "L:X": Hospital Location (#44) IEN #X
;
; Output:
; Pointer to #4
;
N PXVIEN,PXVINST,PXVTO
;
S PXVTO=$P($G(PXVIN),":",1)
S PXVIEN=$P($G(PXVIN),":",2)
S PXVINST=""
;
I PXVTO="I" D
. S PXVINST=PXVIEN
;
I PXVTO="V",$D(^AUPNVSIT(+PXVIEN,0)) D
. S PXVINST=$$DIV1^PXVXR(PXVIEN)
;
I PXVTO="L",$D(^SC(+PXVIEN,0)) D
. S PXVINST=$P($G(^SC(+PXVIEN,0)),U,4)
. I 'PXVINST S PXVINST=$$INS4LOC^VSITCK1(PXVIEN)
;
I 'PXVINST S PXVINST=$G(DUZ(2))
I 'PXVINST S PXVINST=$$KSP^XUPARAM("INST")
;
Q PXVINST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVUTIL 5933 printed Apr 09, 2024@21:28:11 Page 2
PXVUTIL ;BIR/ADM - VIMM UTILITY ROUTINE ;04/16/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**201,210,215,216,211**;Aug 12, 1996;Build 454
+2 ;
+3 ; Reference to UCUMCODE^LEXMUCUM supported by ICR #6225
+4 ;
VIS ; display VIS name with identifiers
+1 NEW C,PXVNAME,PXVDATE,PXVSTAT,PXVLANG,X
+2 SET X=$GET(^AUTTIVIS(Y,0))
+3 SET PXVNAME=$PIECE(X,"^")
SET PXVDATE=$PIECE(X,"^",2)
SET PXVSTAT=$PIECE(X,"^",3)
SET PXVLANG=$PIECE(X,"^",4)
+4 SET X=PXVDATE
SET PXVDATE=$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)_"-"_$EXTRACT(X,2,3)
+5 SET Y=PXVSTAT
SET C=$PIECE(^DD(920,.03,0),"^",2)
if Y'=""
DO Y^DIQ
SET PXVSTAT=Y
+6 SET Y=PXVLANG
SET C=$PIECE(^DD(920,.04,0),"^",2)
if Y'=""
DO Y^DIQ
SET PXVLANG=Y
+7 SET Y=PXVNAME_" "_PXVDATE_" "_PXVSTAT_" "_PXVLANG
+8 QUIT
+9 ;;
DUPDX(PXVIEN,PXVDX) ; extrinsic function to check for duplicate diagnoses
+1 ; PXVIEN - Internal Entry Number of the event, pointing to the
+2 ; V IMMUNIZATION file (9000010.11)
+3 ; PXVDX is the diagnosis entered and used to check for duplicates
+4 ;
+5 ; this code is called by the input transforms of:
+6 ; ^DD(9000010.11,1304,0) & ^DD(9000010.113,.01,0)
+7 ;
+8 ; RETURNS a 1 if the diagnosis already exists for this
+9 ; entry, 0 if not
+10 ;
+11 NEW TXT
KILL TXT
SET TXT(2)=" "
SET TXT(1,"F")="?5"
+12 IF PXVDX=$PIECE($GET(^AUPNVIMM(PXVIEN,13)),"^",4)
SET TXT(1)="Selected diagnosis exists as the Primary Diagnosis for this event."
DO EN^DDIOL(.TXT,"","")
QUIT 1
+13 IF $DATA(^AUPNVIMM(PXVIEN,3,"B",PXVDX))
SET TXT(1)="Selected diagnosis exists for this event."
DO EN^DDIOL(.TXT,"","")
QUIT 1
+14 QUIT 0
+15 ;;
RSETDA ; code needed for the routine AUPNSICD to have the correct value in
+1 ; DA, as AUPNSICD is not designed to be called from a multiple.
+2 NEW DA
SET DA=D0
+3 DO ^AUPNSICD
+4 QUIT
HRS ; called by AH new style x-ref in V IMMUNIZATION file
+1 ; set number of hours between administration and reading of results
+2 NEW PXVX,X1,X2,X3
+3 ; DATE/TIME READ
SET X1=$PIECE($GET(^AUPNVIMM(DA,14)),"^",3)
+4 ; EVENT DATE AND TIME
SET X2=$PIECE($GET(^AUPNVIMM(DA,12)),"^")
+5 ; return difference in seconds
SET X3=2
+6 SET PXVX=""
+7 IF $GET(X1)
IF $LENGTH(X1)>7
IF $GET(X2)
IF $LENGTH(X2)>7
IF $GET(X2)'>$GET(X1)
SET PXVX=$$FMDIFF^XLFDT(X1,X2,X3)\3600
+8 SET $PIECE(^AUPNVIMM(DA,14),"^",6)=PXVX
+9 QUIT
+10 ;
DOSAGE(PXIEN) ; Used to compute Dosage (9000010.11,1312.5)
+1 ;Input:
+2 ; PXIEN = (Required) Pointer to #9000010.11
+3 ;Returns:
+4 ; Concatenation of DOSE_" "_DOSE UNITS (e.g., ".5 mL")
+5 NEW PXDOSE,PXUNITS
+6 IF $GET(PXIEN)=""
QUIT ""
+7 SET PXDOSE=$PIECE($GET(^AUPNVIMM(PXIEN,13)),U,12)
+8 IF PXDOSE=""
QUIT ""
+9 SET PXDOSE=$FNUMBER(PXDOSE,",")
+10 SET PXUNITS=$PIECE($GET(^AUPNVIMM(PXIEN,13)),U,13)
+11 ; ICR 6225
IF PXUNITS
SET PXUNITS=$PIECE($$UCUMCODE^LEXMUCUM(PXUNITS),U)
+12 QUIT PXDOSE_$SELECT(PXUNITS'="":" "_PXUNITS,1:"")
+13 ;
OFFER() ; called from screen on VIS OFFERED/GIVEN TO PATIENT field (#.01) in
+1 ; VIS OFFERED/GIVEN TO PATIENT multiple field (#2) in file #9000010.11
+2 ;
+3 ; PXD is defined by immunization edit process in PCE and is the value of
+4 ; Y from the DIR call to select an immunization.
+5 ;
+6 NEW PXVIS,PXDA
+7 SET PXVIS=0
+8 IF $GET(DA)
IF $DATA(^AUTTIMM($PIECE(^AUPNVIMM(DA,0),"^"),4,"B",Y))
IF '$DATA(^AUPNVIMM(DA,2,"B",Y))
SET PXVIS=1
+9 IF '$GET(DA)
IF $GET(PXD)
SET PXDA=+PXD
IF PXDA
IF $DATA(^AUTTIMM(PXDA,4,"B",Y))
IF '$DATA(^AUPNVIMM(PXDA,2,"B",Y))
SET PXVIS=1
+10 QUIT PXVIS
+11 ;
IMMSEL(PXVIMM,PXVISIT,EVENTDT) ; Immunization screen for V Immunization file
+1 ;
+2 ; Input:
+3 ; PXVIMM: Immunization IEN (#9999999.14)
+4 ; PXVISIT: Visit IEN (#9000010)
+5 ;
+6 ; Return:
+7 ; 0: Entry is not selectable
+8 ; 1: Entry is selectable
+9 ;
+10 NEW PXVHIST,PXVSC,PXVISITDT,TEMP
+11 ;
+12 IF '$GET(PXVIMM)
QUIT 0
+13 IF $GET(PXVISIT)=""
QUIT 0
+14 SET TEMP=$GET(^AUPNVSIT(PXVISIT,0))
+15 IF TEMP=""
QUIT 0
+16 ;
+17 SET PXVISITDT=$GET(EVENTDT)
+18 IF PXVISITDT=""
SET PXVISITDT=$PIECE(TEMP,U,1)
+19 ;
+20 SET PXVSC=$PIECE(TEMP,U,7)
+21 SET PXVHIST=$SELECT(PXVSC="E":1,1:0)
+22 ;
+23 ; For non-historical, only allow active entries
+24 IF 'PXVHIST
IF '$$SCREEN^XTID(9999999.14,,PXVIMM_",",PXVISITDT)
QUIT 1
+25 ;
+26 ; For historical, only allow SELECTABLE FOR HISTORIC entries
+27 IF PXVHIST
IF $PIECE($GET(^AUTTIMM(PXVIMM,6)),U,1)="Y"
QUIT 1
+28 ;
+29 QUIT 0
+30 ;
IMMCRSEL(PXVICR,PXVIMM) ; Immunization screen for V Imm Contra/Refusal Events file
+1 ;
+2 ; Input:
+3 ; PXVICR: Contraindication/Refusal Variable Pointer (#9000010.707, #.01)
+4 ; PXVIMM: Immunization IEN (#9999999.14)
+5 ;
+6 ; Return:
+7 ; 0: Entry is not selectable
+8 ; 1: Entry is selectable
+9 ;
+10 NEW PXCONTRA,PXRSLT
+11 ;
+12 SET PXRSLT=0
+13 ;
+14 IF '$GET(PXVICR)
QUIT PXRSLT
+15 IF '$GET(PXVIMM)
QUIT PXRSLT
+16 ;
+17 IF PXVICR[920.5
Begin DoDot:1
+18 IF $$IMMSTAT^PXAPIIM(PXVIMM)?1(1"A",1"H")
SET PXRSLT=1
End DoDot:1
QUIT PXRSLT
+19 ;
+20 SET PXCONTRA=+PXVICR
+21 ;
+22 ; Immunizations Limited To multiple is null
+23 IF '$ORDER(^PXV(920.4,PXCONTRA,3,0))
Begin DoDot:1
+24 IF $$IMMSTAT^PXAPIIM(PXVIMM)?1(1"A",1"H")
SET PXRSLT=1
End DoDot:1
QUIT PXRSLT
+25 ;
+26 ; PXVIMM is an entry in the Immunizations Limited To multiple
+27 IF $ORDER(^PXV(920.4,PXCONTRA,3,"B",PXVIMM,0))
SET PXRSLT=1
+28 ;
+29 QUIT PXRSLT
ARTAPI(PXALERGY) ; extrinsic function returns whether allergy ; PX*1*216
+1 ; Input:
+2 ; PXALERGY - (required) Pointer to IMM CONTRAINDICATION REASONS file (#920.4) ; PX*1*216
+3 ;
+4 ; Returns:
+5 ; 1: Entry is an allergy ; PX*1*216
+6 ; 0: Entry is not an allergy ; PX*1*216
+7 ;
+8 ; PX*1*216
IF '$GET(PXALERGY)
QUIT ""
+9 ; PX*1*216
IF '$DATA(^PXV(920.4,PXALERGY))
QUIT ""
+10 ; PX*1*216
IF $PIECE($GET(^PXV(920.4,PXALERGY,0)),U)["ALLERGY"
QUIT 1
+11 ; PX*1*216
IF $PIECE($GET(^PXV(920.4,PXALERGY,0)),U)="SEVERE REACTION PREVIOUS DOSE"
QUIT 1
+12 ; PX*1*216
QUIT 0
+13 ;
INST(PXVIN) ; Return Institution based off input
+1 ; Input:
+2 ; PXVIN - Possible values are:
+3 ; "I:X": Institution (#4) IEN #X
+4 ; "V:X": Visit (#9000010) IEN #X
+5 ; "L:X": Hospital Location (#44) IEN #X
+6 ;
+7 ; Output:
+8 ; Pointer to #4
+9 ;
+10 NEW PXVIEN,PXVINST,PXVTO
+11 ;
+12 SET PXVTO=$PIECE($GET(PXVIN),":",1)
+13 SET PXVIEN=$PIECE($GET(PXVIN),":",2)
+14 SET PXVINST=""
+15 ;
+16 IF PXVTO="I"
Begin DoDot:1
+17 SET PXVINST=PXVIEN
End DoDot:1
+18 ;
+19 IF PXVTO="V"
IF $DATA(^AUPNVSIT(+PXVIEN,0))
Begin DoDot:1
+20 SET PXVINST=$$DIV1^PXVXR(PXVIEN)
End DoDot:1
+21 ;
+22 IF PXVTO="L"
IF $DATA(^SC(+PXVIEN,0))
Begin DoDot:1
+23 SET PXVINST=$PIECE($GET(^SC(+PXVIEN,0)),U,4)
+24 IF 'PXVINST
SET PXVINST=$$INS4LOC^VSITCK1(PXVIEN)
End DoDot:1
+25 ;
+26 IF 'PXVINST
SET PXVINST=$GET(DUZ(2))
+27 IF 'PXVINST
SET PXVINST=$$KSP^XUPARAM("INST")
+28 ;
+29 QUIT PXVINST
