source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU2.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: 2.5 KB
Line 
1PSABRKU2 ;BHM/DB - Automatic processing of invoices;16 DEC 99
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26**; 10/24/97
3 ;This routine is a continuation of the Upload GUI
4 ;the program will attempt to process as much of the invoice
5 ;data as it can.
6 ;
7 ;Order Unit matching, supply item identification, and location
8 ;assignment are attempted.
9 ;
10 K PSACTRL,PSALOC,PSAMV,PSACS,PSANCS
11 I '$D(^XTMP("PSAPV")) G Q
12CNT ;Count invoices that need a pharm location or master vault assigned.
13 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL="" D
14 .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
15 .I $G(PSASORT)'=0,$G(PSASORT)'="",$D(^XTMP("PSAPV",PSACTRL,"ST")),$P(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT Q
16 .S PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
17 .I $P(PSAIN,"^",10)="ALL CS",$P(PSAIN,"^",12)="" S PSACNT=PSACNT+1,PSACS(PSACTRL)="" Q
18 .I $P(PSAIN,"^",10)'="ALL CS" D
19 ..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
20 ..I $P(PSAIN,"^",9)="",$P(PSAIN,"^",7)="" S PSACNT=PSACNT+1,PSANCS(PSACTRL)=""
21 I 'PSACNT G Q
22 ;
23 ;Gets pharmacy locations
24 S (PSALOC,PSANUM)=0 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
25 .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
26 .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
27 .S PSANUM=PSANUM+1,PSAONE=PSALOC,PSAISIT=+$P(^PSD(58.8,PSALOC,0),"^",3),PSAOSIT=+$P(^(0),"^",10)
28 .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
29 ;
30 ;Gets master vaults
31 S (PSAMVN,PSAMV)=0 F S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV D
32 .Q:'$D(^PSD(58.8,PSAMV,0))!($P($G(^PSD(58.8,PSAMV,0)),"^")="")
33 .I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
34 .S PSAMVN=PSAMVN+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
35 I 'PSANUM G 2
36 I PSANUM=1 D ONE
37 G 2
38ONE ;Only one location
39 S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
40 S PSACTRL="" F S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL="" D
41 .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
42 .S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSACNT=1
43 S PSA=$O(PSACS("")) D:PSA'="" MASTER
44 Q
45 ;
46MASTER ;Assigns invoice to Master Vault
47 I 'PSAMVN G 2
48 ;
49 I PSAMVN=1 D
50 .S PSACTRL=$O(PSACS(""))
51 .S PSACTRL="" F S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL="" D
52 ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
53 ..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV
542 ;Match order units
55 K X1,X2,X3,X4
56 ;Loop through TMP("PSA ORDER",CMT,0)
57 Q
58Q Q
Note: See TracBrowser for help on using the repository browser.