source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC4.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1PSAPROC4 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,63**; 10/24/97;Build 10
3 ;References to ^PSDRUG( are covered by IA #2095
4 ;References to ^DIC(51.5 are covered by IA #1931
5 ;This routine allows the user to edit invoices with errors or missing
6 ;data.
7 ;
8MANYNDCS ;List drug synonym data & ask user which on to use
9 K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSANDC=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~")
10 F S PSAIEN50=$O(^PSDRUG("C",PSANDC,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D
11 .F S PSASYN=$O(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN)) Q:'PSASYN D
12 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
13 ..;DAVE B (PSA*3*3)
14 ..Q:$D(^PSDRUG(PSAIEN50,"I"))
15 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN
16 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN
17 G:PSAFND SAME G:PSACNT DIFF
18 Q
19 ;
20SAME ;If more than one drug with same VSN, assign to correct drug.
21 W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",!
22 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D
23 .S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0) S PSAMENU=PSAMENU+1
24 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
25 .D LIST Q:PSAOUT
26 D CHOOSE Q:PSAOUT!(Y="")
27 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
28 I PSAPICK<PSAMENU D
29 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),$P(^(PSALINE),"^",5)=$P($P(^(PSALINE),"^",5),"~"),PSANEXT=1,PSADATA=^(PSALINE)
30 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D
31 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE)
32 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
33 ..D HDR^PSAPROC6,EDIT1^PSAUTL1
34 G KILL
35 ;
36DIFF ;If more than one drug with different VSN, assign to correct drug.
37 W !,"There is more than one item in the DRUG file with the same NDC.",!
38 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D
39 .S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1
40 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
41 .D LIST Q:PSAOUT
42 D CHOOSE Q:PSAOUT!(Y="")
43 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
44 I PSAPICK<PSAMENU D
45 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE)
46 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D
47 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE)
48 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
49 ..D HDR^PSAPROC6,EDIT1^PSAUTL1
50KILL K PSASAME,PSAFND
51 Q
52 ;
53LIST Q:PSANODE=""!($P($G(^PSDRUG(PSAIEN50,0)),"^")="")
54 ;3*63 RJS
55 N PSAPPOU,PSADUOU,PSAPPDU,PSAVEND,PSAOU,PSACPPDU,X,PSANDC,PSADU,PSASYNM,PSAVSN
56 S X=PSANODE
57 S PSASYNM=$P(X,U,1),PSANDC=$P(X,U,2),PSAVSN=$P(X,U,4),PSAOU=+$P(X,U,5),PSAPPOU=$P(X,U,6)
58 S PSADUOU=$P(X,U,7),PSAPPDU=$P(X,U,8),PSAVEND=$P(X,U,9)
59 S PSADU=$$GET1^DIQ(50,PSAIEN50,14.5),PSAOU=$P($G(^DIC(51.5,PSAOU,0)),"^")
60 S PSACPPDU=$S('PSADUOU:"BLANK",1:(PSAPPOU*1000/PSADUOU\1/1000)) ;recalculate PPDU, file doesn't reset PPDU
61 W !?1,PSAMENU_".",?4,$P($G(^PSDRUG(PSAIEN50,0)),"^") I $D(^PSDRUG(PSAIEN50,"I")) W ?60,"(INACTIVE)"
62 I PSANDC="",PSAVSN="" W !,?19,"SYN #",PSASYN,": ",PSASYNM,! Q
63 W !,?4,"NDC: ",PSANDC,?25,"Order Unit: ",PSAOU,?46,"Price Per Order Unit: $",$FN(PSAPPOU,",",2)
64 W !,?4,"VSN: ",PSAVSN,?19,"SYN #",PSASYN,": ",PSASYNM,?42,"Dose Unit Per Order Unit: ",PSADUOU
65 W !,?4,"Vendor: ",PSAVEND,?47,"Price Per Dose Unit: ",$FN(PSACPPDU,","),!
66 ;3*63 end
67 Q
68 ;
69CHOOSE S PSAMENU=PSAMENU+1
70 W !?1,PSAMENU,".",?4,"Select another drug."
71 W ! S DIR(0)="N^1:"_PSAMENU,DIR("A")="Select the invoiced drug",DIR("?")="Select the drug from the list for which you were invoiced.",DIR("??")="^D NDCHELP^PSAPROC4"
72 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
73 S PSAPICK=+Y
74 Q
75 ;
76MANYVSNS ;List drug synonym data & ask user which on to use
77 K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSAVSN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5),"~")
78 F S PSAIEN50=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D
79 .F S PSASYN=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN)) Q:'PSASYN D
80 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
81 ..;DAVE B (PSA*3*3)
82 ..Q:$D(^PSDRUG(PSAIEN50,"I"))
83 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN
84 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN
85 G:PSAFND SAMEV G:PSACNT DIFFV
86 Q
87 ;
88SAMEV ;If more than one drug with same NDC, assign to correct drug.
89 W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",!
90 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D
91 .S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1
92 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
93 .D LIST Q:PSAOUT
94 D CHOOSE Q:PSAOUT!(Y="")
95 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
96 I PSAPICK<PSAMENU D
97 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE)
98 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D
99 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE)
100 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
101 ..D HDR^PSAPROC6,EDIT1^PSAUTL1
102 G KILL
103 ;
104DIFFV ;If more than one drug with different VSN, assign to correct drug.
105 W !,"There is more than one item in the DRUG file with the same VSN.",!
106 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D
107 .S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=$G(^PSDRUG(PSAIEN50,1,PSASYN,0)),PSAMENU=PSAMENU+1
108 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
109 .D LIST Q:PSAOUT
110 D CHOOSE Q:PSAOUT!(Y="")
111 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
112 I PSAPICK<PSAMENU D
113 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1
114 .I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D
115 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE)
116 ..S PSANDC=$P($G(^PSDRUG(+$P(PSADIFF(PSAPICK),"^"),1,+$P(PSADIFF(PSAPICK),"^",2),0)),"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
117 ..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
118 ..D HDR^PSAPROC6,EDIT1^PSAUTL1
119 G KILL
120 ;
121NDCHELP ;Extended help for selecting invoiced drug
122 W !?5,"Enter the number to the left of the invoiced drug. If you select a drug",!?5,"from the list, the invoiced drug will be matched to that drug. If you"
123 W !?5,"choose to select another drug, you can select the invoiced drug from the",!?5,"DRUG file or flag this item as a supply item."
124 Q
Note: See TracBrowser for help on using the repository browser.