PSSADRPT ;BIR/RTR-IV ADDITIVE REPORT ;07/15/09
;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
;
REP ;IV Additive report
;
W !!,"This report displays entries in the IV ADDITIVES (#52.6) File. You can select",!,"to display only entries marked with '1 BAG/DAY' in the ADDITIVE FREQUENCY (#18)"
W !,"Field, or only those entries with nothing entered in the ADDITIVE FREQUENCY",!,"(#18) Field, or all entries can be displayed.",!
N DIR,PSSKFTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
K DIR,Y S DIR(0)="SO^1:Print entries marked as '1 BAG/DAY' for ADDITIVE FREQUENCY;N:Print entries marked as Null for ADDITIVE FREQUENCY;A:Print all IV Additives"
S DIR("B")="A",DIR("A")="Print which IV Additives"
S DIR("?")=" ",DIR("?",1)="Enter '1' to see only those IV Additives that are marked as '1 BAG/DAY' in"
S DIR("?",2)="the ADDITIVE FREQUENCY (#18) Field, enter 'N' to see only those IV Additives"
S DIR("?",3)="with no data entered in the ADDITIVE FREQUENCY (#18) Field, enter 'A' to"
S DIR("?",4)="see all IV Additives, regardless of ADDITIVE FREQUENCY designation."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
I Y'="1",Y'="N",Y'="A" D MESS Q
S PSSKFTP=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^PSSADRPT",ZTDESC="IV Additives Report",ZTSAVE("PSSKFTP")="" 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 PSSKFOUT,PSSKFMDV,PSSKFMFD,PSSKFMCT,PSSKFMLN,PSSKFMXX,PSSKFMIN,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3,PSSKFMTP,PSSKFERR,PSSKFERZ,PSSKFERX
S (PSSKFOUT,PSSKFMFD)=0,PSSKFMDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSKFMCT=1
K PSSKFMLN S $P(PSSKFMLN,"-",79)=""
D HD
S PSSKFMXX="" F S PSSKFMXX=$O(^PS(52.6,"B",PSSKFMXX)) Q:PSSKFMXX=""!(PSSKFOUT) D
.F PSSKFMIN=0:0 S PSSKFMIN=$O(^PS(52.6,"B",PSSKFMXX,PSSKFMIN)) Q:'PSSKFMIN!(PSSKFOUT) D
..K PSSKFMTP,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFML3
..S PSSKFMTP=PSSKFMIN_","
..D GETS^DIQ(52.6,PSSKFMTP,".01;1;2;12;15;17;18","IE","PSSKFMAR","PSSKFERR")
..I PSSKFTP=1,$G(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'=1 Q
..I PSSKFTP="N",$G(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'="" Q
..S PSSKFMFD=1
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..W !!?18,"Print Name: "_$G(PSSKFMAR(52.6,PSSKFMTP,.01,"E"))
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..W !?19,"Drug Unit: "_$G(PSSKFMAR(52.6,PSSKFMTP,2,"E"))
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..W !?20,"Synonyms: "
..S PSSKFMSC=0 F PSSKFMSY=0:0 S PSSKFMSY=$O(^PS(52.6,PSSKFMIN,3,PSSKFMSY)) Q:'PSSKFMSY!(PSSKFOUT) D
...K PSSKFMSU,PSSKFMSX
...S PSSKFMSU=PSSKFMSY_","_PSSKFMIN_"," S PSSKFMSX=$$GET1^DIQ(52.63,PSSKFMSU,".01",,,"PSSKFERX")
...W:PSSKFMSC !?30,$G(PSSKFMSX) W:'PSSKFMSC ?30,$G(PSSKFMSX)
...S PSSKFMSC=1
...I ($Y+5)>IOSL D HD Q:PSSKFOUT
..Q:PSSKFOUT
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..W !?16,"Generic Drug: "_$G(PSSKFMAR(52.6,PSSKFMTP,1,"E"))
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..K PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3
..S PSSKFML1=$L($G(PSSKFMAR(52.6,PSSKFMTP,15,"E"))),PSSKFMDF=$G(PSSKFMAR(52.6,PSSKFMTP,15,"I"))
..S PSSKFML2=0 I PSSKFMDF S PSSKFMDZ=PSSKFMDF_"," S PSSKFMDQ=$$GET1^DIQ(50.7,PSSKFMDZ,".02",,,"PSSKFERZ") S PSSKFML2=$L(PSSKFMDQ)
..S PSSKFML3=PSSKFML1+PSSKFML2
..W !?5,"Pharmacy Orderable Item: "_$G(PSSKFMAR(52.6,PSSKFMTP,15,"E"))
..I PSSKFML3<47 W " "_$G(PSSKFMDQ)
..I PSSKFML3'<47 W !?30,$G(PSSKFMDQ)
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..W !?11,"Inactivation Date: "_$G(PSSKFMAR(52.6,PSSKFMTP,12,"E"))
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..W !,"Used in IV Fluid Order Entry: "_$G(PSSKFMAR(52.6,PSSKFMTP,17,"E"))
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
..W !?10,"Additive Frequency: "_$G(PSSKFMAR(52.6,PSSKFMTP,18,"E"))
..I ($Y+5)>IOSL D HD Q:PSSKFOUT
;
END ;End of report
I '$G(PSSKFOUT),'$G(PSSKFMFD) W !!,$S($G(PSSKFTP)=1:"No IV Additives marked as '1 BAG/DAY'.",$G(PSSKFTP)="N":"No IV Additives marked as null.",1:"No IV Additives to print."),!
I $G(PSSKFMDV)="P" W !!,"End of Report.",!
K PSSKFTP
I '$G(PSSKFOUT),$G(PSSKFMDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $G(PSSKFMDV)="C" W !
E W @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
HD ;Report Header
I $G(PSSKFMDV)="C",$G(PSSKFMCT)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSKFOUT=1 Q
W @IOF W !,$S(PSSKFTP=1:"IV Additives marked as '1 BAG/DAY' for ADDITIVE FREQUENCY",PSSKFTP="N":"IV Additives marked as null for ADDITIVE FREQUENCY",1:"All IV Additives"),?68,"Page: "_$G(PSSKFMCT),!,PSSKFMLN,! S PSSKFMCT=PSSKFMCT+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[HPSSADRPT 5120 printed Apr 09, 2024@21:31:51 Page 2
PSSADRPT ;BIR/RTR-IV ADDITIVE REPORT ;07/15/09
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
+2 ;
REP ;IV Additive report
+1 ;
+2 WRITE !!,"This report displays entries in the IV ADDITIVES (#52.6) File. You can select",!,"to display only entries marked with '1 BAG/DAY' in the ADDITIVE FREQUENCY (#18)"
+3 WRITE !,"Field, or only those entries with nothing entered in the ADDITIVE FREQUENCY",!,"(#18) Field, or all entries can be displayed.",!
+4 NEW DIR,PSSKFTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
+5 KILL DIR,Y
SET DIR(0)="SO^1:Print entries marked as '1 BAG/DAY' for ADDITIVE FREQUENCY;N:Print entries marked as Null for ADDITIVE FREQUENCY;A:Print all IV Additives"
+6 SET DIR("B")="A"
SET DIR("A")="Print which IV Additives"
+7 SET DIR("?")=" "
SET DIR("?",1)="Enter '1' to see only those IV Additives that are marked as '1 BAG/DAY' in"
+8 SET DIR("?",2)="the ADDITIVE FREQUENCY (#18) Field, enter 'N' to see only those IV Additives"
+9 SET DIR("?",3)="with no data entered in the ADDITIVE FREQUENCY (#18) Field, enter 'A' to"
+10 SET DIR("?",4)="see all IV Additives, regardless of ADDITIVE FREQUENCY designation."
+11 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
DO MESS
QUIT
+12 IF Y'="1"
IF Y'="N"
IF Y'="A"
DO MESS
QUIT
+13 SET PSSKFTP=Y
+14 WRITE !!?3,"This report is designed for 80 column format!",!
+15 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
+16 IF $DATA(IO("Q"))
SET ZTRTN="START^PSSADRPT"
SET ZTDESC="IV Additives Report"
SET ZTSAVE("PSSKFTP")=""
DO ^%ZTLOAD
WRITE !!,"Report queued to print.",!
Begin DoDot:1
+17 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
+18 ;
+19 USE IO
GOTO STARTX
START ;
+1 USE IO
+2 NEW DIR,Y,DIRUT,DIROUT,DUOUT,DTOUT,X
STARTX ;
+1 NEW PSSKFOUT,PSSKFMDV,PSSKFMFD,PSSKFMCT,PSSKFMLN,PSSKFMXX,PSSKFMIN,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3,PSSKFMTP,PSSKFERR,PSSKFERZ,PSSKFERX
+2 SET (PSSKFOUT,PSSKFMFD)=0
SET PSSKFMDV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
SET PSSKFMCT=1
+3 KILL PSSKFMLN
SET $PIECE(PSSKFMLN,"-",79)=""
+4 DO HD
+5 SET PSSKFMXX=""
FOR
SET PSSKFMXX=$ORDER(^PS(52.6,"B",PSSKFMXX))
if PSSKFMXX=""!(PSSKFOUT)
QUIT
Begin DoDot:1
+6 FOR PSSKFMIN=0:0
SET PSSKFMIN=$ORDER(^PS(52.6,"B",PSSKFMXX,PSSKFMIN))
if 'PSSKFMIN!(PSSKFOUT)
QUIT
Begin DoDot:2
+7 KILL PSSKFMTP,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFML3
+8 SET PSSKFMTP=PSSKFMIN_","
+9 DO GETS^DIQ(52.6,PSSKFMTP,".01;1;2;12;15;17;18","IE","PSSKFMAR","PSSKFERR")
+10 IF PSSKFTP=1
IF $GET(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'=1
QUIT
+11 IF PSSKFTP="N"
IF $GET(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'=""
QUIT
+12 SET PSSKFMFD=1
+13 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+14 WRITE !!?18,"Print Name: "_$GET(PSSKFMAR(52.6,PSSKFMTP,.01,"E"))
+15 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+16 WRITE !?19,"Drug Unit: "_$GET(PSSKFMAR(52.6,PSSKFMTP,2,"E"))
+17 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+18 WRITE !?20,"Synonyms: "
+19 SET PSSKFMSC=0
FOR PSSKFMSY=0:0
SET PSSKFMSY=$ORDER(^PS(52.6,PSSKFMIN,3,PSSKFMSY))
if 'PSSKFMSY!(PSSKFOUT)
QUIT
Begin DoDot:3
+20 KILL PSSKFMSU,PSSKFMSX
+21 SET PSSKFMSU=PSSKFMSY_","_PSSKFMIN_","
SET PSSKFMSX=$$GET1^DIQ(52.63,PSSKFMSU,".01",,,"PSSKFERX")
+22 if PSSKFMSC
WRITE !?30,$GET(PSSKFMSX)
if 'PSSKFMSC
WRITE ?30,$GET(PSSKFMSX)
+23 SET PSSKFMSC=1
+24 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
End DoDot:3
+25 if PSSKFOUT
QUIT
+26 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+27 WRITE !?16,"Generic Drug: "_$GET(PSSKFMAR(52.6,PSSKFMTP,1,"E"))
+28 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+29 KILL PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3
+30 SET PSSKFML1=$LENGTH($GET(PSSKFMAR(52.6,PSSKFMTP,15,"E")))
SET PSSKFMDF=$GET(PSSKFMAR(52.6,PSSKFMTP,15,"I"))
+31 SET PSSKFML2=0
IF PSSKFMDF
SET PSSKFMDZ=PSSKFMDF_","
SET PSSKFMDQ=$$GET1^DIQ(50.7,PSSKFMDZ,".02",,,"PSSKFERZ")
SET PSSKFML2=$LENGTH(PSSKFMDQ)
+32 SET PSSKFML3=PSSKFML1+PSSKFML2
+33 WRITE !?5,"Pharmacy Orderable Item: "_$GET(PSSKFMAR(52.6,PSSKFMTP,15,"E"))
+34 IF PSSKFML3<47
WRITE " "_$GET(PSSKFMDQ)
+35 IF PSSKFML3'<47
WRITE !?30,$GET(PSSKFMDQ)
+36 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+37 WRITE !?11,"Inactivation Date: "_$GET(PSSKFMAR(52.6,PSSKFMTP,12,"E"))
+38 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+39 WRITE !,"Used in IV Fluid Order Entry: "_$GET(PSSKFMAR(52.6,PSSKFMTP,17,"E"))
+40 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
+41 WRITE !?10,"Additive Frequency: "_$GET(PSSKFMAR(52.6,PSSKFMTP,18,"E"))
+42 IF ($Y+5)>IOSL
DO HD
if PSSKFOUT
QUIT
End DoDot:2
End DoDot:1
+43 ;
END ;End of report
+1 IF '$GET(PSSKFOUT)
IF '$GET(PSSKFMFD)
WRITE !!,$SELECT($GET(PSSKFTP)=1:"No IV Additives marked as '1 BAG/DAY'.",$GET(PSSKFTP)="N":"No IV Additives marked as null.",1:"No IV Additives to print."),!
+2 IF $GET(PSSKFMDV)="P"
WRITE !!,"End of Report.",!
+3 KILL PSSKFTP
+4 IF '$GET(PSSKFOUT)
IF $GET(PSSKFMDV)="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(PSSKFMDV)="C"
WRITE !
+6 IF '$TEST
WRITE @IOF
+7 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
+9 ;
HD ;Report Header
+1 IF $GET(PSSKFMDV)="C"
IF $GET(PSSKFMCT)'=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 PSSKFOUT=1
QUIT
+2 WRITE @IOF
WRITE !,$SELECT(PSSKFTP=1:"IV Additives marked as '1 BAG/DAY' for ADDITIVE FREQUENCY",PSSKFTP="N":"IV Additives marked as null for ADDITIVE FREQUENCY",1:"All IV Additives"),?68,"Page: "_$GET(PSSKFMCT),!,PSSKFMLN,!
SET PSSKFMCT=PSSKFMCT+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
