PSABRKU2 ;BHM/DB - Automatic processing of invoices;16 DEC 99
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26**; 10/24/97
;This routine is a continuation of the Upload GUI
;the program will attempt to process as much of the invoice
;data as it can.
;
;Order Unit matching, supply item identification, and location
;assignment are attempted.
;
K PSACTRL,PSALOC,PSAMV,PSACS,PSANCS
I '$D(^XTMP("PSAPV")) G Q
CNT ;Count invoices that need a pharm location or master vault assigned.
F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL="" D
.Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
.I $G(PSASORT)'=0,$G(PSASORT)'="",$D(^XTMP("PSAPV",PSACTRL,"ST")),$P(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT Q
.S PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
.I $P(PSAIN,"^",10)="ALL CS",$P(PSAIN,"^",12)="" S PSACNT=PSACNT+1,PSACS(PSACTRL)="" Q
.I $P(PSAIN,"^",10)'="ALL CS" D
..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
..I $P(PSAIN,"^",9)="",$P(PSAIN,"^",7)="" S PSACNT=PSACNT+1,PSANCS(PSACTRL)=""
I 'PSACNT G Q
;
;Gets pharmacy locations
S (PSALOC,PSANUM)=0 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
.Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
.I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
.S PSANUM=PSANUM+1,PSAONE=PSALOC,PSAISIT=+$P(^PSD(58.8,PSALOC,0),"^",3),PSAOSIT=+$P(^(0),"^",10)
.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
;
;Gets master vaults
S (PSAMVN,PSAMV)=0 F S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV D
.Q:'$D(^PSD(58.8,PSAMV,0))!($P($G(^PSD(58.8,PSAMV,0)),"^")="")
.I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
.S PSAMVN=PSAMVN+1,PSAONEMV=PSAMV,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
I 'PSANUM G 2
I PSANUM=1 D ONE
G 2
ONE ;Only one location
S PSACNT=0,PSALOC=PSAONE,PSALOCN=$O(PSALOCA(""))
S PSACTRL="" F S PSACTRL=$O(PSANCS(PSACTRL)) Q:PSACTRL="" D
.Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
.S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC,PSACNT=1
S PSA=$O(PSACS("")) D:PSA'="" MASTER
Q
;
MASTER ;Assigns invoice to Master Vault
I 'PSAMVN G 2
;
I PSAMVN=1 D
.S PSACTRL=$O(PSACS(""))
.S PSACTRL="" F S PSACTRL=$O(PSACS(PSACTRL)) Q:PSACTRL="" D
..Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
..S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV
2 ;Match order units
K X1,X2,X3,X4
;Loop through TMP("PSA ORDER",CMT,0)
Q
Q Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU2 2609 printed Sep 23, 2025@19:24:56 Page 2
PSABRKU2 ;BHM/DB - Automatic processing of invoices;16 DEC 99
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26**; 10/24/97
+2 ;This routine is a continuation of the Upload GUI
+3 ;the program will attempt to process as much of the invoice
+4 ;data as it can.
+5 ;
+6 ;Order Unit matching, supply item identification, and location
+7 ;assignment are attempted.
+8 ;
+9 KILL PSACTRL,PSALOC,PSAMV,PSACS,PSANCS
+10 IF '$DATA(^XTMP("PSAPV"))
GOTO Q
CNT ;Count invoices that need a pharm location or master vault assigned.
+1 FOR
SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:1
+2 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+3 IF $GET(PSASORT)'=0
IF $GET(PSASORT)'=""
IF $DATA(^XTMP("PSAPV",PSACTRL,"ST"))
IF $PIECE(^XTMP("PSAPV",PSACTRL,"ST"),"^",1)'=PSASORT
QUIT
+4 SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+5 IF $PIECE(PSAIN,"^",10)="ALL CS"
IF $PIECE(PSAIN,"^",12)=""
SET PSACNT=PSACNT+1
SET PSACS(PSACTRL)=""
QUIT
+6 IF $PIECE(PSAIN,"^",10)'="ALL CS"
Begin DoDot:2
+7 IF $PIECE(PSAIN,"^",9)="CS"
if $PIECE(PSAIN,"^",7)=""
SET PSANCS(PSACTRL)=""
if $PIECE(PSAIN,"^",12)=""
SET PSACS(PSACTRL)=""
if $PIECE(PSAIN,"^",7)=""!($PIECE(PSAIN,"^",12)="")
SET PSACNT=PSACNT+1
QUIT
+8 IF $PIECE(PSAIN,"^",9)=""
IF $PIECE(PSAIN,"^",7)=""
SET PSACNT=PSACNT+1
SET PSANCS(PSACTRL)=""
End DoDot:2
End DoDot:1
+9 IF 'PSACNT
GOTO Q
+10 ;
+11 ;Gets pharmacy locations
+12 SET (PSALOC,PSANUM)=0
FOR
SET PSALOC=+$ORDER(^PSD(58.8,"ADISP","P",PSALOC))
if 'PSALOC
QUIT
Begin DoDot:1
+13 if '$DATA(^PSD(58.8,PSALOC,0))!($PIECE($GET(^PSD(58.8,PSALOC,0)),"^")="")
QUIT
+14 IF +$GET(^PSD(58.8,PSALOC,"I"))
IF +^PSD(58.8,PSALOC,"I")'>DT
QUIT
+15 SET PSANUM=PSANUM+1
SET PSAONE=PSALOC
SET PSAISIT=+$PIECE(^PSD(58.8,PSALOC,0),"^",3)
SET PSAOSIT=+$PIECE(^(0),"^",10)
+16 DO SITES^PSAUTL1
SET PSACOMB=$SELECT('$DATA(PSACOMB):"NO COMBINED IP/OP",1:PSACOMB)
SET PSALOCA($PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT
End DoDot:1
+17 ;
+18 ;Gets master vaults
+19 SET (PSAMVN,PSAMV)=0
FOR
SET PSAMV=+$ORDER(^PSD(58.8,"ADISP","M",PSAMV))
if 'PSAMV
QUIT
Begin DoDot:1
+20 if '$DATA(^PSD(58.8,PSAMV,0))!($PIECE($GET(^PSD(58.8,PSAMV,0)),"^")="")
QUIT
+21 IF +$GET(^PSD(58.8,PSAMV,"I"))
IF +^PSD(58.8,PSAMV,"I")'>DT
QUIT
+22 SET PSAMVN=PSAMVN+1
SET PSAONEMV=PSAMV
SET PSAMV($PIECE(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
End DoDot:1
+23 IF 'PSANUM
GOTO 2
+24 IF PSANUM=1
DO ONE
+25 GOTO 2
ONE ;Only one location
+1 SET PSACNT=0
SET PSALOC=PSAONE
SET PSALOCN=$ORDER(PSALOCA(""))
+2 SET PSACTRL=""
FOR
SET PSACTRL=$ORDER(PSANCS(PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:1
+3 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+4 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=PSALOC
SET PSACNT=1
End DoDot:1
+5 SET PSA=$ORDER(PSACS(""))
if PSA'=""
DO MASTER
+6 QUIT
+7 ;
MASTER ;Assigns invoice to Master Vault
+1 IF 'PSAMVN
GOTO 2
+2 ;
+3 IF PSAMVN=1
Begin DoDot:1
+4 SET PSACTRL=$ORDER(PSACS(""))
+5 SET PSACTRL=""
FOR
SET PSACTRL=$ORDER(PSACS(PSACTRL))
if PSACTRL=""
QUIT
Begin DoDot:2
+6 if '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))
QUIT
+7 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=PSAONEMV
End DoDot:2
End DoDot:1
2 ;Match order units
+1 KILL X1,X2,X3,X4
+2 ;Loop through TMP("PSA ORDER",CMT,0)
+3 QUIT
Q QUIT
