source: FOIAVistA/tag/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC6.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: 9.5 KB
Line 
1PSAPROC6 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;10/7/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,34,50**; 10/24/97
3 ;
4 ;This routine allows the user to edit invoices by selecting the
5 ;invoice's line item number.
6 ;
7 ;References to ^PSDRUG( are covered by IA #2095
8 ;
9SEL ;Loops thru selected invoices
10 F PSAPC=1:1 S PSAMENU=$P(PSASEL,",",PSAPC) Q:'PSAMENU!(PSAOUT) D CORR Q:PSAOUT D CHECK
11 Q ;; <= *50 TO QUIT PROPERLY
12 ;
13CHECK ;Looks to see if all line items are processed
14 S (PSACS,PSAERR,PSALINE,PSALINES,PSALNCNT,PSALNSU,PSAOUT,PSASUP)=0
15 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
16 .S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE),PSALNCNT=PSALNCNT+1
17 .S:$P(PSADATA,"^",18)="P"!($P(PSADATA,"^",18)="OK") PSALINES=PSALINES+1
18 .S:$P(PSADATA,"^",19)="CS" PSACS=PSACS+1
19 I PSACS,PSALNCNT=PSACS D
20 .S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)="ALL CS",$P(^("IN"),"^",9)="CS" W !,"All drugs on the invoice are marked as a controlled substance."
21 .D:$P($G(^PSD(58.8,+$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12),0)),"^",2)'="M" MASTER^PSAPROC9
22 E S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)=""
23 I PSACS S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",9)="CS"
24 I +PSALNCNT,PSALNCNT=PSALINES D CHG D END^PSAPROC Q
25 E W !!,"** The invoice has not been placed in a Processed status!"
26 D END^PSAPROC
27 Q
28 ;
29CHG ;Asks if invoice's status should be changed to verified. If so, status
30 ;is changed & new drugs to location is listed.
31 W ! S DIR(0)="Y",DIR("A")="Do you want to change the invoice's status to Processed",DIR("?",1)="Enter YES to change the invoice's status to Processed.",DIR("?")="Enter NO to keep the invoice's status as Uploaded."
32 S DIR("??")="^D CHGYN^PSAPROC6" D ^DIR K DIR
33 I 'Y!($G(DIRUT)) S PSACHG=0,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="" W !!,"** The invoice's status has not been changed to Processed." Q
34 S PSACHG=+Y,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="P"
35 K PSAERR(PSAMENU) ;*50 rid select (1-0)
36 W !!,"The invoice status has been changed to Processed!"
37 ;
38 ;PSA*3*21 (1/3/01 - file data in 58.811)
39 D ^PSAPROC7
40 ;
41 Q
42 ;
43CORR S PSACTRL=$P(PSAERR(PSAMENU),"^",3),(PSALNCNT,PSALINES,PSACS)=0
44 S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSARECD=$S(+$P(PSAIN,"^",11):+$P(PSAIN,"^",11),+$P(PSAIN,"^",6):+$P(PSAIN,"^",6),1:""),PSALOC=+$P(PSAIN,"^",7),PSAMV=+$P(PSAIN,"^",12)
45 D HDR,RECD^PSAPROC3 Q:PSAOUT
46LOC I $P(PSAIN,"^",9)="CS" W !!,"MASTER VAULT: "_$P($G(^PSD(58.8,PSAMV,0)),"^") D MV Q:PSAOUT
47 I $P(PSAIN,"^",10)="" D Q:PSAOUT
48 .;OIFO BAY PINES;TEH;PATCH PSA*3.0*34
49 .D SITES^PSAUTL1 S PSALOCN=$S($D(^PSD(58.8,PSALOC,0)):$P($G(^PSD(58.8,PSALOC,0)),"^"),1:"UNKNOWN")_PSACOMB
50 .W !!,"PHARMACY LOCATION: "
51 .W:$L(PSALOCN)>76 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 !,PSALOCN D PHARM
52LINES S PSADONE=0 F W !!,"Line Item Numbers: " D Q:PSAOUT!(PSADONE)
53 .S PSALINE=0 S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE W ?19,PSALINE
54 .F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
55 ..I $X+$L(PSALINE)+2>79 W !,?19,PSALINE Q
56 ..W ","_PSALINE
57 .W ! S DIR(0)="LO",DIR("A")="Select Line Item Number",DIR("?")="Enter the line numbers to be edited",DIR("??")="^D LNHELP^PSAPROC6"
58 .D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
59 .I X="" S PSADONE=1 Q
60 .S PSALINE=X
61 .I '$D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) W !,"Invalid line number." Q
62 .S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
63 .S PSAIEN=$S(+$P(PSADATA,"^",15):+$P(PSADATA,"^",15),1:+$P(PSADATA,"^",6))
64 .S PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~"),PSASUB=+$P(PSADATA,"^",7),PSASUP=0
65 .S PSALOC=$S($P(PSADATA,"^",19)="CS":+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",7))
66 .D EDITDISP^PSAUTL1 W !,PSASLN,!
67 .D EDITITEM ;*50 ready for patch *54 make an entry point
68 Q
69EDITITEM ;perform edit and checks on an item *50 to be ready for *54
70 D
71 .W "1. Drug",!,"2. Quantity Received",!,"3. Order Unit",!,"4. Dispense Units per Order Unit" S PSACHO=4
72 .I +$P($G(^PSD(58.8,PSALOC,0)),"^",14) W !,"5. Stock Level",!,"6. Reorder Level" S PSACHO=6
73 .W ! S DIR(0)="LO^1:"_PSACHO,DIR("A")="Edit fields",DIR("?")="Enter the number(s) of the data to be edited",DIR("??")="^D DQOR^PSAPROC6"
74 .D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
75 .Q:Y="" S PSAFLDS=Y,PSADU=0 D EDITDISP^PSAUTL1 W !,PSASLN
76FIELDS .F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT) D
77 ..I PSAFLD=1 D ASKDRUG^PSANDF Q
78 ..I PSAFLD=2 D QTY^PSAPROC3 Q
79 ..I PSAFLD=3 D GETOU^PSAPROC3 Q
80 ..I PSAFLD=4,PSAIEN D:$P($G(^PSDRUG(PSAIEN,660)),"^",8)="" DU^PSAPROC8 D DUOU^PSAPROC3 Q
81 ..I PSAFLD=5 D STOCK^PSAPROC8 Q
82 ..I PSAFLD=6 D REORDER^PSAPROC8
83 .D:'PSAOUT PROCESS
84 Q
85 ;
86PROCESS ;Checks for & prompts for missing data.
87 Q:$D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"))
88 S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
89 S PSAIEN=$S(+$P(PSADATA,"^",15):+$P(PSADATA,"^",15),+$P(PSADATA,"^",6):+$P(PSADATA,"^",6),1:0),PSASUB=+$P(PSADATA,"^",7)
90 ;If no order unit, store it.
91 I '+$P($P(PSADATA,"^",2),"~",2),'$P(PSADATA,"^",12) D Q:PSAOUT
92 .I PSAIEN,PSASUB,'$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5) D GETOU^PSAPROC3 Q
93 .I PSAIEN,'PSASUB D GETOU^PSAPROC3
94 ;If synonym & doesn't have disp units/order unit, store it 50.
95 I PSAIEN,PSASUB,'+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",7),'+$P(PSADATA,"^",20) S PSADU=0 D DUOU^PSAPROC8 Q:PSAOUT
96 ;If no synonym & disp units/order unit, store it XTMP.
97 I PSAIEN,'PSASUB,'$P(PSADATA,"^",20) D DUOU^PSAPROC3 Q:PSAOUT
98 I '+$P(PSADATA,"^",3) D PRICE^PSAPROC3 Q:PSAOUT
99 ;If not CS & maintains stock, prompt for stock & reorder levels
100 I $P(PSADATA,"^",19)'="CS",+$P(PSAIN,"^",7),+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),0)),"^",14) D
101 .I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",3),'+$P(PSADATA,"^",27) S PSALOC=$P(PSAIN,"^",7) D STOCK^PSAPROC8 Q:PSAOUT
102 .I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",5),'+$P(PSADATA,"^",21) S PSALOC=$P(PSAIN,"^",7) D REORDER^PSAPROC8 Q:PSAOUT
103 ;If CS & maintains stock, prompt for stock & reorder level
104 I $P(PSADATA,"^",19)="CS",+$P(PSAIN,"^",12),+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),0)),"^",14) D
105 .I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",3),'+$P(PSADATA,"^",27) S PSALOC=$P(PSAIN,"^",12) D STOCK^PSAPROC8 Q:PSAOUT
106 .I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",5),'+$P(PSADATA,"^",21) S PSALOC=$P(PSAIN,"^",12) D REORDER^PSAPROC8 Q:PSAOUT
107 Q:PSAOUT D CHECK^PSANDF Q:PSAOUT D SETLINE^PSAPROC3
108 Q
109 ;
110MV ;Assigns master vault
111 S DIC("A")="Select Master Vault: ",DIC="^PSD(58.8,",DIC(0)="QAEMZ" S:+PSAMV DIC("B")=$P($G(^PSD(58.8,+PSAMV,0)),"^")
112 S DIC("S")="I $D(^PSD(58.8,""ADISP"",""M"",+Y)),'+$G(^PSD(58.8,+Y,""I""))!(+$G(^PSD(58.8,+Y,""I""))&(+$G(^PSD(58.8,+Y,""I""))'<DT))"
113 D ^DIC K DIC I $G(DTOUT)!($G(DUOUT))!(Y<0) S PSAOUT=1 Q
114 S PSAMV=+Y,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=+Y,PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
115 Q
116 ;
117PHARM ;Assigns pharmacy location
118 ;S DIC("A")="Select Pharmacy Location: ",DIC="^PSD(58.8,",DIC(0)="QAEMZ" S:+PSALOC DIC("B")=$P($G(^PSD(58.8,+PSALOC,0)),"^")
119 ;S DIC("S")="I $D(^PSD(58.8,""ADISP"",""P"",+Y)),'$G(^PSD(58.8,+Y,""I""))!(+$G(^PSD(58.8,+Y,""I""))&(+$G(^PSD(58.8,+Y,""I""))'<DT))"
120 ;D ^DIC K DIC I $G(DTOUT)!($G(DUOUT))!(Y<0) S PSAOUT=1 Q
121 ;S PSALOC=+Y,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=+Y,PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
122 ;Dave Blocker (PSA*3*21)
123 D ^PSAUTL5 Q:$G(PSALOC)'>0 S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=+PSALOC,PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
124 ;Eop
125 Q
126 ;
127SUPPLY ;Asks if all items are supply items. If so, invoice is deleted from
128 ;^XTMP global. If not, invoice is added to list of invoices to be edited.
129 W ! S DIR(0)="Y",DIR("A")="Are all the items on the invoice supply items",DIR("B")="N"
130 S DIR("?",1)="Enter YES if all line items are not drugs in the DRUG file.",DIR("?")="Enter NO if there is at least one line item that is in the DRUG file."
131 S DIR("??")="^D ALLSUP^PSAPROC6" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
132 G:'Y NO
133 W ! S DIR(0)="Y",DIR("A")="Are you sure",DIR("B")="Y",DIR("?",1)="Enter YES if all the line items on the invoice are supply items.",DIR("?")="Enter NO if there is at least one item on the invoice that is not a supply."
134 S DIR("??")="^D ALLSUP^PSAPROC6" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
135NO I 'Y S PSACNTER=PSACNTER+1,PSAERR(PSACNTER)=PSAOK(PSA) K PSAOK(PSA) Q
136 K PSAOK(PSA) S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="P",PSASUP=1,PSALINE=0
137 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
138 .S ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")=DUZ_"^"_DT_"^"_"SUPPLY ITEM",$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P"
139 Q
140 ;
141HDR ;Screen header
142 W @IOF,!?26,"<<< EDIT INVOICE SCREEN >>>",!,"Order#: "_$P(PSAIN,"^",4)_" Invoice#: "_$P(PSAIN,"^",2)_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN),!,PSASLN
143 Q
144 ;
145CHGYN ;Extended help - 'Do you want to change the invoice's status to Processed'
146 W !?5,"Enter YES if the invoice is completely correct. You will not be able",!?5,"to edit it again."
147 W !!?5,"Enter NO if you need to edit the invoice again. You can edit it again",!?5,"by selecting the Process Orders option."
148 Q
149DQOR ;Extended help - 'Edit field'
150 W !?5,"Enter the number or range of numbers of the field you want to edit."
151 Q
152LNHELP ;Extended help - 'Line Number"
153 W !?5,"Enter the number of the item on the invoice you want to edit. You can",!?5,"enter a line item number then edit that line item. The ""Line Number""",!?5,"prompt will be displayed again. You can keep entering and editing line"
154 W !?5,"items until you press the Return key at the ""Line Number"" prompt."
155 Q
156ALLSUP ;Extended help - "Are all the items on the invoice supply items" &
157 ;"Are you sure?"
158 W !!?5,"Enter YES if none of the line items on the invoice are",!?5,"in the DRUG file and will never be in the DRUG file.",!!?5,"Enter NO if there is at least one line item on the",!?5,"invoice that is in the DRUG file."
159 Q
Note: See TracBrowser for help on using the repository browser.