source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC.m@ 1625

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1PSAPROC ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data ;10/9/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21**; 10/24/97
3 ;This routine assigns a pharmacy location or master vault to all invoices.
4 ;
5 S PSAOUT=1 D EXIT K PSAOUT ;Kill all option variables
6 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
7ESIG D SIG^XUSESIG I X1="" S PSAOUT=1 G EXIT
8 S PSASLN="",$P(PSASLN,"-",80)="",PSADLN="",$P(PSADLN,"=",80)="",(PSACNT,PSACTRL,PSAOUT)=0
9 ;DAVE B (PSA*3*12) 12MAY99 Multi-divisional select
10 D DAVE
11 ;
12CNT ;Count invoices that need a pharm location or master vault assigned.
13 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL="" D
14 .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
15 .I $G(PSASORT)'=0,$G(PSASORT)'="",$D(^XTMP("PSAPV",PSACTRL,"ST")),$P(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT Q
16 .S PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
17 .;DAVE B (PSA*3*21)
18 .K PSAINVDL D ^PSAPTCH Q:$D(PSAINVDL)
19 .I $P(PSAIN,"^",10)="ALL CS",$P(PSAIN,"^",12)="" S PSACNT=PSACNT+1,PSACS(PSACTRL)="" Q
20 .I $P(PSAIN,"^",10)'="ALL CS" D
21 ..I $P(PSAIN,"^",9)="CS" S:$P(PSAIN,"^",7)="" PSANCS(PSACTRL)="" S:$P(PSAIN,"^",12)="" PSACS(PSACTRL)="" S:$P(PSAIN,"^",7)=""!($P(PSAIN,"^",12)="") PSACNT=PSACNT+1 Q
22 ..I $P(PSAIN,"^",9)="",$P(PSAIN,"^",7)="" S PSACNT=PSACNT+1,PSANCS(PSACTRL)=""
23 I 'PSACNT D ^PSAPROC1 G EXIT
24 ;
25LOC ;Gets pharmacy locations
26 S (PSALOC,PSANUM)=0 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
27 .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
28 .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
29 .S PSANUM=PSANUM+1,PSAONE=PSALOC,PSAISIT=+$P(^PSD(58.8,PSALOC,0),"^",3),PSAOSIT=+$P(^(0),"^",10)
30 .D SITES^PSAUTL1 S PSACOMB=$S('$D(PSACOMB):"NO COMBINED IP/OP",1:PSACOMB),PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
31 ;
32 ;Gets master vaults
33 S (PSAMVN,PSAMV)=0 F S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV D
34 .Q:'$D(^PSD(58.8,PSAMV,0))!($P($G(^PSD(58.8,PSAMV,0)),"^")="")
35 .I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
36 .S PSAMVN=PSAMVN+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
37 ;PSA*3*22 (Set PSDOUT on next line to avoid automatic stuffing
38 I 'PSANUM D NONE S PSAOUT=1 G EXIT
39 I PSANUM=1 D ONE Q:PSAOUT
40 I PSANUM>1 D MANY Q:PSAOUT
41 D ^PSAPROC1 G EXIT
42 ;
43NONE ;No DA pharmacy locations
44 W !!,"There are no Drug Accountability pharmacy locations.",!!,"Use the Set Up/Edit a Pharmacy Location option on Pharmacy Location Maintenance"
45 W !,"Menu to setup one or more pharmacy locations. Then select the Process Uploaded",!,"Prime Vendor Invoice Data option to process the invoices."
46 D END S PSA=$O(PSACS("")) D:PSA'="" MASTER,END
47 Q
48 ;
49ONE ;Only one location
50 S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
51 W !!,"The invoices are being assigned to the pharmacy location. Please wait."
52 S PSACTRL="" F S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL="" D
53 .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
54 .S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSACNT=1 W "."
55 H 1 S PSA=$O(PSACS("")) D:PSA'="" MASTER
56 Q
57 ;
58MANY ;If more than one pharmacy location, display invoices.
59 S PSACTRL="" F S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL="" D Q:PSAOUT
60 .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
61 .S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2)
62 .D DISPLOC
63 .W !,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
64 .W:$D(PSACS(PSACTRL)) !,"Some controlled substances" D SELECT
65 S PSA=$O(PSACS("")) D:PSA'="" MASTER,END K PSAMENU,PSALOCA
66 Q
67 ;
68DISPLOC ;Displays the active pharmacy locations.
69 W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
70 S (PSACNT,PSASTOP)=0,PSALOCN=""
71 F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN=""!(PSASTOP) D
72 .S PSALOC=0 F S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC!(PSASTOP) D
73 ..S PSACNT=PSACNT+1,PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
74 ..I $Y+3>IOSL D HDR I PSAOUT S PSAOUT=0,PSASTOP=1 Q
75 ..W !,$J(PSACNT,2)_"." W:$L(PSALOCN)>72 ?4,$P(PSALOCN,"(IP)",1)_"(IP)",!?21,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<73 ?4,PSALOCN
76 W ! K PSASTOP
77 Q
78 ;
79HDR D END
80 W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
81 Q
82 ;
83SELECT ;Select the Pharmacy Location to be assigned to the order.
84 W ! K DIR S DIR(0)="NO^1:"_PSACNT,DIR("A")="Pharmacy Location",DIR("?")="Select the pharmacy location that received the invoice's drugs"
85 ;
86 ;DAVE B (PSA*3*12) 2/16/99 Force entering a pharacy location
87 S DIR("??")="^D PHARM^PSAPROC" D ^DIR K DIR Q:Y="" ;I Y="" W !!?5,"Enter an Up-arrow '^' to abort the process.",! G SELECT
88 I $G(DIRUT) S PSAOUT=1 Q
89 S PSASEL=Y,PSALOCN=""
90 F S PSALOCN=$O(PSAMENU(PSASEL,PSALOCN)) Q:PSALOCN="" D
91 .S PSALOC=0 F S PSALOC=+$O(PSAMENU(PSASEL,PSALOCN,PSALOC)) Q:'PSALOC D
92 ..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC
93 Q
94 ;
95MASTER ;Assigns invoice to Master Vault
96 I 'PSAMVN W !!,"No master vaults are set up. You must set up a master vault then",!,"select the Process Uploaded Prime Vendor Invoices Data option." S PSAOUT=1 Q
97 ;
98 I PSAMVN=1 D H 1 Q
99 .S PSACTRL=$O(PSACS(""))
100 .W !!,"The invoices are being assigned to the master vault. Please wait."
101 .S PSACTRL="" F S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL="" D
102 ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
103 ..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV W "."
104 ;
105 I PSAMVN>1 D
106 .S PSACTRL="" F S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL="" D Q:PSAOUT
107 ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
108 ..S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2)
109 ..D DISPMV W !,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
110 ..W:$P(PSAIN,"^",10)="ALL CS" !,"** All controlled substances"
111 ..W:$P(PSAIN,"^",10)'="ALL CS" !,"** Some controlled substances"
112 ..D SELMV
113 Q
114 ;
115DISPMV ;Displays active master vaults
116 W @IOF,!?22,"<<< ASSIGN A MASTER VAULT SCREEN >>>",!,PSASLN
117 S PSA=0,PSAMVA="" F S PSAMVA=$O(PSAMV(PSAMVA)) Q:PSAMVA="" D
118 .S PSAMVIEN=0 F S PSAMVIEN=$O(PSAMV(PSAMVA,PSAMVIEN)) Q:'PSAMVIEN D
119 ..S PSA=PSA+1,PSAVAULT(PSA,PSAMVA,PSAMVIEN)=""
120 ..W !,$J(PSA,2)_".",?4,PSAMVA
121 W !
122 Q
123 ;
124SELMV ;Select displayed master vaults
125 W ! S DIR(0)="NO^1:"_PSA,DIR("A")="Select Master Vault",DIR("?")="Select the Master Vault that received the invoice's drugs"
126 ;
127 ;DAVE B (PSA*3*12) 2/16/99 Force entry of MV
128 S DIR("??")="^D MV^PSAPROC" D ^DIR K DIR Q:Y="" ;I Y="" W !!?5,"A Master Vault must be selected. Otherwise enter an up-arrow '^' to abort.",! G SELMV
129 I $G(DIRUT) S PSAOUT=1 Q
130 ;
131 ;
132 S PSASEL=Y
133 S PSAMVA=$O(PSAVAULT(PSASEL,"")) Q:PSAMVA="" S PSAMVIEN=+$O(PSAVAULT(PSASEL,PSAMVA,0)) Q:'PSAMVIEN S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAMVIEN
134 Q
135 ;
136END ;Holds screen
137 S PSASS=21-$Y F PSAKK=1:1:PSASS W !
138 S DIR(0)="E" D ^DIR K DIR S:$G(DIRUT) PSAOUT=1 W @IOF
139 Q
140 ;
141EXIT ;Kills processing variables
142 D:$G(PSAENTRY) PRINT2^PSAUP
143 ;
144 ;DAVE B (PSA*3*12) replaced '$D with '$G on next line
145 K DA,DIC,DIE,DIK,DIR,DIRUT,DR,DTOUT,DUOUT,PSA,PSABEFOR,PSACHG,PSACHO,PSACNT,PSACNT1,PSACNTER,PSACNTOK,PSACOMB,PSACONT,PSACS,PSACTRL,PSAREA,PSAFLD
146 K PSADRG1,PSASORT
147 K PSAD0,PSAD1,PSAD2,PSAD3,PSAD4,PSAD5,PSAD6,PSADATA,PSADIFF,PSADISP,PSADJQTY,PSADLN,PSADONE,PSADU,PSAENTRY,PSAERR,PSAFLDS,PSAFND,PSAFPR,PSAGET,PSAHDR
148 K PSAIEN,PSAIEN3,PSAIEN50,PSAIN,PSAINV,PSAIPR,PSAISIT,PSAISITN,PSAJUST,PSAKK,PSALINE,PSALINES,PSALLSUP,PSALN,PSALNCNT,PSALNSU,PSALOC,PSALOCA,PSALOCN,PSALOCN
149 K PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVN,PSANCS,PSANDC,PSANEXT,PSANODE,PSANUM,PSAOK,PSAONE,PSAONEMV,PSAORD,PSAOSIT,PSAOSITN,PSAOUT,PSAPASS,PSAPC,PSAPCF,PSAPCL,PSAPHARM,PSAPICK,PSAPRICE,PSAPTR
150 K PSARECD,PSAREORD,PSASAME,PSASEL,PSASEL1,PSASKIP,PSASLN,PSASNODE,PSASS,PSASSUB,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSASYN,PSAVAPN,PSAVAULT,PSAVSN,X1,Y,ZTDTH,ZTIO
151 Q
152 ;
153MV ;Extended help for the select "Master Vault" prompt
154 W !?5,"Enter the number of the master vault for which you want to assign",!?5,"the order. The invoiced drugs in the assigned master vault will be"
155 W !?5,"incremented with the quantity received after the order is verified."
156 Q
157PHARM ;Extended help for the select "Pharmacy Location" prompt
158 W !?5,"Enter the number of the pharmacy location for which you want to assign",!?5,"the order. The invoiced drugs in the assigned pharmacy location will be"
159 W !?5,"incremented with the quantity received after the order is verified."
160 Q
161DAVE ;Select division
162 S (CNT,CNTR,DIV,PSASORT)=0
163 S X=0 F S X=$O(^XTMP("PSAPV",X)) Q:X="" I $D(^XTMP("PSAPV",X,"ST")) S DATA=^XTMP("PSAPV",X,"ST"),DIV($P(DATA,"^"))=""
164 Q:$O(DIV(0))="" S (CNT,CNTR)=0,DIR(0)="S^" F S CNT=$G(CNT)+1,CNTR=$O(DIV(CNTR)) Q:CNTR="" S DIR(0)=DIR(0)_CNT_":"_CNTR_";"
165 Q:$L(DIR(0))'>2 S XX=$L(DIR(0)),XX=XX-1,XXX=$E(DIR(0),1,XX),DIR(0)=XXX
166 K X,XX,XXX,CNT,CNTR,DIV
167 W !!,"You have invoices on your system for more than one division.",!,"Please select the location for which you want to process invoices.",!,"or Press the up-arrow to process all invoices."
168 D ^DIR S:+Y>0 PSASORT=Y(0)
169 Q
Note: See TracBrowser for help on using the repository browser.