PSSPRMIX ;BIR/RTR-PREMIX REPORT ;07/14/07
;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
;
REP ;IV Solutions report
;
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."
N DIR,PSSPRTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
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"
S DIR("?")=" ",DIR("?",1)="Enter 'P' to see only those IV Solutions that are marked as PreMix,"
S DIR("?",2)="Enter 'A' to see all IV Solutions, regardless of PreMix designation."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
I Y'="P",Y'="A" D MESS Q
S PSSPRTP=Y
W !!?3,"This report is designed for 80 column format!",!
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
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
.K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
;
U IO G STARTX
START ;
U IO
N DIR,Y,DIRUT,DIROUT,DUOUT,DTOUT,X
STARTX ;
N PSSPRM,PSSPRMDV,PSSPRMLN,PSSPROUT,PSSPRMCT,PSSPRMIN,PSSPRMAR,PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMTP,PSSPRMSU,PSSPRMSY,PSSPRMSX,PSSPRMSC,PSSPRMDF,PSSPRMDZ,PSSPRMDQ,PSSPRMFD
S (PSSPROUT,PSSPRMFD)=0,PSSPRMDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSPRMCT=1
K PSSPRMLN S $P(PSSPRMLN,"-",79)=""
D HD
S PSSPRM="" F S PSSPRM=$O(^PS(52.7,"B",PSSPRM)) Q:PSSPRM=""!(PSSPROUT) D
.F PSSPRMIN=0:0 S PSSPRMIN=$O(^PS(52.7,"B",PSSPRM,PSSPRMIN)) Q:'PSSPRMIN!(PSSPROUT) D
..K PSSPRMAR,PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMTP,PSSPRMSU,PSSPRMSY,PSSPRMSC
..S PSSPRMTP=PSSPRMIN_","
..D GETS^DIQ(52.7,PSSPRMTP,".01;.02;1;2;8;9;17;18","IE","PSSPRMAR")
..I PSSPRTP="P",'$G(PSSPRMAR(52.7,PSSPRMTP,18,"I")) Q
..S PSSPRMFD=1
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..S PSSPRML1=$L($G(PSSPRMAR(52.7,PSSPRMTP,.01,"E"))),PSSPRML2=$L($G(PSSPRMAR(52.7,PSSPRMTP,2,"E"))),PSSPRML3=0
..S PSSPRML3=PSSPRML1+PSSPRML2
..W !!?18,"Print Name: "_$G(PSSPRMAR(52.7,PSSPRMTP,.01,"E"))
..I PSSPRML3<37 W " Volume: "_$G(PSSPRMAR(52.7,PSSPRMTP,2,"E"))
..I PSSPRML3'<37 W !?30,"Volume: "_$G(PSSPRMAR(52.7,PSSPRMTP,2,"E"))
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..W !?14,"Print Name {2}: "_$G(PSSPRMAR(52.7,PSSPRMTP,.02,"E"))
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..W !?20,"Synonyms: "
..S PSSPRMSC=0 F PSSPRMSY=0:0 S PSSPRMSY=$O(^PS(52.7,PSSPRMIN,3,PSSPRMSY)) Q:'PSSPRMSY!(PSSPROUT) D
...K PSSPRMSU,PSSPRMSX
...S PSSPRMSU=PSSPRMSY_","_PSSPRMIN_"," S PSSPRMSX=$$GET1^DIQ(52.703,PSSPRMSU,".01")
...W:PSSPRMSC !?30,$G(PSSPRMSX) W:'PSSPRMSC ?30,$G(PSSPRMSX)
...S PSSPRMSC=1
...I ($Y+5)>IOSL D HD Q:PSSPROUT
..Q:PSSPROUT
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..W !?16,"Generic Drug: "_$G(PSSPRMAR(52.7,PSSPRMTP,1,"E"))
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..K PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMDF,PSSPRMDZ,PSSPRMDQ
..S PSSPRML1=$L($G(PSSPRMAR(52.7,PSSPRMTP,9,"E"))),PSSPRMDF=$G(PSSPRMAR(52.7,PSSPRMTP,9,"I"))
..S PSSPRML2=0 I PSSPRMDF S PSSPRMDZ=PSSPRMDF_"," S PSSPRMDQ=$$GET1^DIQ(50.7,PSSPRMDZ,".02") S PSSPRML2=$L(PSSPRMDQ)
..S PSSPRML3=PSSPRML1+PSSPRML2
..W !?5,"Pharmacy Orderable Item: "_$G(PSSPRMAR(52.7,PSSPRMTP,9,"E"))
..I PSSPRML3<47 W " "_$G(PSSPRMDQ)
..I PSSPRML3'<47 W !?30,$G(PSSPRMDQ)
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..W !?11,"Inactivation Date: "_$G(PSSPRMAR(52.7,PSSPRMTP,8,"E"))
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..W !,"Used in IV Fluid Order Entry: "_$G(PSSPRMAR(52.7,PSSPRMTP,17,"E"))
..I ($Y+5)>IOSL D HD Q:PSSPROUT
..W !?22,"PreMix: "_$G(PSSPRMAR(52.7,PSSPRMTP,18,"E"))
..I ($Y+5)>IOSL D HD Q:PSSPROUT
;
END ;End of report
I PSSPRTP="P",'$G(PSSPROUT),'$G(PSSPRMFD) W !!,"No IV Solutions marked as PreMixes found.",!
I $G(PSSPRMDV)="P" W !!,"End of Report.",!
K PSSPRTP
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
I $G(PSSPRMDV)="C" W !
E W @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
HD ;Report Header
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
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
Q
;
MESS ;
W !!,"No Action taken.",!
K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPRMIX 4760 printed Dec 13, 2024@02:34:14 Page 2
PSSPRMIX ;BIR/RTR-PREMIX REPORT ;07/14/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
+2 ;
REP ;IV Solutions report
+1 ;
+2 WRITE !!,"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."
+3 NEW DIR,PSSPRTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
+4 KILL DIR,Y
SET DIR(0)="SO^P:Print only IV Solutions marked as PreMix;A:Print All IV Solutions"
SET DIR("A")="Print report for PreMix (P), or All IV Solutions (A): (P/A): Premix"
SET DIR("B")="P"
+5 SET DIR("?")=" "
SET DIR("?",1)="Enter 'P' to see only those IV Solutions that are marked as PreMix,"
+6 SET DIR("?",2)="Enter 'A' to see all IV Solutions, regardless of PreMix designation."
+7 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
DO MESS
QUIT
+8 IF Y'="P"
IF Y'="A"
DO MESS
QUIT
+9 SET PSSPRTP=Y
+10 WRITE !!?3,"This report is designed for 80 column format!",!
+11 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)>0
WRITE !!,"Nothing queued to print.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,IOP,%ZIS,POP
QUIT
+12 IF $DATA(IO("Q"))
SET ZTRTN="START^PSSPRMIX"
SET ZTDESC="IV Solutions PreMix Report"
SET ZTSAVE("PSSPRTP")=""
DO ^%ZTLOAD
WRITE !!,"Report queued to print.",!
Begin DoDot:1
+13 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
KILL IOP,%ZIS,POP
QUIT
+14 ;
+15 USE IO
GOTO STARTX
START ;
+1 USE IO
+2 NEW DIR,Y,DIRUT,DIROUT,DUOUT,DTOUT,X
STARTX ;
+1 NEW PSSPRM,PSSPRMDV,PSSPRMLN,PSSPROUT,PSSPRMCT,PSSPRMIN,PSSPRMAR,PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMTP,PSSPRMSU,PSSPRMSY,PSSPRMSX,PSSPRMSC,PSSPRMDF,PSSPRMDZ,PSSPRMDQ,PSSPRMFD
+2 SET (PSSPROUT,PSSPRMFD)=0
SET PSSPRMDV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
SET PSSPRMCT=1
+3 KILL PSSPRMLN
SET $PIECE(PSSPRMLN,"-",79)=""
+4 DO HD
+5 SET PSSPRM=""
FOR
SET PSSPRM=$ORDER(^PS(52.7,"B",PSSPRM))
if PSSPRM=""!(PSSPROUT)
QUIT
Begin DoDot:1
+6 FOR PSSPRMIN=0:0
SET PSSPRMIN=$ORDER(^PS(52.7,"B",PSSPRM,PSSPRMIN))
if 'PSSPRMIN!(PSSPROUT)
QUIT
Begin DoDot:2
+7 KILL PSSPRMAR,PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMTP,PSSPRMSU,PSSPRMSY,PSSPRMSC
+8 SET PSSPRMTP=PSSPRMIN_","
+9 DO GETS^DIQ(52.7,PSSPRMTP,".01;.02;1;2;8;9;17;18","IE","PSSPRMAR")
+10 IF PSSPRTP="P"
IF '$GET(PSSPRMAR(52.7,PSSPRMTP,18,"I"))
QUIT
+11 SET PSSPRMFD=1
+12 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+13 SET PSSPRML1=$LENGTH($GET(PSSPRMAR(52.7,PSSPRMTP,.01,"E")))
SET PSSPRML2=$LENGTH($GET(PSSPRMAR(52.7,PSSPRMTP,2,"E")))
SET PSSPRML3=0
+14 SET PSSPRML3=PSSPRML1+PSSPRML2
+15 WRITE !!?18,"Print Name: "_$GET(PSSPRMAR(52.7,PSSPRMTP,.01,"E"))
+16 IF PSSPRML3<37
WRITE " Volume: "_$GET(PSSPRMAR(52.7,PSSPRMTP,2,"E"))
+17 IF PSSPRML3'<37
WRITE !?30,"Volume: "_$GET(PSSPRMAR(52.7,PSSPRMTP,2,"E"))
+18 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+19 WRITE !?14,"Print Name {2}: "_$GET(PSSPRMAR(52.7,PSSPRMTP,.02,"E"))
+20 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+21 WRITE !?20,"Synonyms: "
+22 SET PSSPRMSC=0
FOR PSSPRMSY=0:0
SET PSSPRMSY=$ORDER(^PS(52.7,PSSPRMIN,3,PSSPRMSY))
if 'PSSPRMSY!(PSSPROUT)
QUIT
Begin DoDot:3
+23 KILL PSSPRMSU,PSSPRMSX
+24 SET PSSPRMSU=PSSPRMSY_","_PSSPRMIN_","
SET PSSPRMSX=$$GET1^DIQ(52.703,PSSPRMSU,".01")
+25 if PSSPRMSC
WRITE !?30,$GET(PSSPRMSX)
if 'PSSPRMSC
WRITE ?30,$GET(PSSPRMSX)
+26 SET PSSPRMSC=1
+27 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
End DoDot:3
+28 if PSSPROUT
QUIT
+29 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+30 WRITE !?16,"Generic Drug: "_$GET(PSSPRMAR(52.7,PSSPRMTP,1,"E"))
+31 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+32 KILL PSSPRML1,PSSPRML2,PSSPRML3,PSSPRMDF,PSSPRMDZ,PSSPRMDQ
+33 SET PSSPRML1=$LENGTH($GET(PSSPRMAR(52.7,PSSPRMTP,9,"E")))
SET PSSPRMDF=$GET(PSSPRMAR(52.7,PSSPRMTP,9,"I"))
+34 SET PSSPRML2=0
IF PSSPRMDF
SET PSSPRMDZ=PSSPRMDF_","
SET PSSPRMDQ=$$GET1^DIQ(50.7,PSSPRMDZ,".02")
SET PSSPRML2=$LENGTH(PSSPRMDQ)
+35 SET PSSPRML3=PSSPRML1+PSSPRML2
+36 WRITE !?5,"Pharmacy Orderable Item: "_$GET(PSSPRMAR(52.7,PSSPRMTP,9,"E"))
+37 IF PSSPRML3<47
WRITE " "_$GET(PSSPRMDQ)
+38 IF PSSPRML3'<47
WRITE !?30,$GET(PSSPRMDQ)
+39 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+40 WRITE !?11,"Inactivation Date: "_$GET(PSSPRMAR(52.7,PSSPRMTP,8,"E"))
+41 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+42 WRITE !,"Used in IV Fluid Order Entry: "_$GET(PSSPRMAR(52.7,PSSPRMTP,17,"E"))
+43 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
+44 WRITE !?22,"PreMix: "_$GET(PSSPRMAR(52.7,PSSPRMTP,18,"E"))
+45 IF ($Y+5)>IOSL
DO HD
if PSSPROUT
QUIT
End DoDot:2
End DoDot:1
+46 ;
END ;End of report
+1 IF PSSPRTP="P"
IF '$GET(PSSPROUT)
IF '$GET(PSSPRMFD)
WRITE !!,"No IV Solutions marked as PreMixes found.",!
+2 IF $GET(PSSPRMDV)="P"
WRITE !!,"End of Report.",!
+3 KILL PSSPRTP
+4 IF '$GET(PSSPROUT)
IF $GET(PSSPRMDV)="C"
WRITE !!,"End of Report."
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+5 IF $GET(PSSPRMDV)="C"
WRITE !
+6 IF '$TEST
WRITE @IOF
+7 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
+9 ;
HD ;Report Header
+1 IF $GET(PSSPRMDV)="C"
IF $GET(PSSPRMCT)'=1
WRITE !
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSPROUT=1
QUIT
+2 WRITE @IOF
WRITE !,$SELECT(PSSPRTP="P":"Solution PreMix report for IV Solutions marked as PreMix",1:"Solution PreMix report for all IV Solutions"),?69,"Page: "_$GET(PSSPRMCT),!,PSSPRMLN,!
SET PSSPRMCT=PSSPRMCT+1
+3 QUIT
+4 ;
MESS ;
+1 WRITE !!,"No Action taken.",!
+2 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+3 QUIT
