PSAPROC ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data ;10/9/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,70**; 10/24/97;Build 12
;This routine assigns a pharmacy location or master vault to all invoices.
;
N PSALCK S (PSALCK,PSAOUT)=1 D EXIT K PSAOUT,PSALCK ;Kill all option variables
I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
ESIG D SIG^XUSESIG I X1="" S PSAOUT=1 G EXIT
S PSASLN="",$P(PSASLN,"-",80)="",PSADLN="",$P(PSADLN,"=",80)="",(PSACNT,PSACTRL,PSAOUT)=0
;DAVE B (PSA*3*12) 12MAY99 Multi-divisional select
D DAVE
;
CNT ;Count invoices that need a pharm location or master vault assigned.
F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL="" D
.Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
.I $G(PSASORT)'=0,$G(PSASORT)'="",$D(^XTMP("PSAPV",PSACTRL,"ST")),$P(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT Q
.S PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
.;DAVE B (PSA*3*21)
.K PSAINVDL D ^PSAPTCH Q:$D(PSAINVDL)
.I $P(PSAIN,"^",10)="ALL CS",$P(PSAIN,"^",12)="" S PSACNT=PSACNT+1,PSACS(PSACTRL)="" Q
.I $P(PSAIN,"^",10)'="ALL CS" D
..I $P(PSAIN,"^",9)="CS" S:$P(PSAIN,"^",7)="" PSANCS(PSACTRL)="" S:$P(PSAIN,"^",12)="" PSACS(PSACTRL)="" S:$P(PSAIN,"^",7)=""!($P(PSAIN,"^",12)="") PSACNT=PSACNT+1 Q
..I $P(PSAIN,"^",9)="",$P(PSAIN,"^",7)="" S PSACNT=PSACNT+1,PSANCS(PSACTRL)=""
I 'PSACNT D ^PSAPROC1 G EXIT
;
LOC ;Gets 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 PSACOMB=$S('$D(PSACOMB):"NO COMBINED IP/OP",1:PSACOMB),PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
;
;Gets master vaults
S (PSAMVN,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)),"^")="")
.I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
.S PSAMVN=PSAMVN+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
;PSA*3*22 (Set PSDOUT on next line to avoid automatic stuffing
I 'PSANUM D NONE S PSAOUT=1 G EXIT
I PSANUM=1 D ONE Q:PSAOUT
I PSANUM>1 D MANY Q:PSAOUT
D ^PSAPROC1 G EXIT
;
NONE ;No DA pharmacy locations
W !!,"There are no Drug Accountability pharmacy locations.",!!,"Use the Set Up/Edit a Pharmacy Location option on Pharmacy Location Maintenance"
W !,"Menu to setup one or more pharmacy locations. Then select the Process Uploaded",!,"Prime Vendor Invoice Data option to process the invoices."
D END S PSA=$O(PSACS("")) D:PSA'="" MASTER,END
Q
;
ONE ;Only one location
S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
W !!,"The invoices are being assigned to the pharmacy location. Please wait."
S PSACTRL="" F S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL="" D
.Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
.S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSACNT=1 W "."
H 1 S PSA=$O(PSACS("")) D:PSA'="" MASTER
Q
;
MANY ;If more than one pharmacy location, display invoices.
S PSACTRL="" F S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL="" D Q:PSAOUT
.Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
.S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2)
.D DISPLOC
.W !,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
.W:$D(PSACS(PSACTRL)) !,"Some controlled substances" D SELECT
S PSA=$O(PSACS("")) D:PSA'="" MASTER,END K PSAMENU,PSALOCA
Q
;
DISPLOC ;Displays the active pharmacy locations.
W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
S (PSACNT,PSASTOP)=0,PSALOCN=""
F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN=""!(PSASTOP) D
.S PSALOC=0 F S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC!(PSASTOP) D
..S PSACNT=PSACNT+1,PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
..I $Y+3>IOSL D HDR I PSAOUT S PSAOUT=0,PSASTOP=1 Q
..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 PSASTOP
Q
;
HDR D END
W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
Q
;
SELECT ;Select the Pharmacy Location to be assigned to the order.
W ! K DIR S DIR(0)="NO^1:"_PSACNT,DIR("A")="Pharmacy Location",DIR("?")="Select the pharmacy location that received the invoice's drugs"
;
;DAVE B (PSA*3*12) 2/16/99 Force entering a pharacy location
S DIR("??")="^D PHARM^PSAPROC" D ^DIR K DIR Q:Y="" ;I Y="" W !!?5,"Enter an Up-arrow '^' to abort the process.",! G SELECT
I $G(DIRUT) S PSAOUT=1 Q
S PSASEL=Y,PSALOCN=""
F S PSALOCN=$O(PSAMENU(PSASEL,PSALOCN)) Q:PSALOCN="" D
.S PSALOC=0 F S PSALOC=+$O(PSAMENU(PSASEL,PSALOCN,PSALOC)) Q:'PSALOC D
..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC
Q
;
MASTER ;Assigns invoice to Master Vault
I 'PSAMVN W !!,"No master vaults are set up. You must set up a master vault then",!,"select the Process Uploaded Prime Vendor Invoices Data option." S PSAOUT=1 Q
;
I PSAMVN=1 D H 1 Q
.S PSACTRL=$O(PSACS(""))
.W !!,"The invoices are being assigned to the master vault. Please wait."
.S PSACTRL="" F S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL="" D
..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV W "."
;
I PSAMVN>1 D
.S PSACTRL="" F S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL="" D Q:PSAOUT
..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
..S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2)
..D DISPMV W !,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
..W:$P(PSAIN,"^",10)="ALL CS" !,"** All controlled substances"
..W:$P(PSAIN,"^",10)'="ALL CS" !,"** Some controlled substances"
..D SELMV
Q
;
DISPMV ;Displays active master vaults
W @IOF,!?22,"<<< ASSIGN A MASTER VAULT SCREEN >>>",!,PSASLN
S PSA=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 PSA=PSA+1,PSAVAULT(PSA,PSAMVA,PSAMVIEN)=""
..W !,$J(PSA,2)_".",?4,PSAMVA
W !
Q
;
SELMV ;Select displayed master vaults
W ! S DIR(0)="NO^1:"_PSA,DIR("A")="Select Master Vault",DIR("?")="Select the Master Vault that received the invoice's drugs"
;
;DAVE B (PSA*3*12) 2/16/99 Force entry of MV
S DIR("??")="^D MV^PSAPROC" D ^DIR K DIR Q:Y="" ;I Y="" W !!?5,"A Master Vault must be selected. Otherwise enter an up-arrow '^' to abort.",! G SELMV
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 $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAMVIEN
Q
;
END ;Holds screen
S PSASS=21-$Y F PSAKK=1:1:PSASS W !
S DIR(0)="E" D ^DIR K DIR S:$G(DIRUT) PSAOUT=1 W @IOF
Q
;
EXIT ;Kills processing variables
I $G(PSAENTRY) D PRINT2^PSAUP
D:($G(PSALCK)!($G(PSAOUT))) PSAUNLCK^PSAPROC8 ;; < PSA*3*70 RJS
;
;DAVE B (PSA*3*12) replaced '$D with '$G on next line
K DA,DIC,DIE,DIK,DIR,DIRUT,DR,DTOUT,DUOUT,PSA,PSABEFOR,PSACHG,PSACHO,PSACNT,PSACNT1,PSACNTER,PSACNTOK,PSACOMB,PSACONT,PSACS,PSACTRL,PSAREA,PSAFLD
K PSADRG1,PSASORT
K PSAD0,PSAD1,PSAD2,PSAD3,PSAD4,PSAD5,PSAD6,PSADATA,PSADIFF,PSADISP,PSADJQTY,PSADLN,PSADONE,PSADU,PSAENTRY,PSAERR,PSAFLDS,PSAFND,PSAFPR,PSAGET,PSAHDR
K PSAIEN,PSAIEN3,PSAIEN50,PSAIN,PSAINV,PSAIPR,PSAISIT,PSAISITN,PSAJUST,PSAKK,PSALINE,PSALINES,PSALLSUP,PSALN,PSALNCNT,PSALNSU,PSALOC,PSALOCA,PSALOCN,PSALOCN
K PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVN,PSANCS,PSANDC,PSANEXT,PSANODE,PSANUM,PSAOK,PSAONE,PSAONEMV,PSAORD,PSAOSIT,PSAOSITN,PSAOUT,PSAPASS,PSAPC,PSAPCF,PSAPCL,PSAPHARM,PSAPICK,PSAPRICE,PSAPTR
K PSARECD,PSAREORD,PSASAME,PSASEL,PSASEL1,PSASKIP,PSASLN,PSASNODE,PSASS,PSASSUB,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSASYN,PSAVAPN,PSAVAULT,PSAVSN,X1,Y,ZTDTH,ZTIO
Q
;
MV ;Extended help for the select "Master Vault" prompt
W !?5,"Enter the number of the master vault for which you want to assign",!?5,"the order. The invoiced drugs in the assigned master vault will be"
W !?5,"incremented with the quantity received after the order is verified."
Q
PHARM ;Extended help for the select "Pharmacy Location" prompt
W !?5,"Enter the number of the pharmacy location for which you want to assign",!?5,"the order. The invoiced drugs in the assigned pharmacy location will be"
W !?5,"incremented with the quantity received after the order is verified."
Q
DAVE ;Select division
S (CNT,CNTR,DIV,PSASORT)=0
S X=0 F S X=$O(^XTMP("PSAPV",X)) Q:X="" I $D(^XTMP("PSAPV",X,"ST")) S DATA=^XTMP("PSAPV",X,"ST"),DIV($P(DATA,"^"))=""
Q:$O(DIV(0))="" S (CNT,CNTR)=0,DIR(0)="S^" F S CNT=$G(CNT)+1,CNTR=$O(DIV(CNTR)) Q:CNTR="" S DIR(0)=DIR(0)_CNT_":"_CNTR_";"
Q:$L(DIR(0))'>2 S XX=$L(DIR(0)),XX=XX-1,XXX=$E(DIR(0),1,XX),DIR(0)=XXX
K X,XX,XXX,CNT,CNTR,DIV
W !!,"You have invoices on your system for more than one division.",!,"Please select the location for which you want to process invoices.",!,"or Press the up-arrow to process all invoices."
D ^DIR S:+Y>0 PSASORT=Y(0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAPROC 9164 printed Sep 23, 2025@19:26:06 Page 2
PSAPROC ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data ;10/9/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,70**; 10/24/97;Build 12
+2 ;This routine assigns a pharmacy location or master vault to all invoices.
+3 ;
+4 ;Kill all option variables
NEW PSALCK
SET (PSALCK,PSAOUT)=1
DO EXIT
KILL PSAOUT,PSALCK
+5 IF '$DATA(^XUSEC("PSA ORDERS",DUZ))
WRITE !,"You do not hold the key to enter the option."
QUIT
ESIG DO SIG^XUSESIG
IF X1=""
SET PSAOUT=1
GOTO EXIT
+1 SET PSASLN=""
SET $PIECE(PSASLN,"-",80)=""
SET PSADLN=""
SET $PIECE(PSADLN,"=",80)=""
SET (PSACNT,PSACTRL,PSAOUT)=0
+2 ;DAVE B (PSA*3*12) 12MAY99 Multi-divisional select
+3 DO DAVE
+4 ;
CNT ;Count invoices that need a pharm location or master vault assigned.
+1 FOR
SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:1
+2 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+3 IF $GET(PSASORT)'=0
IF $GET(PSASORT)'=""
IF $DATA(^XTMP("PSAPV",PSACTRL,"ST"))
IF $PIECE(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT
QUIT
+4 SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+5 ;DAVE B (PSA*3*21)
+6 KILL PSAINVDL
DO ^PSAPTCH
if $DATA(PSAINVDL)
QUIT
+7 IF $PIECE(PSAIN,"^",10)="ALL CS"
IF $PIECE(PSAIN,"^",12)=""
SET PSACNT=PSACNT+1
SET PSACS(PSACTRL)=""
QUIT
+8 IF $PIECE(PSAIN,"^",10)'="ALL CS"
Begin DoDot:2
+9 IF $PIECE(PSAIN,"^",9)="CS"
if $PIECE(PSAIN,"^",7)=""
SET PSANCS(PSACTRL)=""
if $PIECE(PSAIN,"^",12)=""
SET PSACS(PSACTRL)=""
if $PIECE(PSAIN,"^",7)=""!($PIECE(PSAIN,"^",12)="")
SET PSACNT=PSACNT+1
QUIT
+10 IF $PIECE(PSAIN,"^",9)=""
IF $PIECE(PSAIN,"^",7)=""
SET PSACNT=PSACNT+1
SET PSANCS(PSACTRL)=""
End DoDot:2
End DoDot:1
+11 IF 'PSACNT
DO ^PSAPROC1
GOTO EXIT
+12 ;
LOC ;Gets pharmacy locations
+1 SET (PSALOC,PSANUM)=0
FOR
SET PSALOC=+$ORDER(^PSD(58.8,"ADISP","P",PSALOC))
if 'PSALOC
QUIT
Begin DoDot:1
+2 if '$DATA(^PSD(58.8,PSALOC,0))!($PIECE($GET(^PSD(58.8,PSALOC,0)),"^")="")
QUIT
+3 IF +$GET(^PSD(58.8,PSALOC,"I"))
IF +^PSD(58.8,PSALOC,"I")'>DT
QUIT
+4 SET PSANUM=PSANUM+1
SET PSAONE=PSALOC
SET PSAISIT=+$PIECE(^PSD(58.8,PSALOC,0),"^",3)
SET PSAOSIT=+$PIECE(^(0),"^",10)
+5 DO SITES^PSAUTL1
SET PSACOMB=$SELECT('$DATA(PSACOMB):"NO COMBINED IP/OP",1:PSACOMB)
SET PSALOCA($PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
End DoDot:1
+6 ;
+7 ;Gets master vaults
+8 SET (PSAMVN,PSAMV)=0
FOR
SET PSAMV=+$ORDER(^PSD(58.8,"ADISP","M",PSAMV))
if 'PSAMV
QUIT
Begin DoDot:1
+9 if '$DATA(^PSD(58.8,PSAMV,0))!($PIECE($GET(^PSD(58.8,PSAMV,0)),"^")="")
QUIT
+10 IF +$GET(^PSD(58.8,PSAMV,"I"))
IF +^PSD(58.8,PSAMV,"I")'>DT
QUIT
+11 SET PSAMVN=PSAMVN+1
SET PSAONEMV=PSAMV
SET PSAMV($PIECE(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
End DoDot:1
+12 ;PSA*3*22 (Set PSDOUT on next line to avoid automatic stuffing
+13 IF 'PSANUM
DO NONE
SET PSAOUT=1
GOTO EXIT
+14 IF PSANUM=1
DO ONE
if PSAOUT
QUIT
+15 IF PSANUM>1
DO MANY
if PSAOUT
QUIT
+16 DO ^PSAPROC1
GOTO EXIT
+17 ;
NONE ;No DA pharmacy locations
+1 WRITE !!,"There are no Drug Accountability pharmacy locations.",!!,"Use the Set Up/Edit a Pharmacy Location option on Pharmacy Location Maintenance"
+2 WRITE !,"Menu to setup one or more pharmacy locations. Then select the Process Uploaded",!,"Prime Vendor Invoice Data option to process the invoices."
+3 DO END
SET PSA=$ORDER(PSACS(""))
if PSA'=""
DO MASTER
DO END
+4 QUIT
+5 ;
ONE ;Only one location
+1 SET PSACNT=0
SET PSALOC=PSAONE
SET PSALOCN=$ORDER(PSALOCA(""))
+2 WRITE !!,"The invoices are being assigned to the pharmacy location. Please wait."
+3 SET PSACTRL=""
FOR
SET PSACTRL=$ORDER(PSANCS(PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:1
+4 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+5 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC
SET PSACNT=1
WRITE "."
End DoDot:1
+6 HANG 1
SET PSA=$ORDER(PSACS(""))
if PSA'=""
DO MASTER
+7 QUIT
+8 ;
MANY ;If more than one pharmacy location, display invoices.
+1 SET PSACTRL=""
FOR
SET PSACTRL=$ORDER(PSANCS(PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:1
+2 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+3 SET PSAIN=$GET(^XTMP("PSAPV",PSACTRL,"IN"))
SET PSAORD=$PIECE(PSAIN,"^",4)
SET PSAINV=$PIECE(PSAIN,"^",2)
+4 DO DISPLOC
+5 WRITE !,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
+6 if $DATA(PSACS(PSACTRL))
WRITE !,"Some controlled substances"
DO SELECT
End DoDot:1
if PSAOUT
QUIT
+7 SET PSA=$ORDER(PSACS(""))
if PSA'=""
DO MASTER
DO END
KILL PSAMENU,PSALOCA
+8 QUIT
+9 ;
DISPLOC ;Displays the active pharmacy locations.
+1 WRITE @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
+2 SET (PSACNT,PSASTOP)=0
SET PSALOCN=""
+3 FOR
SET PSALOCN=$ORDER(PSALOCA(PSALOCN))
if PSALOCN=""!(PSASTOP)
QUIT
Begin DoDot:1
+4 SET PSALOC=0
FOR
SET PSALOC=$ORDER(PSALOCA(PSALOCN,PSALOC))
if 'PSALOC!(PSASTOP)
QUIT
Begin DoDot:2
+5 SET PSACNT=PSACNT+1
SET PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
+6 IF $Y+3>IOSL
DO HDR
IF PSAOUT
SET PSAOUT=0
SET PSASTOP=1
QUIT
+7 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
+8 WRITE !
KILL PSASTOP
+9 QUIT
+10 ;
HDR DO END
+1 WRITE @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
+2 QUIT
+3 ;
SELECT ;Select the Pharmacy Location to be assigned to the order.
+1 WRITE !
KILL DIR
SET DIR(0)="NO^1:"_PSACNT
SET DIR("A")="Pharmacy Location"
SET DIR("?")="Select the pharmacy location that received the invoice's drugs"
+2 ;
+3 ;DAVE B (PSA*3*12) 2/16/99 Force entering a pharacy location
+4 ;I Y="" W !!?5,"Enter an Up-arrow '^' to abort the process.",! G SELECT
SET DIR("??")="^D PHARM^PSAPROC"
DO ^DIR
KILL DIR
if Y=""
QUIT
+5 IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+6 SET PSASEL=Y
SET PSALOCN=""
+7 FOR
SET PSALOCN=$ORDER(PSAMENU(PSASEL,PSALOCN))
if PSALOCN=""
QUIT
Begin DoDot:1
+8 SET PSALOC=0
FOR
SET PSALOC=+$ORDER(PSAMENU(PSASEL,PSALOCN,PSALOC))
if 'PSALOC
QUIT
Begin DoDot:2
+9 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
MASTER ;Assigns invoice to Master Vault
+1 IF 'PSAMVN
WRITE !!,"No master vaults are set up. You must set up a master vault then",!,"select the Process Uploaded Prime Vendor Invoices Data option."
SET PSAOUT=1
QUIT
+2 ;
+3 IF PSAMVN=1
Begin DoDot:1
+4 SET PSACTRL=$ORDER(PSACS(""))
+5 WRITE !!,"The invoices are being assigned to the master vault. Please wait."
+6 SET PSACTRL=""
FOR
SET PSACTRL=$ORDER(PSACS(PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:2
+7 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+8 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV
WRITE "."
End DoDot:2
End DoDot:1
HANG 1
QUIT
+9 ;
+10 IF PSAMVN>1
Begin DoDot:1
+11 SET PSACTRL=""
FOR
SET PSACTRL=$ORDER(PSACS(PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:2
+12 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+13 SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
SET PSAORD=$PIECE(PSAIN,"^",4)
SET PSAINV=$PIECE(PSAIN,"^",2)
+14 DO DISPMV
WRITE !,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
+15 if $PIECE(PSAIN,"^",10)="ALL CS"
WRITE !,"** All controlled substances"
+16 if $PIECE(PSAIN,"^",10)'="ALL CS"
WRITE !,"** Some controlled substances"
+17 DO SELMV
End DoDot:2
if PSAOUT
QUIT
End DoDot:1
+18 QUIT
+19 ;
DISPMV ;Displays active master vaults
+1 WRITE @IOF,!?22,"<<< ASSIGN A MASTER VAULT SCREEN >>>",!,PSASLN
+2 SET PSA=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 PSA=PSA+1
SET PSAVAULT(PSA,PSAMVA,PSAMVIEN)=""
+5 WRITE !,$JUSTIFY(PSA,2)_".",?4,PSAMVA
End DoDot:2
End DoDot:1
+6 WRITE !
+7 QUIT
+8 ;
SELMV ;Select displayed master vaults
+1 WRITE !
SET DIR(0)="NO^1:"_PSA
SET DIR("A")="Select Master Vault"
SET DIR("?")="Select the Master Vault that received the invoice's drugs"
+2 ;
+3 ;DAVE B (PSA*3*12) 2/16/99 Force entry of MV
+4 ;I Y="" W !!?5,"A Master Vault must be selected. Otherwise enter an up-arrow '^' to abort.",! G SELMV
SET DIR("??")="^D MV^PSAPROC"
DO ^DIR
KILL DIR
if Y=""
QUIT
+5 IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+6 ;
+7 ;
+8 SET PSASEL=Y
+9 SET PSAMVA=$ORDER(PSAVAULT(PSASEL,""))
if PSAMVA=""
QUIT
SET PSAMVIEN=+$ORDER(PSAVAULT(PSASEL,PSAMVA,0))
if 'PSAMVIEN
QUIT
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAMVIEN
+10 QUIT
+11 ;
END ;Holds screen
+1 SET PSASS=21-$Y
FOR PSAKK=1:1:PSASS
WRITE !
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
if $GET(DIRUT)
SET PSAOUT=1
WRITE @IOF
+3 QUIT
+4 ;
EXIT ;Kills processing variables
+1 IF $GET(PSAENTRY)
DO PRINT2^PSAUP
+2 ;; < PSA*3*70 RJS
if ($GET(PSALCK)!($GET(PSAOUT)))
DO PSAUNLCK^PSAPROC8
+3 ;
+4 ;DAVE B (PSA*3*12) replaced '$D with '$G on next line
+5 KILL DA,DIC,DIE,DIK,DIR,DIRUT,DR,DTOUT,DUOUT,PSA,PSABEFOR,PSACHG,PSACHO,PSACNT,PSACNT1,PSACNTER,PSACNTOK,PSACOMB,PSACONT,PSACS,PSACTRL,PSAREA,PSAFLD
+6 KILL PSADRG1,PSASORT
+7 KILL PSAD0,PSAD1,PSAD2,PSAD3,PSAD4,PSAD5,PSAD6,PSADATA,PSADIFF,PSADISP,PSADJQTY,PSADLN,PSADONE,PSADU,PSAENTRY,PSAERR,PSAFLDS,PSAFND,PSAFPR,PSAGET,PSAHDR
+8 KILL PSAIEN,PSAIEN3,PSAIEN50,PSAIN,PSAINV,PSAIPR,PSAISIT,PSAISITN,PSAJUST,PSAKK,PSALINE,PSALINES,PSALLSUP,PSALN,PSALNCNT,PSALNSU,PSALOC,PSALOCA,PSALOCN,PSALOCN
+9 KILL PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVN,PSANCS,PSANDC,PSANEXT,PSANODE,PSANUM,PSAOK,PSAONE,PSAONEMV,PSAORD,PSAOSIT,PSAOSITN,PSAOUT,PSAPASS,PSAPC,PSAPCF,PSAPCL,PSAPHARM,PSAPICK,PSAPRICE,PSAPTR
+10 KILL PSARECD,PSAREORD,PSASAME,PSASEL,PSASEL1,PSASKIP,PSASLN,PSASNODE,PSASS,PSASSUB,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSASYN,PSAVAPN,PSAVAULT,PSAVSN,X1,Y,ZTDTH,ZTIO
+11 QUIT
+12 ;
MV ;Extended help for the select "Master Vault" prompt
+1 WRITE !?5,"Enter the number of the master vault for which you want to assign",!?5,"the order. The invoiced drugs in the assigned master vault will be"
+2 WRITE !?5,"incremented with the quantity received after the order is verified."
+3 QUIT
PHARM ;Extended help for the select "Pharmacy Location" prompt
+1 WRITE !?5,"Enter the number of the pharmacy location for which you want to assign",!?5,"the order. The invoiced drugs in the assigned pharmacy location will be"
+2 WRITE !?5,"incremented with the quantity received after the order is verified."
+3 QUIT
DAVE ;Select division
+1 SET (CNT,CNTR,DIV,PSASORT)=0
+2 SET X=0
FOR
SET X=$ORDER(^XTMP("PSAPV",X))
if X=""
QUIT
IF $DATA(^XTMP("PSAPV",X,"ST"))
SET DATA=^XTMP("PSAPV",X,"ST")
SET DIV($PIECE(DATA,"^"))=""
+3 if $ORDER(DIV(0))=""
QUIT
SET (CNT,CNTR)=0
SET DIR(0)="S^"
FOR
SET CNT=$GET(CNT)+1
SET CNTR=$ORDER(DIV(CNTR))
if CNTR=""
QUIT
SET DIR(0)=DIR(0)_CNT_":"_CNTR_";"
+4 if $LENGTH(DIR(0))'>2
QUIT
SET XX=$LENGTH(DIR(0))
SET XX=XX-1
SET XXX=$EXTRACT(DIR(0),1,XX)
SET DIR(0)=XXX
+5 KILL X,XX,XXX,CNT,CNTR,DIV
+6 WRITE !!,"You have invoices on your system for more than one division.",!,"Please select the location for which you want to process invoices.",!,"or Press the up-arrow to process all invoices."
+7 DO ^DIR
if +Y>0
SET PSASORT=Y(0)
+8 QUIT
