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

PSAPROC.m

Go to the documentation of this file. 
  1. PSAPROC ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data ;10/9/97
  1.  ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21**; 10/24/97
  1.  ;This routine assigns a pharmacy location or master vault to all invoices.
  1.  ;
  1.  S PSAOUT=1 D EXIT K PSAOUT ;Kill all option variables
  1.  I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
  1. ESIG D SIG^XUSESIG I X1="" S PSAOUT=1 G EXIT
  1.  S PSASLN="",$P(PSASLN,"-",80)="",PSADLN="",$P(PSADLN,"=",80)="",(PSACNT,PSACTRL,PSAOUT)=0
  1.  ;DAVE B (PSA*3*12) 12MAY99 Multi-divisional select
  1.  D DAVE
  1.  ;
  1. CNT ;Count invoices that need a pharm location or master vault assigned.
  1.  F  S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""  D
  1.  .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1.  .I $G(PSASORT)'=0,$G(PSASORT)'="",$D(^XTMP("PSAPV",PSACTRL,"ST")),$P(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT Q
  1.  .S PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
  1.  .;DAVE B (PSA*3*21)
  1.  .K PSAINVDL D ^PSAPTCH Q:$D(PSAINVDL)
  1.  .I $P(PSAIN,"^",10)="ALL CS",$P(PSAIN,"^",12)="" S PSACNT=PSACNT+1,PSACS(PSACTRL)="" Q
  1.  .I $P(PSAIN,"^",10)'="ALL CS" D
  1.  ..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
  1.  ..I $P(PSAIN,"^",9)="",$P(PSAIN,"^",7)="" S PSACNT=PSACNT+1,PSANCS(PSACTRL)=""
  1.  I 'PSACNT D ^PSAPROC1 G EXIT
  1.  ;
  1. LOC ;Gets pharmacy locations
  1.  S (PSALOC,PSANUM)=0 F  S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC  D
  1.  .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
  1.  .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
  1.  .S PSANUM=PSANUM+1,PSAONE=PSALOC,PSAISIT=+$P(^PSD(58.8,PSALOC,0),"^",3),PSAOSIT=+$P(^(0),"^",10)
  1.  .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
  1.  ;
  1.  ;Gets master vaults
  1.  S (PSAMVN,PSAMV)=0 F  S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV  D
  1.  .Q:'$D(^PSD(58.8,PSAMV,0))!($P($G(^PSD(58.8,PSAMV,0)),"^")="")
  1.  .I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
  1.  .S PSAMVN=PSAMVN+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
  1.  ;PSA*3*22 (Set PSDOUT on next line to avoid automatic stuffing
  1.  I 'PSANUM D NONE S PSAOUT=1 G EXIT
  1.  I PSANUM=1 D ONE Q:PSAOUT
  1.  I PSANUM>1 D MANY Q:PSAOUT
  1.  D ^PSAPROC1 G EXIT
  1.  ;
  1. NONE ;No DA pharmacy locations
  1.  W !!,"There are no Drug Accountability pharmacy locations.",!!,"Use the Set Up/Edit a Pharmacy Location option on Pharmacy Location Maintenance"
  1.  W !,"Menu to setup one or more pharmacy locations. Then select the Process Uploaded",!,"Prime Vendor Invoice Data option to process the invoices."
  1.  D END S PSA=$O(PSACS("")) D:PSA'="" MASTER,END
  1.  Q
  1.  ;
  1. ONE ;Only one location
  1.  S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
  1.  W !!,"The invoices are being assigned to the pharmacy location. Please wait."
  1.  S PSACTRL="" F  S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL=""  D
  1.  .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1.  .S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSACNT=1 W "."
  1.  H 1 S PSA=$O(PSACS("")) D:PSA'="" MASTER
  1.  Q
  1.  ;
  1. MANY ;If more than one pharmacy location, display invoices.
  1.  S PSACTRL="" F  S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL=""  D  Q:PSAOUT
  1.  .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1.  .S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2)
  1.  .D DISPLOC
  1.  .W !,"Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
  1.  .W:$D(PSACS(PSACTRL)) !,"Some controlled substances" D SELECT
  1.  S PSA=$O(PSACS("")) D:PSA'="" MASTER,END K PSAMENU,PSALOCA
  1.  Q
  1.  ;
  1. DISPLOC ;Displays the active pharmacy locations.
  1.  W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
  1.  S (PSACNT,PSASTOP)=0,PSALOCN=""
  1.  F  S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN=""!(PSASTOP)  D
  1.  .S PSALOC=0 F  S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC!(PSASTOP)  D
  1.  ..S PSACNT=PSACNT+1,PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
  1.  ..I $Y+3>IOSL D HDR I PSAOUT S PSAOUT=0,PSASTOP=1 Q
  1.  ..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
  1.  W ! K PSASTOP
  1.  Q
  1.  ;
  1. HDR D END
  1.  W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN
  1.  Q
  1.  ;
  1. SELECT ;Select the Pharmacy Location to be assigned to the order.
  1.  W ! K DIR S DIR(0)="NO^1:"_PSACNT,DIR("A")="Pharmacy Location",DIR("?")="Select the pharmacy location that received the invoice's drugs"
  1.  ;
  1.  ;DAVE B (PSA*3*12) 2/16/99 Force entering a pharacy location
  1.  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
  1.  I $G(DIRUT) S PSAOUT=1 Q
  1.  S PSASEL=Y,PSALOCN=""
  1.  F  S PSALOCN=$O(PSAMENU(PSASEL,PSALOCN)) Q:PSALOCN=""  D
  1.  .S PSALOC=0 F  S PSALOC=+$O(PSAMENU(PSASEL,PSALOCN,PSALOC)) Q:'PSALOC  D
  1.  ..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC
  1.  Q
  1.  ;
  1. MASTER ;Assigns invoice to Master Vault
  1.  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
  1.  ;
  1.  I PSAMVN=1 D  H 1 Q
  1.  .S PSACTRL=$O(PSACS(""))
  1.  .W !!,"The invoices are being assigned to the master vault. Please wait."
  1.  .S PSACTRL="" F  S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL=""  D
  1.  ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1.  ..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV W "."
  1.  ;
  1.  I PSAMVN>1 D
  1.  .S PSACTRL="" F  S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL=""  D  Q:PSAOUT
  1.  ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1.  ..S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2)
  1.  ..D DISPMV W !,"Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
  1.  ..W:$P(PSAIN,"^",10)="ALL CS" !,"** All controlled substances"
  1.  ..W:$P(PSAIN,"^",10)'="ALL CS" !,"** Some controlled substances"
  1.  ..D SELMV
  1.  Q
  1.  ;
  1. DISPMV ;Displays active master vaults
  1.  W @IOF,!?22,"<<< ASSIGN A MASTER VAULT SCREEN >>>",!,PSASLN
  1.  S PSA=0,PSAMVA="" F  S PSAMVA=$O(PSAMV(PSAMVA)) Q:PSAMVA=""  D
  1.  .S PSAMVIEN=0 F  S PSAMVIEN=$O(PSAMV(PSAMVA,PSAMVIEN)) Q:'PSAMVIEN  D
  1.  ..S PSA=PSA+1,PSAVAULT(PSA,PSAMVA,PSAMVIEN)=""
  1.  ..W !,$J(PSA,2)_".",?4,PSAMVA
  1.  W !
  1.  Q
  1.  ;
  1. SELMV ;Select displayed master vaults
  1.  W ! S DIR(0)="NO^1:"_PSA,DIR("A")="Select Master Vault",DIR("?")="Select the Master Vault that received the invoice's drugs"
  1.  ;
  1.  ;DAVE B (PSA*3*12) 2/16/99 Force entry of MV
  1.  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
  1.  I $G(DIRUT) S PSAOUT=1 Q
  1.  ;
  1.  ;
  1.  S PSASEL=Y
  1.  S PSAMVA=$O(PSAVAULT(PSASEL,"")) Q:PSAMVA=""  S PSAMVIEN=+$O(PSAVAULT(PSASEL,PSAMVA,0)) Q:'PSAMVIEN  S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAMVIEN
  1.  Q
  1.  ;
  1. END ;Holds screen
  1.  S PSASS=21-$Y F PSAKK=1:1:PSASS W !
  1.  S DIR(0)="E" D ^DIR K DIR S:$G(DIRUT) PSAOUT=1 W @IOF
  1.  Q
  1.  ;
  1. EXIT ;Kills processing variables
  1.  D:$G(PSAENTRY) PRINT2^PSAUP
  1.  ;
  1.  ;DAVE B (PSA*3*12) replaced '$D with '$G on next line
  1.  K DA,DIC,DIE,DIK,DIR,DIRUT,DR,DTOUT,DUOUT,PSA,PSABEFOR,PSACHG,PSACHO,PSACNT,PSACNT1,PSACNTER,PSACNTOK,PSACOMB,PSACONT,PSACS,PSACTRL,PSAREA,PSAFLD
  1.  K PSADRG1,PSASORT
  1.  K PSAD0,PSAD1,PSAD2,PSAD3,PSAD4,PSAD5,PSAD6,PSADATA,PSADIFF,PSADISP,PSADJQTY,PSADLN,PSADONE,PSADU,PSAENTRY,PSAERR,PSAFLDS,PSAFND,PSAFPR,PSAGET,PSAHDR
  1.  K PSAIEN,PSAIEN3,PSAIEN50,PSAIN,PSAINV,PSAIPR,PSAISIT,PSAISITN,PSAJUST,PSAKK,PSALINE,PSALINES,PSALLSUP,PSALN,PSALNCNT,PSALNSU,PSALOC,PSALOCA,PSALOCN,PSALOCN
  1.  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
  1.  K PSARECD,PSAREORD,PSASAME,PSASEL,PSASEL1,PSASKIP,PSASLN,PSASNODE,PSASS,PSASSUB,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSASYN,PSAVAPN,PSAVAULT,PSAVSN,X1,Y,ZTDTH,ZTIO
  1.  Q
  1.  ;
  1. MV ;Extended help for the select "Master Vault" prompt
  1.  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"
  1.  W !?5,"incremented with the quantity received after the order is verified."
  1.  Q
  1. PHARM ;Extended help for the select "Pharmacy Location" prompt
  1.  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"
  1.  W !?5,"incremented with the quantity received after the order is verified."
  1.  Q
  1. DAVE ;Select division
  1.  S (CNT,CNTR,DIV,PSASORT)=0
  1.  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,"^"))=""
  1.  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_";"
  1.  Q:$L(DIR(0))'>2  S XX=$L(DIR(0)),XX=XX-1,XXX=$E(DIR(0),1,XX),DIR(0)=XXX
  1.  K X,XX,XXX,CNT,CNTR,DIV
  1.  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."
  1.  D ^DIR S:+Y>0 PSASORT=Y(0)
  1.  Q