- PSSMIRPT ;BIR/RTR-Medication Instruction Report ;07/03/07
- ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
- ;
- ;
- 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
- 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","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 !?19,"SYNONYM: "_$G(PSSMXRAA(51,PSSMXRA,.5,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSMXOUT
- ..W !?17,"EXPANSION: " D
- ...S PSSMXREP=$G(PSSMXRAA(51,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 !
- ..W ?2,"OTHER LANGUAGE EXPANSION: " D
- ...S PSSMXROO=$G(PSSMXRAA(51,PSSMXRA,1.1,"E"))
- ...I PSSMXLNG=132 D Q
- ....I $L(PSSMXROO)<104 W PSSMXROO,! Q
- ....N X,DIWL,DIWR,DIWF S X=PSSMXROO,DIWL=29,DIWR=131,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
- ...I $L(PSSMXROO)<52 W PSSMXROO,! Q
- ...N X,DIWL,DIWR,DIWF S X=PSSMXROO,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 !
- ..W ?20,"PLURAL: "_$G(PSSMXRAA(51,PSSMXRA,9,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSMXOUT
- ..W !?14,"INTENDED USE: "_$G(PSSMXRAA(51,PSSMXRA,30,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSMXOUT
- ..W !?4,"FREQUENCY (IN MINUTES): "_$G(PSSMXRAA(51,PSSMXRA,31,"E"))
- ..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
- PSSMIRPT ;BIR/RTR-Medication Instruction Report ;07/03/07
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
- +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
- +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","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 !?19,"SYNONYM: "_$GET(PSSMXRAA(51,PSSMXRA,.5,"E"))
- +16 IF ($Y+5)>IOSL
- DO HD
- IF PSSMXOUT
- QUIT
- +17 WRITE !?17,"EXPANSION: "
- Begin DoDot:3
- +18 SET PSSMXREP=$GET(PSSMXRAA(51,PSSMXRA,1,"E"))
- +19 IF PSSMXLNG=132
- Begin DoDot:4
- +20 IF $LENGTH(PSSMXREP)<104
- WRITE PSSMXREP,!
- QUIT
- +21 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
- +22 IF $LENGTH(PSSMXREP)<52
- WRITE PSSMXREP,!
- QUIT
- +23 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
- +24 IF ($Y+5)>IOSL
- DO HD
- IF PSSMXOUT
- QUIT
- WRITE !
- +25 WRITE ?2,"OTHER LANGUAGE EXPANSION: "
- Begin DoDot:3
- +26 SET PSSMXROO=$GET(PSSMXRAA(51,PSSMXRA,1.1,"E"))
- +27 IF PSSMXLNG=132
- Begin DoDot:4
- +28 IF $LENGTH(PSSMXROO)<104
- WRITE PSSMXROO,!
- QUIT
- +29 NEW X,DIWL,DIWR,DIWF
- SET X=PSSMXROO
- 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
- +30 IF $LENGTH(PSSMXROO)<52
- WRITE PSSMXROO,!
- QUIT
- +31 NEW X,DIWL,DIWR,DIWF
- SET X=PSSMXROO
- SET DIWL=29
- SET DIWR=79
- SET DIWF="W"
- KILL ^UTILITY($JOB,"W")
- DO ^DIWP
- DO ^DIWW
- KILL ^UTILITY($JOB,"W")
- End DoDot:3
- +32 IF ($Y+5)>IOSL
- DO HD
- IF PSSMXOUT
- QUIT
- WRITE !
- +33 WRITE ?20,"PLURAL: "_$GET(PSSMXRAA(51,PSSMXRA,9,"E"))
- +34 IF ($Y+5)>IOSL
- DO HD
- IF PSSMXOUT
- QUIT
- +35 WRITE !?14,"INTENDED USE: "_$GET(PSSMXRAA(51,PSSMXRA,30,"E"))
- +36 IF ($Y+5)>IOSL
- DO HD
- IF PSSMXOUT
- QUIT
- +37 WRITE !?4,"FREQUENCY (IN MINUTES): "_$GET(PSSMXRAA(51,PSSMXRA,31,"E"))
- +38 IF ($Y+5)>IOSL
- DO HD
- IF PSSMXOUT
- QUIT
- End DoDot:2
- End DoDot:1
- +39 ;
- 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
