- 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 Feb 18, 2025@23:58:02 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