source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC5.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: 6.5 KB
Line 
1PSAPROC5 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
3 ;This routine allows the user to edit invoices with errors or missing
4 ;data.
5 ;
6MANYUPCS ;List supply synonym data & ask user which on to use
7 K PSADIFF,PSASAME
8 S (PSACNT,PSAFND,PSAIEN50)=0,PSASUP=$P($P(PSADATA,"^",26),"~"),PSANDC="S"_PSASUP
9 F S PSAIEN50=$O(^PSDRUG("C",PSANDC,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D
10 .F S PSASYN=$O(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN)) Q:'PSASYN D
11 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
12 ..;DAVE B (PSA*3*3)
13 ..Q:$D(^PSDRUG(PSAIEN50,"I"))
14 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN
15 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN
16 G:PSAFND SAMEU G:PSACNT DIFFU
17 Q
18 ;
19SAMEU ;If more than one drug with same VSN, assign to correct drug.
20 W !!,"There is more than one supply in the DRUG file",!,"with the same UPC and Vendor Stock Number.",!
21 S (PSACNT,PSAMENU)=0
22 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D
23 .S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=$G(^PSDRUG(PSAIEN50,1,PSASYN,0)),PSAMENU=PSAMENU+1
24 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
25 .D LIST^PSAPROC4 Q:PSAOUT
26 D CHOOSEU Q:PSAOUT
27 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G:PSAOUT KILL^PSAPROC4 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=PSASUP,PSANEXT=1,PSADATA=^(PSALINE) G KILL^PSAPROC4
28 I PSAPICK<PSAMENU D
29 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),$P(^(PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",26)=PSASUP,PSANEXT=1,PSADATA=^(PSALINE)
30 .I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
31 G KILL^PSAPROC4
32 ;
33DIFFU ;If more than one supply with different UPC, assign to correct drug.
34 W !!,"There is more than one supply in the DRUG file with the same UPC.",!
35 S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D
36 .S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=$G(^PSDRUG(PSAIEN50,1,PSASYN,0)),PSAMENU=PSAMENU+1
37 .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
38 .D LIST^PSAPROC4 Q:PSAOUT
39 D CHOOSEU Q:PSAOUT
40 I PSAPICK=PSAMENU D ASKDRUG^PSANDF G:PSAOUT KILL^PSAPROC4 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=PSASUP,PSANEXT=1,PSADATA=^(PSALINE) G KILL^PSAPROC4
41 I PSAPICK<PSAMENU D
42 .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),$P(^(PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",26)=PSASUP,PSANEXT=1,PSADATA=^(PSALINE)
43 .I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
44 G KILL^PSAPROC4
45 ;
46CHOOSEU S PSAMENU=PSAMENU+1
47 W !?1,PSAMENU_".",?4,"Select another item."
48 W ! S DIR(0)="NO^1:"_PSAMENU,DIR("A")="Select the invoiced item",DIR("?")="Select the item from the list for which you were invoiced.",DIR("??")="^D UPCHELP^PSAPROC5"
49 D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
50 S PSAPICK=+Y
51 Q
52 ;
53NDCDIFF ;If New NDC is correct, remove "~" piece with questionable NDC in ^XTMP.
54 ;If Old NDC is correct, remove "~" piece with questionable NDC & set
55 ;old NDC in NDC piece in ^XTMP.
56 W !!,"There is a change in Vendor Stock Number's NDC."
57 W !,"New NDC: "_PSANDC_" "
58 W !,"Old NDC: "_$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5),"~",3),!
59 S DIR(0)="Y",DIR("A")="Is the new NDC correct",DIR("B")="Y",DIR("?",1)="Enter Yes if the line item's NDC is correct.",DIR("?")="Enter No is the old NDC is correct."
60 S DIR("??")="^D NEWOLDN^PSAPROC5" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
61 I +Y S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN_"~~~1",$P(^(PSALINE),"^",4)=PSANDC,PSADATA=^(PSALINE),PSANEXT=1 Q
62 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5),"~",3),$P(^(PSALINE),"^",5)=PSAVSN,PSANEXT=1,PSADATA=^(PSALINE)
63 Q
64 ;
65SUPDIFF ;If New UPC is correct, remove "~" piece with questionable UPC in ^XTMP.
66 ;If Old UPC is correct, remove "~" piece with questionable UPC & set old UPC in VSN piece in ^XTMP.
67 W !!,"There is a change in item's Universal Product Code (UPC)."
68 W !,"New UPC: "_PSAUPC
69 W !,"Old UPC: "_$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26),"~",3),!
70 S DIR(0)="Y",DIR("A")="Is the new UPC correct",DIR("B")="Y",DIR("?",1)="Enter Yes if the line item's Universal Product Code is correct.",DIR("?")="Enter No is the old Universal Product Code is correct."
71 S DIR("??")="^D NEWUPC^PSAPROC5" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
72 S PSANDC="S"_$P($P(PSADATA,"^",26),"~")
73 I +Y S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",26)=PSAUPC,PSADATA=^(PSALINE),PSANEXT=1 Q
74 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$P($P(^(PSALINE),"^",26),"~",3),$P(^(PSALINE),"^",4)=PSANDC,PSADATA=^(PSALINE),PSANEXT=1
75 Q
76 ;
77VSNDIFF ;If New VSN is correct, remove "~" piece with questionable VSN in ^XTMP.
78 ;If Old VSN is correct, remove "~" piece with questionable VSN & set old VSN in VSN piece in ^XTMP.
79 W !!,"There is a change in the NDC's Vendor Stock Number (VSN)."
80 W !,"New VSN: "_PSAVSN_" "
81 W !,"Old VSN: "_$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",3),!
82 S DIR(0)="Y",DIR("A")="Is the new VSN correct",DIR("B")="Y",DIR("?",1)="Enter Yes if the line item's Vendor Stock Number is correct.",DIR("?")="Enter No is the old Vendor Stock Number is correct."
83 S DIR("??")="^D NEWOLD^PSAPROC5" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
84 I +Y S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC_"~~~1",$P(^(PSALINE),"^",5)=PSAVSN,PSADATA=^(PSALINE),PSANEXT=1 Q
85 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",3),$P(^(PSALINE),"^",4)=PSANDC,PSADATA=^(PSALINE),PSANEXT=1
86 Q
87 ;
88NEWOLD ;Extended help to 'Is new VSN correct'
89 W !?5,"Enter Yes to add another synonym for the NDC with the new VSN.",!?5,"Enter No to discard the new VSN."
90 Q
91NEWOLDN ;Extended help to 'Is new NDC correct'
92 W !?5,"Enter Yes to add another synonym for the NDC with the new NDC.",!?5,"Enter No to discard the new NDC."
93 Q
94NEWUPC ;Extended help to 'Is new UPC correct'
95 W !?5,"Enter Yes to add another synonym for the NDC with the new UPC.",!?5,"Enter No to discard the new UPC."
96 Q
97UPCHELP ;Extended help for selecting invoiced supply
98 W !?5,"Enter the number of the invoiced item. If you select an item from the",!?5,"list, the invoice data will be added to that item. If you select to"
99 W !?5,"add a new entry in the DRUG file for the invoiced item, a new",!?5,"synonym for the item will be added to the DRUG file."
100 Q
Note: See TracBrowser for help on using the repository browser.