PSSMEDCH ;BIR/RTR-Med Route Mapping Change Report ;07/03/07
;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
;
DRIVER ;
;Med Route Mapping History Report
W !!!,"This report displays changes made to the mapping of Medication Routes in the"
W !,"MEDICATION ROUTES (#51.2) File to Medication Routes in the STANDARD"
W !,"MEDICATION ROUTES (#51.23) File.",!
N DIR,PSSHTYPE,PSSMDONE,DIC,Y,PSSMHRSI,PSSMHRSE,PSSMHREI,PSSMHREE,PSSMHRXX,X,X1,X2,DUOUT,DTOUT,DIRUT,DIROUT,%H,IOP,%ZIS,POP,ZTRTN,ZTSAVE,ZTDESC,ZTSK
K DIR S DIR(0)="SO^S:Single Med Route;A:All Med Routes",DIR("A")="Print report for a Single Med Route, or All Med Routes",DIR("B")="S"
S DIR("?")=" ",DIR("?",1)="Enter 'S' to see a Standard Medication Route mapping history",DIR("?",2)="of one local Medication Route, enter 'A' to see a Standard Medication"
S DIR("?",3)="Route mapping history of all the local Medication Routes."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
I Y'="S",Y'="A" D MESS Q
S PSSHTYPE=Y
I PSSHTYPE="A" G DATE
K DIC W ! S DIC="^PS(51.2,",DIC(0)="QEAM",DIC("A")="Select Med Route: " D ^DIC K DIC I Y<1!($D(DUOUT))!($D(DTOUT)) D MESS Q
S PSSMDONE=+Y
DATE ;
W !
K DIR W ! S DIR(0)="DAO^:DT:APEX",DIR("A")="Beginning Date: ",DIR("?")=" ",DIR("?",1)="Enter the date to begin searching for Medication Route mapping changes.",DIR("?",2)="A future date cannot be entered." D ^DIR K DIR
I 'Y!($D(DTOUT))!($D(DUOUT)) D MESS Q
S (PSSMHRSI,PSSMHRXX)=Y D DD^%DT S PSSMHRSE=Y
K X S X1=PSSMHRSI,X2=-1 D C^%DTC S PSSMHRSI=X_".9999"
W ! K DIR S DIR(0)="DAO^"_PSSMHRXX_"::APEX",DIR("A")="Ending Date: ",DIR("?")=" ",DIR("?",1)="Enter the ending date of the search for Medication Route mapping changes.",DIR("?",2)="This date cannot be before the beginning date." D ^DIR K DIR
I 'Y!($D(DTOUT))!($D(DUOUT)) D MESS Q
S PSSMHREI=Y D DD^%DT S PSSMHREE=Y
K X S X1=PSSMHREI,X2=+1 D C^%DTC S PSSMHREI=X
W ! K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) D MESS Q
I $D(IO("Q")) D K IOP,%ZIS,POP,DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
.S ZTRTN="START^PSSMEDCH",ZTDESC="Medication Route Mapping History report",ZTSAVE("PSSHTYPE")="",ZTSAVE("PSSMDONE")="",ZTSAVE("PSSMHRSI")="",ZTSAVE("PSSMHRSE")="",ZTSAVE("PSSMHREI")="",ZTSAVE("PSSMHREE")="" D ^%ZTLOAD D
.W !!,"Report queued to print.",!
START ;
U IO
N PSSMHRLN,PSSMHOUT,PSSMHDEV,PSSMHCT,PSSMHLEN,PSSMHNAM
N PSSMHRG1,PSSMHRG2,PSSMHRG3,PSSMHRG4,PSSMHRG5,PSSMHRG7,PSSMHRG9
S PSSMHRG9=0
I PSSHTYPE="S" S PSSMHNAM=$P($G(^PS(51.2,+PSSMDONE,0)),"^"),PSSMHLEN=$L(PSSMHNAM)
S PSSMHOUT=0,PSSMHDEV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSMHCT=1
K PSSMHRLN S $P(PSSMHRLN,"-",79)=""
D HD
I PSSHTYPE="S" D G END
.F PSSMHRG1=PSSMHRSI:0 S PSSMHRG1=$O(^PS(51.2,PSSMDONE,2,"B",PSSMHRG1)) Q:'PSSMHRG1!(PSSMHRG1'<PSSMHREI)!(PSSMHOUT) D
..F PSSMHRG2=0:0 S PSSMHRG2=$O(^PS(51.2,PSSMDONE,2,"B",PSSMHRG1,PSSMHRG2)) Q:'PSSMHRG2!(PSSMHOUT) D
...S PSSMHRG7=$G(^PS(51.2,PSSMDONE,2,PSSMHRG2,0)) Q:PSSMHRG7=""
...S PSSMHRG4=PSSMHRG2_","_PSSMDONE_","
...D PRINT
F PSSMHRG1=PSSMHRSI:0 S PSSMHRG1=$O(^PS(51.2,"D",PSSMHRG1)) Q:'PSSMHRG1!(PSSMHRG1'<PSSMHREI)!(PSSMHOUT) D
.F PSSMHRG2=0:0 S PSSMHRG2=$O(^PS(51.2,"D",PSSMHRG1,PSSMHRG2)) Q:'PSSMHRG2!(PSSMHOUT) D
..F PSSMHRG3=0:0 S PSSMHRG3=$O(^PS(51.2,"D",PSSMHRG1,PSSMHRG2,PSSMHRG3)) Q:'PSSMHRG3!(PSSMHOUT) D
...S PSSMHRG7=$G(^PS(51.2,PSSMHRG2,2,PSSMHRG3,0)) Q:PSSMHRG7=""
...S PSSMHRG4=PSSMHRG3_","_PSSMHRG2_","
...S PSSMHNAM=$P($G(^PS(51.2,PSSMHRG2,0)),"^")
...D PRINT
END ;
I '$G(PSSMHOUT),'$G(PSSMHRG9) W !!,?2,"No mapping changes to report.",!
I $G(PSSMHDEV)="P" W !!,"End of Report.",!
I '$G(PSSMHOUT),$G(PSSMHDEV)="C" W !!,"End of Report.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $G(PSSMHDEV)="C" W !
E W @IOF
K PSSHTYPE,PSSMDONE,PSSMHRSI,PSSMHRSE,PSSMHREI,PSSMHREE D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
;
PRINT ;
S PSSMHRG9=1
K PSSMHRG5 D GETS^DIQ(51.27,PSSMHRG4,".01;1;2;3","E","PSSMHRG5")
W !!,?2,"Medication Route: "_$G(PSSMHNAM)
W !?9,"Date/Time: "_$G(PSSMHRG5(51.27,PSSMHRG4,.01,"E"))
I ($Y+5)>IOSL D HD Q:PSSMHOUT
W !?9,"Edited By: "_$S($G(PSSMHRG5(51.27,PSSMHRG4,1,"E"))'="":$G(PSSMHRG5(51.27,PSSMHRG4,1,"E")),1:"AUTOMAPPED")
I ($Y+5)>IOSL D HD Q:PSSMHOUT
W !?9,"Old Value: "_$S($G(PSSMHRG5(51.27,PSSMHRG4,2,"E"))'="":$G(PSSMHRG5(51.27,PSSMHRG4,2,"E")),1:"<no previous value>")
I ($Y+5)>IOSL D HD Q:PSSMHOUT
W !?9,"New Value: "_$S($G(PSSMHRG5(51.27,PSSMHRG4,3,"E"))'="":$G(PSSMHRG5(51.27,PSSMHRG4,3,"E")),1:"<no new value>")
I ($Y+5)>IOSL D HD Q:PSSMHOUT
Q
;
HD ;
I $G(PSSMHDEV)="C",$G(PSSMHCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSMHOUT=1 Q
W @IOF
I PSSHTYPE="A" W !,"Medication Route mapping changes for ALL Medication Routes"
I PSSHTYPE="S" W !,"Medication Route mapping changes for " D
.I +PSSMHLEN<43 W PSSMHNAM Q
.W !,?34,PSSMHNAM
W !,"made between "_PSSMHRSE_" and "_PSSMHREE,?68,"PAGE: "_PSSMHCT,!,PSSMHRLN,! S PSSMHCT=PSSMHCT+1
Q
MESS ;
W !!,"Nothing queued to print.",!
K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSMEDCH 5187 printed Dec 13, 2024@02:33:01 Page 2
PSSMEDCH ;BIR/RTR-Med Route Mapping Change Report ;07/03/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
+2 ;
DRIVER ;
+1 ;Med Route Mapping History Report
+2 WRITE !!!,"This report displays changes made to the mapping of Medication Routes in the"
+3 WRITE !,"MEDICATION ROUTES (#51.2) File to Medication Routes in the STANDARD"
+4 WRITE !,"MEDICATION ROUTES (#51.23) File.",!
+5 NEW DIR,PSSHTYPE,PSSMDONE,DIC,Y,PSSMHRSI,PSSMHRSE,PSSMHREI,PSSMHREE,PSSMHRXX,X,X1,X2,DUOUT,DTOUT,DIRUT,DIROUT,%H,IOP,%ZIS,POP,ZTRTN,ZTSAVE,ZTDESC,ZTSK
+6 KILL DIR
SET DIR(0)="SO^S:Single Med Route;A:All Med Routes"
SET DIR("A")="Print report for a Single Med Route, or All Med Routes"
SET DIR("B")="S"
+7 SET DIR("?")=" "
SET DIR("?",1)="Enter 'S' to see a Standard Medication Route mapping history"
SET DIR("?",2)="of one local Medication Route, enter 'A' to see a Standard Medication"
+8 SET DIR("?",3)="Route mapping history of all the local Medication Routes."
+9 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
DO MESS
QUIT
+10 IF Y'="S"
IF Y'="A"
DO MESS
QUIT
+11 SET PSSHTYPE=Y
+12 IF PSSHTYPE="A"
GOTO DATE
+13 KILL DIC
WRITE !
SET DIC="^PS(51.2,"
SET DIC(0)="QEAM"
SET DIC("A")="Select Med Route: "
DO ^DIC
KILL DIC
IF Y<1!($DATA(DUOUT))!($DATA(DTOUT))
DO MESS
QUIT
+14 SET PSSMDONE=+Y
DATE ;
+1 WRITE !
+2 KILL DIR
WRITE !
SET DIR(0)="DAO^:DT:APEX"
SET DIR("A")="Beginning Date: "
SET DIR("?")=" "
SET DIR("?",1)="Enter the date to begin searching for Medication Route mapping changes."
SET DIR("?",2)="A future date cannot be entered."
DO ^DIR
KILL DIR
+3 IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
DO MESS
QUIT
+4 SET (PSSMHRSI,PSSMHRXX)=Y
DO DD^%DT
SET PSSMHRSE=Y
+5 KILL X
SET X1=PSSMHRSI
SET X2=-1
DO C^%DTC
SET PSSMHRSI=X_".9999"
+6 WRITE !
KILL DIR
SET DIR(0)="DAO^"_PSSMHRXX_"::APEX"
SET DIR("A")="Ending Date: "
SET DIR("?")=" "
SET DIR("?",1)="Enter the ending date of the search for Medication Route mapping changes."
SET DIR("?",2)="This date cannot be before the beginning date."
DO ^DIR
KILL DIR
+7 IF 'Y!($DATA(DTOUT))!($DATA(DUOUT))
DO MESS
QUIT
+8 SET PSSMHREI=Y
DO DD^%DT
SET PSSMHREE=Y
+9 KILL X
SET X1=PSSMHREI
SET X2=+1
DO C^%DTC
SET PSSMHREI=X
+10 WRITE !
KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)
DO MESS
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 SET ZTRTN="START^PSSMEDCH"
SET ZTDESC="Medication Route Mapping History report"
SET ZTSAVE("PSSHTYPE")=""
SET ZTSAVE("PSSMDONE")=""
SET ZTSAVE("PSSMHRSI")=""
SET ZTSAVE("PSSMHRSE")=""
SET ZTSAVE("PSSMHREI")=""
SET ZTSAVE("PSSMHREE")=""
DO ^%ZTLOAD
Begin DoDot:2
End DoDot:2
+13 WRITE !!,"Report queued to print.",!
End DoDot:1
KILL IOP,%ZIS,POP,DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
START ;
+1 USE IO
+2 NEW PSSMHRLN,PSSMHOUT,PSSMHDEV,PSSMHCT,PSSMHLEN,PSSMHNAM
+3 NEW PSSMHRG1,PSSMHRG2,PSSMHRG3,PSSMHRG4,PSSMHRG5,PSSMHRG7,PSSMHRG9
+4 SET PSSMHRG9=0
+5 IF PSSHTYPE="S"
SET PSSMHNAM=$PIECE($GET(^PS(51.2,+PSSMDONE,0)),"^")
SET PSSMHLEN=$LENGTH(PSSMHNAM)
+6 SET PSSMHOUT=0
SET PSSMHDEV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
SET PSSMHCT=1
+7 KILL PSSMHRLN
SET $PIECE(PSSMHRLN,"-",79)=""
+8 DO HD
+9 IF PSSHTYPE="S"
Begin DoDot:1
+10 FOR PSSMHRG1=PSSMHRSI:0
SET PSSMHRG1=$ORDER(^PS(51.2,PSSMDONE,2,"B",PSSMHRG1))
if 'PSSMHRG1!(PSSMHRG1'<PSSMHREI)!(PSSMHOUT)
QUIT
Begin DoDot:2
+11 FOR PSSMHRG2=0:0
SET PSSMHRG2=$ORDER(^PS(51.2,PSSMDONE,2,"B",PSSMHRG1,PSSMHRG2))
if 'PSSMHRG2!(PSSMHOUT)
QUIT
Begin DoDot:3
+12 SET PSSMHRG7=$GET(^PS(51.2,PSSMDONE,2,PSSMHRG2,0))
if PSSMHRG7=""
QUIT
+13 SET PSSMHRG4=PSSMHRG2_","_PSSMDONE_","
+14 DO PRINT
End DoDot:3
End DoDot:2
End DoDot:1
GOTO END
+15 FOR PSSMHRG1=PSSMHRSI:0
SET PSSMHRG1=$ORDER(^PS(51.2,"D",PSSMHRG1))
if 'PSSMHRG1!(PSSMHRG1'<PSSMHREI)!(PSSMHOUT)
QUIT
Begin DoDot:1
+16 FOR PSSMHRG2=0:0
SET PSSMHRG2=$ORDER(^PS(51.2,"D",PSSMHRG1,PSSMHRG2))
if 'PSSMHRG2!(PSSMHOUT)
QUIT
Begin DoDot:2
+17 FOR PSSMHRG3=0:0
SET PSSMHRG3=$ORDER(^PS(51.2,"D",PSSMHRG1,PSSMHRG2,PSSMHRG3))
if 'PSSMHRG3!(PSSMHOUT)
QUIT
Begin DoDot:3
+18 SET PSSMHRG7=$GET(^PS(51.2,PSSMHRG2,2,PSSMHRG3,0))
if PSSMHRG7=""
QUIT
+19 SET PSSMHRG4=PSSMHRG3_","_PSSMHRG2_","
+20 SET PSSMHNAM=$PIECE($GET(^PS(51.2,PSSMHRG2,0)),"^")
+21 DO PRINT
End DoDot:3
End DoDot:2
End DoDot:1
END ;
+1 IF '$GET(PSSMHOUT)
IF '$GET(PSSMHRG9)
WRITE !!,?2,"No mapping changes to report.",!
+2 IF $GET(PSSMHDEV)="P"
WRITE !!,"End of Report.",!
+3 IF '$GET(PSSMHOUT)
IF $GET(PSSMHDEV)="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(PSSMHDEV)="C"
WRITE !
+5 IF '$TEST
WRITE @IOF
+6 KILL PSSHTYPE,PSSMDONE,PSSMHRSI,PSSMHRSE,PSSMHREI,PSSMHREE
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
+8 ;
PRINT ;
+1 SET PSSMHRG9=1
+2 KILL PSSMHRG5
DO GETS^DIQ(51.27,PSSMHRG4,".01;1;2;3","E","PSSMHRG5")
+3 WRITE !!,?2,"Medication Route: "_$GET(PSSMHNAM)
+4 WRITE !?9,"Date/Time: "_$GET(PSSMHRG5(51.27,PSSMHRG4,.01,"E"))
+5 IF ($Y+5)>IOSL
DO HD
if PSSMHOUT
QUIT
+6 WRITE !?9,"Edited By: "_$SELECT($GET(PSSMHRG5(51.27,PSSMHRG4,1,"E"))'="":$GET(PSSMHRG5(51.27,PSSMHRG4,1,"E")),1:"AUTOMAPPED")
+7 IF ($Y+5)>IOSL
DO HD
if PSSMHOUT
QUIT
+8 WRITE !?9,"Old Value: "_$SELECT($GET(PSSMHRG5(51.27,PSSMHRG4,2,"E"))'="":$GET(PSSMHRG5(51.27,PSSMHRG4,2,"E")),1:"<no previous value>")
+9 IF ($Y+5)>IOSL
DO HD
if PSSMHOUT
QUIT
+10 WRITE !?9,"New Value: "_$SELECT($GET(PSSMHRG5(51.27,PSSMHRG4,3,"E"))'="":$GET(PSSMHRG5(51.27,PSSMHRG4,3,"E")),1:"<no new value>")
+11 IF ($Y+5)>IOSL
DO HD
if PSSMHOUT
QUIT
+12 QUIT
+13 ;
HD ;
+1 IF $GET(PSSMHDEV)="C"
IF $GET(PSSMHCT)'=1
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSMHOUT=1
QUIT
+2 WRITE @IOF
+3 IF PSSHTYPE="A"
WRITE !,"Medication Route mapping changes for ALL Medication Routes"
+4 IF PSSHTYPE="S"
WRITE !,"Medication Route mapping changes for "
Begin DoDot:1
+5 IF +PSSMHLEN<43
WRITE PSSMHNAM
QUIT
+6 WRITE !,?34,PSSMHNAM
End DoDot:1
+7 WRITE !,"made between "_PSSMHRSE_" and "_PSSMHREE,?68,"PAGE: "_PSSMHCT,!,PSSMHRLN,!
SET PSSMHCT=PSSMHCT+1
+8 QUIT
MESS ;
+1 WRITE !!,"Nothing queued to print.",!
+2 KILL DIR
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+3 QUIT
