source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVER2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1PSAVER2 ;BIR/JMB-Verify Invoices - CONT'D ;10/7/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,60,64**; 10/24/97;Build 4
3 ;This routine contains the prompts for the fields that the verifier
4 ;is allowed to edit.
5 ;
6 ;References to ^DIC(51.5, are covered by IA #1931
7 ;References to ^PSDRUG( are covered by IA #2095
8 ;References to ^PSDRUG("C" are covered by IA #2095
9 ;
10ASKDRUG W !,"If the item will never be in the DRUG, press the Return key then",!,"answer YES to the ""Is this a supply item?"" prompt. To bypass this",!,"line item, enter ""^"" then press the Return key.",!
11 S PSAGAIN=0,PSABEFOR=PSADRG,DIC(0)="AEMQZ",DIC="^PSDRUG(" D ^DIC K DIC
12 I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
13 S PSADJFLD="D",PSAREA="",PSASUPP=0
14 I +Y=-1 D Q:PSASUPP!(PSAOUT)
15 .S PSAVER=1 D SUPPLY^PSANDF Q:PSAOUT I 'PSASUPP S PSAGAIN=1 Q
16 .S PSA50IEN=0,PSADJ=PSAREA,PSAREA="" K ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)
17 .D RECORD
18 G:$G(PSAGAIN) ASKDRUG
19 S (PSA50IEN,PSADJ,PSADRG)=+Y D RECORD,HDR^PSAVER1,VERDISP^PSAUTL4
20 I PSANDC'="",$O(^PSDRUG("C",PSANDC,PSA50IEN,0)) D
21 .S PSASUB=+$O(^PSDRUG("C",PSANDC,PSA50IEN,0)),$P(^PSD(58.811,PSAIEN,1,PSAIEN1,2),"^",3)=PSASUB
22 .I '+$P($G(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7) D DUOU Q
23 .I +$P($G(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7),+$P($G(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)'=+$P($G(^PSDRUG(PSABEFOR,1,PSASUB,0)),"^",7) D DUOU
24 ;
25 I PSANDC'="",'$O(^PSDRUG("C",PSANDC,PSA50IEN,0)),PSA50IEN'=PSABEFOR D DUOU
26 ;
27 I PSANDC="",PSAUPC="" D
28 .W !,"The vendor did not send a NDC or UPC for the drug. Enter the",!,"NDC if it is available. Enter the UPC if you do not know the NDC.",!
29 .S DIR(0)="SA^N:NDC;U:UPC",DIR("A")="Will you enter the NDC or UPC? ",DIR("B")="N",DIR("??")="^D NDCUPC^PSANDF1" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
30 .I Y="N" D GETNDC^PSANDF Q:PSAOUT S PSANDC=Y D:PSANDC'="" ADDDATA
31 .I Y="U" D GETUPC^PSANDF Q:PSAOUT S PSANDC="S"_Y,PSAUPC=Y D:PSANDC'="" ADDDATA
32 Q
33 ;
34ADDDATA ;Adds the missing NDC and/or UPC
35 K DA S DA(2)=PSAIEN,DA(1)=PSAIEN1,DA=PSALINE,DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,",DR="13///^S X="_PSANDC_$S(PSAUPC'="":";15///^S X="_PSAUPC,1:"")
36 F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
37 D ^DIE L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
38 K DIE I $G(DTOUT)!($G(DUOUT)) S PSAOUT=0 Q
39 D VERDISP^PSAUTL4
40 Q
41RECORD ;Adds adjusted data to DA ORDERS file
42 S PSANEW=0
43 I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0)) S ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0)="^58.811259SA^^"
44 I $D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B",PSADJFLD)) D Q
45 .S DA=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B",PSADJFLD,0))
46 .I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0)) D NEW Q
47 .D ADJ
48 ;
49NEW S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0)) DIC("P")=$P(^DD(58.81125,9,0),"^",2) K DA
50 S DA(3)=PSAIEN,DA(2)=PSAIEN1,DA(1)=PSALINE,X=PSADJFLD,DIC="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811
51 F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
52 D ^DIC L -^PSD(58.811,PSAIEN,1,PSAIEN1,0) K DIC,DLAYGO S DA=+Y
53 ;
54ADJ S DA(3)=PSAIEN,DA(2)=PSAIEN1,DA(1)=PSALINE,DIE="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
55 ;
56 ;PSA*3*3 (DaveB 1JUN98)
57 S DR="5///^S X=PSADJ"_$S(PSAREA'="":";6////^S X=PSAREA",1:"")_";7///^S X="_DT_";8////^S X="_DUZ ; *60
58 F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
59 D ^DIE
60INDEX S DIK=DIE D IX1^DIK K DIE,DIK L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
61 Q
62 ;
63DUOU ;Gets Dispense Units Per Order Unit
64 ;DAVE B (PSA*3*12) If PSASUPP is defined, the item is supply
65 ;no need to ask for dispense units per order unit.
66 I $G(PSASUPP)=1 W !,"Item appears to be marked for supply, no need to enter Dispense Units Per Order Unit." Q
67 W !,"DISPENSE UNITS: "_$S($P($G(^PSDRUG(PSA50IEN,660)),"^",8)'="":$P($G(^PSDRUG(PSA50IEN,660)),"^",8),1:"Blank")
68 S DIR(0)="NO^::2",DIR("A")="DISPENSE UNITS PER ORDER UNIT",DIR("B")=$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)),"^")
69 S DIR("?")="Enter the number of dispense units contained in one order unit",DIR("??")="^D DUOUHELP^PSAPROC3"
70 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
71 S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^")=+Y S:+Y PSASET=1
72 Q:Y'=""
73 ;
74 W !!,"The dispense units per order unit must be entered",!,"to change the status of the invoice to Verified."
75 S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to enter the data now"
76 S DIR("?",1)="Enter Yes to return to the DISPENSE UNITS PER ORDER UNIT prompt.",DIR("?")="Enter No to bypass entering the dispense units now."
77 S DIR("??")="^D DUOUYN^PSAPROC8" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
78 W ! G:+Y DUOU
79 Q
80 ;
81OU ;Get order unit
82 S DIC(0)="QAEMZ",DIC="^DIC(51.5,",DIC("A")="ORDER UNIT: ",DR=.01 S:+PSAOU&($P($G(^DIC(51.5,+PSAOU,0)),"^")'="") DIC("B")=$P(^DIC(51.5,+PSAOU,0),"^") D ^DIC K DIC
83 I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
84 ;
85 ;PSA*3*12 Dave B, allow verifier to change OU to original if necessary
86 G:Y=-1 OU S PSADJFLD="O",PSADJ=+Y,PSAREA="" D RECORD
87 Q
88 ;
89PHARM ;Pharmacy Location/Master Vault -- DR is set prior to the call.
90 K DA S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1," D ^DIE K DIE
91 S:$G(DTOUT)!($G(DUOUT)) PSAOUT=1
92 Q
93 ;
94QTY ;Adjust the quantity received
95 S DIR(0)="N",DIR("A")="QUANTITY RECEIVED",DIR("B")=PSAQTY
96 S DIR("?",1)="If the quantity received is different than the invoiced or",DIR("?")="adjusted quantity, enter the correct quantity received.",DIR("??")="^D QTYHELP^PSAPROC3"
97 D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
98 Q:PSAQTY=+Y S PSADJ=+Y
99 S DIR(0)="F^1:30",DIR("A")="ADJUSTMENT REASON",DIR("?")="Enter the reason you adjusted the quantity received.",DIR("??")="^D ADJREA^PSAPROC3"
100 D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
101 S PSADJFLD="Q",PSAREA=Y D RECORD
102 Q
103 ;
104RECD ;Date Received
105 K PSARECD S PSAREC=$S(+$P(PSAIN,"^",7):+$P(PSAIN,"^",7),+$P(PSAIN,"^",6):+$P(PSAIN,"^",6),1:"")
106 S DIR(0)="D",DIR("A")="Date received",DIR("?")="Enter the date the drugs were received.",DIR("??")="^D RECHELP^PSAPROC3" S:PSAREC DIR("B")=$$FMTE^XLFDT(PSAREC)
107 D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
108 Q:'+$P(PSAIN,"^",7)&(+Y=+$P(PSAIN,"^",6))
109 Q:+$P(PSAIN,"^",6)'=+$P(PSAIN,"^",7)&(+$P(PSAIN,"^",7)=+Y)
110 S:+$P(PSAIN,"^",6)=+Y PSARECD="@"
111 S:+$P(PSAIN,"^",6)'=+Y&(+$P(PSAIN,"^",7)'=+Y) PSARECD=+Y
112 Q:'$D(PSARECD) K DA
113 S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1,",DR="8///"_$S(+PSARECD:"^S X="_PSARECD,1:"@")
114 F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
115 D ^DIE L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
116 K DIE
117 I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1
118 Q
119 ;
120REORDER ;Enter reorder level for drug if the field is blank.
121 S DIR(0)="NO^0:99999",DIR("A")="REORDER LEVEL (in Dispense Units)",DIR("??")="^D REORD^PSAPROC8",DIR("B")=+PSAREORD
122 S DIR("?")="Enter the minimum number of dispense units to keep in the "_$S(+$P(PSADATA,"^",10):"master vault",1:"pharmacy location")_"."
123 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
124 S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^",2)=+Y
125 Q
126STOCK ;Enter stock level for drug if the field is blank.
127 S DIR(0)="NO^0:99999",DIR("A")="STOCK LEVEL (in Dispense Units)",DIR("??")="^D STKLEVEL^PSAPROC8",DIR("B")=+PSASTOCK
128 S DIR("?")="Enter the ideal number of dispense units to keep on the shelf."
129 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
130 S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^",4)=+Y
131 Q
Note: See TracBrowser for help on using the repository browser.