| [613] | 1 | PSABRKU2 ;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
|
|---|
| 12 | CNT ;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
|
|---|
| 38 | ONE ;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 | ;
|
|---|
| 46 | MASTER ;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
|
|---|
| 54 | 2 ;Match order units
|
|---|
| 55 | K X1,X2,X3,X4
|
|---|
| 56 | ;Loop through TMP("PSA ORDER",CMT,0)
|
|---|
| 57 | Q
|
|---|
| 58 | Q Q
|
|---|
