132 lines
7.1 KiB
Mathematica
132 lines
7.1 KiB
Mathematica
PSAVER2 ;BIR/JMB-Verify Invoices - CONT'D ;10/7/97
|
|
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,60,64**; 10/24/97;Build 4
|
|
;This routine contains the prompts for the fields that the verifier
|
|
;is allowed to edit.
|
|
;
|
|
;References to ^DIC(51.5, are covered by IA #1931
|
|
;References to ^PSDRUG( are covered by IA #2095
|
|
;References to ^PSDRUG("C" are covered by IA #2095
|
|
;
|
|
ASKDRUG 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.",!
|
|
S PSAGAIN=0,PSABEFOR=PSADRG,DIC(0)="AEMQZ",DIC="^PSDRUG(" D ^DIC K DIC
|
|
I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
S PSADJFLD="D",PSAREA="",PSASUPP=0
|
|
I +Y=-1 D Q:PSASUPP!(PSAOUT)
|
|
.S PSAVER=1 D SUPPLY^PSANDF Q:PSAOUT I 'PSASUPP S PSAGAIN=1 Q
|
|
.S PSA50IEN=0,PSADJ=PSAREA,PSAREA="" K ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)
|
|
.D RECORD
|
|
G:$G(PSAGAIN) ASKDRUG
|
|
S (PSA50IEN,PSADJ,PSADRG)=+Y D RECORD,HDR^PSAVER1,VERDISP^PSAUTL4
|
|
I PSANDC'="",$O(^PSDRUG("C",PSANDC,PSA50IEN,0)) D
|
|
.S PSASUB=+$O(^PSDRUG("C",PSANDC,PSA50IEN,0)),$P(^PSD(58.811,PSAIEN,1,PSAIEN1,2),"^",3)=PSASUB
|
|
.I '+$P($G(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7) D DUOU Q
|
|
.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
|
|
;
|
|
I PSANDC'="",'$O(^PSDRUG("C",PSANDC,PSA50IEN,0)),PSA50IEN'=PSABEFOR D DUOU
|
|
;
|
|
I PSANDC="",PSAUPC="" D
|
|
.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.",!
|
|
.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
|
|
.I Y="N" D GETNDC^PSANDF Q:PSAOUT S PSANDC=Y D:PSANDC'="" ADDDATA
|
|
.I Y="U" D GETUPC^PSANDF Q:PSAOUT S PSANDC="S"_Y,PSAUPC=Y D:PSANDC'="" ADDDATA
|
|
Q
|
|
;
|
|
ADDDATA ;Adds the missing NDC and/or UPC
|
|
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:"")
|
|
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
D ^DIE L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
|
|
K DIE I $G(DTOUT)!($G(DUOUT)) S PSAOUT=0 Q
|
|
D VERDISP^PSAUTL4
|
|
Q
|
|
RECORD ;Adds adjusted data to DA ORDERS file
|
|
S PSANEW=0
|
|
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^^"
|
|
I $D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B",PSADJFLD)) D Q
|
|
.S DA=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B",PSADJFLD,0))
|
|
.I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0)) D NEW Q
|
|
.D ADJ
|
|
;
|
|
NEW S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0)) DIC("P")=$P(^DD(58.81125,9,0),"^",2) K DA
|
|
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
|
|
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
D ^DIC L -^PSD(58.811,PSAIEN,1,PSAIEN1,0) K DIC,DLAYGO S DA=+Y
|
|
;
|
|
ADJ S DA(3)=PSAIEN,DA(2)=PSAIEN1,DA(1)=PSALINE,DIE="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
|
|
;
|
|
;PSA*3*3 (DaveB 1JUN98)
|
|
S DR="5///^S X=PSADJ"_$S(PSAREA'="":";6////^S X=PSAREA",1:"")_";7///^S X="_DT_";8////^S X="_DUZ ; *60
|
|
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
D ^DIE
|
|
INDEX S DIK=DIE D IX1^DIK K DIE,DIK L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
|
|
Q
|
|
;
|
|
DUOU ;Gets Dispense Units Per Order Unit
|
|
;DAVE B (PSA*3*12) If PSASUPP is defined, the item is supply
|
|
;no need to ask for dispense units per order unit.
|
|
I $G(PSASUPP)=1 W !,"Item appears to be marked for supply, no need to enter Dispense Units Per Order Unit." Q
|
|
W !,"DISPENSE UNITS: "_$S($P($G(^PSDRUG(PSA50IEN,660)),"^",8)'="":$P($G(^PSDRUG(PSA50IEN,660)),"^",8),1:"Blank")
|
|
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)),"^")
|
|
S DIR("?")="Enter the number of dispense units contained in one order unit",DIR("??")="^D DUOUHELP^PSAPROC3"
|
|
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^")=+Y S:+Y PSASET=1
|
|
Q:Y'=""
|
|
;
|
|
W !!,"The dispense units per order unit must be entered",!,"to change the status of the invoice to Verified."
|
|
S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to enter the data now"
|
|
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."
|
|
S DIR("??")="^D DUOUYN^PSAPROC8" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
|
|
W ! G:+Y DUOU
|
|
Q
|
|
;
|
|
OU ;Get order unit
|
|
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
|
|
I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
;
|
|
;PSA*3*12 Dave B, allow verifier to change OU to original if necessary
|
|
G:Y=-1 OU S PSADJFLD="O",PSADJ=+Y,PSAREA="" D RECORD
|
|
Q
|
|
;
|
|
PHARM ;Pharmacy Location/Master Vault -- DR is set prior to the call.
|
|
K DA S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1," D ^DIE K DIE
|
|
S:$G(DTOUT)!($G(DUOUT)) PSAOUT=1
|
|
Q
|
|
;
|
|
QTY ;Adjust the quantity received
|
|
S DIR(0)="N",DIR("A")="QUANTITY RECEIVED",DIR("B")=PSAQTY
|
|
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"
|
|
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
|
|
Q:PSAQTY=+Y S PSADJ=+Y
|
|
S DIR(0)="F^1:30",DIR("A")="ADJUSTMENT REASON",DIR("?")="Enter the reason you adjusted the quantity received.",DIR("??")="^D ADJREA^PSAPROC3"
|
|
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
|
|
S PSADJFLD="Q",PSAREA=Y D RECORD
|
|
Q
|
|
;
|
|
RECD ;Date Received
|
|
K PSARECD S PSAREC=$S(+$P(PSAIN,"^",7):+$P(PSAIN,"^",7),+$P(PSAIN,"^",6):+$P(PSAIN,"^",6),1:"")
|
|
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)
|
|
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
|
|
Q:'+$P(PSAIN,"^",7)&(+Y=+$P(PSAIN,"^",6))
|
|
Q:+$P(PSAIN,"^",6)'=+$P(PSAIN,"^",7)&(+$P(PSAIN,"^",7)=+Y)
|
|
S:+$P(PSAIN,"^",6)=+Y PSARECD="@"
|
|
S:+$P(PSAIN,"^",6)'=+Y&(+$P(PSAIN,"^",7)'=+Y) PSARECD=+Y
|
|
Q:'$D(PSARECD) K DA
|
|
S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1,",DR="8///"_$S(+PSARECD:"^S X="_PSARECD,1:"@")
|
|
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|
D ^DIE L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
|
|
K DIE
|
|
I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1
|
|
Q
|
|
;
|
|
REORDER ;Enter reorder level for drug if the field is blank.
|
|
S DIR(0)="NO^0:99999",DIR("A")="REORDER LEVEL (in Dispense Units)",DIR("??")="^D REORD^PSAPROC8",DIR("B")=+PSAREORD
|
|
S DIR("?")="Enter the minimum number of dispense units to keep in the "_$S(+$P(PSADATA,"^",10):"master vault",1:"pharmacy location")_"."
|
|
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^",2)=+Y
|
|
Q
|
|
STOCK ;Enter stock level for drug if the field is blank.
|
|
S DIR(0)="NO^0:99999",DIR("A")="STOCK LEVEL (in Dispense Units)",DIR("??")="^D STKLEVEL^PSAPROC8",DIR("B")=+PSASTOCK
|
|
S DIR("?")="Enter the ideal number of dispense units to keep on the shelf."
|
|
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^",4)=+Y
|
|
Q
|