PSSMIRPT ;BIR/RTR-Medication Instruction Report ;07/03/07
;;1.0;PHARMACY DATA MANAGEMENT;**129,201**;9/30/97;Build 25
;
;
EN ;Prompts for Medication Instruction File Report
W !!,"This report displays entries from the MEDICATION INSTRUCTION (#51) File. It"
W !,"can be run for all Medication Instructions or only Medication Instructions"
W !,"without a FREQUENCY (IN MINUTES). If a FREQUENCY (IN MINUTES) cannot be"
W !,"determined for an order, the daily dosage check cannot occur for that order."
N DIR,PSSMXRP,PSSMXLNG,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
K DIR,Y S DIR(0)="SO^A:All Medication Instructions;O:Only Medication Instructions with a missing frequency",DIR("A",1)="Print All Medication Instructions, or Only Medication Instructions",DIR("A")="without a frequency",DIR("B")="A"
S DIR("?")=" ",DIR("?",1)=" ",DIR("?",2)="Enter 'A' to see all Medication Instructions, enter 'O' to see only",DIR("?",3)="those Medication Instructions without data in the FREQUENCY (IN MINUTES)"
S DIR("?",4)="(#31) Field. A FREQUENCY (IN MINUTES) must be derived from a Schedule",DIR("?",5)="for the daily dosage check to occur for an order."
W ! D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
I Y'="A",Y'="O" D MESS K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
S PSSMXRP=Y
K DIR,Y S DIR(0)="SO^80:80 Column;132:132 Column",DIR("A")="Print report in 80 or 132 column format",DIR("B")="80"
S DIR("?")=" ",DIR("?",1)="Enter 80 to print the report in an 80 column format,",DIR("?",2)="Enter 132 to print the report in an 132 column format."
W ! D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
I Y'="80",Y'="132" D MESS K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
S PSSMXLNG=Y W !
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 D MESS K DIR,Y 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^PSSMIRPT",ZTDESC="Medication Instruction File Report",ZTSAVE("PSSMXRP")="",ZTSAVE("PSSMXLNG")="" D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",! D Q
.K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
;
;
START ;Print Medication Instruction File report
U IO
N PSSMXOUT,PSSMXNOF,PSSMXDEV,PSSMXCT,PSSMXLIN,PSSMXQ,PSSMXQEN,PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO,PSSFD,PSSDFS
S (PSSMXOUT,PSSMXNOF)=0,PSSMXDEV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSMXCT=1
K PSSMXLIN S:PSSMXLNG=132 $P(PSSMXLIN,"-",130)="" S:PSSMXLNG=80 $P(PSSMXLIN,"-",78)=""
D HD
S PSSMXQ="" F S PSSMXQ=$O(^PS(51,"B",PSSMXQ)) Q:PSSMXQ=""!(PSSMXOUT) D
.F PSSMXQEN=0:0 S PSSMXQEN=$O(^PS(51,"B",PSSMXQ,PSSMXQEN)) Q:'PSSMXQEN!(PSSMXOUT) I '$G(^PS(51,"B",PSSMXQ,PSSMXQEN)) D
..K PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
..S PSSMXRA=PSSMXQEN_","
..D GETS^DIQ(51,PSSMXRA,".01;.5;1;1.1;9;30;31;32;32.1*;33*","E","PSSMXRAA")
..I PSSMXRP="O",$G(PSSMXRAA(51,PSSMXRA,31,"E"))'="" Q
..S PSSMXNOF=1
..W !!,$G(PSSMXRAA(51,PSSMXRA,.01,"E"))
..I ($Y+5)>IOSL D HD Q:PSSMXOUT
..W !?25,"SYNONYM: "_$G(PSSMXRAA(51,PSSMXRA,.5,"E"))
..I ($Y+5)>IOSL D HD Q:PSSMXOUT
..W !?23,"EXPANSION: " D
...S PSSMXREP=$G(PSSMXRAA(51,PSSMXRA,1,"E"))
...I PSSMXLNG=132 D Q
....W PSSMXREP,! Q
...I $L(PSSMXREP)<46 W PSSMXREP,! Q
...N X,DIWL,DIWR,DIWF S X=PSSMXREP,DIWL=35,DIWR=79,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
..I ($Y+5)>IOSL D HD Q:PSSMXOUT W !
..W ?8,"OTHER LANGUAGE EXPANSION: " D
...S PSSMXROO=$G(PSSMXRAA(51,PSSMXRA,1.1,"E"))
...I PSSMXLNG=132 D Q
....I $L(PSSMXROO)<98 W PSSMXROO,! Q
....N X,DIWL,DIWR,DIWF S X=PSSMXROO,DIWL=35,DIWR=131,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
...I $L(PSSMXROO)<46 W PSSMXROO,! Q
...N X,DIWL,DIWR,DIWF S X=PSSMXROO,DIWL=35,DIWR=79,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
..I ($Y+5)>IOSL D HD Q:PSSMXOUT W !
..W ?26,"PLURAL: "_$G(PSSMXRAA(51,PSSMXRA,9,"E"))
..I ($Y+5)>IOSL D HD Q:PSSMXOUT
..W !?20,"INTENDED USE: "_$G(PSSMXRAA(51,PSSMXRA,30,"E"))
..I ($Y+5)>IOSL D HD Q:PSSMXOUT
..W !?10,"DOSING CHECK FREQUENCY: "_$G(PSSMXRAA(51,PSSMXRA,32,"E"))
..I ($Y+5)>IOSL D HD Q:PSSMXOUT
..W !?5,"DRUG(S) FOR DOSING CHK FREQ: "
..IF $D(PSSMXRAA(51.321)) SET PSSFD=1,PSSDFS=0 FOR SET PSSFD=$O(PSSMXRAA(51.321,PSSFD)) Q:PSSFD']""!(PSSMXOUT) D
...W:'PSSDFS ?34,$G(PSSMXRAA(51.321,PSSFD,.01,"E")) W:PSSDFS !,?34,$G(PSSMXRAA(51.321,PSSFD,.01,"E")) S PSSDFS=1
...I ($Y+5)>IOSL D HD Q:PSSMXOUT
..Q:PSSMXOUT
..W !?10,"FREQUENCY (IN MINUTES): "_$G(PSSMXRAA(51,PSSMXRA,31,"E"))
..I ($Y+5)>IOSL D HD Q:PSSMXOUT
..W !?5,"OLD MED INSTRUCTION NAME(S): "
..IF $D(PSSMXRAA(51.33)) SET PSSFD=1,PSSDFS=0 FOR SET PSSFD=$O(PSSMXRAA(51.33,PSSFD)) Q:PSSFD']""!(PSSMXOUT) D
...W:'PSSDFS ?34,$G(PSSMXRAA(51.33,PSSFD,.01,"E")) W:PSSDFS !,?34,$G(PSSMXRAA(51.33,PSSFD,.01,"E")) S PSSDFS=1
...I ($Y+5)>IOSL D HD Q:PSSMXOUT
..ELSE I ($Y+5)>IOSL D HD Q:PSSMXOUT
;
END ;
I '$G(PSSMXOUT),PSSMXRP="O",'$G(PSSMXNOF) W !!,"No Medication Instructions found without frequencies.",!
I $G(PSSMXDEV)="P" W !!,"End of Report.",!
I '$G(PSSMXOUT),$G(PSSMXDEV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $G(PSSMXDEV)="C" W !
E W @IOF
K PSSMXRP,PSSMXLNG
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
HD ;Report Header
I $G(PSSMXDEV)="C",$G(PSSMXCT)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSMXOUT=1 Q
W @IOF
I PSSMXRP="A" W !,"MEDICATION INSTRUCTION FILE REPORT (All)"
I PSSMXRP="O" W !,"MEDICATION INSTRUCTIONS WITHOUT FREQUENCY REPORT"
W ?$S(PSSMXLNG=80:68,1:120),"PAGE: "_PSSMXCT,!,PSSMXLIN,! S PSSMXCT=PSSMXCT+1
Q
;
MESS ;
W !!,"Nothing queued to print.",!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSMIRPT 5930 printed Nov 22, 2024@17:43:06 Page 2
PSSMIRPT ;BIR/RTR-Medication Instruction Report ;07/03/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129,201**;9/30/97;Build 25
+2 ;
+3 ;
EN ;Prompts for Medication Instruction File Report
+1 WRITE !!,"This report displays entries from the MEDICATION INSTRUCTION (#51) File. It"
+2 WRITE !,"can be run for all Medication Instructions or only Medication Instructions"
+3 WRITE !,"without a FREQUENCY (IN MINUTES). If a FREQUENCY (IN MINUTES) cannot be"
+4 WRITE !,"determined for an order, the daily dosage check cannot occur for that order."
+5 NEW DIR,PSSMXRP,PSSMXLNG,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
+6 KILL DIR,Y
SET DIR(0)="SO^A:All Medication Instructions;O:Only Medication Instructions with a missing frequency"
SET DIR("A",1)="Print All Medication Instructions, or Only Medication Instructions"
SET DIR("A")="without a frequency"
SET DIR("B")="A"
+7 SET DIR("?")=" "
SET DIR("?",1)=" "
SET DIR("?",2)="Enter 'A' to see all Medication Instructions, enter 'O' to see only"
SET DIR("?",3)="those Medication Instructions without data in the FREQUENCY (IN MINUTES)"
+8 SET DIR("?",4)="(#31) Field. A FREQUENCY (IN MINUTES) must be derived from a Schedule"
SET DIR("?",5)="for the daily dosage check to occur for an order."
+9 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
DO MESS
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
+10 IF Y'="A"
IF Y'="O"
DO MESS
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
+11 SET PSSMXRP=Y
+12 KILL DIR,Y
SET DIR(0)="SO^80:80 Column;132:132 Column"
SET DIR("A")="Print report in 80 or 132 column format"
SET DIR("B")="80"
+13 SET DIR("?")=" "
SET DIR("?",1)="Enter 80 to print the report in an 80 column format,"
SET DIR("?",2)="Enter 132 to print the report in an 132 column format."
+14 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
DO MESS
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
+15 IF Y'="80"
IF Y'="132"
DO MESS
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
+16 SET PSSMXLNG=Y
WRITE !
+17 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)>0
DO MESS
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,IOP,%ZIS,POP
QUIT
+18 IF $DATA(IO("Q"))
SET ZTRTN="START^PSSMIRPT"
SET ZTDESC="Medication Instruction File Report"
SET ZTSAVE("PSSMXRP")=""
SET ZTSAVE("PSSMXLNG")=""
DO ^%ZTLOAD
KILL %ZIS
WRITE !!,"Report queued to print.",!
Begin DoDot:1
+19 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+20 ;
+21 ;
START ;Print Medication Instruction File report
+1 USE IO
+2 NEW PSSMXOUT,PSSMXNOF,PSSMXDEV,PSSMXCT,PSSMXLIN,PSSMXQ,PSSMXQEN,PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO,PSSFD,PSSDFS
+3 SET (PSSMXOUT,PSSMXNOF)=0
SET PSSMXDEV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
SET PSSMXCT=1
+4 KILL PSSMXLIN
if PSSMXLNG=132
SET $PIECE(PSSMXLIN,"-",130)=""
if PSSMXLNG=80
SET $PIECE(PSSMXLIN,"-",78)=""
+5 DO HD
+6 SET PSSMXQ=""
FOR
SET PSSMXQ=$ORDER(^PS(51,"B",PSSMXQ))
if PSSMXQ=""!(PSSMXOUT)
QUIT
Begin DoDot:1
+7 FOR PSSMXQEN=0:0
SET PSSMXQEN=$ORDER(^PS(51,"B",PSSMXQ,PSSMXQEN))
if 'PSSMXQEN!(PSSMXOUT)
QUIT
IF '$GET(^PS(51,"B",PSSMXQ,PSSMXQEN))
Begin DoDot:2
+8 KILL PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
+9 SET PSSMXRA=PSSMXQEN_","
+10 DO GETS^DIQ(51,PSSMXRA,".01;.5;1;1.1;9;30;31;32;32.1*;33*","E","PSSMXRAA")
+11 IF PSSMXRP="O"
IF $GET(PSSMXRAA(51,PSSMXRA,31,"E"))'=""
QUIT
+12 SET PSSMXNOF=1
+13 WRITE !!,$GET(PSSMXRAA(51,PSSMXRA,.01,"E"))
+14 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
+15 WRITE !?25,"SYNONYM: "_$GET(PSSMXRAA(51,PSSMXRA,.5,"E"))
+16 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
+17 WRITE !?23,"EXPANSION: "
Begin DoDot:3
+18 SET PSSMXREP=$GET(PSSMXRAA(51,PSSMXRA,1,"E"))
+19 IF PSSMXLNG=132
Begin DoDot:4
+20 WRITE PSSMXREP,!
QUIT
End DoDot:4
QUIT
+21 IF $LENGTH(PSSMXREP)<46
WRITE PSSMXREP,!
QUIT
+22 NEW X,DIWL,DIWR,DIWF
SET X=PSSMXREP
SET DIWL=35
SET DIWR=79
SET DIWF="W"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
DO ^DIWW
KILL ^UTILITY($JOB,"W")
End DoDot:3
+23 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
WRITE !
+24 WRITE ?8,"OTHER LANGUAGE EXPANSION: "
Begin DoDot:3
+25 SET PSSMXROO=$GET(PSSMXRAA(51,PSSMXRA,1.1,"E"))
+26 IF PSSMXLNG=132
Begin DoDot:4
+27 IF $LENGTH(PSSMXROO)<98
WRITE PSSMXROO,!
QUIT
+28 NEW X,DIWL,DIWR,DIWF
SET X=PSSMXROO
SET DIWL=35
SET DIWR=131
SET DIWF="W"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
DO ^DIWW
KILL ^UTILITY($JOB,"W")
End DoDot:4
QUIT
+29 IF $LENGTH(PSSMXROO)<46
WRITE PSSMXROO,!
QUIT
+30 NEW X,DIWL,DIWR,DIWF
SET X=PSSMXROO
SET DIWL=35
SET DIWR=79
SET DIWF="W"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
DO ^DIWW
KILL ^UTILITY($JOB,"W")
End DoDot:3
+31 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
WRITE !
+32 WRITE ?26,"PLURAL: "_$GET(PSSMXRAA(51,PSSMXRA,9,"E"))
+33 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
+34 WRITE !?20,"INTENDED USE: "_$GET(PSSMXRAA(51,PSSMXRA,30,"E"))
+35 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
+36 WRITE !?10,"DOSING CHECK FREQUENCY: "_$GET(PSSMXRAA(51,PSSMXRA,32,"E"))
+37 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
+38 WRITE !?5,"DRUG(S) FOR DOSING CHK FREQ: "
+39 IF $DATA(PSSMXRAA(51.321))
SET PSSFD=1
SET PSSDFS=0
FOR
SET PSSFD=$ORDER(PSSMXRAA(51.321,PSSFD))
if PSSFD']""!(PSSMXOUT)
QUIT
Begin DoDot:3
+40 if 'PSSDFS
WRITE ?34,$GET(PSSMXRAA(51.321,PSSFD,.01,"E"))
if PSSDFS
WRITE !,?34,$GET(PSSMXRAA(51.321,PSSFD,.01,"E"))
SET PSSDFS=1
+41 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
End DoDot:3
+42 if PSSMXOUT
QUIT
+43 WRITE !?10,"FREQUENCY (IN MINUTES): "_$GET(PSSMXRAA(51,PSSMXRA,31,"E"))
+44 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
+45 WRITE !?5,"OLD MED INSTRUCTION NAME(S): "
+46 IF $DATA(PSSMXRAA(51.33))
SET PSSFD=1
SET PSSDFS=0
FOR
SET PSSFD=$ORDER(PSSMXRAA(51.33,PSSFD))
if PSSFD']""!(PSSMXOUT)
QUIT
Begin DoDot:3
+47 if 'PSSDFS
WRITE ?34,$GET(PSSMXRAA(51.33,PSSFD,.01,"E"))
if PSSDFS
WRITE !,?34,$GET(PSSMXRAA(51.33,PSSFD,.01,"E"))
SET PSSDFS=1
+48 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
End DoDot:3
+49 IF '$TEST
IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
End DoDot:2
End DoDot:1
+50 ;
END ;
+1 IF '$GET(PSSMXOUT)
IF PSSMXRP="O"
IF '$GET(PSSMXNOF)
WRITE !!,"No Medication Instructions found without frequencies.",!
+2 IF $GET(PSSMXDEV)="P"
WRITE !!,"End of Report.",!
+3 IF '$GET(PSSMXOUT)
IF $GET(PSSMXDEV)="C"
WRITE !!,"End of Report."
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+4 IF $GET(PSSMXDEV)="C"
WRITE !
+5 IF '$TEST
WRITE @IOF
+6 KILL PSSMXRP,PSSMXLNG
+7 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
+9 ;
HD ;Report Header
+1 IF $GET(PSSMXDEV)="C"
IF $GET(PSSMXCT)'=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 PSSMXOUT=1
QUIT
+2 WRITE @IOF
+3 IF PSSMXRP="A"
WRITE !,"MEDICATION INSTRUCTION FILE REPORT (All)"
+4 IF PSSMXRP="O"
WRITE !,"MEDICATION INSTRUCTIONS WITHOUT FREQUENCY REPORT"
+5 WRITE ?$SELECT(PSSMXLNG=80:68,1:120),"PAGE: "_PSSMXCT,!,PSSMXLIN,!
SET PSSMXCT=PSSMXCT+1
+6 QUIT
+7 ;
MESS ;
+1 WRITE !!,"Nothing queued to print.",!
+2 QUIT
+3 ;
