PSSHRHAI ;BIRMINGHAM/GN-Orderable Items High Risk/High Alert Report ;9/25/15 10:03am
;;1.0;PHARMACY DATA MANAGEMENT;**191**;9/30/97;Build 40
;
Q
INIT ; Initialize Variables
N PSSOIEN,PSSDRG,PSSDSG,PSSSPCE,PSSLN,PSSDDRG,PSSINACT,PSSDDIEN,PSSDSGF,PAGNO,PSSMRR,TERM
N PSSQ,PSSVAL,PSSDRGS,PSSDSGI,PSSHRA,PSSINACTS
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") Q:POP
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
;
GET50P7 ;
S (PSSDRG,PSSDRGS)=""
F S PSSDRG=$O(^PS(50.7,"ADF",PSSDRG)) Q:(PSSDRG="")!PSSQ D
.S PSSDSG="",PSSDRGP=PSSDRG
. 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 PSSHRA=$P($G(^PS(50.7,PSSOIEN,0)),U,14)
... I PSSVAL[+PSSHRA S PSSINACT=$P(^PS(50.7,PSSOIEN,0),U,4) D
.... S PSSDSGF=$P(^PS(50.606,PSSDSG,0),U),PSSDSGI=$P(^PS(50.606,PSSDSG,0),U,2),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=$S(PSSDSGI="":" ",1:PSSDSGI)
..... D PRNLN
.....Q
....Q
...Q
..Q
.Q
Q
;
ASKUSR ; Prompt user for input values
K DIR
S DIR(0)="SB^A:ALL;1:1;2:2;3:3",DIR("B")="A",DIR("A")="Print Report for (A)ll or Specific HR/HA Flag values(1,2,3)"
S (DIR("?"),DIR("??"))="^D HELP^PSSHRHAI"
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 that do not require a witness in BCMA",!
W:PSSVAL="2" !!,"This report will be for items that recommend a witness in BCMA",!
W:PSSVAL="3" !!,"This report will be for items that require a witness in BCMA",!
W:PSSVAL="A" !!,"This report will be for all High Risk/High Alert witness related items ",!
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 HIGH RISK/ALERT-NO WITNESS REQUIRED IN BCMA"
W !," 2 RECOMMEND WITNESS IN BCMA-HIGH RISK/ALERT"
W !," 3 WITNESS REQUIRED IN BCMA-HIGH RISK/ALERT",!
Q
;
PRNHDR ; Heading
Q:PSSQ
S PAGNO=PAGNO+1
W @IOF
W !,?57,$E($$FMTE^XLFDT($$NOW^XLFDT),1,18)
W !,?42,"High Risk/High Alert for Orderable Items Report",?125,"Page ",PAGNO
W !,?5,"ORDERABLE ITEM OI INACTIVE HRHA 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,PSSHRAP
S:PSSDRGS=PSSDRG (PSSDRGP,PSSINACTP,PSSHRAP)=" "
S:PSSDRGS'=PSSDRG (PSSDRGS,PSSDRGP)=PSSDRG,(PSSINACTS,PSSINACTP)=PSSINACT,PSSHRAP=" "_PSSHRA_" "
W !,?5,$E(PSSDRGP_PSSSPCE,1,30)_" "_$E($$FMTE^XLFDT(PSSINACTP,5)_PSSSPCE,1,12)_" "_$E(PSSHRAP_PSSSPCE,1,4)_" "_$E(PSSDDRG_PSSSPCE,1,30)_" "_$E(PSSDSGI_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[HPSSHRHAI 3821 printed Sep 23, 2025@20:07:32 Page 2
PSSHRHAI ;BIRMINGHAM/GN-Orderable Items High Risk/High Alert Report ;9/25/15 10:03am
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**191**;9/30/97;Build 40
+2 ;
+3 QUIT
INIT ; Initialize Variables
+1 NEW PSSOIEN,PSSDRG,PSSDSG,PSSSPCE,PSSLN,PSSDDRG,PSSINACT,PSSDDIEN,PSSDSGF,PAGNO,PSSMRR,TERM
+2 NEW PSSQ,PSSVAL,PSSDRGS,PSSDSGI,PSSHRA,PSSINACTS
+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 POP
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 ;
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=""
SET PSSDRGP=PSSDRG
+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 PSSHRA=$PIECE($GET(^PS(50.7,PSSOIEN,0)),U,14)
+8 IF PSSVAL[+PSSHRA
SET PSSINACT=$PIECE(^PS(50.7,PSSOIEN,0),U,4)
Begin DoDot:4
+9 SET PSSDSGF=$PIECE(^PS(50.606,PSSDSG,0),U)
SET PSSDSGI=$PIECE(^PS(50.606,PSSDSG,0),U,2)
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=$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 ;
ASKUSR ; Prompt user for input values
+1 KILL DIR
+2 SET DIR(0)="SB^A:ALL;1:1;2:2;3:3"
SET DIR("B")="A"
SET DIR("A")="Print Report for (A)ll or Specific HR/HA Flag values(1,2,3)"
+3 SET (DIR("?"),DIR("??"))="^D HELP^PSSHRHAI"
+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 that do not require a witness in BCMA",!
+7 if PSSVAL="2"
WRITE !!,"This report will be for items that recommend a witness in BCMA",!
+8 if PSSVAL="3"
WRITE !!,"This report will be for items that require a witness in BCMA",!
+9 if PSSVAL="A"
WRITE !!,"This report will be for all High Risk/High Alert witness related items ",!
+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
+14 ;
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 HIGH RISK/ALERT-NO WITNESS REQUIRED IN BCMA"
+6 WRITE !," 2 RECOMMEND WITNESS IN BCMA-HIGH RISK/ALERT"
+7 WRITE !," 3 WITNESS REQUIRED IN BCMA-HIGH RISK/ALERT",!
+8 QUIT
+9 ;
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 !,?42,"High Risk/High Alert for Orderable Items Report",?125,"Page ",PAGNO
+6 WRITE !,?5,"ORDERABLE ITEM OI INACTIVE HRHA 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,PSSHRAP
+2 if PSSDRGS=PSSDRG
SET (PSSDRGP,PSSINACTP,PSSHRAP)=" "
+3 if PSSDRGS'=PSSDRG
SET (PSSDRGS,PSSDRGP)=PSSDRG
SET (PSSINACTS,PSSINACTP)=PSSINACT
SET PSSHRAP=" "_PSSHRA_" "
+4 WRITE !,?5,$EXTRACT(PSSDRGP_PSSSPCE,1,30)_" "_$EXTRACT($$FMTE^XLFDT(PSSINACTP,5)_PSSSPCE,1,12)_" "_$EXTRACT(PSSHRAP_PSSSPCE,1,4)_" "_$EXTRACT(PSSDDRG_PSSSPCE,1,30)_" "_$EXTRACT(PSSDSGI_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 ;
