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

PXVINV.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN ; entry point for inventory report
  1. 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
  1. S PXVOUT=0
  1. W @IOF,"IMMUNIZATION INVENTORY REPORTS FOR "_PXVTITLE,!
  1. K DIR S DIR("A",1)="Display/Print Which of the Following?",DIR("A",2)=""
  1. S DIR("A",3)="1. All or Selected Active Inventory",DIR("A",4)="2. Active Inventory With Zero Doses Available"
  1. S DIR("A",5)="",DIR("A")="Enter a number",DIR(0)="NO^1:2"
  1. S DIR("?",1)=" Enter '1' to display/print all or selected active immunization inventory"
  1. S DIR("?",2)=" items or enter '2' to display/print all active immunization inventory"
  1. S DIR("?",3)=" items with zero doses in stock.",DIR("?",4)=""
  1. S DIR("?")="NOTE: Reports will include lots not associated with any facility."
  1. D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S PXVOUT=1 D END Q
  1. S PXVSEL=Y
  1. I PXVSEL=2 G DEV
  1. W ! K DIR S DIR("A")="Display Inventory Information for All Immunizations",DIR("B")="YES",DIR(0)="Y"
  1. S DIR("?",1)=" Press ENTER to display inventory information for all immunizations or"
  1. S DIR("?")=" enter 'NO' to select specific immunizations."
  1. D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PXVOUT=1 D END Q
  1. I 'Y D IMM I PXVOUT D END Q
  1. DEV K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Display/Print on which Device: ",%ZIS="QM"
  1. W ! D ^%ZIS I POP S PXVOUT=1 G END
  1. 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
  1. BEG ;
  1. U IO S (PXVHDR,PXVIMM,PXVOUT)=0,PAGE=1 K ^TMP("PXV",$J) S Y=DT X ^DD("DD") S PXVPRINT="DATE PRINTED: "_Y
  1. S PXVTITL="ACTIVE IMMUNIZATION INVENTORY"
  1. I PXVSEL=1 S PXVTITL=$S($O(PXVIMM(0)):"SELECTED",1:"ALL")_" "_PXVTITL
  1. I PXVSEL=2 S PXVTITL=PXVTITL_" - ZERO DOSES AVAILABLE"
  1. I $O(PXVIMM(0)) S PXVIMM=1
  1. S (PXVVAC,CNT)=0 F S PXVVAC=$O(^AUTTIML("C",PXVVAC)) Q:'PXVVAC!PXVOUT D
  1. .S PXVLN=0 F S PXVLN=$O(^AUTTIML("C",PXVVAC,PXVLN)) Q:'PXVLN!PXVOUT D UTIL
  1. D HDR,PRINT,END
  1. Q
  1. UTIL ;
  1. S PXV0=$G(^AUTTIML(PXVLN,0)) I '$P(PXV0,"^",3),($P(PXV0,"^",10)=PXVFIEN!($P(PXV0,"^",10)="")) D
  1. .S Z=$E($P($G(^AUTTIMM(PXVVAC,0)),"^"),1,80)
  1. .I PXVSEL=1 D
  1. ..I PXVIMM S:$D(PXVIMM(PXVVAC)) ^TMP("PXV",$J,Z,PXVLN)=PXV0,CNT=CNT+1,^TMP("PXV",$J)=CNT Q
  1. ..S ^TMP("PXV",$J,Z,PXVLN)=PXV0,CNT=CNT+1,^TMP("PXV",$J)=CNT Q
  1. .I PXVSEL=2,$P(PXV0,"^",12)=0 S ^TMP("PXV",$J,Z,PXVLN)=PXV0,CNT=CNT+1,^TMP("PXV",$J)=CNT
  1. Q
  1. IMM ; select immunization(s) for display
  1. 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
  1. S PXVCT=+Y,PXVIMM(PXVCT)=+Y
  1. MORE ; ask for more immunizations
  1. 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
  1. Q
  1. PRINT ; print report
  1. I $Y+5>IOSL D HDR I PXVOUT Q
  1. 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
  1. S PXVNAME="" I $O(^TMP("PXV",$J,PXVNAME))="" W !,"NO ACTIVE IMMUNIZATION INVENTORY FOUND" I PXVSEL=2 W " WITH ZERO DOSES AVAILABLE"
  1. Q
  1. INV ;
  1. I $Y+4>IOSL D HDR I PXVOUT Q
  1. S PXV0=^TMP("PXV",$J,PXVNAME,PXVLN)
  1. F I=1,2,3,4,9,10,12 S PXV(I)=$P(PXV0,"^",I)
  1. S Y=PXV(2),C=$P(^DD(9999999.41,.02,0),"^",2) D:Y'="" Y^DIQ S PXVMAN=Y
  1. S Y=PXV(3),C=$P(^DD(9999999.41,.03,0),"^",2) D:Y'="" Y^DIQ S PXVSTAT=Y
  1. S Y=PXV(4),C=$P(^DD(9999999.41,.04,0),"^",2) D:Y'="" Y^DIQ S PXVVAC=Y
  1. S Y=PXV(9),C=$P(^DD(9999999.41,.09,0),"^",2) D:Y'="" Y^DIQ S PXVEXP=Y
  1. S PXVSITE=$S($G(PXV(10)):$$GET1^DIQ(4,PXV(10),99),1:"NA")
  1. S PXBYINIT=$$GETINIT(PXVLN)
  1. W !,PXVVAC,!,PXV(1),?28,PXVSTAT,?40,PXBYINIT,?49,PXV(12),?65,PXVEXP,!,$E(PXVMAN,1,63),?65,PXVSITE,!
  1. Q
  1. 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
  1. W:$E(IOST)="P" @IOF K ^TMP("PXV",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
  1. 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
  1. D ^%ZISC W @IOF
  1. Q
  1. HDR ; print heading
  1. I $D(ZTQUEUED) D STOP I PXVHALT S PXVOUT=1 Q
  1. 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
  1. W @IOF,?(80-$L(PXVTITLE)\2),PXVTITLE,!,?(80-$L(PXVTITL)\2),PXVTITL
  1. I $E(IOST)="P" W !,?(80-$L(PXVPRINT)\2),PXVPRINT,!
  1. W !,"IMMUNIZATION",!,"LOT NUMBER",?28,"STATUS",?40,"BY",?49,"DOSES UNUSED",?65,"EXPIRATION DATE",!,"MANUFACTURER",?65,"STATION NUMBER",! F LINE=1:1:80 W "="
  1. S PXVHDR=1
  1. Q
  1. STOP ;
  1. S PXVHALT=0 Q:'$D(^%ZIS(14.7))
  1. S ZTSTOP=0 I $$S^%ZTLOAD S (PXVHALT,ZTSTOP)=1 W !!!,?10,"** Task Being Stopped at User's Request **",!!! K ZTREQ
  1. Q
  1. ;
  1. GETINIT(PXVLN) ; Get initials of first user who set this lot to active
  1. N PXDT,PXI,PXINIT,PXUSER,PXX
  1. S PXINIT=""
  1. I '$G(PXVLN) Q PXINIT
  1. S PXDT=0
  1. F S PXDT=$O(^AUTTIML(PXVLN,1,"B",PXDT)) Q:'PXDT D Q:PXINIT'=""
  1. . S PXI=0
  1. . F S PXI=$O(^AUTTIML(PXVLN,1,"B",PXDT,PXI)) Q:'PXI D Q:PXINIT'=""
  1. . . S PXX=$G(^AUTTIML(PXVLN,1,PXI,0))
  1. . . I '$P(PXX,U,3) D ;status=active
  1. . . . S PXUSER=$P(PXX,U,2)
  1. . . . S PXINIT=$$GET1^DIQ(200,PXUSER_",",1)
  1. . . . I PXINIT="" S PXINIT=" "
  1. Q PXINIT