- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAVER2 7439 printed Feb 18, 2025@23:17:25 Page 2
- 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
- +2 ;This routine contains the prompts for the fields that the verifier
- +3 ;is allowed to edit.
- +4 ;
- +5 ;References to ^DIC(51.5, are covered by IA #1931
- +6 ;References to ^PSDRUG( are covered by IA #2095
- +7 ;References to ^PSDRUG("C" are covered by IA #2095
- +8 ;
- ASKDRUG WRITE !,"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 SET PSAGAIN=0
- SET PSABEFOR=PSADRG
- SET DIC(0)="AEMQZ"
- SET DIC="^PSDRUG("
- DO ^DIC
- KILL DIC
- +2 IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- QUIT
- +3 SET PSADJFLD="D"
- SET PSAREA=""
- SET PSASUPP=0
- +4 IF +Y=-1
- Begin DoDot:1
- +5 SET PSAVER=1
- DO SUPPLY^PSANDF
- if PSAOUT
- QUIT
- IF 'PSASUPP
- SET PSAGAIN=1
- QUIT
- +6 SET PSA50IEN=0
- SET PSADJ=PSAREA
- SET PSAREA=""
- KILL ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)
- +7 DO RECORD
- End DoDot:1
- if PSASUPP!(PSAOUT)
- QUIT
- +8 if $GET(PSAGAIN)
- GOTO ASKDRUG
- +9 SET (PSA50IEN,PSADJ,PSADRG)=+Y
- DO RECORD
- DO HDR^PSAVER1
- DO VERDISP^PSAUTL4
- +10 IF PSANDC'=""
- IF $ORDER(^PSDRUG("C",PSANDC,PSA50IEN,0))
- Begin DoDot:1
- +11 SET PSASUB=+$ORDER(^PSDRUG("C",PSANDC,PSA50IEN,0))
- SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,2),"^",3)=PSASUB
- +12 IF '+$PIECE($GET(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)
- DO DUOU
- QUIT
- +13 IF +$PIECE($GET(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)
- IF +$PIECE($GET(^PSDRUG(PSA50IEN,1,PSASUB,0)),"^",7)'=+$PIECE($GET(^PSDRUG(PSABEFOR,1,PSASUB,0)),"^",7)
- DO DUOU
- End DoDot:1
- +14 ;
- +15 IF PSANDC'=""
- IF '$ORDER(^PSDRUG("C",PSANDC,PSA50IEN,0))
- IF PSA50IEN'=PSABEFOR
- DO DUOU
- +16 ;
- +17 IF PSANDC=""
- IF PSAUPC=""
- Begin DoDot:1
- +18 WRITE !,"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.",!
- +19 SET DIR(0)="SA^N:NDC;U:UPC"
- SET DIR("A")="Will you enter the NDC or UPC? "
- SET DIR("B")="N"
- SET DIR("??")="^D NDCUPC^PSANDF1"
- DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET PSAOUT=1
- QUIT
- +20 IF Y="N"
- DO GETNDC^PSANDF
- if PSAOUT
- QUIT
- SET PSANDC=Y
- if PSANDC'=""
- DO ADDDATA
- +21 IF Y="U"
- DO GETUPC^PSANDF
- if PSAOUT
- QUIT
- SET PSANDC="S"_Y
- SET PSAUPC=Y
- if PSANDC'=""
- DO ADDDATA
- End DoDot:1
- +22 QUIT
- +23 ;
- ADDDATA ;Adds the missing NDC and/or UPC
- +1 KILL DA
- SET DA(2)=PSAIEN
- SET DA(1)=PSAIEN1
- SET DA=PSALINE
- SET DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,"
- SET DR="13///^S X="_PSANDC_$SELECT(PSAUPC'="":";15///^S X="_PSAUPC,1:"")
- +2 FOR
- LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF $TEST
- QUIT
- +3 DO ^DIE
- LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
- +4 KILL DIE
- IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=0
- QUIT
- +5 DO VERDISP^PSAUTL4
- +6 QUIT
- RECORD ;Adds adjusted data to DA ORDERS file
- +1 SET PSANEW=0
- +2 IF '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0))
- SET ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0)="^58.811259SA^^"
- +3 IF $DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B",PSADJFLD))
- Begin DoDot:1
- +4 SET DA=$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B",PSADJFLD,0))
- +5 IF '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0))
- DO NEW
- QUIT
- +6 DO ADJ
- End DoDot:1
- QUIT
- +7 ;
- NEW if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0))
- SET DIC("P")=$PIECE(^DD(58.81125,9,0),"^",2)
- KILL DA
- +1 SET DA(3)=PSAIEN
- SET DA(2)=PSAIEN1
- SET DA(1)=PSALINE
- SET X=PSADJFLD
- SET DIC="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
- SET DIC(0)="L"
- SET DLAYGO=58.811
- +2 FOR
- LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF $TEST
- QUIT
- +3 DO ^DIC
- LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
- KILL DIC,DLAYGO
- SET DA=+Y
- +4 ;
- ADJ SET DA(3)=PSAIEN
- SET DA(2)=PSAIEN1
- SET DA(1)=PSALINE
- SET DIE="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
- +1 ;
- +2 ;PSA*3*3 (DaveB 1JUN98)
- +3 ; *60
- SET DR="5///^S X=PSADJ"_$SELECT(PSAREA'="":";6////^S X=PSAREA",1:"")_";7///^S X="_DT_";8////^S X="_DUZ
- +4 FOR
- LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF $TEST
- QUIT
- +5 DO ^DIE
- INDEX SET DIK=DIE
- DO IX1^DIK
- KILL DIE,DIK
- LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
- +1 QUIT
- +2 ;
- DUOU ;Gets Dispense Units Per Order Unit
- +1 ;DAVE B (PSA*3*12) If PSASUPP is defined, the item is supply
- +2 ;no need to ask for dispense units per order unit.
- +3 IF $GET(PSASUPP)=1
- WRITE !,"Item appears to be marked for supply, no need to enter Dispense Units Per Order Unit."
- QUIT
- +4 WRITE !,"DISPENSE UNITS: "_$SELECT($PIECE($GET(^PSDRUG(PSA50IEN,660)),"^",8)'="":$PIECE($GET(^PSDRUG(PSA50IEN,660)),"^",8),1:"Blank")
- +5 SET DIR(0)="NO^::2"
- SET DIR("A")="DISPENSE UNITS PER ORDER UNIT"
- SET DIR("B")=$PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)),"^")
- +6 SET DIR("?")="Enter the number of dispense units contained in one order unit"
- SET DIR("??")="^D DUOUHELP^PSAPROC3"
- +7 DO ^DIR
- KILL DIR
- IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- QUIT
- +8 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^")=+Y
- if +Y
- SET PSASET=1
- +9 if Y'=""
- QUIT
- +10 ;
- +11 WRITE !!,"The dispense units per order unit must be entered",!,"to change the status of the invoice to Verified."
- +12 SET DIR(0)="Y"
- SET DIR("B")="Y"
- SET DIR("A")="Do you want to enter the data now"
- +13 SET DIR("?",1)="Enter Yes to return to the DISPENSE UNITS PER ORDER UNIT prompt."
- SET DIR("?")="Enter No to bypass entering the dispense units now."
- +14 SET DIR("??")="^D DUOUYN^PSAPROC8"
- DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET PSAOUT=1
- QUIT
- +15 WRITE !
- if +Y
- GOTO DUOU
- +16 QUIT
- +17 ;
- OU ;Get order unit
- +1 SET DIC(0)="QAEMZ"
- SET DIC="^DIC(51.5,"
- SET DIC("A")="ORDER UNIT: "
- SET DR=.01
- if +PSAOU&($PIECE($GET(^DIC(51.5,+PSAOU,0)),"^")'="")
- SET DIC("B")=$PIECE(^DIC(51.5,+PSAOU,0),"^")
- DO ^DIC
- KILL DIC
- +2 IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- QUIT
- +3 ;
- +4 ;PSA*3*12 Dave B, allow verifier to change OU to original if necessary
- +5 if Y=-1
- GOTO OU
- SET PSADJFLD="O"
- SET PSADJ=+Y
- SET PSAREA=""
- DO RECORD
- +6 QUIT
- +7 ;
- PHARM ;Pharmacy Location/Master Vault -- DR is set prior to the call.
- +1 KILL DA
- SET DA(1)=PSAIEN
- SET DA=PSAIEN1
- SET DIE="^PSD(58.811,"_DA(1)_",1,"
- DO ^DIE
- KILL DIE
- +2 if $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- +3 QUIT
- +4 ;
- QTY ;Adjust the quantity received
- +1 SET DIR(0)="N"
- SET DIR("A")="QUANTITY RECEIVED"
- SET DIR("B")=PSAQTY
- +2 SET DIR("?",1)="If the quantity received is different than the invoiced or"
- SET DIR("?")="adjusted quantity, enter the correct quantity received."
- SET DIR("??")="^D QTYHELP^PSAPROC3"
- +3 DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET PSAOUT=1
- QUIT
- +4 if PSAQTY=+Y
- QUIT
- SET PSADJ=+Y
- +5 SET DIR(0)="F^1:30"
- SET DIR("A")="ADJUSTMENT REASON"
- SET DIR("?")="Enter the reason you adjusted the quantity received."
- SET DIR("??")="^D ADJREA^PSAPROC3"
- +6 DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET PSAOUT=1
- QUIT
- +7 SET PSADJFLD="Q"
- SET PSAREA=Y
- DO RECORD
- +8 QUIT
- +9 ;
- RECD ;Date Received
- +1 KILL PSARECD
- SET PSAREC=$SELECT(+$PIECE(PSAIN,"^",7):+$PIECE(PSAIN,"^",7),+$PIECE(PSAIN,"^",6):+$PIECE(PSAIN,"^",6),1:"")
- +2 SET DIR(0)="D"
- SET DIR("A")="Date received"
- SET DIR("?")="Enter the date the drugs were received."
- SET DIR("??")="^D RECHELP^PSAPROC3"
- if PSAREC
- SET DIR("B")=$$FMTE^XLFDT(PSAREC)
- +3 DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET PSAOUT=1
- QUIT
- +4 if '+$PIECE(PSAIN,"^",7)&(+Y=+$PIECE(PSAIN,"^",6))
- QUIT
- +5 if +$PIECE(PSAIN,"^",6)'=+$PIECE(PSAIN,"^",7)&(+$PIECE(PSAIN,"^",7)=+Y)
- QUIT
- +6 if +$PIECE(PSAIN,"^",6)=+Y
- SET PSARECD="@"
- +7 if +$PIECE(PSAIN,"^",6)'=+Y&(+$PIECE(PSAIN,"^",7)'=+Y)
- SET PSARECD=+Y
- +8 if '$DATA(PSARECD)
- QUIT
- KILL DA
- +9 SET DA(1)=PSAIEN
- SET DA=PSAIEN1
- SET DIE="^PSD(58.811,"_DA(1)_",1,"
- SET DR="8///"_$SELECT(+PSARECD:"^S X="_PSARECD,1:"@")
- +10 FOR
- LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF $TEST
- QUIT
- +11 DO ^DIE
- LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
- +12 KILL DIE
- +13 IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- +14 QUIT
- +15 ;
- REORDER ;Enter reorder level for drug if the field is blank.
- +1 SET DIR(0)="NO^0:99999"
- SET DIR("A")="REORDER LEVEL (in Dispense Units)"
- SET DIR("??")="^D REORD^PSAPROC8"
- SET DIR("B")=+PSAREORD
- +2 SET DIR("?")="Enter the minimum number of dispense units to keep in the "_$SELECT(+$PIECE(PSADATA,"^",10):"master vault",1:"pharmacy location")_"."
- +3 DO ^DIR
- KILL DIR
- IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- QUIT
- +4 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^",2)=+Y
- +5 QUIT
- STOCK ;Enter stock level for drug if the field is blank.
- +1 SET DIR(0)="NO^0:99999"
- SET DIR("A")="STOCK LEVEL (in Dispense Units)"
- SET DIR("??")="^D STKLEVEL^PSAPROC8"
- SET DIR("B")=+PSASTOCK
- +2 SET DIR("?")="Enter the ideal number of dispense units to keep on the shelf."
- +3 DO ^DIR
- KILL DIR
- IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- QUIT
- +4 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2),"^",4)=+Y
- +5 QUIT