Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXVUTIL

PXVUTIL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to UCUMCODE^LEXMUCUM supported by ICR #6225
  1. ;
  1. VIS ; display VIS name with identifiers
  1. N C,PXVNAME,PXVDATE,PXVSTAT,PXVLANG,X
  1. S X=$G(^AUTTIVIS(Y,0))
  1. S PXVNAME=$P(X,"^"),PXVDATE=$P(X,"^",2),PXVSTAT=$P(X,"^",3),PXVLANG=$P(X,"^",4)
  1. S X=PXVDATE,PXVDATE=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
  1. S Y=PXVSTAT,C=$P(^DD(920,.03,0),"^",2) D:Y'="" Y^DIQ S PXVSTAT=Y
  1. S Y=PXVLANG,C=$P(^DD(920,.04,0),"^",2) D:Y'="" Y^DIQ S PXVLANG=Y
  1. S Y=PXVNAME_" "_PXVDATE_" "_PXVSTAT_" "_PXVLANG
  1. Q
  1. ;;
  1. DUPDX(PXVIEN,PXVDX) ; extrinsic function to check for duplicate diagnoses
  1. ; PXVIEN - Internal Entry Number of the event, pointing to the
  1. ; V IMMUNIZATION file (9000010.11)
  1. ; PXVDX is the diagnosis entered and used to check for duplicates
  1. ;
  1. ; this code is called by the input transforms of:
  1. ; ^DD(9000010.11,1304,0) & ^DD(9000010.113,.01,0)
  1. ;
  1. ; RETURNS a 1 if the diagnosis already exists for this
  1. ; entry, 0 if not
  1. ;
  1. N TXT K TXT S TXT(2)=" ",TXT(1,"F")="?5"
  1. 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
  1. I $D(^AUPNVIMM(PXVIEN,3,"B",PXVDX)) S TXT(1)="Selected diagnosis exists for this event." D EN^DDIOL(.TXT,"","") Q 1
  1. Q 0
  1. ;;
  1. 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.
  1. N DA S DA=D0
  1. D ^AUPNSICD
  1. Q
  1. HRS ; called by AH new style x-ref in V IMMUNIZATION file
  1. ; set number of hours between administration and reading of results
  1. N PXVX,X1,X2,X3
  1. S X1=$P($G(^AUPNVIMM(DA,14)),"^",3) ; DATE/TIME READ
  1. S X2=$P($G(^AUPNVIMM(DA,12)),"^") ; EVENT DATE AND TIME
  1. S X3=2 ; return difference in seconds
  1. S PXVX=""
  1. I $G(X1),$L(X1)>7,$G(X2),$L(X2)>7,$G(X2)'>$G(X1) S PXVX=$$FMDIFF^XLFDT(X1,X2,X3)\3600
  1. S $P(^AUPNVIMM(DA,14),"^",6)=PXVX
  1. Q
  1. ;
  1. DOSAGE(PXIEN) ; Used to compute Dosage (9000010.11,1312.5)
  1. ;Input:
  1. ; PXIEN = (Required) Pointer to #9000010.11
  1. ;Returns:
  1. ; Concatenation of DOSE_" "_DOSE UNITS (e.g., ".5 mL")
  1. N PXDOSE,PXUNITS
  1. I $G(PXIEN)="" Q ""
  1. S PXDOSE=$P($G(^AUPNVIMM(PXIEN,13)),U,12)
  1. I PXDOSE="" Q ""
  1. S PXDOSE=$FN(PXDOSE,",")
  1. S PXUNITS=$P($G(^AUPNVIMM(PXIEN,13)),U,13)
  1. I PXUNITS S PXUNITS=$P($$UCUMCODE^LEXMUCUM(PXUNITS),U) ; ICR 6225
  1. Q PXDOSE_$S(PXUNITS'="":" "_PXUNITS,1:"")
  1. ;
  1. 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
  1. ;
  1. ; PXD is defined by immunization edit process in PCE and is the value of
  1. ; Y from the DIR call to select an immunization.
  1. ;
  1. N PXVIS,PXDA
  1. S PXVIS=0
  1. I $G(DA),$D(^AUTTIMM($P(^AUPNVIMM(DA,0),"^"),4,"B",Y)),'$D(^AUPNVIMM(DA,2,"B",Y)) S PXVIS=1
  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
  1. Q PXVIS
  1. ;
  1. IMMSEL(PXVIMM,PXVISIT,EVENTDT) ; Immunization screen for V Immunization file
  1. ;
  1. ; Input:
  1. ; PXVIMM: Immunization IEN (#9999999.14)
  1. ; PXVISIT: Visit IEN (#9000010)
  1. ;
  1. ; Return:
  1. ; 0: Entry is not selectable
  1. ; 1: Entry is selectable
  1. ;
  1. N PXVHIST,PXVSC,PXVISITDT,TEMP
  1. ;
  1. I '$G(PXVIMM) Q 0
  1. I $G(PXVISIT)="" Q 0
  1. S TEMP=$G(^AUPNVSIT(PXVISIT,0))
  1. I TEMP="" Q 0
  1. ;
  1. S PXVISITDT=$G(EVENTDT)
  1. I PXVISITDT="" S PXVISITDT=$P(TEMP,U,1)
  1. ;
  1. S PXVSC=$P(TEMP,U,7)
  1. S PXVHIST=$S(PXVSC="E":1,1:0)
  1. ;
  1. ; For non-historical, only allow active entries
  1. I 'PXVHIST,'$$SCREEN^XTID(9999999.14,,PXVIMM_",",PXVISITDT) Q 1
  1. ;
  1. ; For historical, only allow SELECTABLE FOR HISTORIC entries
  1. I PXVHIST,$P($G(^AUTTIMM(PXVIMM,6)),U,1)="Y" Q 1
  1. ;
  1. Q 0
  1. ;
  1. IMMCRSEL(PXVICR,PXVIMM) ; Immunization screen for V Imm Contra/Refusal Events file
  1. ;
  1. ; Input:
  1. ; PXVICR: Contraindication/Refusal Variable Pointer (#9000010.707, #.01)
  1. ; PXVIMM: Immunization IEN (#9999999.14)
  1. ;
  1. ; Return:
  1. ; 0: Entry is not selectable
  1. ; 1: Entry is selectable
  1. ;
  1. N PXCONTRA,PXRSLT
  1. ;
  1. S PXRSLT=0
  1. ;
  1. I '$G(PXVICR) Q PXRSLT
  1. I '$G(PXVIMM) Q PXRSLT
  1. ;
  1. I PXVICR[920.5 D Q PXRSLT
  1. . I $$IMMSTAT^PXAPIIM(PXVIMM)?1(1"A",1"H") S PXRSLT=1
  1. ;
  1. S PXCONTRA=+PXVICR
  1. ;
  1. ; Immunizations Limited To multiple is null
  1. I '$O(^PXV(920.4,PXCONTRA,3,0)) D Q PXRSLT
  1. . I $$IMMSTAT^PXAPIIM(PXVIMM)?1(1"A",1"H") S PXRSLT=1
  1. ;
  1. ; PXVIMM is an entry in the Immunizations Limited To multiple
  1. I $O(^PXV(920.4,PXCONTRA,3,"B",PXVIMM,0)) S PXRSLT=1
  1. ;
  1. Q PXRSLT
  1. ARTAPI(PXALERGY) ; extrinsic function returns whether allergy ; PX*1*216
  1. ; Input:
  1. ; PXALERGY - (required) Pointer to IMM CONTRAINDICATION REASONS file (#920.4) ; PX*1*216
  1. ;
  1. ; Returns:
  1. ; 1: Entry is an allergy ; PX*1*216
  1. ; 0: Entry is not an allergy ; PX*1*216
  1. ;
  1. I '$G(PXALERGY) Q "" ; PX*1*216
  1. I '$D(^PXV(920.4,PXALERGY)) Q "" ; PX*1*216
  1. I $P($G(^PXV(920.4,PXALERGY,0)),U)["ALLERGY" Q 1 ; PX*1*216
  1. I $P($G(^PXV(920.4,PXALERGY,0)),U)="SEVERE REACTION PREVIOUS DOSE" Q 1 ; PX*1*216
  1. Q 0 ; PX*1*216
  1. ;
  1. INST(PXVIN) ; Return Institution based off input
  1. ; Input:
  1. ; PXVIN - Possible values are:
  1. ; "I:X": Institution (#4) IEN #X
  1. ; "V:X": Visit (#9000010) IEN #X
  1. ; "L:X": Hospital Location (#44) IEN #X
  1. ;
  1. ; Output:
  1. ; Pointer to #4
  1. ;
  1. N PXVIEN,PXVINST,PXVTO
  1. ;
  1. S PXVTO=$P($G(PXVIN),":",1)
  1. S PXVIEN=$P($G(PXVIN),":",2)
  1. S PXVINST=""
  1. ;
  1. I PXVTO="I" D
  1. . S PXVINST=PXVIEN
  1. ;
  1. I PXVTO="V",$D(^AUPNVSIT(+PXVIEN,0)) D
  1. . S PXVINST=$$DIV1^PXVXR(PXVIEN)
  1. ;
  1. I PXVTO="L",$D(^SC(+PXVIEN,0)) D
  1. . S PXVINST=$P($G(^SC(+PXVIEN,0)),U,4)
  1. . I 'PXVINST S PXVINST=$$INS4LOC^VSITCK1(PXVIEN)
  1. ;
  1. I 'PXVINST S PXVINST=$G(DUZ(2))
  1. I 'PXVINST S PXVINST=$$KSP^XUPARAM("INST")
  1. ;
  1. Q PXVINST