PSSIIRPT ;BIR/JCH-Infusion Instruction Report ;10/26/12
;;1.0;PHARMACY DATA MANAGEMENT;**172**;9/30/07;Build 28
;
;
EN ;Prompts for Infusion Instruction File Report
W !!,"This report displays entries from the INFUSION INSTRUCTION (#53.47) File."
;
N DIR,PSSMXLNG,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
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^PSSIIRPT",ZTDESC="Infusion Instruction File Report",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
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(53.47,"B",PSSMXQ)) Q:PSSMXQ=""!(PSSMXOUT) D
.F PSSMXQEN=0:0 S PSSMXQEN=$O(^PS(53.47,"B",PSSMXQ,PSSMXQEN)) Q:'PSSMXQEN!(PSSMXOUT) I '$G(^PS(53.47,"B",PSSMXQ,PSSMXQEN)) D
..K PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
..S PSSMXRA=PSSMXQEN_","
..D GETS^DIQ(53.47,PSSMXRA,".01;1","E","PSSMXRAA")
..S PSSMXNOF=1
..W !!,$G(PSSMXRAA(53.47,PSSMXRA,.01,"E"))
..I ($Y+5)>IOSL D HD Q:PSSMXOUT
..W !?17,"EXPANSION: " D
...S PSSMXREP=$G(PSSMXRAA(53.47,PSSMXRA,1,"E"))
...I PSSMXLNG=132 D Q
....I $L(PSSMXREP)<104 W PSSMXREP,! Q
....N X,DIWL,DIWR,DIWF S X=PSSMXREP,DIWL=29,DIWR=131,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
...I $L(PSSMXREP)<52 W PSSMXREP,! Q
...N X,DIWL,DIWR,DIWF S X=PSSMXREP,DIWL=29,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 !
..I ($Y+5)>IOSL D HD Q:PSSMXOUT W !
;
END ;
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 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
W !,"INFUSION INSTRUCTION FILE 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[HPSSIIRPT 3104 printed Oct 16, 2024@18:32:47 Page 2
PSSIIRPT ;BIR/JCH-Infusion Instruction Report ;10/26/12
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**172**;9/30/07;Build 28
+2 ;
+3 ;
EN ;Prompts for Infusion Instruction File Report
+1 WRITE !!,"This report displays entries from the INFUSION INSTRUCTION (#53.47) File."
+2 ;
+3 NEW DIR,PSSMXLNG,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
+4 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"
+5 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."
+6 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
+7 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
+8 SET PSSMXLNG=Y
WRITE !
+9 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
+10 IF $DATA(IO("Q"))
SET ZTRTN="START^PSSIIRPT"
SET ZTDESC="Infusion Instruction File Report"
SET ZTSAVE("PSSMXLNG")=""
DO ^%ZTLOAD
KILL %ZIS
WRITE !!,"Report queued to print.",!
Begin DoDot:1
+11 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+12 ;
+13 ;
START ;Print Medication Instruction File report
+1 USE IO
+2 NEW PSSMXOUT,PSSMXNOF,PSSMXDEV,PSSMXCT,PSSMXLIN,PSSMXQ,PSSMXQEN,PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
+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(53.47,"B",PSSMXQ))
if PSSMXQ=""!(PSSMXOUT)
QUIT
Begin DoDot:1
+7 FOR PSSMXQEN=0:0
SET PSSMXQEN=$ORDER(^PS(53.47,"B",PSSMXQ,PSSMXQEN))
if 'PSSMXQEN!(PSSMXOUT)
QUIT
IF '$GET(^PS(53.47,"B",PSSMXQ,PSSMXQEN))
Begin DoDot:2
+8 KILL PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
+9 SET PSSMXRA=PSSMXQEN_","
+10 DO GETS^DIQ(53.47,PSSMXRA,".01;1","E","PSSMXRAA")
+11 SET PSSMXNOF=1
+12 WRITE !!,$GET(PSSMXRAA(53.47,PSSMXRA,.01,"E"))
+13 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
+14 WRITE !?17,"EXPANSION: "
Begin DoDot:3
+15 SET PSSMXREP=$GET(PSSMXRAA(53.47,PSSMXRA,1,"E"))
+16 IF PSSMXLNG=132
Begin DoDot:4
+17 IF $LENGTH(PSSMXREP)<104
WRITE PSSMXREP,!
QUIT
+18 NEW X,DIWL,DIWR,DIWF
SET X=PSSMXREP
SET DIWL=29
SET DIWR=131
SET DIWF="W"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
DO ^DIWW
KILL ^UTILITY($JOB,"W")
End DoDot:4
QUIT
+19 IF $LENGTH(PSSMXREP)<52
WRITE PSSMXREP,!
QUIT
+20 NEW X,DIWL,DIWR,DIWF
SET X=PSSMXREP
SET DIWL=29
SET DIWR=79
SET DIWF="W"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
DO ^DIWW
KILL ^UTILITY($JOB,"W")
End DoDot:3
+21 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
WRITE !
+22 IF ($Y+5)>IOSL
DO HD
if PSSMXOUT
QUIT
WRITE !
End DoDot:2
End DoDot:1
+23 ;
END ;
+1 IF $GET(PSSMXDEV)="P"
WRITE !!,"End of Report.",!
+2 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
+3 IF $GET(PSSMXDEV)="C"
WRITE !
+4 IF '$TEST
WRITE @IOF
+5 KILL PSSMXLNG
+6 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
+8 ;
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 WRITE !,"INFUSION INSTRUCTION FILE REPORT"
+4 WRITE ?$SELECT(PSSMXLNG=80:68,1:120),"PAGE: "_PSSMXCT,!,PSSMXLIN,!
SET PSSMXCT=PSSMXCT+1
+5 QUIT
+6 ;
MESS ;
+1 WRITE !!,"Nothing queued to print.",!
+2 QUIT
