PXVINV ;BIR/ADM - IMMUNIZATION INVENTORY REPORT ;Aug 06, 2021@10:56:49
;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,217**;Aug 12, 1996;Build 134
;
EN ; entry point for inventory report
N C,CNT,DIC,DIR,LINE,PAGE,PXBYINIT,PXV,PXV0,PXVCT,PXVEXP,PXVHALT,PXVHDR,PXVIMM,PXVLN,PXVMAN,PXVNAME,PXVOUT,PXVPRINT,PXVSEL,PXVSITE,PXVSTAT,PXVTITL,PXVVAC,X,Y,Z
S PXVOUT=0
W @IOF,"IMMUNIZATION INVENTORY REPORTS FOR "_PXVTITLE,!
K DIR S DIR("A",1)="Display/Print Which of the Following?",DIR("A",2)=""
S DIR("A",3)="1. All or Selected Active Inventory",DIR("A",4)="2. Active Inventory With Zero Doses Available"
S DIR("A",5)="",DIR("A")="Enter a number",DIR(0)="NO^1:2"
S DIR("?",1)=" Enter '1' to display/print all or selected active immunization inventory"
S DIR("?",2)=" items or enter '2' to display/print all active immunization inventory"
S DIR("?",3)=" items with zero doses in stock.",DIR("?",4)=""
S DIR("?")="NOTE: Reports will include lots not associated with any facility."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S PXVOUT=1 D END Q
S PXVSEL=Y
I PXVSEL=2 G DEV
W ! K DIR S DIR("A")="Display Inventory Information for All Immunizations",DIR("B")="YES",DIR(0)="Y"
S DIR("?",1)=" Press ENTER to display inventory information for all immunizations or"
S DIR("?")=" enter 'NO' to select specific immunizations."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PXVOUT=1 D END Q
I 'Y D IMM I PXVOUT D END Q
DEV K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Display/Print on which Device: ",%ZIS="QM"
W ! D ^%ZIS I POP S PXVOUT=1 G END
I $D(IO("Q")) K IO("Q") S ZTDESC="IMMUNIZATION INVENTORY",ZTRTN="BEG^PXVINV",(ZTSAVE("PXVFIEN"),ZTSAVE("PXVIMM*"),ZTSAVE("PXVSEL"),ZTSAVE("PXVTITLE"))="" D ^%ZTLOAD G END
BEG ;
U IO S (PXVHDR,PXVIMM,PXVOUT)=0,PAGE=1 K ^TMP("PXV",$J) S Y=DT X ^DD("DD") S PXVPRINT="DATE PRINTED: "_Y
S PXVTITL="ACTIVE IMMUNIZATION INVENTORY"
I PXVSEL=1 S PXVTITL=$S($O(PXVIMM(0)):"SELECTED",1:"ALL")_" "_PXVTITL
I PXVSEL=2 S PXVTITL=PXVTITL_" - ZERO DOSES AVAILABLE"
I $O(PXVIMM(0)) S PXVIMM=1
S (PXVVAC,CNT)=0 F S PXVVAC=$O(^AUTTIML("C",PXVVAC)) Q:'PXVVAC!PXVOUT D
.S PXVLN=0 F S PXVLN=$O(^AUTTIML("C",PXVVAC,PXVLN)) Q:'PXVLN!PXVOUT D UTIL
D HDR,PRINT,END
Q
UTIL ;
S PXV0=$G(^AUTTIML(PXVLN,0)) I '$P(PXV0,"^",3),($P(PXV0,"^",10)=PXVFIEN!($P(PXV0,"^",10)="")) D
.S Z=$E($P($G(^AUTTIMM(PXVVAC,0)),"^"),1,80)
.I PXVSEL=1 D
..I PXVIMM S:$D(PXVIMM(PXVVAC)) ^TMP("PXV",$J,Z,PXVLN)=PXV0,CNT=CNT+1,^TMP("PXV",$J)=CNT Q
..S ^TMP("PXV",$J,Z,PXVLN)=PXV0,CNT=CNT+1,^TMP("PXV",$J)=CNT Q
.I PXVSEL=2,$P(PXV0,"^",12)=0 S ^TMP("PXV",$J,Z,PXVLN)=PXV0,CNT=CNT+1,^TMP("PXV",$J)=CNT
Q
IMM ; select immunization(s) for display
W !! S PXVIMM=1 K DIC S DIC("S")="I '$P(^(0),""^"",7)",DIC=9999999.14,DIC(0)="QEAMZ",DIC("A")="Display Inventory Information for which Immunization? " D ^DIC I Y<0 S PXVOUT=1 Q
S PXVCT=+Y,PXVIMM(PXVCT)=+Y
MORE ; ask for more immunizations
K DIC S DIC("S")="I '$P(^(0),""^"",7)",DIC=9999999.14,DIC(0)="QEAMZ",DIC("A")="Select an Additional Immunization: " D ^DIC I Y>0 S PXVCT=+Y,PXVIMM(PXVCT)=+Y G MORE
Q
PRINT ; print report
I $Y+5>IOSL D HDR I PXVOUT Q
S PXVNAME="" F S PXVNAME=$O(^TMP("PXV",$J,PXVNAME)) Q:PXVNAME=""!PXVOUT S PXVLN=0 F S PXVLN=$O(^TMP("PXV",$J,PXVNAME,PXVLN)) Q:'PXVLN!PXVOUT D INV Q:PXVOUT
S PXVNAME="" I $O(^TMP("PXV",$J,PXVNAME))="" W !,"NO ACTIVE IMMUNIZATION INVENTORY FOUND" I PXVSEL=2 W " WITH ZERO DOSES AVAILABLE"
Q
INV ;
I $Y+4>IOSL D HDR I PXVOUT Q
S PXV0=^TMP("PXV",$J,PXVNAME,PXVLN)
F I=1,2,3,4,9,10,12 S PXV(I)=$P(PXV0,"^",I)
S Y=PXV(2),C=$P(^DD(9999999.41,.02,0),"^",2) D:Y'="" Y^DIQ S PXVMAN=Y
S Y=PXV(3),C=$P(^DD(9999999.41,.03,0),"^",2) D:Y'="" Y^DIQ S PXVSTAT=Y
S Y=PXV(4),C=$P(^DD(9999999.41,.04,0),"^",2) D:Y'="" Y^DIQ S PXVVAC=Y
S Y=PXV(9),C=$P(^DD(9999999.41,.09,0),"^",2) D:Y'="" Y^DIQ S PXVEXP=Y
S PXVSITE=$S($G(PXV(10)):$$GET1^DIQ(4,PXV(10),99),1:"NA")
S PXBYINIT=$$GETINIT(PXVLN)
W !,PXVVAC,!,PXV(1),?28,PXVSTAT,?40,PXBYINIT,?49,PXV(12),?65,PXVEXP,!,$E(PXVMAN,1,63),?65,PXVSITE,!
Q
END I 'PXVOUT,$E(IOST)="C" W !! K DIR S DIR(0)="FOA",DIR("A")="Press Enter/Return key to continue " D ^DIR K DIR
W:$E(IOST)="P" @IOF K ^TMP("PXV",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
K C,CNT,DIC,DIR,LINE,PAGE,PXBYINIT,PXV,PXV0,PXVCT,PXVEXP,PXVHALT,PXVHDR,PXVIMM,PXVLN,PXVMAN,PXVNAME,PXVOUT,PXVPRINT,PXVSEL,PXVSITE,PXVSTAT,PXVTITL,PXVVAC,X,Y,Z
D ^%ZISC W @IOF
Q
HDR ; print heading
I $D(ZTQUEUED) D STOP I PXVHALT S PXVOUT=1 Q
I $E(IOST)'="P",PXVHDR K DIR S DIR(0)="FOA",DIR("A")="Press Enter/Return key to continue " D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PXVOUT=1 Q
W @IOF,?(80-$L(PXVTITLE)\2),PXVTITLE,!,?(80-$L(PXVTITL)\2),PXVTITL
I $E(IOST)="P" W !,?(80-$L(PXVPRINT)\2),PXVPRINT,!
W !,"IMMUNIZATION",!,"LOT NUMBER",?28,"STATUS",?40,"BY",?49,"DOSES UNUSED",?65,"EXPIRATION DATE",!,"MANUFACTURER",?65,"STATION NUMBER",! F LINE=1:1:80 W "="
S PXVHDR=1
Q
STOP ;
S PXVHALT=0 Q:'$D(^%ZIS(14.7))
S ZTSTOP=0 I $$S^%ZTLOAD S (PXVHALT,ZTSTOP)=1 W !!!,?10,"** Task Being Stopped at User's Request **",!!! K ZTREQ
Q
;
GETINIT(PXVLN) ; Get initials of first user who set this lot to active
N PXDT,PXI,PXINIT,PXUSER,PXX
S PXINIT=""
I '$G(PXVLN) Q PXINIT
S PXDT=0
F S PXDT=$O(^AUTTIML(PXVLN,1,"B",PXDT)) Q:'PXDT D Q:PXINIT'=""
. S PXI=0
. F S PXI=$O(^AUTTIML(PXVLN,1,"B",PXDT,PXI)) Q:'PXI D Q:PXINIT'=""
. . S PXX=$G(^AUTTIML(PXVLN,1,PXI,0))
. . I '$P(PXX,U,3) D ;status=active
. . . S PXUSER=$P(PXX,U,2)
. . . S PXINIT=$$GET1^DIQ(200,PXUSER_",",1)
. . . I PXINIT="" S PXINIT=" "
Q PXINIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVINV 5601 printed Dec 13, 2024@02:31:45 Page 2
PXVINV ;BIR/ADM - IMMUNIZATION INVENTORY REPORT ;Aug 06, 2021@10:56:49
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210,216,217**;Aug 12, 1996;Build 134
+2 ;
EN ; entry point for inventory report
+1 NEW C,CNT,DIC,DIR,LINE,PAGE,PXBYINIT,PXV,PXV0,PXVCT,PXVEXP,PXVHALT,PXVHDR,PXVIMM,PXVLN,PXVMAN,PXVNAME,PXVOUT,PXVPRINT,PXVSEL,PXVSITE,PXVSTAT,PXVTITL,PXVVAC,X,Y,Z
+2 SET PXVOUT=0
+3 WRITE @IOF,"IMMUNIZATION INVENTORY REPORTS FOR "_PXVTITLE,!
+4 KILL DIR
SET DIR("A",1)="Display/Print Which of the Following?"
SET DIR("A",2)=""
+5 SET DIR("A",3)="1. All or Selected Active Inventory"
SET DIR("A",4)="2. Active Inventory With Zero Doses Available"
+6 SET DIR("A",5)=""
SET DIR("A")="Enter a number"
SET DIR(0)="NO^1:2"
+7 SET DIR("?",1)=" Enter '1' to display/print all or selected active immunization inventory"
+8 SET DIR("?",2)=" items or enter '2' to display/print all active immunization inventory"
+9 SET DIR("?",3)=" items with zero doses in stock."
SET DIR("?",4)=""
+10 SET DIR("?")="NOTE: Reports will include lots not associated with any facility."
+11 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET PXVOUT=1
DO END
QUIT
+12 SET PXVSEL=Y
+13 IF PXVSEL=2
GOTO DEV
+14 WRITE !
KILL DIR
SET DIR("A")="Display Inventory Information for All Immunizations"
SET DIR("B")="YES"
SET DIR(0)="Y"
+15 SET DIR("?",1)=" Press ENTER to display inventory information for all immunizations or"
+16 SET DIR("?")=" enter 'NO' to select specific immunizations."
+17 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXVOUT=1
DO END
QUIT
+18 IF 'Y
DO IMM
IF PXVOUT
DO END
QUIT
DEV KILL IOP,%ZIS,POP,IO("Q")
SET %ZIS("A")="Display/Print on which Device: "
SET %ZIS="QM"
+1 WRITE !
DO ^%ZIS
IF POP
SET PXVOUT=1
GOTO END
+2 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="IMMUNIZATION INVENTORY"
SET ZTRTN="BEG^PXVINV"
SET (ZTSAVE("PXVFIEN"),ZTSAVE("PXVIMM*"),ZTSAVE("PXVSEL"),ZTSAVE("PXVTITLE"))=""
DO ^%ZTLOAD
GOTO END
BEG ;
+1 USE IO
SET (PXVHDR,PXVIMM,PXVOUT)=0
SET PAGE=1
KILL ^TMP("PXV",$JOB)
SET Y=DT
XECUTE ^DD("DD")
SET PXVPRINT="DATE PRINTED: "_Y
+2 SET PXVTITL="ACTIVE IMMUNIZATION INVENTORY"
+3 IF PXVSEL=1
SET PXVTITL=$SELECT($ORDER(PXVIMM(0)):"SELECTED",1:"ALL")_" "_PXVTITL
+4 IF PXVSEL=2
SET PXVTITL=PXVTITL_" - ZERO DOSES AVAILABLE"
+5 IF $ORDER(PXVIMM(0))
SET PXVIMM=1
+6 SET (PXVVAC,CNT)=0
FOR
SET PXVVAC=$ORDER(^AUTTIML("C",PXVVAC))
if 'PXVVAC!PXVOUT
QUIT
Begin DoDot:1
+7 SET PXVLN=0
FOR
SET PXVLN=$ORDER(^AUTTIML("C",PXVVAC,PXVLN))
if 'PXVLN!PXVOUT
QUIT
DO UTIL
End DoDot:1
+8 DO HDR
DO PRINT
DO END
+9 QUIT
UTIL ;
+1 SET PXV0=$GET(^AUTTIML(PXVLN,0))
IF '$PIECE(PXV0,"^",3)
IF ($PIECE(PXV0,"^",10)=PXVFIEN!($PIECE(PXV0,"^",10)=""))
Begin DoDot:1
+2 SET Z=$EXTRACT($PIECE($GET(^AUTTIMM(PXVVAC,0)),"^"),1,80)
+3 IF PXVSEL=1
Begin DoDot:2
+4 IF PXVIMM
if $DATA(PXVIMM(PXVVAC))
SET ^TMP("PXV",$JOB,Z,PXVLN)=PXV0
SET CNT=CNT+1
SET ^TMP("PXV",$JOB)=CNT
QUIT
+5 SET ^TMP("PXV",$JOB,Z,PXVLN)=PXV0
SET CNT=CNT+1
SET ^TMP("PXV",$JOB)=CNT
QUIT
End DoDot:2
+6 IF PXVSEL=2
IF $PIECE(PXV0,"^",12)=0
SET ^TMP("PXV",$JOB,Z,PXVLN)=PXV0
SET CNT=CNT+1
SET ^TMP("PXV",$JOB)=CNT
End DoDot:1
+7 QUIT
IMM ; select immunization(s) for display
+1 WRITE !!
SET PXVIMM=1
KILL DIC
SET DIC("S")="I '$P(^(0),""^"",7)"
SET DIC=9999999.14
SET DIC(0)="QEAMZ"
SET DIC("A")="Display Inventory Information for which Immunization? "
DO ^DIC
IF Y<0
SET PXVOUT=1
QUIT
+2 SET PXVCT=+Y
SET PXVIMM(PXVCT)=+Y
MORE ; ask for more immunizations
+1 KILL DIC
SET DIC("S")="I '$P(^(0),""^"",7)"
SET DIC=9999999.14
SET DIC(0)="QEAMZ"
SET DIC("A")="Select an Additional Immunization: "
DO ^DIC
IF Y>0
SET PXVCT=+Y
SET PXVIMM(PXVCT)=+Y
GOTO MORE
+2 QUIT
PRINT ; print report
+1 IF $Y+5>IOSL
DO HDR
IF PXVOUT
QUIT
+2 SET PXVNAME=""
FOR
SET PXVNAME=$ORDER(^TMP("PXV",$JOB,PXVNAME))
if PXVNAME=""!PXVOUT
QUIT
SET PXVLN=0
FOR
SET PXVLN=$ORDER(^TMP("PXV",$JOB,PXVNAME,PXVLN))
if 'PXVLN!PXVOUT
QUIT
DO INV
if PXVOUT
QUIT
+3 SET PXVNAME=""
IF $ORDER(^TMP("PXV",$JOB,PXVNAME))=""
WRITE !,"NO ACTIVE IMMUNIZATION INVENTORY FOUND"
IF PXVSEL=2
WRITE " WITH ZERO DOSES AVAILABLE"
+4 QUIT
INV ;
+1 IF $Y+4>IOSL
DO HDR
IF PXVOUT
QUIT
+2 SET PXV0=^TMP("PXV",$JOB,PXVNAME,PXVLN)
+3 FOR I=1,2,3,4,9,10,12
SET PXV(I)=$PIECE(PXV0,"^",I)
+4 SET Y=PXV(2)
SET C=$PIECE(^DD(9999999.41,.02,0),"^",2)
if Y'=""
DO Y^DIQ
SET PXVMAN=Y
+5 SET Y=PXV(3)
SET C=$PIECE(^DD(9999999.41,.03,0),"^",2)
if Y'=""
DO Y^DIQ
SET PXVSTAT=Y
+6 SET Y=PXV(4)
SET C=$PIECE(^DD(9999999.41,.04,0),"^",2)
if Y'=""
DO Y^DIQ
SET PXVVAC=Y
+7 SET Y=PXV(9)
SET C=$PIECE(^DD(9999999.41,.09,0),"^",2)
if Y'=""
DO Y^DIQ
SET PXVEXP=Y
+8 SET PXVSITE=$SELECT($GET(PXV(10)):$$GET1^DIQ(4,PXV(10),99),1:"NA")
+9 SET PXBYINIT=$$GETINIT(PXVLN)
+10 WRITE !,PXVVAC,!,PXV(1),?28,PXVSTAT,?40,PXBYINIT,?49,PXV(12),?65,PXVEXP,!,$EXTRACT(PXVMAN,1,63),?65,PXVSITE,!
+11 QUIT
END IF 'PXVOUT
IF $EXTRACT(IOST)="C"
WRITE !!
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press Enter/Return key to continue "
DO ^DIR
KILL DIR
+1 if $EXTRACT(IOST)="P"
WRITE @IOF
KILL ^TMP("PXV",$JOB)
IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+2 KILL C,CNT,DIC,DIR,LINE,PAGE,PXBYINIT,PXV,PXV0,PXVCT,PXVEXP,PXVHALT,PXVHDR,PXVIMM,PXVLN,PXVMAN,PXVNAME,PXVOUT,PXVPRINT,PXVSEL,PXVSITE,PXVSTAT,PXVTITL,PXVVAC,X,Y,Z
+3 DO ^%ZISC
WRITE @IOF
+4 QUIT
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO STOP
IF PXVHALT
SET PXVOUT=1
QUIT
+2 IF $EXTRACT(IOST)'="P"
IF PXVHDR
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press Enter/Return key to continue "
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXVOUT=1
QUIT
+3 WRITE @IOF,?(80-$LENGTH(PXVTITLE)\2),PXVTITLE,!,?(80-$LENGTH(PXVTITL)\2),PXVTITL
+4 IF $EXTRACT(IOST)="P"
WRITE !,?(80-$LENGTH(PXVPRINT)\2),PXVPRINT,!
+5 WRITE !,"IMMUNIZATION",!,"LOT NUMBER",?28,"STATUS",?40,"BY",?49,"DOSES UNUSED",?65,"EXPIRATION DATE",!,"MANUFACTURER",?65,"STATION NUMBER",!
FOR LINE=1:1:80
WRITE "="
+6 SET PXVHDR=1
+7 QUIT
STOP ;
+1 SET PXVHALT=0
if '$DATA(^%ZIS(14.7))
QUIT
+2 SET ZTSTOP=0
IF $$S^%ZTLOAD
SET (PXVHALT,ZTSTOP)=1
WRITE !!!,?10,"** Task Being Stopped at User's Request **",!!!
KILL ZTREQ
+3 QUIT
+4 ;
GETINIT(PXVLN) ; Get initials of first user who set this lot to active
+1 NEW PXDT,PXI,PXINIT,PXUSER,PXX
+2 SET PXINIT=""
+3 IF '$GET(PXVLN)
QUIT PXINIT
+4 SET PXDT=0
+5 FOR
SET PXDT=$ORDER(^AUTTIML(PXVLN,1,"B",PXDT))
if 'PXDT
QUIT
Begin DoDot:1
+6 SET PXI=0
+7 FOR
SET PXI=$ORDER(^AUTTIML(PXVLN,1,"B",PXDT,PXI))
if 'PXI
QUIT
Begin DoDot:2
+8 SET PXX=$GET(^AUTTIML(PXVLN,1,PXI,0))
+9 ;status=active
IF '$PIECE(PXX,U,3)
Begin DoDot:3
+10 SET PXUSER=$PIECE(PXX,U,2)
+11 SET PXINIT=$$GET1^DIQ(200,PXUSER_",",1)
+12 IF PXINIT=""
SET PXINIT=" "
End DoDot:3
End DoDot:2
if PXINIT'=""
QUIT
End DoDot:1
if PXINIT'=""
QUIT
+13 QUIT PXINIT
