source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU1.m@ 701

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1PSABRKU1 ;BIR/DB-Upload and Process Prime Vendor Invoice Data ;8/19/99
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41**; 10/24/97
3 ;
4PSAUPLD(RET,TMP) ;uploads data in VISTA
5 D NOW^%DTC
6 S X=0
7 I $G(TMP(0))="******" S PSAOUT=0 D STRT S RET="OK" Q
8 I $G(TMP(0))="KEY" G LOGON
9 S X=0,CNT=1 F S X=$O(^TMP($J,"PSAX12",X)) Q:X'>0 S CNT=$G(CNT)+1
10 S X=-1 F S X=$O(TMP(X)) Q:X="" S DATA=$G(TMP(X)) I $G(DATA)'="" S DATA=$P(DATA,"^",2,99) S ^TMP($J,"PSAX12",CNT,0)=DATA,CNT=$G(CNT)+1
11 ;
12 ;
13 S RET="OK"
14 Q
15STRT S (PSABBC,PSACNT,PSAISA,PSALINE,PSASEGD,PSALND)=0 K TMP
16 D NOW^%DTC S Y=% X ^DD("DD")
17 S ^TMP($J,"PSA UPLOAD",.3,0)="Results : "
18 S ^TMP($J,"PSA UPLOAD",.5,0)="Finished : "_Y
19 D NOW^%DTC S DT=$P(%,".")
20 F S PSALINE=$O(^TMP($J,"PSAX12",PSALINE)) Q:'PSALINE D Q:PSABBC&(PSAISA)
21 .I $E($G(^TMP($J,"PSAX12",PSALINE,0)),1,3)="ISA" S PSADB=^TMP($J,"PSAX12",PSALINE,0) S PSASEGD=$E(^(0),4,4),PSALND=$E(^(0),106,106),PSAISA=1 Q
22 ;
23 I PSASEGD=""!(PSALND="") D G KILL
24 .S PSASTAR="",$P(PSASTAR,"*",80)=""
25 G:PSASEGD="~"&(PSALND="^") LINE
26 ;
27 ;Changes the data element and segment delimiters to ^ and ~.
28 S (PSACNT,PSALINE)=0 F S PSALINE=$O(^TMP($J,"PSAX12",PSALINE)) Q:'PSALINE D Q:PSAOUT
29 .S PSADATA=^TMP($J,"PSAX12",PSALINE,0)
30 .I PSALND'="~" S PSADATA=$TR(PSADATA,PSALND,"~")
31 .I PSASEGD'="^" S PSADATA=$TR(PSADATA,PSASEGD,"^")
32 .S ^TMP($J,"PSAX12",PSALINE,0)=PSADATA
33 ;
34LINE ;Places each segment on a node to itself.
35 K ^TMP($J,"PSAPV")
36 S PSAHOLD="",(PSACNT,PSALINE)=0
37 F S PSALINE=$O(^TMP($J,"PSAX12",PSALINE)) Q:'PSALINE D
38 .S PSADATA=^TMP($J,"PSAX12",PSALINE,0),PSADATA=PSAHOLD_PSADATA
39 .I PSADATA'["~" S PSAHOLD=PSADATA Q
40 .S PSASTOP=0 F S PSASEG=$P(PSADATA,"~") Q:PSASEG="" D Q:PSASTOP
41 ..S PSACNT=PSACNT+1,^TMP($J,"PSAPV",PSACNT,0)=PSASEG
42 ..S PSADATA=$P(PSADATA,"~",2,99) I PSADATA'["~" S PSASTOP=1,PSAHOLD=PSADATA Q
43 ..S PSAHOLD=""
44 ;
45SPACES ;remove all leading spaces in all data elements
46 S (PSACNT,PSALINE)=0 F S PSALINE=$O(^TMP($J,"PSAPV",PSALINE)) Q:'PSALINE D
47 .S PSASEG=^TMP($J,"PSAPV",PSALINE,0)
48 .I $E(PSASEG,1,3)="ISA" S ^TMP($J,"PSAPVS",PSALINE)=^TMP($J,"PSAPV",PSALINE,0) Q
49 .S PSACNT=0,PSASEGL=$L(PSASEG)
50 .F PSAEX=1:1:PSASEGL S PSAX=$E(PSASEG,PSAEX,PSAEX) S:PSAX="^" PSACNT=PSACNT+1
51 .F PSAPC=1:1:(PSACNT+1) S PSADE=$P(PSASEG,"^",PSAPC) D
52 ..F Q:$E(PSADE,1,1)'=" " S PSADE=$E(PSADE,2,999)
53 ..S $P(PSASEG,"^",PSAPC)=PSADE
54 .S ^TMP($J,"PSAPVS",PSALINE)=PSASEG
55 K ^TMP($J,"PSAPV")
56 ;
57CHECK ;Looks for X12 errors. If no errors, loads data into ^TMP($J,"PSAPV SET")
58 D ^PSABRKU3
59 D XTMP^PSABRKU4
60 S PSANEXT=$O(^XTMP("PSAPV",0))
61 D ^PSABRKU6
62 ;
63KILL K ^TMP($J,"PSAPVS"),^TMP($J,"PSAPV SET"),^TMP($J,"PSAX12")
64 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
65 K PSALAST,PSALINE,PSALLCS,PSALLOK,PSALND,PSALOC,PSANDC,PSANEW,PSANEXT,PSANTYPE,PSAOK,PSAORD,PSAORDDT,PSAORDN,PSAOSIT,PSAOSITN,PSAOUT,PSAPC
66 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
67 S (X,CNT)=0 F S X=$O(PSAGUI2(X)) Q:X="" S CNT=$G(CNT)+1
68 I $G(CNT)>0 S ^TMP($J,"PSA UPLOAD",1.6,0)="Orders Uploaded : "_$G(CNT)
69 S (X,CNTR)=0 F S X=$O(PSAGUI3(X)) Q:X="" S CNTR=$G(CNTR)+1
70 I $G(CNTR)>0 S ^TMP($J,"PSA UPLOAD",1.7,0)="Invoices Uploaded : "_$G(CNTR)
71 S ^TMP($J,"PSA UPLOAD",1.8,0)="Line Items Uploaded : "_$G(PSAGUI4)
72 S RET=$G(CNT)_"^"_$G(CNTR)_"^"_$G(PSAGUI4) K CNT,CNTR
73 K PSAGUI1
74 I $D(^TMP($J,"PSA UPLOAD")) S XMSUB="Upload Status Report",XMDUZ="DRUG ACCOUNTABILITY UPLOAD INTERFACE",XMY(DUZ)="",XMTEXT="^TMP($J,"_"""PSA UPLOAD"""_"," D ^XMD
75 K ^TMP($J,"PSA UPLOAD"),^TMP($J,"PSAX12"),^TMP($J,"PSAPVS")
76 Q
77LOGON ;Check security key
78 S (PSAGUI2,PSAGUI3,PSAGUI4)=0
79 K ^TMP($J,"PSAX12"),^TMP($J,"PSA UPLOAD"),PSACNT,CNT
80 I '$D(^XUSEC("PSA ORDERS",DUZ)) S RET(0)="0" Q
81 D NOW^%DTC S Y=% X ^DD("DD") S ^TMP($J,"PSA UPLOAD",.4,0)="Upload Started : "_Y,RET(0)=1 Q
82 Q
Note: See TracBrowser for help on using the repository browser.