- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCIMM 1634 printed Feb 18, 2025@23:09:34 Page 2
- PXRMCIMM ;SLC/AGP - Computed findings for IMMUNIZATIONS. ;Dec 22, 2022@14:09:34
- +1 ;;2.0;CLINICAL REMINDERS;**65,84**;Feb 4, 2005;Build 2
- +2 ;
- +3 ; Reference to GETLOT^PXAPIIM in ICR #6387
- +4 ; Reference to CVXTOIEN^PXAPIIM in ICR #6387
- +5 ; Reference to ^AUTTIMM( in ICR #1990
- +6 ;
- +7 QUIT
- +8 ;
- LOTINFO(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
- +1 NEW CNT,DTE,LOC,I,IMMIEN,IMMNAME,INPUTS,NODE,PXRMARR,PXRMCDAT,TCNT
- +2 SET INPUTS=""
- SET NFOUND=0
- SET IMMIEN=""
- +3 IF TEST["I:"
- Begin DoDot:1
- +4 SET IMMNAME=$PIECE(TEST,":",2)
- +5 SET IMMIEN=$ORDER(^AUTTIMM("B",IMMNAME,""))
- End DoDot:1
- +6 IF TEST["C:"
- Begin DoDot:1
- +7 DO CVXTOIEN^PXAPIIM(.PXRMCDAT,$PIECE(TEST,":",2))
- +8 SET IMMIEN=$PIECE($GET(PXRMCDAT),U)
- +9 SET IMMNAME=$PIECE($GET(PXRMCDAT),U,2)
- End DoDot:1
- +10 SET TEST=""
- +11 SET DTE=$GET(^TMP($JOB,"PXRM DIALOG VISIT INFO","DATETIME"))
- +12 SET LOC=$PIECE($GET(^TMP($JOB,"PXRM DIALOG VISIT INFO","LOCATION")),U)
- +13 IF +LOC<1
- QUIT
- +14 SET LOC="L:"_LOC
- +15 IF $GET(IMMIEN)=""
- QUIT
- +16 DO GETLOT^PXAPIIM(.PXRMARR,IMMIEN,DTE,LOC)
- +17 SET CNT=0
- FOR
- SET CNT=$ORDER(PXRMARR(CNT))
- if CNT'>0
- QUIT
- Begin DoDot:1
- +18 SET NODE=$GET(PXRMARR(CNT,0))
- +19 SET NFOUND=NFOUND+1
- SET TEST(NFOUND)=1
- SET DATE(NFOUND)=DT
- +20 SET DATA(NFOUND,"LOT NUMBER")=$PIECE(NODE,U,2)
- +21 SET DATA(NFOUND,"MANUFACTURER")=$PIECE(NODE,U,3)
- +22 SET DATA(NFOUND,"EXPIRATION DATE")=$PIECE(NODE,U,4)
- +23 SET DATA(NFOUND,"DOSES UNUSED")=$PIECE(NODE,U,5)
- +24 SET DATA(NFOUND,"LOW SUPPLY ALERT")=$PIECE(NODE,U,6)
- +25 SET DATA(NFOUND,"NDC CODE")=$PIECE(NODE,U,7)
- +26 SET TCNT=1
- +27 SET TEXT(NFOUND,TCNT)="Immunization: "_IMMNAME
- +28 SET TCNT=TCNT+1
- SET TEXT(NFOUND,TCNT)="Lot: "_$PIECE(NODE,U,2)
- +29 SET TCNT=TCNT+1
- SET TEXT(NFOUND,TCNT)="Manufacturer: "_$PIECE(NODE,U,3)_" Expiration Date: "_$TRANSLATE($$FMTE^XLFDT($PIECE(NODE,U,4),"2ZM"),"@"," ")
- +30 SET TCNT=TCNT+1
- SET TEXT(NFOUND,TCNT)="Doses unused: "_$PIECE(NODE,U,5)_" NDC Code: "_$PIECE(NODE,U,7)
- End DoDot:1
- +31 QUIT
