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

PSAPROC9.m

Go to the documentation of this file. 
  1. PSAPROC9 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;8/19/97
  1.  ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**39**; 10/24/97
  1.  ;This routine processes the line item when the user selects automatic
  1.  ;processing.
  1.  ;
  1.  S (PSACONT,PSADU,PSANEXT)=0
  1.  I '+$P(PSADATA,"^",6),PSANDC="" D  Q:PSAOUT  G:PSANEXT NEXT
  1.  .I +$P($P(PSADATA,"^",5),"~",2) D MANYVSNS^PSAPROC4 D:PSAOUT CONT Q
  1.  .I PSAVSN="" D  Q:PSAOUT  G:PSANEXT NEXT
  1.  ..I +$P($P(PSADATA,"^",26),"~",2) D ^PSAPROC5 D:PSAOUT CONT Q
  1.  ..I +$P($P(PSADATA,"^",26),"~",3) D SUPDIFF^PSAPROC5 D:PSAOUT CONT
  1.  I '+$P(PSADATA,"^",6),'+$P(PSADATA,"^",15),PSANDC'="" D ^PSANDF D:PSAOUT CONT Q:PSAOUT
  1.  I PSANDC'="" D  Q:PSAOUT  G:PSANEXT NEXT
  1.  .I +$P($P(PSADATA,"^",4),"~",2) D MANYNDCS^PSAPROC4 D:PSAOUT CONT Q
  1.  .I $P($P(PSADATA,"^",4),"~",3)'="" D VSNDIFF^PSAPROC5 D:PSAOUT CONT
  1.  I +$P($P(PSADATA,"^",5),"~",2) D MANYVSNS^PSAPROC4 D:PSAOUT CONT Q:PSAOUT  G:PSANEXT NEXT
  1.  ;VMP OIFO BAY PINES;VGF;PSA*3.0*39
  1.  I $P($P(PSADATA,"^",5),"~",3)]"" D NDCDIFF^PSAPROC5 D:PSAOUT CONT Q:PSAOUT
  1. NEXT Q:PSACONT
  1.  S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
  1.  I '+$P(PSADATA,"^",6),'+$P(PSADATA,"^",15),'$D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")) D:'$G(PSAPASS) ASKDRUG^PSANDF D:PSAOUT CONT Q:PSAOUT  S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
  1.  Q:$G(PSAPASS)
  1.  I $G(PSASUPP) S PSALINES=PSALINES+1 Q
  1.  S PSAIEN=$S(+$P(PSADATA,"^",15):+$P(PSADATA,"^",15),1:+$P(PSADATA,"^",6))
  1.  I PSAIEN S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)=$S($P($G(^PSDRUG(PSAIEN,2)),"^",3)["N":"CS",1:"")
  1.  I PSAIEN,PSANDC'="" S PSASUB=0 F  S PSASUB=$O(^PSDRUG("C",PSANDC,PSAIEN,PSASUB)) Q:'PSASUB  I $P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^")=PSANDC Q
  1.  S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",7)=$S(+$G(PSASUB):PSASUB,1:"0~1")
  1. QTY I '+PSADATA,$P(PSADATA,"^",8)="" D QTY^PSAPROC3 D:PSAOUT CONT Q:PSAOUT
  1. OU I '+$P($P(PSADATA,"^",2),"~",2),'+$P(PSADATA,"^",12) D  D:PSAOUT CONT Q:PSAOUT
  1.  .I PSAIEN,PSASUB,'$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5) D GETOU^PSAPROC3 Q
  1.  .I PSAIEN,'PSASUB D GETOU^PSAPROC3
  1. DU I PSAIEN,$P($G(^PSDRUG(PSAIEN,660)),"^",8)="" D DU^PSAPROC8 D:PSAOUT CONT Q:PSAOUT
  1. DUOU ;If drug has synonym & no conv factor set conv factor in 50.
  1.  I PSAIEN,PSASUB,$D(^PSDRUG(PSAIEN,1,PSASUB,0)),'+$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",7),'+$P(PSADATA,"^",20) D DUOU^PSAPROC8 D:PSAOUT CONT Q:PSAOUT
  1.  ;If drug doesn't have synonym & disp units/order unit, store disp units/order unit in XTMP.
  1.  I PSAIEN,'PSASUB,'+$P(PSADATA,"^",20) D DUOU^PSAPROC3 D:PSAOUT CONT Q:PSAOUT
  1. PRICE I '+$P(PSADATA,"^",3) D PRICE^PSAPROC3 D:PSAOUT CONT Q:PSAOUT
  1. NOTCS ;If drug is not a CS & no stock level/reorder level, store in XTMP.
  1.  S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
  1.  I $P(PSADATA,"^",19)'="CS" D  Q:PSAOUT
  1.  .I '+$P(PSAIN,"^",7) D GETLOC D EDITDISP^PSAUTL1,END^PSAPROC D:PSAOUT CONT Q:PSAOUT
  1.  .I $P(PSADATA,"^",19)'="CS",+$P(PSAIN,"^",7),+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),0)),"^",14) D  Q:PSAOUT
  1.  ..I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",3),'+$P(PSADATA,"^",27) S PSALOC=$P(PSAIN,"^",7) D STOCK^PSAPROC8 D:PSAOUT CONT Q:PSAOUT
  1.  ..I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",5),'+$P(PSADATA,"^",21) S PSALOC=$P(PSAIN,"^",7) D REORDER^PSAPROC8 D:PSAOUT CONT
  1. CS ;If drug is a CS & no stock level/reorder level, store in XTMP.
  1.  I $P(PSADATA,"^",19)="CS" D  Q:PSAOUT
  1.  .S PSACS=PSACS+1
  1.  .I '+$P(PSAIN,"^",12) D MASTER D EDITDISP^PSAUTL1,END^PSAPROC D:PSAOUT CONT Q:PSAOUT
  1.  .I +$P(PSAIN,"^",12),+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),0)),"^",14) D  Q:PSAOUT
  1.  ..I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",3),'+$P(PSADATA,"^",27) S PSALOC=$P(PSAIN,"^",12) D STOCK^PSAPROC8 S PSALOC=+$P(PSAIN,"^",7),PSAMV=+$P(PSAIN,"^",12) D:PSAOUT CONT Q:PSAOUT
  1.  ..I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",5),'+$P(PSADATA,"^",21) S PSALOC=$P(PSAIN,"^",12) D REORDER^PSAPROC8 S PSALOC=+$P(PSAIN,"^",7),PSAMV=+$P(PSAIN,"^",12) D:PSAOUT CONT
  1.  D CHECK^PSANDF D:PSAOUT CONT Q:PSAOUT  D SETLINE^PSAPROC3 W !
  1.  Q
  1.  ;
  1. CONT ;Asks if user wants to continue processing invoice.
  1.  S PSAINV=$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",2)
  1.  W ! S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to continue processing invoice# "_PSAINV,DIR("?")="Enter YES to process the next line item.",DIR("?")="Enter NO to stop processing the invoice.",DIR("??")="^D CONTYN^PSAPROC9"
  1.  D ^DIR K DIR S PSACONT=Y Q:$G(DIRUT)!('Y)
  1.  S PSAOUT=0
  1.  Q
  1. MASTER ;Assigns invoice to Master Vault
  1.  S PSAINV=$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",2)
  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.  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.  I PSAMVN=1 D  Q
  1.  .S PSAMV=PSAONEMV
  1.  .W @IOF,!?22,"<<< ASSIGN A MASTER VAULT SCREEN >>>"
  1.  .W !!,"Controlled substances on the invoice has been",!,"automatically assigned to the Master Vault."
  1.  .W !!,$P(^PSD(58.8,PSAMV,0),"^"),!,PSASLN
  1.  .W !,"Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
  1.  .S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAMV,PSAIN=^("IN")
  1.  .D END^PSAPROC
  1.  I PSAMVN>1 D DISPMV W !,"Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(+PSAIN) 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.  S DIR("??")="^D MV^PSAPROC" D ^DIR K DIR Q:Y=""  I $G(DIRUT) S PSAOUT=1 Q
  1.  S PSASEL1=Y
  1.  S PSAMVA=$O(PSAVAULT(PSASEL1,"")) Q:PSAMVA=""  S PSAMVIEN=+$O(PSAVAULT(PSASEL1,PSAMVA,0)) Q:'PSAMVIEN  S PSAMV=PSAMVIEN,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAMV,PSAIN=^("IN")
  1.  Q
  1.  ;
  1. GETLOC ;Gets pharmacy locations
  1.  S PSAINV=$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",2)
  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 PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
  1.  G:'PSANUM NONE G:PSANUM=1 ONE G:PSANUM>1 MANY
  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 menu"
  1.  W !,"to setup one or more pharmacy locations. Then select the Process Uploaded",!,"Prime Vendor Invoice Data option to process the invoices."
  1.  Q
  1.  ;
  1. ONE ;Only one location
  1.  S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
  1.  W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>"
  1.  W !!,"The non-controlled substance items on the invoice have",!,"been automatically assigned to the Pharmacy Location.",!
  1.  W:$L(PSALOCN)>76 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 PSALOCN W !,PSASLN
  1.  W !!,"Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
  1.  S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSAIN=^("IN")
  1.  Q
  1.  ;
  1. MANY ;If more than one pharmacy location, display invoices.
  1.  D DISPLOC W !,"Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(+PSAIN) D SELLOC
  1.  Q
  1.  ;
  1. DISPLOC ;Displays the active pharmacy locations.
  1.  W @IOF,!?19,"<<< ASSIGN A PHARMACY LOCATION SCREEN >>>",!,PSASLN,!
  1.  S PSACNT=0,PSALOCN="" F  S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN=""  D
  1.  .S PSALOC=0 F  S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC  D
  1.  ..S PSACNT=PSACNT+1,PSAMENU(PSACNT,PSALOCN,PSALOC)=PSALOC
  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 !
  1.  Q
  1.  ;
  1. SELLOC ;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.  S DIR("??")="^D LOCHELP^PSAVER5" D ^DIR K DIR Q:Y=""  I $G(DIRUT) S PSAOUT=1 Q
  1.  S PSASEL1=Y
  1.  S PSALOCN=$O(PSAMENU(PSASEL1,"")) Q:PSALOCN=""  S PSALOC=$O(PSAMENU(PSASEL1,PSALOCN,0)) Q:'PSALOC  S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSAIN=^("IN")
  1.  Q
  1.  ;
  1. CONTYN ;Extended help for 'Do you want to continue processing invoice# 99'
  1.  W !?5,"Enter YES to continue processing the current invoice and line item.",!?5,"Enter NO to discontinue processing the current invoice and exit the option."
  1.  Q