- 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 Jan 18, 2025@03:32: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 ;