- PSAUTL5 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data Utility - CONT'D ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
- ;This utility displays locations & allows user to select one, many, or
- ;all locations.
- K PSALOCA,PSAMNU
- S PSALOC=+$O(^PSD(58.8,"ADISP","P",0))
- I 'PSALOC W !!?5,"No Drug Accountability location has been created yet." S PSAOUT=1 G EXIT
- ;
- ORDER ;If more than one pharmacy location, collect them in alpha order.
- S (PSACNT,PSALOC)=0 W !
- 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
- .D SITES^PSAUTL1
- .S PSACNT=PSACNT+1,PSAONE=+PSALOC
- .S PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=$P(^(0),"^",3)_"^"_$P(^(0),"^",10)_"^"_$P($G(^PSD(58.8,PSALOC,"I")),"^")
- I PSACNT=1 G:$G(PSATRAN)="" ONE W !?5,"There is only one active pharmacy location.",!?5,"There must be at least two to transfer drugs." S PSAOUT=1 Q
- S PSACHK=$O(PSALOCA("")) I PSACHK="" G EXIT
- G DISP
- ;
- ONE ;only one
- S PSALOC=PSAONE
- I '$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="") W !,"There are no Drug Accountability pharmacy locations with data." Q
- S PSALOCN="",PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" S PSALOC=0,PSALOC=+$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC S PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC)
- G EXIT
- ;
- DISP ;Displays the available pharmacy locations.
- W ! S PSACNT=0,PSALOCN=""
- F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" D
- .S PSALOC=0 F S PSALOC=+$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC D
- ..S PSACNT=PSACNT+1,PSAMNU(PSACNT,PSALOCN,PSALOC)=""
- ..W !,$J(PSACNT,2)
- ..W:$L(PSALOCN)>76 ?4,$P(PSALOCN,"(IP)",1)_"(IP)",!?21,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 ?4,PSALOCN
- W !
- ;
- SELECT S DIR(0)="L^1:"_PSACNT,DIR("A")="Select PHARMACY LOCATION",DIR("??")="^D HELP^PSAUTL3"
- S DIR("?")="Enter the number of the pharmacy location"
- D ^DIR K DIR I 'Y S PSAOUT=1 G EXIT
- S PSASL=Y F PSAPCC=1:1 S PSANUM=+$P(PSASL,",",PSAPCC) Q:'PSANUM D
- .S PSALOCN=$O(PSAMNU(PSANUM,"")),PSALOC=+$O(PSAMNU(PSANUM,PSALOCN,0))
- .S PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC)
- ;
- EXIT ;Kills all variables except PSALOC array & PSAOUT
- ;K DIR,PSACOMB,PSAISIT,PSAISITN,PSAMNU,PSAONE,PSANUM,PSAOSIT,PSAOSITN,Y
- Q
- ;
- FROMHELP ;Extended help to 'Select Transfer from Pharmacy'
- W !?5,"Enter the number of the pharmacy location that will transfer the drugs to another pharmacy."
- Q
- HELP ;Extended help to 'Select PHARMACY LOCATION'
- W !?5,"Enter the number of the pharmacy location you want to select.",!?5,"If you want more than one pharmacy location, enter the numbers",!?5,"separated by a comma."
- W !!?5,"For example: Enter 1,3 or 1-3,5."
- Q
- TOHELP ;Extended help to 'Select Transfer to Pharmacy'
- W !?5,"Enter the number of the pharmacy location that will receive the transferred the drugs."
- Q
- ;
- SETAORD ;Set logic for "AORD" X-Ref
- S PSADA(1)=$O(^PSD(58.811,"B",X,0))
- S PSADA=0 F S PSADA=$O(^PSD(58.811,PSADA(1),1,PSADA)) Q:'PSADA D
- .S ^PSD(58.811,"AORD",X,$P($G(^PSD(58.811,PSADA(1),1,PSADA,0)),"^"),PSADA(1),PSADA)=""
- K PSADA
- Q
- KILLAORD ;Kill logic for "AORD" X-Ref
- K ^PSD(58.811,"AORD",X)
- Q
- ;
- SLOC ;Set logic for "ALOC" X-Ref on Pharmacy Location & Master Vault fields
- Q:'+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",2)
- S ^PSD(58.811,"ALOC",X,+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",2),DA(1),DA)=""
- Q
- KLOC ;Kill logic for "ALOC" X-Ref on Pharmacy Location & Master Vault fields
- K ^PSD(58.811,"ALOC",X,+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",2),DA(1),DA)
- Q
- ;
- SLOCDT ;Set logic for "ALOC" X-Ref on Invoice Date field
- S:+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",5) ^PSD(58.811,"ALOC",+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",5),X,DA(1),DA)=""
- S:+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",12) ^PSD(58.811,"ALOC",+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",12),X,DA(1),DA)=""
- Q
- KLOCDT ;Kill logic for "ALOC" X-Ref
- K ^PSD(58.811,"ALOC",+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",5),X,DA(1),DA)
- K ^PSD(58.811,"ALOC",+$P($G(^PSD(58.811,DA(1),1,DA,0)),"^",12),X,DA(1),DA)
- Q
- PSAUTL5 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data Utility - CONT'D ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
- +2 ;This utility displays locations & allows user to select one, many, or
- +3 ;all locations.
- +4 KILL PSALOCA,PSAMNU
- +5 SET PSALOC=+$ORDER(^PSD(58.8,"ADISP","P",0))
- +6 IF 'PSALOC
- WRITE !!?5,"No Drug Accountability location has been created yet."
- SET PSAOUT=1
- GOTO EXIT
- +7 ;
- ORDER ;If more than one pharmacy location, collect them in alpha order.
- +1 SET (PSACNT,PSALOC)=0
- WRITE !
- +2 FOR
- SET PSALOC=+$ORDER(^PSD(58.8,"ADISP","P",PSALOC))
- IF 'PSALOC
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^PSD(58.8,PSALOC,0))!($PIECE($GET(^PSD(58.8,PSALOC,0)),"^")="")
- QUIT
- +4 IF +$GET(^PSD(58.8,PSALOC,"I"))
- IF +^PSD(58.8,PSALOC,"I")'>DT
- QUIT
- +5 DO SITES^PSAUTL1
- +6 SET PSACNT=PSACNT+1
- SET PSAONE=+PSALOC
- +7 SET PSALOCA($PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=$PIECE(^(0),"^",3)_"^"_$PIECE(^(0),"^",10)_"^"_$PIECE($GET(^PSD(58.8,PSALOC,"I")),"^")
- End DoDot:1
- +8 IF PSACNT=1
- IF $GET(PSATRAN)=""
- GOTO ONE
- WRITE !?5,"There is only one active pharmacy location.",!?5,"There must be at least two to transfer drugs."
- SET PSAOUT=1
- QUIT
- +9 SET PSACHK=$ORDER(PSALOCA(""))
- IF PSACHK=""
- GOTO EXIT
- +10 GOTO DISP
- +11 ;
- ONE ;only one
- +1 SET PSALOC=PSAONE
- +2 IF '$DATA(^PSD(58.8,PSALOC,0))!($PIECE($GET(^PSD(58.8,PSALOC,0)),"^")="")
- WRITE !,"There are no Drug Accountability pharmacy locations with data."
- QUIT
- +3 SET PSALOCN=""
- SET PSALOCN=$ORDER(PSALOCA(PSALOCN))
- IF PSALOCN=""
- QUIT
- SET PSALOC=0
- SET PSALOC=+$ORDER(PSALOCA(PSALOCN,PSALOC))
- IF 'PSALOC
- QUIT
- SET PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC)
- +4 GOTO EXIT
- +5 ;
- DISP ;Displays the available pharmacy locations.
- +1 WRITE !
- SET PSACNT=0
- SET PSALOCN=""
- +2 FOR
- SET PSALOCN=$ORDER(PSALOCA(PSALOCN))
- IF PSALOCN=""
- QUIT
- Begin DoDot:1
- +3 SET PSALOC=0
- FOR
- SET PSALOC=+$ORDER(PSALOCA(PSALOCN,PSALOC))
- IF 'PSALOC
- QUIT
- Begin DoDot:2
- +4 SET PSACNT=PSACNT+1
- SET PSAMNU(PSACNT,PSALOCN,PSALOC)=""
- +5 WRITE !,$JUSTIFY(PSACNT,2)
- +6 IF $LENGTH(PSALOCN)>76
- WRITE ?4,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?21,$PIECE(PSALOCN,"(IP)",2)
- IF $LENGTH(PSALOCN)<77
- WRITE ?4,PSALOCN
- End DoDot:2
- End DoDot:1
- +7 WRITE !
- +8 ;
- SELECT SET DIR(0)="L^1:"_PSACNT
- SET DIR("A")="Select PHARMACY LOCATION"
- SET DIR("??")="^D HELP^PSAUTL3"
- +1 SET DIR("?")="Enter the number of the pharmacy location"
- +2 DO ^DIR
- KILL DIR
- IF 'Y
- SET PSAOUT=1
- GOTO EXIT
- +3 SET PSASL=Y
- FOR PSAPCC=1:1
- SET PSANUM=+$PIECE(PSASL,",",PSAPCC)
- IF 'PSANUM
- QUIT
- Begin DoDot:1
- +4 SET PSALOCN=$ORDER(PSAMNU(PSANUM,""))
- SET PSALOC=+$ORDER(PSAMNU(PSANUM,PSALOCN,0))
- +5 SET PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC)
- End DoDot:1
- +6 ;
- EXIT ;Kills all variables except PSALOC array & PSAOUT
- +1 ;K DIR,PSACOMB,PSAISIT,PSAISITN,PSAMNU,PSAONE,PSANUM,PSAOSIT,PSAOSITN,Y
- +2 QUIT
- +3 ;
- FROMHELP ;Extended help to 'Select Transfer from Pharmacy'
- +1 WRITE !?5,"Enter the number of the pharmacy location that will transfer the drugs to another pharmacy."
- +2 QUIT
- HELP ;Extended help to 'Select PHARMACY LOCATION'
- +1 WRITE !?5,"Enter the number of the pharmacy location you want to select.",!?5,"If you want more than one pharmacy location, enter the numbers",!?5,"separated by a comma."
- +2 WRITE !!?5,"For example: Enter 1,3 or 1-3,5."
- +3 QUIT
- TOHELP ;Extended help to 'Select Transfer to Pharmacy'
- +1 WRITE !?5,"Enter the number of the pharmacy location that will receive the transferred the drugs."
- +2 QUIT
- +3 ;
- SETAORD ;Set logic for "AORD" X-Ref
- +1 SET PSADA(1)=$ORDER(^PSD(58.811,"B",X,0))
- +2 SET PSADA=0
- FOR
- SET PSADA=$ORDER(^PSD(58.811,PSADA(1),1,PSADA))
- IF 'PSADA
- QUIT
- Begin DoDot:1
- +3 SET ^PSD(58.811,"AORD",X,$PIECE($GET(^PSD(58.811,PSADA(1),1,PSADA,0)),"^"),PSADA(1),PSADA)=""
- End DoDot:1
- +4 KILL PSADA
- +5 QUIT
- KILLAORD ;Kill logic for "AORD" X-Ref
- +1 KILL ^PSD(58.811,"AORD",X)
- +2 QUIT
- +3 ;
- SLOC ;Set logic for "ALOC" X-Ref on Pharmacy Location & Master Vault fields
- +1 IF '+$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",2)
- QUIT
- +2 SET ^PSD(58.811,"ALOC",X,+$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",2),DA(1),DA)=""
- +3 QUIT
- KLOC ;Kill logic for "ALOC" X-Ref on Pharmacy Location & Master Vault fields
- +1 KILL ^PSD(58.811,"ALOC",X,+$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",2),DA(1),DA)
- +2 QUIT
- +3 ;
- SLOCDT ;Set logic for "ALOC" X-Ref on Invoice Date field
- +1 IF +$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",5)
- SET ^PSD(58.811,"ALOC",+$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",5),X,DA(1),DA)=""
- +2 IF +$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",12)
- SET ^PSD(58.811,"ALOC",+$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",12),X,DA(1),DA)=""
- +3 QUIT
- KLOCDT ;Kill logic for "ALOC" X-Ref
- +1 KILL ^PSD(58.811,"ALOC",+$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",5),X,DA(1),DA)
- +2 KILL ^PSD(58.811,"ALOC",+$PIECE($GET(^PSD(58.811,DA(1),1,DA,0)),"^",12),X,DA(1),DA)
- +3 QUIT