- 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
- 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
