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

PSDNMU.m

Go to the documentation of this file. 
  1. PSDNMU ;DOIFO/CMS - CS Monitoring Utility routine ;17 Dec 02
  1.  ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97 
  1.  ;Reference to ^PSD(58.8 supported by IA #2711
  1.  ;Reference to ^PS(59 supported by IA #2621
  1.  Q
  1.  ;
  1. CII ;Select CS DEA Codes
  1.  ; Return PSDCII=2,3,4,5 or user selection
  1.  ; Return PSDOUT=1 if '^" entered
  1.  N X,Y K DIR,DTOUT,DUOUT,PSDOUT
  1.  S DIR(0)="L^2:5:0",DIR("A")="Include RXs with CS schedule(s)"
  1.  S DIR("B")="2"
  1.  S DIR("?")="Enter range or combination of DEA Codes (schedules) from 2 to 5.     Enter '^' to exit."
  1.  D ^DIR K DIR
  1.  S PSDCII=Y
  1.  I $D(DTOUT)!($D(DUOUT)) K PSDCII S PSDOUT=1
  1. CIIQ K DIR,DIRUT,DIROUT,DTOUT,DUOUT,PSDNO
  1.  Q
  1.  ;
  1. CIIO ;Optional Select CS DEA Codes
  1.  ; Return PSDCII=2,3,4,5 or user selection or null
  1.  ; Return PSDOUT=1 if '^" entered
  1.  N X,Y K DIR,DTOUT,DUOUT,PSDOUT
  1.  W !,"OPTIONAL"
  1.  S DIR(0)="LO^2:5:0",DIR("A")="Include RXs with CS schedule(s)"
  1.  S DIR("?")="Enter range or combination of DEA Codes (schedules) from 2 to 5.   Enter '^' to exit."
  1.  D ^DIR K DIR
  1.  S PSDCII=Y
  1.  I $D(DTOUT)!($D(DUOUT)) K PSDCII S PSDOUT=1
  1. CIIOQ K DIR,DIRUT,DIROUT,DTOUT,DUOUT,PSDNO
  1.  Q
  1.  ;
  1. INPS ;Select Inpatient Site file 59.4
  1.  ; Return PSDIDIV=ien^Name
  1.  ; Return PSDOUT=1  If '^' entered
  1.  N D,DIC,DTOUT,X,Y K PSDIDIV
  1. INPSC S DIC="^PS(59.4,",DIC(0)="QEAM",D="B"
  1.  S DIC("S")="I +$P(^(0),""^"",31)"
  1.  W ! D ^DIC K DIC
  1.  I X="^"!($D(DTOUT)) S PSDOUT=1 G INPSQ
  1.  I +Y<0 W !!,"A CS Inpatient Site must be selected!  Enter '^' to exit." G INPSC
  1.  I +Y S PSDIDIV=Y G INPSQ
  1. INPSQ Q
  1.  ;
  1. PLOC ;Ask Pharmacy Location
  1.  ; PSDIDIV must be defined to selected inpatient site
  1.  ; Return PSDPLOC array  ie. PSDPLOC(file58.8ien)=""
  1.  ; Return PSDOUT=1  If '^' entered
  1.  ;
  1.  N DIC,X,Y K PSDPLOC,PSDOUT
  1.  S DIC("A")="Select Pharmacy Location(s): "
  1. PLOCC S DIC=58.8,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)=+$G(PSDIDIV)" D ^DIC
  1.  I X="^ALL" D PLOCA G PLOCQ
  1.  I X["^"!($D(DTOUT)) K PSDPLOC S PSDOUT=1 G PLOCQ
  1.  I +Y<1,'$O(PSDPLOC(0)) W !!,"A 'Pharmacy Location' must be selected! Enter '^ALL' to select all locations.  Enter '^' to exit." G PLOCC
  1.  I +Y<0,$O(PSDPLOC(0)) G PLOCQ
  1.  S PSDPLOC(+Y)=$P(Y,U,2)
  1.  S DIC("A")="Select another Pharmacy Location: " G PLOCC
  1. PLOCQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  Q
  1.  ;
  1. PLOCA ;Get all Pharmacy Location for selected Inpatient Site
  1.  ; Return PSDPLOC(ien)=Name
  1.  N PSDY
  1.  S PSDY=0,PSDPLOC="^ALL"
  1.  F  S PSDY=$O(^PSD(58.8,PSDY)) Q:'PSDY  D
  1.  . I $P($G(^PSD(58.8,PSDY,0)),U,3)'=+PSDIDIV Q
  1.  . S PSDPLOC(PSDY)=$P(^PSD(58.8,PSDY,0),U,1)
  1.  Q
  1.  ;
  1. DISD ;Discharge Days Number
  1.  ;Return PSDISB - Number of Days to ignore before Discharge Date 
  1.  ;Return PSDISA - Number of Days to ignore after Discharge Date
  1.  ;Return PSDOUT=1  If '^' entered
  1.  ;
  1.  N %,%DT,X,Y K DIR,PSDISA,PSDISB
  1.  S DIR(0)="NO^0:3:0",DIR("B")=0
  1.  S DIR("A")="Number of days to ignore BEFORE discharge date"
  1.  S DIR("?")="Enter number of days (0-3) to ignore BEFORE discharge date.  Enter '^' to Exit."
  1.  D ^DIR K DIR
  1.  I +Y S PSDISB=+Y
  1.  I $D(DTOUT)!($D(DUOUT)) S PSDOUT=1 G DISDQ
  1.  S DIR(0)="NO^0:3:0",DIR("B")=0
  1.  S DIR("A")="Number of days to ignore AFTER  discharge date"
  1.  S DIR("?")="Enter number of days (0-3) to ignore AFTER discharge date.  Enter '^' to Exit."
  1.  D ^DIR
  1.  I +Y S PSDISA=+Y
  1.  I $D(DTOUT)!($D(DUOUT)) K PSDISB,PSDISA S PSDOUT=1
  1. DISDQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  Q
  1.  ;
  1. DATE ;Ask Date Range
  1.  ; Pass PSDDTN - Name of Date Range (Opt.)
  1.  ; Return PSDSD - Start Date Range ie. 3030109.9999^JAN 10, 2003
  1.  ; Return PSDED - End Date Range ie. 3030118.9999^JAN 19, 2003
  1.  ; Return PSDOUT=1  If '^' entered
  1.  ;
  1.  N %,%DT,X,Y K PSDSD,PSDED,PSDOUT
  1. DST W ! K %DT S %DT="AEP",%DT("A")="Start with "_$G(PSDDTN)_" Date: " D ^%DT
  1.  I X["^" K PSDSD,PSDED S PSDOUT=1 G DATEQ
  1.  I Y<0 W !,"Date Range is required!  Enter '^' to exit." G DST
  1.  S PSDSD=Y D D^DIQ S PSDSD=PSDSD-.0001,$P(PSDSD,"^",2)=Y
  1.  S %DT("A")="End with "_$G(PSDDTN)_" Date: " D ^%DT
  1.  I X["^" K PSDSD,PSDED S PSDOUT=1 G DATEQ
  1.  I Y<PSDSD W !!,"The ending date of the range must be later than the starting date." G DST
  1.  S PSDED=Y D D^DIQ S PSDED=PSDED+.9999,$P(PSDED,"^",2)=Y
  1. DATEQ Q
  1.  ;
  1.  ;
  1. DIV ;Ask Outpatient Division(s)
  1.  ; Return PSDODIV array  ie. PSDODIV(file59ien)=""
  1.  ; Return PSDOUT=1  If '^' entered
  1.  ;
  1.  N DIC,X,Y K PSDODIV,PSDOUT
  1.  S DIC("A")="Select Outpatient Division: "
  1. DIVC S DIC=59,DIC(0)="AEMQ" D ^DIC
  1.  I X["^"!($D(DTOUT)) K PSDODIV S PSDOUT=1 G DIVQ
  1.  I +Y<1,'$O(PSDODIV(0)) W !!,"A 'DIVISION' must be selected!  or Enter '^' to exit." G DIVC
  1.  I +Y<0,$O(PSDODIV(0)) G DIVQ
  1.  S PSDODIV(+Y)=$P(Y,U,2)_"^"_$P($G(^PS(59,+Y,0)),U,6)
  1.  S DIC("A")="Select another Outpatient Division: " G DIVC
  1. DIVQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  Q