source: FOIAVistA/tag/r/CONTROLLED_SUBSTANCES-PSD/PSDNMU.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1PSDNMU ;DOIFO/CMS - CS Monitoring Utility routine ;17 Dec 02
2 ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
3 ;Reference to ^PSD(58.8 supported by IA #2711
4 ;Reference to ^PS(59 supported by IA #2621
5 Q
6 ;
7CII ;Select CS DEA Codes
8 ; Return PSDCII=2,3,4,5 or user selection
9 ; Return PSDOUT=1 if '^" entered
10 N X,Y K DIR,DTOUT,DUOUT,PSDOUT
11 S DIR(0)="L^2:5:0",DIR("A")="Include RXs with CS schedule(s)"
12 S DIR("B")="2"
13 S DIR("?")="Enter range or combination of DEA Codes (schedules) from 2 to 5. Enter '^' to exit."
14 D ^DIR K DIR
15 S PSDCII=Y
16 I $D(DTOUT)!($D(DUOUT)) K PSDCII S PSDOUT=1
17CIIQ K DIR,DIRUT,DIROUT,DTOUT,DUOUT,PSDNO
18 Q
19 ;
20CIIO ;Optional Select CS DEA Codes
21 ; Return PSDCII=2,3,4,5 or user selection or null
22 ; Return PSDOUT=1 if '^" entered
23 N X,Y K DIR,DTOUT,DUOUT,PSDOUT
24 W !,"OPTIONAL"
25 S DIR(0)="LO^2:5:0",DIR("A")="Include RXs with CS schedule(s)"
26 S DIR("?")="Enter range or combination of DEA Codes (schedules) from 2 to 5. Enter '^' to exit."
27 D ^DIR K DIR
28 S PSDCII=Y
29 I $D(DTOUT)!($D(DUOUT)) K PSDCII S PSDOUT=1
30CIIOQ K DIR,DIRUT,DIROUT,DTOUT,DUOUT,PSDNO
31 Q
32 ;
33INPS ;Select Inpatient Site file 59.4
34 ; Return PSDIDIV=ien^Name
35 ; Return PSDOUT=1 If '^' entered
36 N D,DIC,DTOUT,X,Y K PSDIDIV
37INPSC S DIC="^PS(59.4,",DIC(0)="QEAM",D="B"
38 S DIC("S")="I +$P(^(0),""^"",31)"
39 W ! D ^DIC K DIC
40 I X="^"!($D(DTOUT)) S PSDOUT=1 G INPSQ
41 I +Y<0 W !!,"A CS Inpatient Site must be selected! Enter '^' to exit." G INPSC
42 I +Y S PSDIDIV=Y G INPSQ
43INPSQ Q
44 ;
45PLOC ;Ask Pharmacy Location
46 ; PSDIDIV must be defined to selected inpatient site
47 ; Return PSDPLOC array ie. PSDPLOC(file58.8ien)=""
48 ; Return PSDOUT=1 If '^' entered
49 ;
50 N DIC,X,Y K PSDPLOC,PSDOUT
51 S DIC("A")="Select Pharmacy Location(s): "
52PLOCC S DIC=58.8,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)=+$G(PSDIDIV)" D ^DIC
53 I X="^ALL" D PLOCA G PLOCQ
54 I X["^"!($D(DTOUT)) K PSDPLOC S PSDOUT=1 G PLOCQ
55 I +Y<1,'$O(PSDPLOC(0)) W !!,"A 'Pharmacy Location' must be selected! Enter '^ALL' to select all locations. Enter '^' to exit." G PLOCC
56 I +Y<0,$O(PSDPLOC(0)) G PLOCQ
57 S PSDPLOC(+Y)=$P(Y,U,2)
58 S DIC("A")="Select another Pharmacy Location: " G PLOCC
59PLOCQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
60 Q
61 ;
62PLOCA ;Get all Pharmacy Location for selected Inpatient Site
63 ; Return PSDPLOC(ien)=Name
64 N PSDY
65 S PSDY=0,PSDPLOC="^ALL"
66 F S PSDY=$O(^PSD(58.8,PSDY)) Q:'PSDY D
67 . I $P($G(^PSD(58.8,PSDY,0)),U,3)'=+PSDIDIV Q
68 . S PSDPLOC(PSDY)=$P(^PSD(58.8,PSDY,0),U,1)
69 Q
70 ;
71DISD ;Discharge Days Number
72 ;Return PSDISB - Number of Days to ignore before Discharge Date
73 ;Return PSDISA - Number of Days to ignore after Discharge Date
74 ;Return PSDOUT=1 If '^' entered
75 ;
76 N %,%DT,X,Y K DIR,PSDISA,PSDISB
77 S DIR(0)="NO^0:3:0",DIR("B")=0
78 S DIR("A")="Number of days to ignore BEFORE discharge date"
79 S DIR("?")="Enter number of days (0-3) to ignore BEFORE discharge date. Enter '^' to Exit."
80 D ^DIR K DIR
81 I +Y S PSDISB=+Y
82 I $D(DTOUT)!($D(DUOUT)) S PSDOUT=1 G DISDQ
83 S DIR(0)="NO^0:3:0",DIR("B")=0
84 S DIR("A")="Number of days to ignore AFTER discharge date"
85 S DIR("?")="Enter number of days (0-3) to ignore AFTER discharge date. Enter '^' to Exit."
86 D ^DIR
87 I +Y S PSDISA=+Y
88 I $D(DTOUT)!($D(DUOUT)) K PSDISB,PSDISA S PSDOUT=1
89DISDQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
90 Q
91 ;
92DATE ;Ask Date Range
93 ; Pass PSDDTN - Name of Date Range (Opt.)
94 ; Return PSDSD - Start Date Range ie. 3030109.9999^JAN 10, 2003
95 ; Return PSDED - End Date Range ie. 3030118.9999^JAN 19, 2003
96 ; Return PSDOUT=1 If '^' entered
97 ;
98 N %,%DT,X,Y K PSDSD,PSDED,PSDOUT
99DST W ! K %DT S %DT="AEP",%DT("A")="Start with "_$G(PSDDTN)_" Date: " D ^%DT
100 I X["^" K PSDSD,PSDED S PSDOUT=1 G DATEQ
101 I Y<0 W !,"Date Range is required! Enter '^' to exit." G DST
102 S PSDSD=Y D D^DIQ S PSDSD=PSDSD-.0001,$P(PSDSD,"^",2)=Y
103 S %DT("A")="End with "_$G(PSDDTN)_" Date: " D ^%DT
104 I X["^" K PSDSD,PSDED S PSDOUT=1 G DATEQ
105 I Y<PSDSD W !!,"The ending date of the range must be later than the starting date." G DST
106 S PSDED=Y D D^DIQ S PSDED=PSDED+.9999,$P(PSDED,"^",2)=Y
107DATEQ Q
108 ;
109 ;
110DIV ;Ask Outpatient Division(s)
111 ; Return PSDODIV array ie. PSDODIV(file59ien)=""
112 ; Return PSDOUT=1 If '^' entered
113 ;
114 N DIC,X,Y K PSDODIV,PSDOUT
115 S DIC("A")="Select Outpatient Division: "
116DIVC S DIC=59,DIC(0)="AEMQ" D ^DIC
117 I X["^"!($D(DTOUT)) K PSDODIV S PSDOUT=1 G DIVQ
118 I +Y<1,'$O(PSDODIV(0)) W !!,"A 'DIVISION' must be selected! or Enter '^' to exit." G DIVC
119 I +Y<0,$O(PSDODIV(0)) G DIVQ
120 S PSDODIV(+Y)=$P(Y,U,2)_"^"_$P($G(^PS(59,+Y,0)),U,6)
121 S DIC("A")="Select another Outpatient Division: " G DIVC
122DIVQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
123 Q
Note: See TracBrowser for help on using the repository browser.