PSSINSTR ;HPS/RTR-Medication Route Utilities ; 4/23/20 3:36pm
;;1.0;PHARMACY DATA MANAGEMENT;**245**;;Build 4
Q
REP ;Med Instruction Med Route Report
W !!,"This report displays matches between the Medication Instruction file (#51)"
W !,"and the Medication Routes file (#51.2) when a Name in the Medication"
W !,"Instruction file matches an Abbreviation in the Medication Routes file."
;
N DIR,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 W !!,"No Action taken.",! 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^PSSINSTR",ZTDESC="Med Instruction Med Route Report" D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
START ;
U IO
N DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
STARTX ;
N PSSTLINE,PSSTOUT,PSSTDV,PSSTCT,DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
N PSSIIEN,PSSINAM,PSSINS,PSSRIEN,PSSRNAM
S PSSTOUT=0,PSSTDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSTCT=1
K PSSTLINE S $P(PSSTLINE,"-",75)=""
D HD
S PSSINS="" F S PSSINS=$O(^PS(51,"B",PSSINS)) Q:PSSINS=""!(PSSTOUT) D
. Q:'$D(^PS(51.2,"C",PSSINS))
. S PSSIIEN=$O(^PS(51,"B",PSSINS,0)),PSSRIEN=$O(^PS(51.2,"C",PSSINS,0))
. S PSSINAM=$E($P(^PS(51,PSSIIEN,0),U,2),1,30) ;Instruction Name
. S PSSRNAM=$P(^PS(51.2,PSSRIEN,0),U,1) ;Route Abbreviation
. W !,PSSINS,?12,$E(PSSINAM,1,30),?43,$E(PSSRNAM,1,30)
. I ($Y+5)>IOSL D HD Q:PSSTOUT
END ;
I $G(PSSTDV)="P" W !!,"End of Report."
I '$G(PSSTOUT),$G(PSSTDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $G(PSSTDV)="C" W !
E W @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
HD ;
I $G(PSSTDV)="C",$G(PSSTCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSTOUT=1 Q
W @IOF W !,"MED INSTRUCTION MED ROUTE REPORT",?65,"Page: "_$G(PSSTCT) S PSSTCT=PSSTCT+1
W !!,"NAME/ABBR",?12,"INSTR EXPANSION",?43,"ROUTE NAME"
W !,PSSTLINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSINSTR 2078 printed Sep 15, 2024@21:56:15 Page 2
PSSINSTR ;HPS/RTR-Medication Route Utilities ; 4/23/20 3:36pm
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**245**;;Build 4
+2 QUIT
REP ;Med Instruction Med Route Report
+1 WRITE !!,"This report displays matches between the Medication Instruction file (#51)"
+2 WRITE !,"and the Medication Routes file (#51.2) when a Name in the Medication"
+3 WRITE !,"Instruction file matches an Abbreviation in the Medication Routes file."
+4 ;
+5 NEW DIR,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
+6 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)>0
WRITE !!,"No Action taken.",!
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,IOP,%ZIS,POP
QUIT
+7 IF $DATA(IO("Q"))
SET ZTRTN="START^PSSINSTR"
SET ZTDESC="Med Instruction Med Route Report"
DO ^%ZTLOAD
KILL %ZIS
WRITE !!,"Report queued to print.",!
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
START ;
+1 USE IO
+2 NEW DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
STARTX ;
+1 NEW PSSTLINE,PSSTOUT,PSSTDV,PSSTCT,DIR,DUOUT,DTOUT,Y,X,DIRUT,DIROUT
+2 NEW PSSIIEN,PSSINAM,PSSINS,PSSRIEN,PSSRNAM
+3 SET PSSTOUT=0
SET PSSTDV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
SET PSSTCT=1
+4 KILL PSSTLINE
SET $PIECE(PSSTLINE,"-",75)=""
+5 DO HD
+6 SET PSSINS=""
FOR
SET PSSINS=$ORDER(^PS(51,"B",PSSINS))
if PSSINS=""!(PSSTOUT)
QUIT
Begin DoDot:1
+7 if '$DATA(^PS(51.2,"C",PSSINS))
QUIT
+8 SET PSSIIEN=$ORDER(^PS(51,"B",PSSINS,0))
SET PSSRIEN=$ORDER(^PS(51.2,"C",PSSINS,0))
+9 ;Instruction Name
SET PSSINAM=$EXTRACT($PIECE(^PS(51,PSSIIEN,0),U,2),1,30)
+10 ;Route Abbreviation
SET PSSRNAM=$PIECE(^PS(51.2,PSSRIEN,0),U,1)
+11 WRITE !,PSSINS,?12,$EXTRACT(PSSINAM,1,30),?43,$EXTRACT(PSSRNAM,1,30)
+12 IF ($Y+5)>IOSL
DO HD
if PSSTOUT
QUIT
End DoDot:1
END ;
+1 IF $GET(PSSTDV)="P"
WRITE !!,"End of Report."
+2 IF '$GET(PSSTOUT)
IF $GET(PSSTDV)="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(PSSTDV)="C"
WRITE !
+4 IF '$TEST
WRITE @IOF
+5 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
HD ;
+1 IF $GET(PSSTDV)="C"
IF $GET(PSSTCT)'=1
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSTOUT=1
QUIT
+2 WRITE @IOF
WRITE !,"MED INSTRUCTION MED ROUTE REPORT",?65,"Page: "_$GET(PSSTCT)
SET PSSTCT=PSSTCT+1
+3 WRITE !!,"NAME/ABBR",?12,"INSTR EXPANSION",?43,"ROUTE NAME"
+4 WRITE !,PSSTLINE
+5 QUIT
