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

PXRMCIMM.m

Go to the documentation of this file.
PXRMCIMM ;SLC/AGP - Computed findings for IMMUNIZATIONS. ;Dec 22, 2022@14:09:34
 ;;2.0;CLINICAL REMINDERS;**65,84**;Feb 4, 2005;Build 2
 ;
 ; Reference to GETLOT^PXAPIIM in ICR #6387
 ; Reference to CVXTOIEN^PXAPIIM in ICR #6387
 ; Reference to ^AUTTIMM( in ICR #1990
 ;
 Q
 ;
LOTINFO(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
 N CNT,DTE,LOC,I,IMMIEN,IMMNAME,INPUTS,NODE,PXRMARR,PXRMCDAT,TCNT
 S INPUTS="",NFOUND=0,IMMIEN=""
 I TEST["I:" D
 .S IMMNAME=$P(TEST,":",2)
 .S IMMIEN=$O(^AUTTIMM("B",IMMNAME,""))
 I TEST["C:" D
 .D CVXTOIEN^PXAPIIM(.PXRMCDAT,$P(TEST,":",2))
 .S IMMIEN=$P($G(PXRMCDAT),U)
 .S IMMNAME=$P($G(PXRMCDAT),U,2)
 S TEST=""
 S DTE=$G(^TMP($J,"PXRM DIALOG VISIT INFO","DATETIME"))
 S LOC=$P($G(^TMP($J,"PXRM DIALOG VISIT INFO","LOCATION")),U)
 I +LOC<1 Q
 S LOC="L:"_LOC
 I $G(IMMIEN)="" Q
 D GETLOT^PXAPIIM(.PXRMARR,IMMIEN,DTE,LOC)
 S CNT=0 F  S CNT=$O(PXRMARR(CNT)) Q:CNT'>0  D
 .S NODE=$G(PXRMARR(CNT,0))
 .S NFOUND=NFOUND+1,TEST(NFOUND)=1,DATE(NFOUND)=DT
 .S DATA(NFOUND,"LOT NUMBER")=$P(NODE,U,2)
 .S DATA(NFOUND,"MANUFACTURER")=$P(NODE,U,3)
 .S DATA(NFOUND,"EXPIRATION DATE")=$P(NODE,U,4)
 .S DATA(NFOUND,"DOSES UNUSED")=$P(NODE,U,5)
 .S DATA(NFOUND,"LOW SUPPLY ALERT")=$P(NODE,U,6)
 .S DATA(NFOUND,"NDC CODE")=$P(NODE,U,7)
 .S TCNT=1
 .S TEXT(NFOUND,TCNT)="Immunization: "_IMMNAME
 .S TCNT=TCNT+1,TEXT(NFOUND,TCNT)="Lot: "_$P(NODE,U,2)
 .S TCNT=TCNT+1,TEXT(NFOUND,TCNT)="Manufacturer: "_$P(NODE,U,3)_"  Expiration Date: "_$TR($$FMTE^XLFDT($P(NODE,U,4),"2ZM"),"@"," ")
 .S TCNT=TCNT+1,TEXT(NFOUND,TCNT)="Doses unused: "_$P(NODE,U,5)_"  NDC Code: "_$P(NODE,U,7)
 Q