- 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 Feb 18, 2025@23:15:16 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