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

PSAUP.m

Go to the documentation of this file. 
  1. PSAUP ;BIR/JMB-Upload and Process Prime Vendor Invoice Data ;7/23/97
  1.  ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12**; 10/24/97
  1.  ;This routine uploads the prime vendor data into ^TMP("PSAPV",$J).
  1.  ;The  X12 data is checked for proper format. If the X12 data is correct,
  1.  ;it is loaded into ^XTMP("PSAX12").
  1.  ;
  1.  I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
  1.  W @IOF,!,"****************************** I M P O R T A N T ******************************"
  1.  W !!,"This option uploads the invoice data received from your prime vendor.",!,"In order to upload the data, you must be running ProComm Plus software",!,"on Pharmacy's prime vendor PC.",!!
  1.  S PSASTLN="",$P(PSASTLN,"*",80)="" W PSASTLN,! K PSASTLN
  1.  S DIR("A")="Are you ready to upload the prime vendor invoice data",DIR(0)="Y",DIR("B")="Yes",DIR("??")="^D YNUPLOAD^PSAUP1" D ^DIR K DIR
  1.  I 'Y S PSAOUT=1 G KILL
  1.  I $D(^DIZ(8980,"AOK",DUZ)) S XTKDIC="^TMP(""PSAX12"",$J,",DWLC=0,XTKMODE=2
  1.  I '$D(^DIZ(8980,"AOK",DUZ)) D RFILE^XTKERM4
  1.  S PSAOUT=0 K ^TMP("PSAX12",$J)
  1.  W !!,"Press <ALT> 1 if your Prime Vendor script is installed as a Meta Key,",!,"otherwise press <ALT> F5 and enter ""PV""",!
  1.  X ^%ZOSF("EOFF") R X:DTIME X ^%ZOSF("EON") D HASH^XUSHSHP I X'="$4_\y o\Xp>RN}ab*_%," S PSAOUT=1
  1.  I '$G(PSAOUT) S XTKDIC="^TMP(""PSAX12"",$J,",DWLC=0,XTKMODE=2 D RECEIVE^XTKERMIT
  1.  I $G(PSAOUT) S XTKERR="The invoice file cannot be uploaded. Contact your IRM staff for assistance." K ^TMP("PSAPV",$J) H 1
  1.  I $G(XTKERR)'=0 W !!,"ERROR - "_XTKERR S PSAOUT=1 Q
  1.  I DWLC=0 W !,"ERROR - NO LINES RECEIVED." S PSAOUT=1 Q
  1.  W @IOF,!,"Done",!,"The data uploaded to a temporary file. "_DWLC," lines received.",!! H 2
  1.  G:'$O(^TMP("PSAX12",$J,0)) KILL
  1.  ;
  1. UNWRAP ;Changes the data element and segment delimiters to ^ & ~, places each
  1.  ;segment on a node to itself, then removes leading spaces from each
  1.  ;data element
  1.  W !,"Unwrapping the invoice."
  1.  ;
  1.  ;Get delimiters
  1.  S (PSABBC,PSAISA,PSALINE,PSASEGD,PSALND)=0
  1.  F  S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE  D  Q:PSABBC&(PSAISA)
  1.  .I $E($G(^TMP("PSAX12",$J,PSALINE,0)),1,3)="ISA" S DAVE=^TMP("PSAX12",$J,PSALINE,0) S PSASEGD=$E(^(0),4,4),PSALND=$E(^(0),106,106),PSAISA=1 W "." Q
  1.  .I $P($G(^TMP("PSAX12",$J,PSALINE,0)),PSASEGD,2)="DS",$P($G(^(0)),PSASEGD,3)="BBC" S PSABBC=1
  1.  ;If drug company is Bergen (BBC), changes data element to ^ and adds
  1.  ;segment delimiters to ~.
  1.  I PSABBC S (PSACNT,PSALINE)=0 F  S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE  D
  1.  .S PSADATA=^TMP("PSAX12",$J,PSALINE,0)_"~"
  1.  .I PSASEGD'="^" S PSADATA=$TR(PSADATA,PSASEGD,"^")
  1.  .I $E($G(^TMP("PSAX12",$J,PSALINE,0)),1,3)="ISA" W "."
  1.  .S ^TMP("PSAX12",$J,PSALINE,0)=PSADATA
  1.  G:PSABBC LINE
  1.  ;
  1.  I PSASEGD=""!(PSALND="") D  G KILL
  1.  .S PSASTAR="",$P(PSASTAR,"*",80)=""
  1.  .W !,PSASTAR,!,"There is a major error in the invoice file.",!,"Contact your IRM Staff for assistance."
  1.  .W !!,"Press the Esc key then enter YES at the 'EXIT SCRIPT (Y/N)' prompt.",!,"Press RETURN to exit the option.",!,PSASTAR D END^PSAPROC
  1.  G:PSASEGD="~"&(PSALND="^") LINE
  1.  ;
  1.  ;Changes the data element and segment delimiters to ^ and ~.
  1.  S (PSACNT,PSALINE)=0 F  S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE  D  Q:PSAOUT
  1.  .S PSADATA=^TMP("PSAX12",$J,PSALINE,0)
  1.  .I PSALND'="~" S PSADATA=$TR(PSADATA,PSALND,"~")
  1.  .I PSASEGD'="^" S PSADATA=$TR(PSADATA,PSASEGD,"^")
  1.  .S ^TMP("PSAX12",$J,PSALINE,0)=PSADATA
  1.  .I $P(^TMP("PSAX12",$J,PSALINE,0),"^")="ISA" W "."
  1.  ;
  1. LINE ;Places each segment on a node to itself.
  1.  K ^TMP("PSAPV",$J)
  1.  S PSAHOLD="",(PSACNT,PSALINE)=0
  1.  F  S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE  D
  1.  .S PSADATA=^TMP("PSAX12",$J,PSALINE,0),PSADATA=PSAHOLD_PSADATA
  1.  .I PSADATA'["~" S PSAHOLD=PSADATA Q
  1.  .S PSASTOP=0 F  S PSASEG=$P(PSADATA,"~") Q:PSASEG=""  D  Q:PSASTOP
  1.  ..S PSACNT=PSACNT+1,^TMP("PSAPV",$J,PSACNT,0)=PSASEG
  1.  ..I $P(PSASEG,"^")="ISA" W "."
  1.  ..S PSADATA=$P(PSADATA,"~",2,99) I PSADATA'["~" S PSASTOP=1,PSAHOLD=PSADATA Q
  1.  ..S PSAHOLD=""
  1.  ;
  1. SPACES ;remove all leading spaces in all data elements
  1.  K ^TMP("PSAX12",$J)
  1.  S (PSACNT,PSALINE)=0 F  S PSALINE=$O(^TMP("PSAPV",$J,PSALINE)) Q:'PSALINE  D
  1.  .S PSASEG=^TMP("PSAPV",$J,PSALINE,0)
  1.  .I $E(PSASEG,1,3)="ISA" S ^TMP("PSAPVS",$J,PSALINE)=^TMP("PSAPV",$J,PSALINE,0) W "." Q
  1.  .S PSACNT=0,PSASEGL=$L(PSASEG)
  1.  .F PSAEX=1:1:PSASEGL S PSAX=$E(PSASEG,PSAEX,PSAEX) S:PSAX="^" PSACNT=PSACNT+1
  1.  .F PSAPC=1:1:(PSACNT+1) S PSADE=$P(PSASEG,"^",PSAPC) D
  1.  ..F  Q:$E(PSADE,1,1)'=" "  S PSADE=$E(PSADE,2,999)
  1.  ..S $P(PSASEG,"^",PSAPC)=PSADE
  1.  .S ^TMP("PSAPVS",$J,PSALINE)=PSASEG
  1.  K ^TMP("PSAPV",$J)
  1.  W !,"Finished unwrapping the invoice." H 2
  1.  ;
  1. CHECK ;Looks for X12 errors. If no errors, loads data into ^TMP("PSAPV SET",$J)
  1.  W !!,"Checking the invoice data."
  1.  D ^PSAUP2
  1.  K ^TMP("PSAPVS",$J)
  1.  I PSAOUT K ^TMP("PSAPV SET",$J) G KILL
  1.  W !,"Finished checking the invoice data." H 2
  1.  ;
  1. LOADXTMP ;Loads data into ^XTMP("PSAPV").
  1.  W !!,"Loading data into VISTA."
  1.  D XTMP^PSAUP1
  1.  K ^TMP("PSAPV SET",$J) G:PSAOUT KILL
  1.  W !,"Finished loading data into VISTA."
  1.  W !!,"** The upload was successful. **" H 4
  1.  D END^PSAPROC
  1.  ;
  1. STORE ;Get the line item data and store in ^XTMP("PSAPV")
  1.  W @IOF S PSANEXT=$O(^XTMP("PSAPV",0))
  1.  I PSANEXT="" W !,"There are no valid invoices to process." H 1 G KILL
  1.  W !,"Searching for and storing the drug data for each line item."
  1.  D ^PSAUP5
  1.  W !,"Finished storing the drug data." H 1
  1.  ;
  1. PRINT ;Ask if user wants to print invoices.
  1.  S PSASTA="U"
  1.  W ! S DIR(0)="Y",DIR("A")="Print all uploaded invoices",DIR("B")="Y",DIR("?",1)="Enter YES to print the invoices that were uploaded.",DIR("?")="Enter NO to bypass printing the invoices and continue.",DIR("??")="^D YNPRINT^PSAUP1"
  1.  D ^DIR K DIR G:$G(DIRUT) KILL D:Y ^PSAUP4
  1.  ;
  1. PROC ;Ask if user wants to process the invoice data now.
  1.  W ! S DIR(0)="Y",DIR("A")="Do you want to process the invoices now",DIR("B")="Y",DIR("?",1)="Enter YES to process the invoices that were uploaded.",DIR("?")="Enter NO to exit the option.",DIR("??")="^D YNPROCES^PSAUP1"
  1.  D ^DIR K DIR G:'Y!($G(DIRUT)) KILL
  1.  D KILL
  1.  ;
  1. PHARM ;Assign a pharmacy location or master vault to each Order.
  1.  ;Then process the invoice data.
  1.  S PSAOUT=0
  1.  D ^PSAPROC G:$G(PSAOUT) EXIT^PSAPROC
  1.  ;
  1. PRINT2 W !! S DIR(0)="Y",DIR("A")="Print all unprocessed and just processed invoices",DIR("B")="N"
  1.  S DIR("?",1)="Enter YES to print all of the uploaded invoices that are",DIR("?")="unprocessed or just processed. Enter NO to exit the option."
  1.  S DIR("??")="^D PRT2^PSAUP1"
  1.  D ^DIR K DIR D:+Y ^PSAUP4 S PSAENTRY=0
  1.  G EXIT^PSAPROC
  1.  ;
  1. KILL ;Kills uploading variables
  1.  K ^TMP("PSAPV",$J),^TMP("PSAPVS",$J),^TMP("PSAPV SET",$J),^TMP("PSAX12",$J)
  1.  K %,DIR,DIRUT,DWLC,PSABBC,PSACNT,PSACTN1,PSACOMB,PSACS,PSACTRL,PSACTRL2,PSADATA,PSADE,PSADT,PSADUP,PSAENTRY,PSAERR,PSAEX,PSAEXPEC,PSAFND1,PSAGS,PSAHOLD,PSAIEN,PSAIN,PSAINV,PSAINVDT,PSAINVN,PSAISA,PSAISIT,PSAISITN,PSAITCNT,PSAITEM
  1.  K PSALAST,PSALINE,PSALLCS,PSALLOK,PSALND,PSALOC,PSANDC,PSANEW,PSANEXT,PSANTYPE,PSAOK,PSAORD,PSAORDDT,PSAORDN,PSAOSIT,PSAOSITN,PSAOUT,PSAPC
  1.  K PSAS,PSASEG,PSASEGL,PSASEGD,PSASS,PSAST,PSASTA,PSASTAR,PSASTCNT,PSASUB,PSASYN,PSAUOM,PSAUOM1,PSAUOMH,PSAUOMH1,PSAVSN,PSAX,X,X1,X2,XTKDIC,XTKERR,XTKMODE,Y
  1.  Q