PSAPROC8 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,64,70**; 10/24/97;Build 12
;This routine processes uploaded invoices.
;
DU ;Prompts Dispense Unit if blank
F L +^PSDRUG(PSAIEN,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
S DIE="^PSDRUG(",DA=PSAIEN,DR=14.5 D ^DIE K DIE L -^PSDRUG(PSAIEN,0)
I +$P($G(^PSDRUG(PSAIEN,660)),"^",8) D G DU
.F L +^PSDRUG(PSAIEN,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
.S DIE="^PSDRUG(",DA=PSAIEN,DR="14.5///@" D ^DIE K DIE L -^PSDRUG(PSAIEN,0)
I $P($G(^PSDRUG(PSAIEN,660)),"^",8)'="" S PSADU=1 Q
;
W !,"The dispense units must be entered to change",!,"the status of the invoice to Processed."
S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to enter the dispense units now",DIR("?",1)="Enter Yes to return to the DISPENSE UNIT prompt.",DIR("?")="Enter No to bypass entering the dispense units now."
S DIR("??")="^D DISPYN^PSAPROC8" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
G:+Y DU
Q
;
DUOU ;Gets Dispense Units per Order Unit
W:'$G(PSADU) !,"DISPENSE UNITS: "_$P($G(^PSDRUG(PSAIEN,660)),"^",8)
S PSADU=1
F L +^PSDRUG(PSAIEN,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
S DIE="^PSDRUG("_PSAIEN_",1,",DA(1)=PSAIEN,DA=+PSASUB,DR=403 D ^DIE K DIE L -^PSDRUG(PSAIEN,0)
I $D(Y)!($G(DTOUT)) S PSAOUT=1 Q
Q:+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",7)
;
S DIR(0)="Y",DIR("B")="Y",DIR("A",1)="The dispense units per order unit must be entered to change the ",DIR("A")="status of the invoice to Processed. Do you want to enter the data now"
S DIR("?",1)="Enter Yes to return to the "_$P($G(^PSDRUG(PSAIEN,660)),"^",8)_"s per "_$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^",2)_" prompt."
S DIR("?")="Enter No to bypass entering the dispense units now.",DIR("??")="^D DUOUYN^PSAPROC8"
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
G:+Y DUOU
Q
OK ;
S PSACNTOK=PSACNTOK+1,PSAOK(PSACNTOK)=$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",4)_"^"_$P(^("IN"),"^",2)_"^"_PSACTRL_"^"_$P(^("IN"),"^",7)
Q
PRICE ;Price per Order Unit changed
S PSAIPR=$L($FN($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",3),",",2)),PSAFPR=$L($FN($P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",6),",",2))
S PSAJUST=$S(PSAIPR>PSAFPR:PSAIPR,1:PSAFPR)
W !!,"Price per Order Unit -- Invoice's: $"_$J($FN($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",3),",",2),PSAJUST,2),!?24,"File's : $"_$J($FN($P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",6),",",2),PSAJUST,2),!
S DIR(0)="Y",DIR("A")="Is the invoice's price per order unit correct",DIR("B")="Y",DIR("?",1)="Enter Yes if "_$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",3)_" is correct."
S DIR("?")="Enter No to keep the file's price per order unit.",DIR("??")="^D PRICEOU^PSAPROC1" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",22)=+Y
I '+Y S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",23)=+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",6),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",24)=DUZ,$P(^(PSALINE),"^",25)=DT
Q
;
REORDER ;Enter reorder level for drug if the field is blank.
W:'$G(PSADU) !,"DISPENSE UNITS: "_$P($G(^PSDRUG(+PSAIEN,660)),"^",8)
S PSADU=1,DIR(0)="NO^0:99999",DIR("A")="REORDER LEVEL IN "_$P($G(^PSD(58.8,PSALOC,0)),"^")
S DIR("?")="Enter the minimum number of dispense units to keep in the "_$S($P(PSADATA,"^",19)="CS":"master vault.",1:"pharmacy location."),DIR("??")="^D REORD^PSAPROC8"
S DIR("B")=$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),+$P($G(^PSD(58.8,PSALOC,1,PSAIEN,0)),"^",5):$P(^PSD(58.8,PSALOC,1,PSAIEN,0),"^",5),1:"")
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",21)=+Y
Q
;
STOCK ;Enter stock level for drug if the field is blank.
W:'$G(PSADU) !,"DISPENSE UNITS: "_$P($G(^PSDRUG(+PSAIEN,660)),"^",8)
S PSADU=1,DIR(0)="NO^0:99999",DIR("A")="STOCK LEVEL IN "_$P($G(^PSD(58.8,+PSALOC,0)),"^")
S DIR("?")="Enter the minimum number of dispense units to keep on the shelf",DIR("??")="^D STKLEVEL^PSAPROC8"
S DIR("B")=$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),+$P($G(^PSD(58.8,PSALOC,1,PSAIEN,0)),"^",3):$P(^PSD(58.8,PSALOC,1,PSAIEN,0),"^",3),1:"")
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
Q:$G(DIRUT)
S:+Y $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",27)=+Y
Q
;
DISPYN ;Extended help to enter dispense units
W !?5,"Enter Yes if you want to enter the dispense units now.",!!?5,"Enter No to bypass entering the dispense units. The invoice will not",!?5,"be placed in a Processed status if the dispense units are not entered."
Q
DUOUYN ;Extended help to enter dispense units per order units
W !?5,"Enter Yes if you want to enter the dispense units per order unit now.",!!?5,"Enter No to bypass entering the dispense units per order unit. The"
W !?5,"invoice will not be placed in a "_$S($D(PSABEFOR):"Verified",1:"Processed")_" status if the dispense units",!?5,"are not entered."
Q
PRICEOU ;Extended help to 'Is invoice's price per order unit correct'
W !?5,"Enter Yes if the invoice's price per order unit is correct. The",!?5,"invoice's price per order unit will be entered into the DRUG file."
W !!?5,"Enter No if the invoice's price per order unit is not correct.",!?5,"The DRUG file's price per order unit will remain the same."
Q
REORD ;Extended help for 'Reorder level'
W !?5,"Enter the lowest amount of "_$P($G(^PSDRUG(PSAIEN,660)),"^",8)_"s to keep in the "_$S($P(PSADATA,"^",19)="CS":"master vault",1:"pharmacy location")_"."
W !!?5,"When the amount on hand is lower than the reorder level, a mail",!?5,"message will be sent showing the drug name, reorder level, and",!?5,"quantity on hand."
Q
STKLEVEL ;Extended help for 'Stock level'
W !?5,"Enter the ideal number of dispense units to keep on the shelf. When the",!?5,"number of dispense units is equal to or less than the reorder level, the"
W !?5,"amount to order is determined by subtracting the current number of dispense",!?5,"units from the stock level."
Q
PLOCK(PSATYP) ;SET ^XTMP("PSAPV",PSACRTL WITH A LOCK INDENTIFER <- PSA*3*70 RJS
N PSAPC,PSAORD,PSATMP,PSAMENU,PSADUZ S PSATMP=""
F L +^XTMP("PSAPVL"):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
I PSATYP=2 D
.F PSAPC=1:1 S PSAMENU=$P(PSASEL,",",PSAPC) Q:'PSAMENU!(PSAOUT) D
..Q:'$D(PSAERR(PSAMENU))
..S PSACTRL=$P(PSAERR(PSAMENU),"^",3),PSAORD=$P(PSAERR(PSAMENU),"^",1),PSADUZ=$G(^XTMP("PSAPVL",PSACTRL))
..I $P(PSADUZ,"^",3)<+$H K ^XTMP("PSAPVL",PSACTRL)
..I $D(^XTMP("PSAPVL",PSACTRL)),+PSADUZ=DUZ,$P(PSADUZ,"^",2)'=$J W !!,?5,"YOU ARE CURRENTLY PROCESSING ORDER# ",PSAORD," IN ANOTHER SESSION" Q
..I $D(^XTMP("PSAPVL",PSACTRL)),+PSADUZ'=DUZ W !!,?5,"ORDER# ",PSAORD," IS CURRENTLY BEING PROCESSED BY ",$P($P(^VA(200,+PSADUZ,0),"^",1),",",2)," ",$P($P(^VA(200,+PSADUZ,0),"^",1),",",1) Q
..I '$D(^XTMP("PSAPV",PSACTRL,"IN"))&($D(^PSD(58.811,"B",PSAORD))) W !!,?5,"ORDER# ",PSAORD," HAS ALREAY BEEN PROCESSED BY ANOTHER USER" Q
..S ^XTMP("PSAPVL",PSACTRL)=DUZ_"^"_$J_"^"_+$H
..S PSATMP=PSATMP_PSAMENU_",",PSALCK=1
I PSATYP=1 D
.F PSAPC=1:1 S PSA=+$P(PSASEL,",",PSAPC) Q:'PSA D
..Q:'$D(PSAOK(PSA))
..S PSACTRL=$P(PSAOK(PSA),"^",3),PSAORD=$P(PSAOK(PSA),"^",1),PSADUZ=$G(^XTMP("PSAPVL",PSACTRL))
..I $P(PSADUZ,"^",3)<+$H K ^XTMP("PSAPVL",PSACTRL)
..I $D(^XTMP("PSAPVL",PSACTRL)),+PSADUZ=DUZ,$P(PSADUZ,"^",2)'=$J W !!,?5,"YOU ARE CURRENTLY PROCESSING ORDER# ",PSAORD," IN ANOTHER SESSION" Q
..I $D(^XTMP("PSAPVL",PSACTRL)),+PSADUZ'=DUZ W !!,?5,"ORDER# ",PSAORD," IS CURRENTLY BEING PROCESSED BY ",$P($P(^VA(200,+PSADUZ,0),"^",1),",",2)," ",$P($P(^VA(200,+PSADUZ,0),"^",1),",",1) Q
..I '$D(^XTMP("PSAPV",PSACTRL,"IN"))&($D(^PSD(58.811,"B",PSAORD))) W !!,?5,"ORDER# ",PSAORD," HAS ALREAY BEEN PROCESSED BY ANOTHER USER" Q
..S ^XTMP("PSAPVL",PSACTRL)=DUZ_"^"_$J_"^"_+$H
..S PSATMP=PSATMP_PSACTRL_",",PSALCK=1
S PSASEL=PSATMP K PSATYP
L -^XTMP("PSAPVL")
Q
PSAUNLCK ;CLEANUP LOCK INDICATOR <- PSA*3*70 RJS
N PSACTRL,PSADUZ
S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPVL",PSACTRL)) Q:'PSACTRL D
.S PSADUZ=$G(^XTMP("PSAPVL",PSACTRL))
.I $P(PSADUZ,"^",3)<+$H K ^XTMP("PSAPVL",PSACTRL) Q
.I $G(^XTMP("PSAPVL",PSACTRL)),'$G(^XTMP("PSAPV",PSACTRL,"IN")) K ^XTMP("PSAPVL",PSACTRL) Q
.I +$G(^XTMP("PSAPVL",PSACTRL))=DUZ,$G(^XTMP("PSAPV",PSACTRL,"IN")) D Q
..K:$P(^XTMP("PSAPVL",PSACTRL),"^",2)=$J ^XTMP("PSAPVL",PSACTRL) Q
..W !!,"YOU ARE CURRENTLY PROCESSING ORDER# ",$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",4)," IN ANOTHER SESSION"
.I +$G(^XTMP("PSAPVL",PSACTRL))'=DUZ,$G(^XTMP("PSAPV",PSACTRL,"IN")) D Q
..W !!,$P($P(^VA(200,+PSADUZ,0),"^",1),",",2)," ",$P($P(^VA(200,+PSADUZ,0),"^",1),",",1)," IS CURRENTLY PROCESSING ORDER# ",$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",4)," IN ANOTHER SESSION"
K PSALCK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAPROC8 8722 printed Sep 23, 2025@19:26:14 Page 2
PSAPROC8 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,64,70**; 10/24/97;Build 12
+2 ;This routine processes uploaded invoices.
+3 ;
DU ;Prompts Dispense Unit if blank
+1 FOR
LOCK +^PSDRUG(PSAIEN,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+2 SET DIE="^PSDRUG("
SET DA=PSAIEN
SET DR=14.5
DO ^DIE
KILL DIE
LOCK -^PSDRUG(PSAIEN,0)
+3 IF +$PIECE($GET(^PSDRUG(PSAIEN,660)),"^",8)
Begin DoDot:1
+4 FOR
LOCK +^PSDRUG(PSAIEN,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+5 SET DIE="^PSDRUG("
SET DA=PSAIEN
SET DR="14.5///@"
DO ^DIE
KILL DIE
LOCK -^PSDRUG(PSAIEN,0)
End DoDot:1
GOTO DU
+6 IF $PIECE($GET(^PSDRUG(PSAIEN,660)),"^",8)'=""
SET PSADU=1
QUIT
+7 ;
+8 WRITE !,"The dispense units must be entered to change",!,"the status of the invoice to Processed."
+9 SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Do you want to enter the dispense units now"
SET DIR("?",1)="Enter Yes to return to the DISPENSE UNIT prompt."
SET DIR("?")="Enter No to bypass entering the dispense units now."
+10 SET DIR("??")="^D DISPYN^PSAPROC8"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+11 if +Y
GOTO DU
+12 QUIT
+13 ;
DUOU ;Gets Dispense Units per Order Unit
+1 if '$GET(PSADU)
WRITE !,"DISPENSE UNITS: "_$PIECE($GET(^PSDRUG(PSAIEN,660)),"^",8)
+2 SET PSADU=1
+3 FOR
LOCK +^PSDRUG(PSAIEN,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+4 SET DIE="^PSDRUG("_PSAIEN_",1,"
SET DA(1)=PSAIEN
SET DA=+PSASUB
SET DR=403
DO ^DIE
KILL DIE
LOCK -^PSDRUG(PSAIEN,0)
+5 IF $DATA(Y)!($GET(DTOUT))
SET PSAOUT=1
QUIT
+6 if +$PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",7)
QUIT
+7 ;
+8 SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A",1)="The dispense units per order unit must be entered to change the "
SET DIR("A")="status of the invoice to Processed. Do you want to enter the data now"
+9 SET DIR("?",1)="Enter Yes to return to the "_$PIECE($GET(^PSDRUG(PSAIEN,660)),"^",8)_"s per "_$PIECE($GET(^DIC(51.5,+$PIECE($PIECE(PSADATA,"^",2),"~",2),0)),"^",2)_" prompt."
+10 SET DIR("?")="Enter No to bypass entering the dispense units now."
SET DIR("??")="^D DUOUYN^PSAPROC8"
+11 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+12 if +Y
GOTO DUOU
+13 QUIT
OK ;
+1 SET PSACNTOK=PSACNTOK+1
SET PSAOK(PSACNTOK)=$PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",4)_"^"_$PIECE(^("IN"),"^",2)_"^"_PSACTRL_"^"_$PIECE(^("IN"),"^",7)
+2 QUIT
PRICE ;Price per Order Unit changed
+1 SET PSAIPR=$LENGTH($FNUMBER($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",3),",",2))
SET PSAFPR=$LENGTH($FNUMBER($PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",6),",",2))
+2 SET PSAJUST=$SELECT(PSAIPR>PSAFPR:PSAIPR,1:PSAFPR)
+3 WRITE !!,"Price per Order Unit -- Invoice's: $"_$JUSTIFY($FNUMBER($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",3),",",2),PSAJUST,2),!?24,"File's : $"_$JUSTIFY($FNUMBER($PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",6),",",2),PSAJUST,2),!
+4 SET DIR(0)="Y"
SET DIR("A")="Is the invoice's price per order unit correct"
SET DIR("B")="Y"
SET DIR("?",1)="Enter Yes if "_$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",3)_" is correct."
+5 SET DIR("?")="Enter No to keep the file's price per order unit."
SET DIR("??")="^D PRICEOU^PSAPROC1"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+6 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",22)=+Y
+7 IF '+Y
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",23)=+$PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",6)
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",24)=DUZ
SET $PIECE(^(PSALINE),"^",25)=DT
+8 QUIT
+9 ;
REORDER ;Enter reorder level for drug if the field is blank.
+1 if '$GET(PSADU)
WRITE !,"DISPENSE UNITS: "_$PIECE($GET(^PSDRUG(+PSAIEN,660)),"^",8)
+2 SET PSADU=1
SET DIR(0)="NO^0:99999"
SET DIR("A")="REORDER LEVEL IN "_$PIECE($GET(^PSD(58.8,PSALOC,0)),"^")
+3 SET DIR("?")="Enter the minimum number of dispense units to keep in the "_$SELECT($PIECE(PSADATA,"^",19)="CS":"master vault.",1:"pharmacy location.")
SET DIR("??")="^D REORD^PSAPROC8"
+4 SET DIR("B")=$SELECT(+$PIECE(PSADATA,"^",21):+$PIECE(PSADATA,"^",21),+$PIECE($GET(^PSD(58.8,PSALOC,1,PSAIEN,0)),"^",5):$PIECE(^PSD(58.8,PSALOC,1,PSAIEN,0),"^",5),1:"")
+5 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+6 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",21)=+Y
+7 QUIT
+8 ;
STOCK ;Enter stock level for drug if the field is blank.
+1 if '$GET(PSADU)
WRITE !,"DISPENSE UNITS: "_$PIECE($GET(^PSDRUG(+PSAIEN,660)),"^",8)
+2 SET PSADU=1
SET DIR(0)="NO^0:99999"
SET DIR("A")="STOCK LEVEL IN "_$PIECE($GET(^PSD(58.8,+PSALOC,0)),"^")
+3 SET DIR("?")="Enter the minimum number of dispense units to keep on the shelf"
SET DIR("??")="^D STKLEVEL^PSAPROC8"
+4 SET DIR("B")=$SELECT(+$PIECE(PSADATA,"^",27):+$PIECE(PSADATA,"^",27),+$PIECE($GET(^PSD(58.8,PSALOC,1,PSAIEN,0)),"^",3):$PIECE(^PSD(58.8,PSALOC,1,PSAIEN,0),"^",3),1:"")
+5 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+6 if $GET(DIRUT)
QUIT
+7 if +Y
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",27)=+Y
+8 QUIT
+9 ;
DISPYN ;Extended help to enter dispense units
+1 WRITE !?5,"Enter Yes if you want to enter the dispense units now.",!!?5,"Enter No to bypass entering the dispense units. The invoice will not",!?5,"be placed in a Processed status if the dispense units are not entered."
+2 QUIT
DUOUYN ;Extended help to enter dispense units per order units
+1 WRITE !?5,"Enter Yes if you want to enter the dispense units per order unit now.",!!?5,"Enter No to bypass entering the dispense units per order unit. The"
+2 WRITE !?5,"invoice will not be placed in a "_$SELECT($DATA(PSABEFOR):"Verified",1:"Processed")_" status if the dispense units",!?5,"are not entered."
+3 QUIT
PRICEOU ;Extended help to 'Is invoice's price per order unit correct'
+1 WRITE !?5,"Enter Yes if the invoice's price per order unit is correct. The",!?5,"invoice's price per order unit will be entered into the DRUG file."
+2 WRITE !!?5,"Enter No if the invoice's price per order unit is not correct.",!?5,"The DRUG file's price per order unit will remain the same."
+3 QUIT
REORD ;Extended help for 'Reorder level'
+1 WRITE !?5,"Enter the lowest amount of "_$PIECE($GET(^PSDRUG(PSAIEN,660)),"^",8)_"s to keep in the "_$SELECT($PIECE(PSADATA,"^",19)="CS":"master vault",1:"pharmacy location")_"."
+2 WRITE !!?5,"When the amount on hand is lower than the reorder level, a mail",!?5,"message will be sent showing the drug name, reorder level, and",!?5,"quantity on hand."
+3 QUIT
STKLEVEL ;Extended help for 'Stock level'
+1 WRITE !?5,"Enter the ideal number of dispense units to keep on the shelf. When the",!?5,"number of dispense units is equal to or less than the reorder level, the"
+2 WRITE !?5,"amount to order is determined by subtracting the current number of dispense",!?5,"units from the stock level."
+3 QUIT
PLOCK(PSATYP) ;SET ^XTMP("PSAPV",PSACRTL WITH A LOCK INDENTIFER <- PSA*3*70 RJS
+1 NEW PSAPC,PSAORD,PSATMP,PSAMENU,PSADUZ
SET PSATMP=""
+2 FOR
LOCK +^XTMP("PSAPVL"):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+3 IF PSATYP=2
Begin DoDot:1
+4 FOR PSAPC=1:1
SET PSAMENU=$PIECE(PSASEL,",",PSAPC)
if 'PSAMENU!(PSAOUT)
QUIT
Begin DoDot:2
+5 if '$DATA(PSAERR(PSAMENU))
QUIT
+6 SET PSACTRL=$PIECE(PSAERR(PSAMENU),"^",3)
SET PSAORD=$PIECE(PSAERR(PSAMENU),"^",1)
SET PSADUZ=$GET(^XTMP("PSAPVL",PSACTRL))
+7 IF $PIECE(PSADUZ,"^",3)<+$HOROLOG
KILL ^XTMP("PSAPVL",PSACTRL)
+8 IF $DATA(^XTMP("PSAPVL",PSACTRL))
IF +PSADUZ=DUZ
IF $PIECE(PSADUZ,"^",2)'=$JOB
WRITE !!,?5,"YOU ARE CURRENTLY PROCESSING ORDER# ",PSAORD," IN ANOTHER SESSION"
QUIT
+9 IF $DATA(^XTMP("PSAPVL",PSACTRL))
IF +PSADUZ'=DUZ
WRITE !!,?5,"ORDER# ",PSAORD," IS CURRENTLY BEING PROCESSED BY ",$PIECE($PIECE(^VA(200,+PSADUZ,0),"^",1),",",2)," ",$PIECE($PIECE(^VA(200,+PSADUZ,0),"^",1),",",1)
QUIT
+10 IF '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))&($DATA(^PSD(58.811,"B",PSAORD)))
WRITE !!,?5,"ORDER# ",PSAORD," HAS ALREAY BEEN PROCESSED BY ANOTHER USER"
QUIT
+11 SET ^XTMP("PSAPVL",PSACTRL)=DUZ_"^"_$JOB_"^"_+$HOROLOG
+12 SET PSATMP=PSATMP_PSAMENU_","
SET PSALCK=1
End DoDot:2
End DoDot:1
+13 IF PSATYP=1
Begin DoDot:1
+14 FOR PSAPC=1:1
SET PSA=+$PIECE(PSASEL,",",PSAPC)
if 'PSA
QUIT
Begin DoDot:2
+15 if '$DATA(PSAOK(PSA))
QUIT
+16 SET PSACTRL=$PIECE(PSAOK(PSA),"^",3)
SET PSAORD=$PIECE(PSAOK(PSA),"^",1)
SET PSADUZ=$GET(^XTMP("PSAPVL",PSACTRL))
+17 IF $PIECE(PSADUZ,"^",3)<+$HOROLOG
KILL ^XTMP("PSAPVL",PSACTRL)
+18 IF $DATA(^XTMP("PSAPVL",PSACTRL))
IF +PSADUZ=DUZ
IF $PIECE(PSADUZ,"^",2)'=$JOB
WRITE !!,?5,"YOU ARE CURRENTLY PROCESSING ORDER# ",PSAORD," IN ANOTHER SESSION"
QUIT
+19 IF $DATA(^XTMP("PSAPVL",PSACTRL))
IF +PSADUZ'=DUZ
WRITE !!,?5,"ORDER# ",PSAORD," IS CURRENTLY BEING PROCESSED BY ",$PIECE($PIECE(^VA(200,+PSADUZ,0),"^",1),",",2)," ",$PIECE($PIECE(^VA(200,+PSADUZ,0),"^",1),",",1)
QUIT
+20 IF '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))&($DATA(^PSD(58.811,"B",PSAORD)))
WRITE !!,?5,"ORDER# ",PSAORD," HAS ALREAY BEEN PROCESSED BY ANOTHER USER"
QUIT
+21 SET ^XTMP("PSAPVL",PSACTRL)=DUZ_"^"_$JOB_"^"_+$HOROLOG
+22 SET PSATMP=PSATMP_PSACTRL_","
SET PSALCK=1
End DoDot:2
End DoDot:1
+23 SET PSASEL=PSATMP
KILL PSATYP
+24 LOCK -^XTMP("PSAPVL")
+25 QUIT
PSAUNLCK ;CLEANUP LOCK INDICATOR <- PSA*3*70 RJS
+1 NEW PSACTRL,PSADUZ
+2 SET PSACTRL=0
FOR
SET PSACTRL=$ORDER(^XTMP("PSAPVL",PSACTRL))
if 'PSACTRL
QUIT
Begin DoDot:1
+3 SET PSADUZ=$GET(^XTMP("PSAPVL",PSACTRL))
+4 IF $PIECE(PSADUZ,"^",3)<+$HOROLOG
KILL ^XTMP("PSAPVL",PSACTRL)
QUIT
+5 IF $GET(^XTMP("PSAPVL",PSACTRL))
IF '$GET(^XTMP("PSAPV",PSACTRL,"IN"))
KILL ^XTMP("PSAPVL",PSACTRL)
QUIT
+6 IF +$GET(^XTMP("PSAPVL",PSACTRL))=DUZ
IF $GET(^XTMP("PSAPV",PSACTRL,"IN"))
Begin DoDot:2
+7 if $PIECE(^XTMP("PSAPVL",PSACTRL),"^",2)=$JOB
KILL ^XTMP("PSAPVL",PSACTRL)
QUIT
+8 WRITE !!,"YOU ARE CURRENTLY PROCESSING ORDER# ",$PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",4)," IN ANOTHER SESSION"
End DoDot:2
QUIT
+9 IF +$GET(^XTMP("PSAPVL",PSACTRL))'=DUZ
IF $GET(^XTMP("PSAPV",PSACTRL,"IN"))
Begin DoDot:2
+10 WRITE !!,$PIECE($PIECE(^VA(200,+PSADUZ,0),"^",1),",",2)," ",$PIECE($PIECE(^VA(200,+PSADUZ,0),"^",1),",",1)," IS CURRENTLY PROCESSING ORDER# ",$PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",4)," IN ANOTHER SESSION"
End DoDot:2
QUIT
End DoDot:1
+11 KILL PSALCK
+12 QUIT
