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

PSSPRMIX.m

Go to the documentation of this file. 
  1. PSSPRMIX ;BIR/RTR-PREMIX REPORT ;07/14/07
  1.  ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
  1.  ;
  1. REP ;IV Solutions report
  1.  ;
  1.  W !!,"This report displays only those solutions in the IV Solutions (#52.7) File",!,"that are marked as PreMix IV Solutions, or it displays all Solutions."
  1.  N DIR,PSSPRTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
  1.  K DIR,Y S DIR(0)="SO^P:Print only IV Solutions marked as PreMix;A:Print All IV Solutions",DIR("A")="Print report for PreMix (P), or All IV Solutions (A): (P/A): Premix",DIR("B")="P"
  1.  S DIR("?")=" ",DIR("?",1)="Enter 'P' to see only those IV Solutions that are marked as PreMix,"
  1.  S DIR("?",2)="Enter 'A' to see all IV Solutions, regardless of PreMix designation."
  1.  D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
  1.  I Y'="P",Y'="A" D MESS Q
  1.  S PSSPRTP=Y
  1.  W !!?3,"This report is designed for 80 column format!",!
  1.  K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 W !!,"Nothing queued to print.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,IOP,%ZIS,POP Q
  1.  I $D(IO("Q")) S ZTRTN="START^PSSPRMIX",ZTDESC="IV Solutions PreMix Report",ZTSAVE("PSSPRTP")="" D ^%ZTLOAD W !!,"Report queued to print.",! D  K IOP,%ZIS,POP Q
  1.  .K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1.  ;
  1.  U IO G STARTX
  1. START ;
  1.  U IO
  1.  N DIR,Y,DIRUT,DIROUT,DUOUT,DTOUT,X
  1. STARTX ;
  1.  N PSSPRM,PSSPRMDV,PSSPRMLN,PSSPROUT,PSSPRMCT,PSSPRMIN,PSSPRMAR,PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMTP,PSSPRMSU,PSSPRMSY,PSSPRMSX,PSSPRMSC,PSSPRMDF,PSSPRMDZ,PSSPRMDQ,PSSPRMFD
  1.  S (PSSPROUT,PSSPRMFD)=0,PSSPRMDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSPRMCT=1
  1.  K PSSPRMLN S $P(PSSPRMLN,"-",79)=""
  1.  D HD
  1.  S PSSPRM="" F  S PSSPRM=$O(^PS(52.7,"B",PSSPRM)) Q:PSSPRM=""!(PSSPROUT)  D
  1.  .F PSSPRMIN=0:0 S PSSPRMIN=$O(^PS(52.7,"B",PSSPRM,PSSPRMIN)) Q:'PSSPRMIN!(PSSPROUT)  D
  1.  ..K PSSPRMAR,PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMTP,PSSPRMSU,PSSPRMSY,PSSPRMSC
  1.  ..S PSSPRMTP=PSSPRMIN_","
  1.  ..D GETS^DIQ(52.7,PSSPRMTP,".01;.02;1;2;8;9;17;18","IE","PSSPRMAR")
  1.  ..I PSSPRTP="P",'$G(PSSPRMAR(52.7,PSSPRMTP,18,"I")) Q
  1.  ..S PSSPRMFD=1
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..S PSSPRML1=$L($G(PSSPRMAR(52.7,PSSPRMTP,.01,"E"))),PSSPRML2=$L($G(PSSPRMAR(52.7,PSSPRMTP,2,"E"))),PSSPRML3=0
  1.  ..S PSSPRML3=PSSPRML1+PSSPRML2
  1.  ..W !!?18,"Print Name: "_$G(PSSPRMAR(52.7,PSSPRMTP,.01,"E"))
  1.  ..I PSSPRML3<37 W "    Volume: "_$G(PSSPRMAR(52.7,PSSPRMTP,2,"E"))
  1.  ..I PSSPRML3'<37 W !?30,"Volume: "_$G(PSSPRMAR(52.7,PSSPRMTP,2,"E"))
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..W !?14,"Print Name {2}: "_$G(PSSPRMAR(52.7,PSSPRMTP,.02,"E"))
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..W !?20,"Synonyms: "
  1.  ..S PSSPRMSC=0 F PSSPRMSY=0:0 S PSSPRMSY=$O(^PS(52.7,PSSPRMIN,3,PSSPRMSY)) Q:'PSSPRMSY!(PSSPROUT)  D
  1.  ...K PSSPRMSU,PSSPRMSX
  1.  ...S PSSPRMSU=PSSPRMSY_","_PSSPRMIN_"," S PSSPRMSX=$$GET1^DIQ(52.703,PSSPRMSU,".01")
  1.  ...W:PSSPRMSC !?30,$G(PSSPRMSX) W:'PSSPRMSC ?30,$G(PSSPRMSX)
  1.  ...S PSSPRMSC=1
  1.  ...I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..Q:PSSPROUT
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..W !?16,"Generic Drug: "_$G(PSSPRMAR(52.7,PSSPRMTP,1,"E"))
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..K PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMDF,PSSPRMDZ,PSSPRMDQ
  1.  ..S PSSPRML1=$L($G(PSSPRMAR(52.7,PSSPRMTP,9,"E"))),PSSPRMDF=$G(PSSPRMAR(52.7,PSSPRMTP,9,"I"))
  1.  ..S PSSPRML2=0 I PSSPRMDF S PSSPRMDZ=PSSPRMDF_"," S PSSPRMDQ=$$GET1^DIQ(50.7,PSSPRMDZ,".02") S PSSPRML2=$L(PSSPRMDQ)
  1.  ..S PSSPRML3=PSSPRML1+PSSPRML2
  1.  ..W !?5,"Pharmacy Orderable Item: "_$G(PSSPRMAR(52.7,PSSPRMTP,9,"E"))
  1.  ..I PSSPRML3<47 W "  "_$G(PSSPRMDQ)
  1.  ..I PSSPRML3'<47 W !?30,$G(PSSPRMDQ)
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..W !?11,"Inactivation Date: "_$G(PSSPRMAR(52.7,PSSPRMTP,8,"E"))
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..W !,"Used in IV Fluid Order Entry: "_$G(PSSPRMAR(52.7,PSSPRMTP,17,"E"))
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ..W !?22,"PreMix: "_$G(PSSPRMAR(52.7,PSSPRMTP,18,"E"))
  1.  ..I ($Y+5)>IOSL D HD Q:PSSPROUT
  1.  ;
  1. END ;End of report
  1.  I PSSPRTP="P",'$G(PSSPROUT),'$G(PSSPRMFD) W !!,"No IV Solutions marked as PreMixes found.",!
  1.  I $G(PSSPRMDV)="P" W !!,"End of Report.",!
  1.  K PSSPRTP
  1.  I '$G(PSSPROUT),$G(PSSPRMDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1.  I $G(PSSPRMDV)="C" W !
  1.  E  W @IOF
  1.  D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. HD ;Report Header
  1.  I $G(PSSPRMDV)="C",$G(PSSPRMCT)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSPROUT=1 Q
  1.  W @IOF W !,$S(PSSPRTP="P":"Solution PreMix report for IV Solutions marked as PreMix",1:"Solution PreMix report for all IV Solutions"),?69,"Page: "_$G(PSSPRMCT),!,PSSPRMLN,! S PSSPRMCT=PSSPRMCT+1
  1.  Q
  1.  ;
  1. MESS ;
  1.  W !!,"No Action taken.",!
  1.  K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1.  Q