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