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

PSABRKU2.m

Go to the documentation of this file.
  1. PSABRKU2 ;BHM/DB - Automatic processing of invoices;16 DEC 99
  1. ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26**; 10/24/97
  1. ;This routine is a continuation of the Upload GUI
  1. ;the program will attempt to process as much of the invoice
  1. ;data as it can.
  1. ;
  1. ;Order Unit matching, supply item identification, and location
  1. ;assignment are attempted.
  1. ;
  1. K PSACTRL,PSALOC,PSAMV,PSACS,PSANCS
  1. I '$D(^XTMP("PSAPV")) G Q
  1. CNT ;Count invoices that need a pharm location or master vault assigned.
  1. F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL="" D
  1. .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1. .I $G(PSASORT)'=0,$G(PSASORT)'="",$D(^XTMP("PSAPV",PSACTRL,"ST")),$P(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT Q
  1. .S PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
  1. .I $P(PSAIN,"^",10)="ALL CS",$P(PSAIN,"^",12)="" S PSACNT=PSACNT+1,PSACS(PSACTRL)="" Q
  1. .I $P(PSAIN,"^",10)'="ALL CS" D
  1. ..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
  1. ..I $P(PSAIN,"^",9)="",$P(PSAIN,"^",7)="" S PSACNT=PSACNT+1,PSANCS(PSACTRL)=""
  1. I 'PSACNT G Q
  1. ;
  1. ;Gets pharmacy locations
  1. S (PSALOC,PSANUM)=0 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
  1. .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
  1. .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
  1. .S PSANUM=PSANUM+1,PSAONE=PSALOC,PSAISIT=+$P(^PSD(58.8,PSALOC,0),"^",3),PSAOSIT=+$P(^(0),"^",10)
  1. .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
  1. ;
  1. ;Gets master vaults
  1. S (PSAMVN,PSAMV)=0 F S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV D
  1. .Q:'$D(^PSD(58.8,PSAMV,0))!($P($G(^PSD(58.8,PSAMV,0)),"^")="")
  1. .I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
  1. .S PSAMVN=PSAMVN+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
  1. I 'PSANUM G 2
  1. I PSANUM=1 D ONE
  1. G 2
  1. ONE ;Only one location
  1. S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
  1. S PSACTRL="" F S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL="" D
  1. .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1. .S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSACNT=1
  1. S PSA=$O(PSACS("")) D:PSA'="" MASTER
  1. Q
  1. ;
  1. MASTER ;Assigns invoice to Master Vault
  1. I 'PSAMVN G 2
  1. ;
  1. I PSAMVN=1 D
  1. .S PSACTRL=$O(PSACS(""))
  1. .S PSACTRL="" F S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL="" D
  1. ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
  1. ..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV
  1. 2 ;Match order units
  1. K X1,X2,X3,X4
  1. ;Loop through TMP("PSA ORDER",CMT,0)
  1. Q
  1. Q Q