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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNMU 4659 printed Apr 09, 2024@20:54:07 Page 2
PSDNMU ;DOIFO/CMS - CS Monitoring Utility routine ;17 Dec 02
+1 ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
+2 ;Reference to ^PSD(58.8 supported by IA #2711
+3 ;Reference to ^PS(59 supported by IA #2621
+4 QUIT
+5 ;
CII ;Select CS DEA Codes
+1 ; Return PSDCII=2,3,4,5 or user selection
+2 ; Return PSDOUT=1 if '^" entered
+3 NEW X,Y
KILL DIR,DTOUT,DUOUT,PSDOUT
+4 SET DIR(0)="L^2:5:0"
SET DIR("A")="Include RXs with CS schedule(s)"
+5 SET DIR("B")="2"
+6 SET DIR("?")="Enter range or combination of DEA Codes (schedules) from 2 to 5. Enter '^' to exit."
+7 DO ^DIR
KILL DIR
+8 SET PSDCII=Y
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
KILL PSDCII
SET PSDOUT=1
CIIQ KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,PSDNO
+1 QUIT
+2 ;
CIIO ;Optional Select CS DEA Codes
+1 ; Return PSDCII=2,3,4,5 or user selection or null
+2 ; Return PSDOUT=1 if '^" entered
+3 NEW X,Y
KILL DIR,DTOUT,DUOUT,PSDOUT
+4 WRITE !,"OPTIONAL"
+5 SET DIR(0)="LO^2:5:0"
SET DIR("A")="Include RXs with CS schedule(s)"
+6 SET DIR("?")="Enter range or combination of DEA Codes (schedules) from 2 to 5. Enter '^' to exit."
+7 DO ^DIR
KILL DIR
+8 SET PSDCII=Y
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
KILL PSDCII
SET PSDOUT=1
CIIOQ KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,PSDNO
+1 QUIT
+2 ;
INPS ;Select Inpatient Site file 59.4
+1 ; Return PSDIDIV=ien^Name
+2 ; Return PSDOUT=1 If '^' entered
+3 NEW D,DIC,DTOUT,X,Y
KILL PSDIDIV
INPSC SET DIC="^PS(59.4,"
SET DIC(0)="QEAM"
SET D="B"
+1 SET DIC("S")="I +$P(^(0),""^"",31)"
+2 WRITE !
DO ^DIC
KILL DIC
+3 IF X="^"!($DATA(DTOUT))
SET PSDOUT=1
GOTO INPSQ
+4 IF +Y<0
WRITE !!,"A CS Inpatient Site must be selected! Enter '^' to exit."
GOTO INPSC
+5 IF +Y
SET PSDIDIV=Y
GOTO INPSQ
INPSQ QUIT
+1 ;
PLOC ;Ask Pharmacy Location
+1 ; PSDIDIV must be defined to selected inpatient site
+2 ; Return PSDPLOC array ie. PSDPLOC(file58.8ien)=""
+3 ; Return PSDOUT=1 If '^' entered
+4 ;
+5 NEW DIC,X,Y
KILL PSDPLOC,PSDOUT
+6 SET DIC("A")="Select Pharmacy Location(s): "
PLOCC SET DIC=58.8
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,3)=+$G(PSDIDIV)"
DO ^DIC
+1 IF X="^ALL"
DO PLOCA
GOTO PLOCQ
+2 IF X["^"!($DATA(DTOUT))
KILL PSDPLOC
SET PSDOUT=1
GOTO PLOCQ
+3 IF +Y<1
IF '$ORDER(PSDPLOC(0))
WRITE !!,"A 'Pharmacy Location' must be selected! Enter '^ALL' to select all locations. Enter '^' to exit."
GOTO PLOCC
+4 IF +Y<0
IF $ORDER(PSDPLOC(0))
GOTO PLOCQ
+5 SET PSDPLOC(+Y)=$PIECE(Y,U,2)
+6 SET DIC("A")="Select another Pharmacy Location: "
GOTO PLOCC
PLOCQ KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+1 QUIT
+2 ;
PLOCA ;Get all Pharmacy Location for selected Inpatient Site
+1 ; Return PSDPLOC(ien)=Name
+2 NEW PSDY
+3 SET PSDY=0
SET PSDPLOC="^ALL"
+4 FOR
SET PSDY=$ORDER(^PSD(58.8,PSDY))
if 'PSDY
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^PSD(58.8,PSDY,0)),U,3)'=+PSDIDIV
QUIT
+6 SET PSDPLOC(PSDY)=$PIECE(^PSD(58.8,PSDY,0),U,1)
End DoDot:1
+7 QUIT
+8 ;
DISD ;Discharge Days Number
+1 ;Return PSDISB - Number of Days to ignore before Discharge Date
+2 ;Return PSDISA - Number of Days to ignore after Discharge Date
+3 ;Return PSDOUT=1 If '^' entered
+4 ;
+5 NEW %,%DT,X,Y
KILL DIR,PSDISA,PSDISB
+6 SET DIR(0)="NO^0:3:0"
SET DIR("B")=0
+7 SET DIR("A")="Number of days to ignore BEFORE discharge date"
+8 SET DIR("?")="Enter number of days (0-3) to ignore BEFORE discharge date. Enter '^' to Exit."
+9 DO ^DIR
KILL DIR
+10 IF +Y
SET PSDISB=+Y
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
SET PSDOUT=1
GOTO DISDQ
+12 SET DIR(0)="NO^0:3:0"
SET DIR("B")=0
+13 SET DIR("A")="Number of days to ignore AFTER discharge date"
+14 SET DIR("?")="Enter number of days (0-3) to ignore AFTER discharge date. Enter '^' to Exit."
+15 DO ^DIR
+16 IF +Y
SET PSDISA=+Y
+17 IF $DATA(DTOUT)!($DATA(DUOUT))
KILL PSDISB,PSDISA
SET PSDOUT=1
DISDQ KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+1 QUIT
+2 ;
DATE ;Ask Date Range
+1 ; Pass PSDDTN - Name of Date Range (Opt.)
+2 ; Return PSDSD - Start Date Range ie. 3030109.9999^JAN 10, 2003
+3 ; Return PSDED - End Date Range ie. 3030118.9999^JAN 19, 2003
+4 ; Return PSDOUT=1 If '^' entered
+5 ;
+6 NEW %,%DT,X,Y
KILL PSDSD,PSDED,PSDOUT
DST WRITE !
KILL %DT
SET %DT="AEP"
SET %DT("A")="Start with "_$GET(PSDDTN)_" Date: "
DO ^%DT
+1 IF X["^"
KILL PSDSD,PSDED
SET PSDOUT=1
GOTO DATEQ
+2 IF Y<0
WRITE !,"Date Range is required! Enter '^' to exit."
GOTO DST
+3 SET PSDSD=Y
DO D^DIQ
SET PSDSD=PSDSD-.0001
SET $PIECE(PSDSD,"^",2)=Y
+4 SET %DT("A")="End with "_$GET(PSDDTN)_" Date: "
DO ^%DT
+5 IF X["^"
KILL PSDSD,PSDED
SET PSDOUT=1
GOTO DATEQ
+6 IF Y<PSDSD
WRITE !!,"The ending date of the range must be later than the starting date."
GOTO DST
+7 SET PSDED=Y
DO D^DIQ
SET PSDED=PSDED+.9999
SET $PIECE(PSDED,"^",2)=Y
DATEQ QUIT
+1 ;
+2 ;
DIV ;Ask Outpatient Division(s)
+1 ; Return PSDODIV array ie. PSDODIV(file59ien)=""
+2 ; Return PSDOUT=1 If '^' entered
+3 ;
+4 NEW DIC,X,Y
KILL PSDODIV,PSDOUT
+5 SET DIC("A")="Select Outpatient Division: "
DIVC SET DIC=59
SET DIC(0)="AEMQ"
DO ^DIC
+1 IF X["^"!($DATA(DTOUT))
KILL PSDODIV
SET PSDOUT=1
GOTO DIVQ
+2 IF +Y<1
IF '$ORDER(PSDODIV(0))
WRITE !!,"A 'DIVISION' must be selected! or Enter '^' to exit."
GOTO DIVC
+3 IF +Y<0
IF $ORDER(PSDODIV(0))
GOTO DIVQ
+4 SET PSDODIV(+Y)=$PIECE(Y,U,2)_"^"_$PIECE($GET(^PS(59,+Y,0)),U,6)
+5 SET DIC("A")="Select another Outpatient Division: "
GOTO DIVC
DIVQ KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+1 QUIT
