source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUP.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1PSAUP ;BIR/JMB-Upload and Process Prime Vendor Invoice Data ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12**; 10/24/97
3 ;This routine uploads the prime vendor data into ^TMP("PSAPV",$J).
4 ;The X12 data is checked for proper format. If the X12 data is correct,
5 ;it is loaded into ^XTMP("PSAX12").
6 ;
7 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
8 W @IOF,!,"****************************** I M P O R T A N T ******************************"
9 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.",!!
10 S PSASTLN="",$P(PSASTLN,"*",80)="" W PSASTLN,! K PSASTLN
11 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
12 I 'Y S PSAOUT=1 G KILL
13 I $D(^DIZ(8980,"AOK",DUZ)) S XTKDIC="^TMP(""PSAX12"",$J,",DWLC=0,XTKMODE=2
14 I '$D(^DIZ(8980,"AOK",DUZ)) D RFILE^XTKERM4
15 S PSAOUT=0 K ^TMP("PSAX12",$J)
16 W !!,"Press <ALT> 1 if your Prime Vendor script is installed as a Meta Key,",!,"otherwise press <ALT> F5 and enter ""PV""",!
17 X ^%ZOSF("EOFF") R X:DTIME X ^%ZOSF("EON") D HASH^XUSHSHP I X'="$4_\y o\Xp>RN}ab*_%," S PSAOUT=1
18 I '$G(PSAOUT) S XTKDIC="^TMP(""PSAX12"",$J,",DWLC=0,XTKMODE=2 D RECEIVE^XTKERMIT
19 I $G(PSAOUT) S XTKERR="The invoice file cannot be uploaded. Contact your IRM staff for assistance." K ^TMP("PSAPV",$J) H 1
20 I $G(XTKERR)'=0 W !!,"ERROR - "_XTKERR S PSAOUT=1 Q
21 I DWLC=0 W !,"ERROR - NO LINES RECEIVED." S PSAOUT=1 Q
22 W @IOF,!,"Done",!,"The data uploaded to a temporary file. "_DWLC," lines received.",!! H 2
23 G:'$O(^TMP("PSAX12",$J,0)) KILL
24 ;
25UNWRAP ;Changes the data element and segment delimiters to ^ & ~, places each
26 ;segment on a node to itself, then removes leading spaces from each
27 ;data element
28 W !,"Unwrapping the invoice."
29 ;
30 ;Get delimiters
31 S (PSABBC,PSAISA,PSALINE,PSASEGD,PSALND)=0
32 F S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE D Q:PSABBC&(PSAISA)
33 .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
34 .I $P($G(^TMP("PSAX12",$J,PSALINE,0)),PSASEGD,2)="DS",$P($G(^(0)),PSASEGD,3)="BBC" S PSABBC=1
35 ;If drug company is Bergen (BBC), changes data element to ^ and adds
36 ;segment delimiters to ~.
37 I PSABBC S (PSACNT,PSALINE)=0 F S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE D
38 .S PSADATA=^TMP("PSAX12",$J,PSALINE,0)_"~"
39 .I PSASEGD'="^" S PSADATA=$TR(PSADATA,PSASEGD,"^")
40 .I $E($G(^TMP("PSAX12",$J,PSALINE,0)),1,3)="ISA" W "."
41 .S ^TMP("PSAX12",$J,PSALINE,0)=PSADATA
42 G:PSABBC LINE
43 ;
44 I PSASEGD=""!(PSALND="") D G KILL
45 .S PSASTAR="",$P(PSASTAR,"*",80)=""
46 .W !,PSASTAR,!,"There is a major error in the invoice file.",!,"Contact your IRM Staff for assistance."
47 .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
48 G:PSASEGD="~"&(PSALND="^") LINE
49 ;
50 ;Changes the data element and segment delimiters to ^ and ~.
51 S (PSACNT,PSALINE)=0 F S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE D Q:PSAOUT
52 .S PSADATA=^TMP("PSAX12",$J,PSALINE,0)
53 .I PSALND'="~" S PSADATA=$TR(PSADATA,PSALND,"~")
54 .I PSASEGD'="^" S PSADATA=$TR(PSADATA,PSASEGD,"^")
55 .S ^TMP("PSAX12",$J,PSALINE,0)=PSADATA
56 .I $P(^TMP("PSAX12",$J,PSALINE,0),"^")="ISA" W "."
57 ;
58LINE ;Places each segment on a node to itself.
59 K ^TMP("PSAPV",$J)
60 S PSAHOLD="",(PSACNT,PSALINE)=0
61 F S PSALINE=$O(^TMP("PSAX12",$J,PSALINE)) Q:'PSALINE D
62 .S PSADATA=^TMP("PSAX12",$J,PSALINE,0),PSADATA=PSAHOLD_PSADATA
63 .I PSADATA'["~" S PSAHOLD=PSADATA Q
64 .S PSASTOP=0 F S PSASEG=$P(PSADATA,"~") Q:PSASEG="" D Q:PSASTOP
65 ..S PSACNT=PSACNT+1,^TMP("PSAPV",$J,PSACNT,0)=PSASEG
66 ..I $P(PSASEG,"^")="ISA" W "."
67 ..S PSADATA=$P(PSADATA,"~",2,99) I PSADATA'["~" S PSASTOP=1,PSAHOLD=PSADATA Q
68 ..S PSAHOLD=""
69 ;
70SPACES ;remove all leading spaces in all data elements
71 K ^TMP("PSAX12",$J)
72 S (PSACNT,PSALINE)=0 F S PSALINE=$O(^TMP("PSAPV",$J,PSALINE)) Q:'PSALINE D
73 .S PSASEG=^TMP("PSAPV",$J,PSALINE,0)
74 .I $E(PSASEG,1,3)="ISA" S ^TMP("PSAPVS",$J,PSALINE)=^TMP("PSAPV",$J,PSALINE,0) W "." Q
75 .S PSACNT=0,PSASEGL=$L(PSASEG)
76 .F PSAEX=1:1:PSASEGL S PSAX=$E(PSASEG,PSAEX,PSAEX) S:PSAX="^" PSACNT=PSACNT+1
77 .F PSAPC=1:1:(PSACNT+1) S PSADE=$P(PSASEG,"^",PSAPC) D
78 ..F Q:$E(PSADE,1,1)'=" " S PSADE=$E(PSADE,2,999)
79 ..S $P(PSASEG,"^",PSAPC)=PSADE
80 .S ^TMP("PSAPVS",$J,PSALINE)=PSASEG
81 K ^TMP("PSAPV",$J)
82 W !,"Finished unwrapping the invoice." H 2
83 ;
84CHECK ;Looks for X12 errors. If no errors, loads data into ^TMP("PSAPV SET",$J)
85 W !!,"Checking the invoice data."
86 D ^PSAUP2
87 K ^TMP("PSAPVS",$J)
88 I PSAOUT K ^TMP("PSAPV SET",$J) G KILL
89 W !,"Finished checking the invoice data." H 2
90 ;
91LOADXTMP ;Loads data into ^XTMP("PSAPV").
92 W !!,"Loading data into VISTA."
93 D XTMP^PSAUP1
94 K ^TMP("PSAPV SET",$J) G:PSAOUT KILL
95 W !,"Finished loading data into VISTA."
96 W !!,"** The upload was successful. **" H 4
97 D END^PSAPROC
98 ;
99STORE ;Get the line item data and store in ^XTMP("PSAPV")
100 W @IOF S PSANEXT=$O(^XTMP("PSAPV",0))
101 I PSANEXT="" W !,"There are no valid invoices to process." H 1 G KILL
102 W !,"Searching for and storing the drug data for each line item."
103 D ^PSAUP5
104 W !,"Finished storing the drug data." H 1
105 ;
106PRINT ;Ask if user wants to print invoices.
107 S PSASTA="U"
108 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"
109 D ^DIR K DIR G:$G(DIRUT) KILL D:Y ^PSAUP4
110 ;
111PROC ;Ask if user wants to process the invoice data now.
112 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"
113 D ^DIR K DIR G:'Y!($G(DIRUT)) KILL
114 D KILL
115 ;
116PHARM ;Assign a pharmacy location or master vault to each Order.
117 ;Then process the invoice data.
118 S PSAOUT=0
119 D ^PSAPROC G:$G(PSAOUT) EXIT^PSAPROC
120 ;
121PRINT2 W !! S DIR(0)="Y",DIR("A")="Print all unprocessed and just processed invoices",DIR("B")="N"
122 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."
123 S DIR("??")="^D PRT2^PSAUP1"
124 D ^DIR K DIR D:+Y ^PSAUP4 S PSAENTRY=0
125 G EXIT^PSAPROC
126 ;
127KILL ;Kills uploading variables
128 K ^TMP("PSAPV",$J),^TMP("PSAPVS",$J),^TMP("PSAPV SET",$J),^TMP("PSAX12",$J)
129 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
130 K PSALAST,PSALINE,PSALLCS,PSALLOK,PSALND,PSALOC,PSANDC,PSANEW,PSANEXT,PSANTYPE,PSAOK,PSAORD,PSAORDDT,PSAORDN,PSAOSIT,PSAOSITN,PSAOUT,PSAPC
131 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
132 Q
Note: See TracBrowser for help on using the repository browser.