Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSHRHAI

PSSHRHAI.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. INIT ; Initialize Variables
  1. N PSSOIEN,PSSDRG,PSSDSG,PSSSPCE,PSSLN,PSSDDRG,PSSINACT,PSSDDIEN,PSSDSGF,PAGNO,PSSMRR,TERM
  1. N PSSQ,PSSVAL,PSSDRGS,PSSDSGI,PSSHRA,PSSINACTS
  1. S PAGNO=0,$P(PSSSPCE," ",30)="",PSSQ=0
  1. D MAIN
  1. K POP,DTOUT,DUOUT,Y
  1. Q
  1. ;
  1. MAIN ;
  1. D ASKUSR Q:PSSQ
  1. ;open print device
  1. D OPEN^%ZISUTL("PSSMRRI") Q:POP
  1. S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. U IO
  1. D PRNHDR,GET50P7
  1. ;close print device
  1. D CLOSE^%ZISUTL("PSSMRRI")
  1. Q
  1. ;
  1. GET50P7 ;
  1. S (PSSDRG,PSSDRGS)=""
  1. F S PSSDRG=$O(^PS(50.7,"ADF",PSSDRG)) Q:(PSSDRG="")!PSSQ D
  1. .S PSSDSG="",PSSDRGP=PSSDRG
  1. . F S PSSDSG=$O(^PS(50.7,"ADF",PSSDRG,PSSDSG)) Q:(PSSDSG="")!PSSQ D
  1. .. S PSSOIEN=""
  1. .. F S PSSOIEN=$O(^PS(50.7,"ADF",PSSDRG,PSSDSG,PSSOIEN)) Q:(PSSOIEN="")!PSSQ D
  1. ... S PSSHRA=$P($G(^PS(50.7,PSSOIEN,0)),U,14)
  1. ... I PSSVAL[+PSSHRA S PSSINACT=$P(^PS(50.7,PSSOIEN,0),U,4) D
  1. .... S PSSDSGF=$P(^PS(50.606,PSSDSG,0),U),PSSDSGI=$P(^PS(50.606,PSSDSG,0),U,2),PSSDDIEN="",PSSDRG=PSSDRG_" - "_PSSDSGF
  1. .... F S PSSDDIEN=$O(^PS(50.7,"A50",PSSOIEN,PSSDDIEN)) Q:(PSSDDIEN="")!PSSQ D
  1. ..... S:$G(PSSDDIEN)]"" PSSDDRG=$P(^PSDRUG(PSSDDIEN,0),"^"),PSSDSGI=$S(PSSDSGI="":" ",1:PSSDSGI)
  1. ..... D PRNLN
  1. .....Q
  1. ....Q
  1. ...Q
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. ASKUSR ; Prompt user for input values
  1. K DIR
  1. 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)"
  1. S (DIR("?"),DIR("??"))="^D HELP^PSSHRHAI"
  1. D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!,"Nothing queued to print.",! S PSSQ=1 Q
  1. S PSSVAL=X
  1. W:PSSVAL="1" !!,"This report will be for items that do not require a witness in BCMA",!
  1. W:PSSVAL="2" !!,"This report will be for items that recommend a witness in BCMA",!
  1. W:PSSVAL="3" !!,"This report will be for items that require a witness in BCMA",!
  1. W:PSSVAL="A" !!,"This report will be for all High Risk/High Alert witness related items ",!
  1. K DIR S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" D ^DIR K DIR I Y'=1 G ASKUSR
  1. S:PSSVAL="A" PSSVAL="123"
  1. W $C(7),!!?3,"This report is designed for 132 column output!",!
  1. Q
  1. ;
  1. HELP ;
  1. Q:$L(X)<2
  1. D Q23
  1. S X="",DIR("L")="" ;Setting DIR("L") suppresses extra help display.
  1. Q
  1. Q23 ;
  1. W !,"Enter 'A' to run report for All Orderable Items. Enter '1, 2 or 3'"
  1. W !,"to show only the selected values."
  1. W !," Select one of the following:"
  1. W !," A ALL"
  1. W !," 1 HIGH RISK/ALERT-NO WITNESS REQUIRED IN BCMA"
  1. W !," 2 RECOMMEND WITNESS IN BCMA-HIGH RISK/ALERT"
  1. W !," 3 WITNESS REQUIRED IN BCMA-HIGH RISK/ALERT",!
  1. Q
  1. ;
  1. PRNHDR ; Heading
  1. Q:PSSQ
  1. S PAGNO=PAGNO+1
  1. W @IOF
  1. W !,?57,$E($$FMTE^XLFDT($$NOW^XLFDT),1,18)
  1. W !,?42,"High Risk/High Alert for Orderable Items Report",?125,"Page ",PAGNO
  1. W !,?5,"ORDERABLE ITEM OI INACTIVE HRHA DISPENSE DRUG (DD) DD INACTIVE"
  1. W !,?5,"NAME - DOSAGE FORM DATE VAL NAME DATE "
  1. W !,?5,"------------------------------ ------------ ---- ------------------------------ -----------"
  1. Q
  1. ;
  1. PRNLN ;Write line on report
  1. N PSSDRGP,PSSINACTP,PSSHRAP
  1. S:PSSDRGS=PSSDRG (PSSDRGP,PSSINACTP,PSSHRAP)=" "
  1. S:PSSDRGS'=PSSDRG (PSSDRGS,PSSDRGP)=PSSDRG,(PSSINACTS,PSSINACTP)=PSSINACT,PSSHRAP=" "_PSSHRA_" "
  1. 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)
  1. I $Y>(IOSL-1) D:$G(TERM) PAUSE D PRNHDR
  1. Q
  1. ;
  1. PAUSE Q:'$G(TERM)
  1. N X
  1. U IO(0) W !!,"Press RETURN to continue, '^' to exit"
  1. R X:$G(DTIME) I (X="^")!('$T) S PSSQ=1 Q
  1. U IO
  1. Q
  1. ;