PSSMRRI ;ALB/DRP PRINT MRR ITEMS ;06/18/15
;;1.0;PHARMACY DATA MANAGEMENT;**191**;9/30/97;Build 40
;
Q
INIT ;
N PSSOIEN,PSSDRG,PSSDSG,PSSSPCE,PSSLN,PSSDDRG,PSSINACT,PSSDDIEN,PSSDSGF,PAGNO,PSSMRR,PSSDRGS,PSSINACTS,PSSDSGI
N PSSQ,PSSVAL,TERM
S PAGNO=0,$P(PSSSPCE," ",30)="",PSSQ=0
D MAIN
K POP,DTOUT,DUOUT,Y
Q
;
MAIN ;
D ASKUSR Q:PSSQ
;open print device
D OPEN^%ZISUTL("PSSMRRI",,) I $G(POP) W !!,"Nothing queued to print.",! Q
S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
U IO
D PRNHDR,GET50P7
;close print device
D CLOSE^%ZISUTL("PSSMRRI")
Q
;
ASKUSR ; Prompt user for inout values
K DIR
S DIR(0)="SB^A:ALL;1:1;2:2;3:3",DIR("B")="A",DIR("A")="Enter 'A' to run report for all Orderable Items. Enter '1, 2 or 3' to show only the selected values."
S (DIR("?"),DIR("??"))="^D HELP^PSSMRRI"
D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! S PSSQ=1 Q
S PSSVAL=X
W:PSSVAL="1" !!,"This report will be for items requiring removal at the next administration ",!
W:PSSVAL="2" !!,"This report will be for items with optional removal prior to next administration. ",!
W:PSSVAL="3" !!,"This report will be for items that require removal prior to the next administration. ",!
W:PSSVAL="A" !!,"This report will be for all items that require removal.",!
K DIR S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR K DIR I Y'=1 G ASKUSR
S:PSSVAL="A" PSSVAL="123"
W $C(7),!!?3,"This report is designed for 132 column output!",!
Q
HELP ;
Q:$L(X)<2
D Q23
S X="",DIR("L")="" ;Setting DIR("L") suppresses extra help display.
Q
Q23 ;
W !,"Enter 'A' to run report for all Orderable Items. Enter '1, 2 or 3'"
W !,"to show only the selected values."
W !," Select one of the following:"
W !," A ALL"
W !," 1 Removal at Next Administration"
W !," 2 Removal Period Optional Prior to Next Administration"
W !," 3 Removal Period Required Prior to Next Administration",!
Q
;
GET50P7 ;
S (PSSDRG,PSSDRGS)=""
F S PSSDRG=$O(^PS(50.7,"ADF",PSSDRG)) Q:(PSSDRG="")!PSSQ D
.S PSSDSG=""
. F S PSSDSG=$O(^PS(50.7,"ADF",PSSDRG,PSSDSG)) Q:(PSSDSG="")!PSSQ D
.. S PSSOIEN=""
.. F S PSSOIEN=$O(^PS(50.7,"ADF",PSSDRG,PSSDSG,PSSOIEN)) Q:(PSSOIEN="")!PSSQ D
... S PSSMRR=$G(^PS(50.7,PSSOIEN,4))
... I PSSVAL[+PSSMRR S PSSINACT=$P(^PS(50.7,PSSOIEN,0),U,4) D
.... S PSSDSGF=$P(^PS(50.606,PSSDSG,0),U),PSSDDIEN="",PSSDRG=PSSDRG_" - "_PSSDSGF
.... F S PSSDDIEN=$O(^PS(50.7,"A50",PSSOIEN,PSSDDIEN)) Q:(PSSDDIEN="")!PSSQ D
..... S:$G(PSSDDIEN)]"" PSSDDRG=$P(^PSDRUG(PSSDDIEN,0),"^"),PSSDSGI=$G(^PSDRUG(PSSDDIEN,"I")),PSSDSGI=$S(PSSDSGI="":" ",1:PSSDSGI)
..... D PRNLN
.....Q
....Q
...Q
..Q
.Q
Q
;
PRNHDR ; Heading
Q:PSSQ
S PAGNO=PAGNO+1
W @IOF
W !,?57,$E($$FMTE^XLFDT($$NOW^XLFDT),1,18)
W !,?19,"Orderable Items Report on Medications Requiring Removal (MRR) Prompt for Removal in BCMA Value",?125,"Page ",PAGNO
W !,?5,"ORDERABLE ITEM OI INACTIVE MRR DISPENSE DRUG (DD) DD INACTIVE"
W !,?5,"NAME - DOSAGE FORM DATE VAL NAME DATE "
W !,?5,"------------------------------ ------------ --- ------------------------------ -----------"
Q
;
PRNLN ;Write line on report
N PSSDRGP,PSSINACTP,PSSMRRP
S:PSSDRGS=PSSDRG (PSSDRGP,PSSINACTP,PSSMRRP)=" "
S:PSSDRGS'=PSSDRG (PSSDRGS,PSSDRGP)=PSSDRG,PSSINACTP=PSSINACT,PSSMRRP=" "_PSSMRR_" "
W !,?5,$E(PSSDRGP_PSSSPCE,1,30)_" "_$E($$FMTE^XLFDT(PSSINACTP,5)_PSSSPCE,1,12)_" "_$E(PSSMRRP_PSSSPCE,1,3)_" "_$E(PSSDDRG_PSSSPCE,1,30)_" "_$E($$FMTE^XLFDT(PSSDSGI,5)_PSSSPCE,1,12)
I $Y>(IOSL-1) D:$G(TERM) PAUSE D PRNHDR
Q
;
PAUSE Q:'$G(TERM)
N X
U IO(0) W !!,"Press RETURN to continue, '^' to exit"
R X:$G(DTIME) I (X="^")!('$T) S PSSQ=1 Q
U IO
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSMRRI 3900 printed Oct 16, 2024@18:33:50 Page 2
PSSMRRI ;ALB/DRP PRINT MRR ITEMS ;06/18/15
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**191**;9/30/97;Build 40
+2 ;
+3 QUIT
INIT ;
+1 NEW PSSOIEN,PSSDRG,PSSDSG,PSSSPCE,PSSLN,PSSDDRG,PSSINACT,PSSDDIEN,PSSDSGF,PAGNO,PSSMRR,PSSDRGS,PSSINACTS,PSSDSGI
+2 NEW PSSQ,PSSVAL,TERM
+3 SET PAGNO=0
SET $PIECE(PSSSPCE," ",30)=""
SET PSSQ=0
+4 DO MAIN
+5 KILL POP,DTOUT,DUOUT,Y
+6 QUIT
+7 ;
MAIN ;
+1 DO ASKUSR
if PSSQ
QUIT
+2 ;open print device
+3 DO OPEN^%ZISUTL("PSSMRRI",,)
IF $GET(POP)
WRITE !!,"Nothing queued to print.",!
QUIT
+4 SET TERM=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+5 USE IO
+6 DO PRNHDR
DO GET50P7
+7 ;close print device
+8 DO CLOSE^%ZISUTL("PSSMRRI")
+9 QUIT
+10 ;
ASKUSR ; Prompt user for inout values
+1 KILL DIR
+2 SET DIR(0)="SB^A:ALL;1:1;2:2;3:3"
SET DIR("B")="A"
SET DIR("A")="Enter 'A' to run report for all Orderable Items. Enter '1, 2 or 3' to show only the selected values."
+3 SET (DIR("?"),DIR("??"))="^D HELP^PSSMRRI"
+4 DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!,"Nothing queued to print.",!
SET PSSQ=1
QUIT
+5 SET PSSVAL=X
+6 if PSSVAL="1"
WRITE !!,"This report will be for items requiring removal at the next administration ",!
+7 if PSSVAL="2"
WRITE !!,"This report will be for items with optional removal prior to next administration. ",!
+8 if PSSVAL="3"
WRITE !!,"This report will be for items that require removal prior to the next administration. ",!
+9 if PSSVAL="A"
WRITE !!,"This report will be for all items that require removal.",!
+10 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF Y'=1
GOTO ASKUSR
+11 if PSSVAL="A"
SET PSSVAL="123"
+12 WRITE $CHAR(7),!!?3,"This report is designed for 132 column output!",!
+13 QUIT
HELP ;
+1 if $LENGTH(X)<2
QUIT
+2 DO Q23
+3 ;Setting DIR("L") suppresses extra help display.
SET X=""
SET DIR("L")=""
+4 QUIT
Q23 ;
+1 WRITE !,"Enter 'A' to run report for all Orderable Items. Enter '1, 2 or 3'"
+2 WRITE !,"to show only the selected values."
+3 WRITE !," Select one of the following:"
+4 WRITE !," A ALL"
+5 WRITE !," 1 Removal at Next Administration"
+6 WRITE !," 2 Removal Period Optional Prior to Next Administration"
+7 WRITE !," 3 Removal Period Required Prior to Next Administration",!
+8 QUIT
+9 ;
GET50P7 ;
+1 SET (PSSDRG,PSSDRGS)=""
+2 FOR
SET PSSDRG=$ORDER(^PS(50.7,"ADF",PSSDRG))
if (PSSDRG="")!PSSQ
QUIT
Begin DoDot:1
+3 SET PSSDSG=""
+4 FOR
SET PSSDSG=$ORDER(^PS(50.7,"ADF",PSSDRG,PSSDSG))
if (PSSDSG="")!PSSQ
QUIT
Begin DoDot:2
+5 SET PSSOIEN=""
+6 FOR
SET PSSOIEN=$ORDER(^PS(50.7,"ADF",PSSDRG,PSSDSG,PSSOIEN))
if (PSSOIEN="")!PSSQ
QUIT
Begin DoDot:3
+7 SET PSSMRR=$GET(^PS(50.7,PSSOIEN,4))
+8 IF PSSVAL[+PSSMRR
SET PSSINACT=$PIECE(^PS(50.7,PSSOIEN,0),U,4)
Begin DoDot:4
+9 SET PSSDSGF=$PIECE(^PS(50.606,PSSDSG,0),U)
SET PSSDDIEN=""
SET PSSDRG=PSSDRG_" - "_PSSDSGF
+10 FOR
SET PSSDDIEN=$ORDER(^PS(50.7,"A50",PSSOIEN,PSSDDIEN))
if (PSSDDIEN="")!PSSQ
QUIT
Begin DoDot:5
+11 if $GET(PSSDDIEN)]""
SET PSSDDRG=$PIECE(^PSDRUG(PSSDDIEN,0),"^")
SET PSSDSGI=$GET(^PSDRUG(PSSDDIEN,"I"))
SET PSSDSGI=$SELECT(PSSDSGI="":" ",1:PSSDSGI)
+12 DO PRNLN
+13 QUIT
End DoDot:5
+14 QUIT
End DoDot:4
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
PRNHDR ; Heading
+1 if PSSQ
QUIT
+2 SET PAGNO=PAGNO+1
+3 WRITE @IOF
+4 WRITE !,?57,$EXTRACT($$FMTE^XLFDT($$NOW^XLFDT),1,18)
+5 WRITE !,?19,"Orderable Items Report on Medications Requiring Removal (MRR) Prompt for Removal in BCMA Value",?125,"Page ",PAGNO
+6 WRITE !,?5,"ORDERABLE ITEM OI INACTIVE MRR DISPENSE DRUG (DD) DD INACTIVE"
+7 WRITE !,?5,"NAME - DOSAGE FORM DATE VAL NAME DATE "
+8 WRITE !,?5,"------------------------------ ------------ --- ------------------------------ -----------"
+9 QUIT
+10 ;
PRNLN ;Write line on report
+1 NEW PSSDRGP,PSSINACTP,PSSMRRP
+2 if PSSDRGS=PSSDRG
SET (PSSDRGP,PSSINACTP,PSSMRRP)=" "
+3 if PSSDRGS'=PSSDRG
SET (PSSDRGS,PSSDRGP)=PSSDRG
SET PSSINACTP=PSSINACT
SET PSSMRRP=" "_PSSMRR_" "
+4 WRITE !,?5,$EXTRACT(PSSDRGP_PSSSPCE,1,30)_" "_$EXTRACT($$FMTE^XLFDT(PSSINACTP,5)_PSSSPCE,1,12)_" "_$EXTRACT(PSSMRRP_PSSSPCE,1,3)_" "_$EXTRACT(PSSDDRG_PSSSPCE,1,30)_" "_$EXTRACT($$FMTE^XLFDT(PSSDSGI,5)_PSSSPCE,1,12)
+5 IF $Y>(IOSL-1)
if $GET(TERM)
DO PAUSE
DO PRNHDR
+6 QUIT
+7 ;
PAUSE if '$GET(TERM)
QUIT
+1 NEW X
+2 USE IO(0)
WRITE !!,"Press RETURN to continue, '^' to exit"
+3 READ X:$GET(DTIME)
IF (X="^")!('$TEST)
SET PSSQ=1
QUIT
+4 USE IO
+5 QUIT
+6 ;
