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