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

PSSMRRI.m

Go to the documentation of this file.
  1. PSSMRRI ;ALB/DRP PRINT MRR ITEMS ;06/18/15
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**191**;9/30/97;Build 40
  1. ;
  1. Q
  1. INIT ;
  1. N PSSOIEN,PSSDRG,PSSDSG,PSSSPCE,PSSLN,PSSDDRG,PSSINACT,PSSDDIEN,PSSDSGF,PAGNO,PSSMRR,PSSDRGS,PSSINACTS,PSSDSGI
  1. N PSSQ,PSSVAL,TERM
  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",,) I $G(POP) W !!,"Nothing queued to print.",! Q
  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. ASKUSR ; Prompt user for inout values
  1. K DIR
  1. 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."
  1. S (DIR("?"),DIR("??"))="^D HELP^PSSMRRI"
  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 requiring removal at the next administration ",!
  1. W:PSSVAL="2" !!,"This report will be for items with optional removal prior to next administration. ",!
  1. W:PSSVAL="3" !!,"This report will be for items that require removal prior to the next administration. ",!
  1. W:PSSVAL="A" !!,"This report will be for all items that require removal.",!
  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. 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 Removal at Next Administration"
  1. W !," 2 Removal Period Optional Prior to Next Administration"
  1. W !," 3 Removal Period Required Prior to Next Administration",!
  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=""
  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 PSSMRR=$G(^PS(50.7,PSSOIEN,4))
  1. ... I PSSVAL[+PSSMRR S PSSINACT=$P(^PS(50.7,PSSOIEN,0),U,4) D
  1. .... S PSSDSGF=$P(^PS(50.606,PSSDSG,0),U),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=$G(^PSDRUG(PSSDDIEN,"I")),PSSDSGI=$S(PSSDSGI="":" ",1:PSSDSGI)
  1. ..... D PRNLN
  1. .....Q
  1. ....Q
  1. ...Q
  1. ..Q
  1. .Q
  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 !,?19,"Orderable Items Report on Medications Requiring Removal (MRR) Prompt for Removal in BCMA Value",?125,"Page ",PAGNO
  1. W !,?5,"ORDERABLE ITEM OI INACTIVE MRR 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,PSSMRRP
  1. S:PSSDRGS=PSSDRG (PSSDRGP,PSSINACTP,PSSMRRP)=" "
  1. S:PSSDRGS'=PSSDRG (PSSDRGS,PSSDRGP)=PSSDRG,PSSINACTP=PSSINACT,PSSMRRP=" "_PSSMRR_" "
  1. 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)
  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. ;