PSALEVEL ;BIR/JMB-Enter/Edit Stock and Reorder Levels ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
;This routine allows the user to select a pharmacy location/master vault
;to set the MAINTAIN STOCK LEVELS? field. If yes, the stock and reorder
;levels can be edited.
;
I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
SETUP S PSASLN="",$P(PSASLN,"-",80)=""
;Counts pharmacy locations
S (PSALOC,PSANUM)=0
F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
.Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
.I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
.S PSANUM=PSANUM+1,PSAONE=PSALOC,PSAISIT=+$P(^PSD(58.8,PSALOC,0),"^",3),PSAOSIT=+$P(^(0),"^",10)
.D SITES^PSAUTL1 S PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
;Counts master vaults
S (PSAMVNUM,PSAMV)=0
F S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV D
.Q:'$D(^PSD(58.8,PSAMV,0))!($P($G(^PSD(58.8,PSAMV,0)),"^")="")!('$P($G(^PSD(58.8,PSAMV,0)),"^",8))
.I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
.S PSAMVNUM=PSAMVNUM+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
;
BEGIN S (PSABEG,PSALOC,PSAMV,PSAOUT)=0
I $D(^XUSEC("PSJ RPHARM",DUZ)) G:'PSAMVNUM&('PSANUM) NONE D PHARMKEY
I '$D(^XUSEC("PSJ RPHARM",DUZ)) G:'PSANUM NONE D:PSANUM=1 ONE D:PSANUM>1 MANY
G:PSAOUT EXIT G:PSABEG BEGIN
;
MAINTAIN ;Maintain reorder levels in pharmacy location/master vault?
S PSA=$S(PSALOC:PSALOC,1:PSAMV)
S DIE="^PSD(58.8,",DA=PSA,DR=34 D ^DIE K DA,DIE
G:$G(DTOUT)!($G(DUOUT)) EXIT
I '+X G:PSANUM&(PSAMVNUM) BEGIN G EXIT
;
GETDRUG ;Gets drug levels
W ! S DIC(0)="AEMQZ",DIC="^PSD(58.8,"_PSA_",1,",DA(1)=PSA,DIC("S")="I +$P($G(^PSD(58.8,PSA,1,+Y,0)),U,14)'<DT!('$P($G(^PSD(58.8,PSA,1,+Y,0)),U,14))"
D ^DIC K DA,DIC G:$G(DTOUT)!($G(DUOUT)) EXIT
I Y=-1 G:(PSANUM=1&('PSAMVNUM))!('PSANUM&(PSAMVNUM=1)) EXIT G BEGIN
S PSADRG=+Y
S DIE="^PSD(58.8,"_PSA_",1,",DA(1)=PSA,DA=PSADRG,DR="2STOCK LEVEL (in Dispense Units);4REORDER LEVEL (in Dispense Units)" D ^DIE K DIE
G:$G(DTOUT)!($G(DUOUT)) EXIT
G GETDRUG
;
CHOOSE ;Selects the type of location to have the levels enter/edited.
W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN
S DIR(0)="SO^P:Pharmacy Location;M:Master Vault",DIR("A")="Enter/edit levels for a pharmacy location or master vault",DIR("??")="^D CHO^PSALEVEL"
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
S PSACHO=Y
I PSACHO="P" D:PSANUM=1 ONE D:PSANUM>1 MANY Q
I PSACHO="M" D:PSAMVNUM=1 ONEMV D:PSAMVNUM>1 MANYMV
Q
;
EXIT ;Kills variables
K DA,DIC,DIE,DIR,DIRUT,DR,DTOUT,DUOUT,PSA,PSABEG,PSACHO,PSACNT,PSACOMB,PSADRG,PSAISIT,PSAISITN,PSALOC,PSALOCA,PSALOCN
K PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVNUM,PSANUM,PSAONE,PSAONEMV,PSAOSIT,PSAOSITN,PSAOUT,PSASEL,PSASLN,PSAVAULT,X,Y
Q
;
PHARMKEY ;
I 'PSAMVNUM D:PSANUM=1 ONE D:PSANUM>1 MANY Q
I PSANUM D CHOOSE Q
I 'PSANUM D:PSAMVNUM=1 ONEMV D:PSAMVNUM>1 MANYMV
Q
;
ONEMV ;Assigns invoice to Master Vault
S PSAMV=PSAONEMV
W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
W !?31,"<< MASTER VAULT >>",!!,$P(^PSD(58.8,PSAMV,0),"^"),!,PSASLN,!
Q
;
MANYMV ;Displays active master vaults
W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN,!
S PSASEL=0,PSAMVA="" F S PSAMVA=$O(PSAMV(PSAMVA)) Q:PSAMVA="" D
.S PSAMVIEN=0 F S PSAMVIEN=$O(PSAMV(PSAMVA,PSAMVIEN)) Q:'PSAMVIEN D
..S PSASEL=PSASEL+1,PSAVAULT(PSASEL,PSAMVA,PSAMVIEN)=""
..W !,$J(PSASEL,2)_".",?4,PSAMVA
W ! S DIR(0)="NO^1:"_PSASEL,DIR("A")="Select Master Vault",DIR("?")="Select the Master Vault to be edited",DIR("??")="^D MV^PSALEVEL"
D ^DIR K DIR I Y="",PSANUM S PSABEG=1 Q
I Y="",'PSANUM S PSAOUT=1 Q
I $G(DIRUT) S PSAOUT=1 Q
S PSASEL=Y
S PSAMVA=$O(PSAVAULT(PSASEL,"")) Q:PSAMVA="" S PSAMVIEN=+$O(PSAVAULT(PSASEL,PSAMVA,0)) Q:'PSAMVIEN S PSAMV=PSAMVIEN
W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
W !?31,"<< MASTER VAULT >>",!!,$P(^PSD(58.8,PSAMV,0),"^"),!,PSASLN,!
Q
;
NONE ;No DA pharmacy locations
Q:PSAMVNUM
W !!,"There are no Drug Accountability pharmacy locations.",!!,"Use the Set Up/Edit a Pharmacy Location option on Pharmacy Location menu"
W !,"to setup one or more pharmacy locations."
G EXIT
;
ONE ;Only one location
S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
W !?31,"PHARMACY LOCATION",!!
I $L(PSALOCN)>76 W $P(PSALOCN,":")_" :"_$P($P(PSALOCN,":",2),"(IP)",1)_"(IP)",!?20,$P(PSALOCN,"(IP)",2)
W:$L(PSALOCN)<77 PSALOCN W !,PSASLN,!
Q
;
MANY ;If more than one pharmacy location, display invoices.
W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN,!
S PSACNT=0,PSALOCN="" F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" D
.S PSALOC=0 F S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC D
..S PSACNT=PSACNT+1,PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
..W !,$J(PSACNT,2)_"." W:$L(PSALOCN)>72 ?4,$P(PSALOCN,"(IP)",1)_"(IP)",!?21,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<73 ?4,PSALOCN
W !! K DIR S DIR(0)="NO^1:"_PSACNT,DIR("A")="Pharmacy Location",DIR("?")="Select the pharmacy location to be edited",DIR("??")="^D PL^PSALEVEL"
D ^DIR K DIR I Y="",PSAMVNUM S PSABEG=1 Q
I Y="",'PSAMVNUM S PSAOUT=1 Q
I $G(DIRUT) S PSAOUT=1 Q
S PSASEL=Y,PSALOCN=$O(PSAMENU(PSASEL,"")) Q:PSALOCN=""
S PSALOC=$O(PSAMENU(PSASEL,PSALOCN,0)) Q:'PSALOC
W @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
W !?28,"<< PHARMACY LOCATION >>",!!
I $L(PSALOCN)>76 W $P(PSALOCN,"(IP)",1)_"(IP)",!?20,$P(PSALOCN,"(IP)",2)
W:$L(PSALOCN)<77 PSALOCN W !,PSASLN,!
Q
;
CHO ;Extended help for "Enter/edit levels for pharmacy location or master vault."
W !?5,"Enter P to add or edit stock and reorder levels in a pharmacy location.",!?5,"Enter M to add or edit stock and reorder levels in a master vault."
W !!?5,"After making your selection, you will be given a list of active pharmacy",!?5,"locations or master vaults from which to choose."
Q
MV ;Extended help for "Select Master Vault"
W !?5,"Enter the numbers of master vaults from the list. Select the ones that",!?5,"contain drugs you want to add or edit stock and reorder levels."
Q
PL ;Extended help for "Select Pharmacy Location"
W !?5,"Enter the numbers of pharmacy locations from the list. Select the ones that",!?5,"contain drugs you want to add or edit stock and reorder levels."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSALEVEL 6503 printed Sep 23, 2025@19:25:26 Page 2
PSALEVEL ;BIR/JMB-Enter/Edit Stock and Reorder Levels ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
+2 ;This routine allows the user to select a pharmacy location/master vault
+3 ;to set the MAINTAIN STOCK LEVELS? field. If yes, the stock and reorder
+4 ;levels can be edited.
+5 ;
+6 IF '$DATA(^XUSEC("PSA ORDERS",DUZ))
WRITE !,"You do not hold the key to enter the option."
QUIT
SETUP SET PSASLN=""
SET $PIECE(PSASLN,"-",80)=""
+1 ;Counts pharmacy locations
+2 SET (PSALOC,PSANUM)=0
+3 FOR
SET PSALOC=+$ORDER(^PSD(58.8,"ADISP","P",PSALOC))
if 'PSALOC
QUIT
Begin DoDot:1
+4 if '$DATA(^PSD(58.8,PSALOC,0))!($PIECE($GET(^PSD(58.8,PSALOC,0)),"^")="")
QUIT
+5 IF +$GET(^PSD(58.8,PSALOC,"I"))
IF +^PSD(58.8,PSALOC,"I")'>DT
QUIT
+6 SET PSANUM=PSANUM+1
SET PSAONE=PSALOC
SET PSAISIT=+$PIECE(^PSD(58.8,PSALOC,0),"^",3)
SET PSAOSIT=+$PIECE(^(0),"^",10)
+7 DO SITES^PSAUTL1
SET PSALOCA($PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
End DoDot:1
+8 ;Counts master vaults
+9 SET (PSAMVNUM,PSAMV)=0
+10 FOR
SET PSAMV=+$ORDER(^PSD(58.8,"ADISP","M",PSAMV))
if 'PSAMV
QUIT
Begin DoDot:1
+11 if '$DATA(^PSD(58.8,PSAMV,0))!($PIECE($GET(^PSD(58.8,PSAMV,0)),"^")="")!('$PIECE($GET(^PSD(58.8,PSAMV,0)),"^",8))
QUIT
+12 IF +$GET(^PSD(58.8,PSAMV,"I"))
IF +^PSD(58.8,PSAMV,"I")'>DT
QUIT
+13 SET PSAMVNUM=PSAMVNUM+1
SET PSAONEMV=PSAMV
SET PSAMV($PIECE(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
End DoDot:1
+14 ;
BEGIN SET (PSABEG,PSALOC,PSAMV,PSAOUT)=0
+1 IF $DATA(^XUSEC("PSJ RPHARM",DUZ))
if 'PSAMVNUM&('PSANUM)
GOTO NONE
DO PHARMKEY
+2 IF '$DATA(^XUSEC("PSJ RPHARM",DUZ))
if 'PSANUM
GOTO NONE
if PSANUM=1
DO ONE
if PSANUM>1
DO MANY
+3 if PSAOUT
GOTO EXIT
if PSABEG
GOTO BEGIN
+4 ;
MAINTAIN ;Maintain reorder levels in pharmacy location/master vault?
+1 SET PSA=$SELECT(PSALOC:PSALOC,1:PSAMV)
+2 SET DIE="^PSD(58.8,"
SET DA=PSA
SET DR=34
DO ^DIE
KILL DA,DIE
+3 if $GET(DTOUT)!($GET(DUOUT))
GOTO EXIT
+4 IF '+X
if PSANUM&(PSAMVNUM)
GOTO BEGIN
GOTO EXIT
+5 ;
GETDRUG ;Gets drug levels
+1 WRITE !
SET DIC(0)="AEMQZ"
SET DIC="^PSD(58.8,"_PSA_",1,"
SET DA(1)=PSA
SET DIC("S")="I +$P($G(^PSD(58.8,PSA,1,+Y,0)),U,14)'<DT!('$P($G(^PSD(58.8,PSA,1,+Y,0)),U,14))"
+2 DO ^DIC
KILL DA,DIC
if $GET(DTOUT)!($GET(DUOUT))
GOTO EXIT
+3 IF Y=-1
if (PSANUM=1&('PSAMVNUM))!('PSANUM&(PSAMVNUM=1))
GOTO EXIT
GOTO BEGIN
+4 SET PSADRG=+Y
+5 SET DIE="^PSD(58.8,"_PSA_",1,"
SET DA(1)=PSA
SET DA=PSADRG
SET DR="2STOCK LEVEL (in Dispense Units);4REORDER LEVEL (in Dispense Units)"
DO ^DIE
KILL DIE
+6 if $GET(DTOUT)!($GET(DUOUT))
GOTO EXIT
+7 GOTO GETDRUG
+8 ;
CHOOSE ;Selects the type of location to have the levels enter/edited.
+1 WRITE @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN
+2 SET DIR(0)="SO^P:Pharmacy Location;M:Master Vault"
SET DIR("A")="Enter/edit levels for a pharmacy location or master vault"
SET DIR("??")="^D CHO^PSALEVEL"
+3 DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+4 SET PSACHO=Y
+5 IF PSACHO="P"
if PSANUM=1
DO ONE
if PSANUM>1
DO MANY
QUIT
+6 IF PSACHO="M"
if PSAMVNUM=1
DO ONEMV
if PSAMVNUM>1
DO MANYMV
+7 QUIT
+8 ;
EXIT ;Kills variables
+1 KILL DA,DIC,DIE,DIR,DIRUT,DR,DTOUT,DUOUT,PSA,PSABEG,PSACHO,PSACNT,PSACOMB,PSADRG,PSAISIT,PSAISITN,PSALOC,PSALOCA,PSALOCN
+2 KILL PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVNUM,PSANUM,PSAONE,PSAONEMV,PSAOSIT,PSAOSITN,PSAOUT,PSASEL,PSASLN,PSAVAULT,X,Y
+3 QUIT
+4 ;
PHARMKEY ;
+1 IF 'PSAMVNUM
if PSANUM=1
DO ONE
if PSANUM>1
DO MANY
QUIT
+2 IF PSANUM
DO CHOOSE
QUIT
+3 IF 'PSANUM
if PSAMVNUM=1
DO ONEMV
if PSAMVNUM>1
DO MANYMV
+4 QUIT
+5 ;
ONEMV ;Assigns invoice to Master Vault
+1 SET PSAMV=PSAONEMV
+2 WRITE @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
+3 WRITE !?31,"<< MASTER VAULT >>",!!,$PIECE(^PSD(58.8,PSAMV,0),"^"),!,PSASLN,!
+4 QUIT
+5 ;
MANYMV ;Displays active master vaults
+1 WRITE @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN,!
+2 SET PSASEL=0
SET PSAMVA=""
FOR
SET PSAMVA=$ORDER(PSAMV(PSAMVA))
if PSAMVA=""
QUIT
Begin DoDot:1
+3 SET PSAMVIEN=0
FOR
SET PSAMVIEN=$ORDER(PSAMV(PSAMVA,PSAMVIEN))
if 'PSAMVIEN
QUIT
Begin DoDot:2
+4 SET PSASEL=PSASEL+1
SET PSAVAULT(PSASEL,PSAMVA,PSAMVIEN)=""
+5 WRITE !,$JUSTIFY(PSASEL,2)_".",?4,PSAMVA
End DoDot:2
End DoDot:1
+6 WRITE !
SET DIR(0)="NO^1:"_PSASEL
SET DIR("A")="Select Master Vault"
SET DIR("?")="Select the Master Vault to be edited"
SET DIR("??")="^D MV^PSALEVEL"
+7 DO ^DIR
KILL DIR
IF Y=""
IF PSANUM
SET PSABEG=1
QUIT
+8 IF Y=""
IF 'PSANUM
SET PSAOUT=1
QUIT
+9 IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+10 SET PSASEL=Y
+11 SET PSAMVA=$ORDER(PSAVAULT(PSASEL,""))
if PSAMVA=""
QUIT
SET PSAMVIEN=+$ORDER(PSAVAULT(PSASEL,PSAMVA,0))
if 'PSAMVIEN
QUIT
SET PSAMV=PSAMVIEN
+12 WRITE @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
+13 WRITE !?31,"<< MASTER VAULT >>",!!,$PIECE(^PSD(58.8,PSAMV,0),"^"),!,PSASLN,!
+14 QUIT
+15 ;
NONE ;No DA pharmacy locations
+1 if PSAMVNUM
QUIT
+2 WRITE !!,"There are no Drug Accountability pharmacy locations.",!!,"Use the Set Up/Edit a Pharmacy Location option on Pharmacy Location menu"
+3 WRITE !,"to setup one or more pharmacy locations."
+4 GOTO EXIT
+5 ;
ONE ;Only one location
+1 SET PSACNT=0
SET PSALOC=PSAONE
SET PSALOCN=$ORDER(PSALOCA(""))
+2 WRITE @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
+3 WRITE !?31,"PHARMACY LOCATION",!!
+4 IF $LENGTH(PSALOCN)>76
WRITE $PIECE(PSALOCN,":")_" :"_$PIECE($PIECE(PSALOCN,":",2),"(IP)",1)_"(IP)",!?20,$PIECE(PSALOCN,"(IP)",2)
+5 if $LENGTH(PSALOCN)<77
WRITE PSALOCN
WRITE !,PSASLN,!
+6 QUIT
+7 ;
MANY ;If more than one pharmacy location, display invoices.
+1 WRITE @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>",!,PSASLN,!
+2 SET PSACNT=0
SET PSALOCN=""
FOR
SET PSALOCN=$ORDER(PSALOCA(PSALOCN))
if PSALOCN=""
QUIT
Begin DoDot:1
+3 SET PSALOC=0
FOR
SET PSALOC=$ORDER(PSALOCA(PSALOCN,PSALOC))
if 'PSALOC
QUIT
Begin DoDot:2
+4 SET PSACNT=PSACNT+1
SET PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
+5 WRITE !,$JUSTIFY(PSACNT,2)_"."
if $LENGTH(PSALOCN)>72
WRITE ?4,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?21,$PIECE(PSALOCN,"(IP)",2)
if $LENGTH(PSALOCN)<73
WRITE ?4,PSALOCN
End DoDot:2
End DoDot:1
+6 WRITE !!
KILL DIR
SET DIR(0)="NO^1:"_PSACNT
SET DIR("A")="Pharmacy Location"
SET DIR("?")="Select the pharmacy location to be edited"
SET DIR("??")="^D PL^PSALEVEL"
+7 DO ^DIR
KILL DIR
IF Y=""
IF PSAMVNUM
SET PSABEG=1
QUIT
+8 IF Y=""
IF 'PSAMVNUM
SET PSAOUT=1
QUIT
+9 IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+10 SET PSASEL=Y
SET PSALOCN=$ORDER(PSAMENU(PSASEL,""))
if PSALOCN=""
QUIT
+11 SET PSALOC=$ORDER(PSAMENU(PSASEL,PSALOCN,0))
if 'PSALOC
QUIT
+12 WRITE @IOF,!?16,"<< ENTER/EDIT STOCK AND REORDER LEVELS SCREEN >>"
+13 WRITE !?28,"<< PHARMACY LOCATION >>",!!
+14 IF $LENGTH(PSALOCN)>76
WRITE $PIECE(PSALOCN,"(IP)",1)_"(IP)",!?20,$PIECE(PSALOCN,"(IP)",2)
+15 if $LENGTH(PSALOCN)<77
WRITE PSALOCN
WRITE !,PSASLN,!
+16 QUIT
+17 ;
CHO ;Extended help for "Enter/edit levels for pharmacy location or master vault."
+1 WRITE !?5,"Enter P to add or edit stock and reorder levels in a pharmacy location.",!?5,"Enter M to add or edit stock and reorder levels in a master vault."
+2 WRITE !!?5,"After making your selection, you will be given a list of active pharmacy",!?5,"locations or master vaults from which to choose."
+3 QUIT
MV ;Extended help for "Select Master Vault"
+1 WRITE !?5,"Enter the numbers of master vaults from the list. Select the ones that",!?5,"contain drugs you want to add or edit stock and reorder levels."
+2 QUIT
PL ;Extended help for "Select Pharmacy Location"
+1 WRITE !?5,"Enter the numbers of pharmacy locations from the list. Select the ones that",!?5,"contain drugs you want to add or edit stock and reorder levels."
+2 QUIT
