Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSAVER2

PSAVER2.m

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