Routine: PSALOC

PSALOC ;BIR/MNT,DB-Set Up/Edit a Pharmacy Location ;7/23/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97

 ;References to ^PS(59, are covered under IA #212

 ;References to ^PS(59.4, are covered under IA #2505

 ;Due to merging facilities, this functionality is being

 K PSALOC,PSALOCA,PSAMNU

 S PSALOC=+$O(^PSD(58.8,"ADISP","P",0))

 I 'PSALOC W !!?5,"No Drug Accountability location has been created yet." G ADD

 D HDR

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

 .K PSAISIT,PSAOSIT

 .S PSACNT=PSACNT+1,PSAONE=+PSALOC

 .S PSALOCA($P(^PSD(58.8,PSALOC,0),"^"),PSALOC)=$P(^(0),"^",3)_"^"_$P(^(0),"^",10) I $D(^PSD(58.8,PSALOC,7)) D

 ..;OP multiple has data

 ..S X2=0 F  S X2=$O(^PSD(58.8,PSALOC,7,X2)) Q:X2'>0  I $P(^PSD(58.8,PSALOC,0),"^",10)'=X2,$P($G(^PSD(58.8,PSALOC,7,X2,0)),"^",2)="" S PSALOCA($P(^PSD(58.8,PSALOC,0),"^"),PSALOC)=PSALOCA($P(^PSD(58.8,PSALOC,0),"^"),PSALOC)_"^"_X2

 S PSACHK=$O(PSALOCA("")) I PSACHK="" G ADD

 I $G(PSACNT)=1 G DISP

 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

 G EXIT

DISP ;Displays the available pharmacy locations.

 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)=PSALOCA(PSALOCN,PSALOC)

 ..W !,$J(PSACNT,2),?5,PSALOCN S DATA=PSAMNU(PSACNT,PSALOCN,PSALOC) W:$P(DATA,"^",1)'="" ?25,$P($G(^PS(59.4,$P(DATA,"^",1),0)),"^") W:$P(DATA,"^",2)'="" ?50,$P($G(^PS(59,$P(DATA,"^",2),0)),"^")

 ..I $P(DATA,"^",3)'="" F X3=3:1 Q:$P(DATA,"^",X3)=""  W:$P(DATA,"^",2)'="" "," W !,?50,$P($G(^PS(59,$P(DATA,"^",X3),0)),"^")

 ..;I $D(^PSD(58.8,PSALOC,"I")) W !,"*****   INACTIVE   *****"

 ;S PSACNT=$G(PSACNT)+1 W !,$J(PSACNT,2),?5,"New Pharmacy Location",! S PSANEW=PSACNT

SELECT S DIR(0)="L^1:"_PSACNT,DIR("A")="Select PHARMACY LOCATION",DIR("??")="^D HELP^PSAUTL3"

 K PSALOC

 S DIR("?")="Enter the number of the pharmacy location"

 D ^DIR K DIR I 'Y S PSAOUT=1 G EXIT

 S PSANUM=+Y

 ;I +Y=PSANEW G ADD

 S PSALOCN=$O(PSAMNU(+Y,"")),PSALOC=+$O(PSAMNU(+Y,PSALOCN,0)),PSAITY=$S($E(PSALOCN)="C":3,$E(PSALOCN)="I":1,$E(PSALOCN)="O":2,1:"")

EXIT ;Kills all variables except PSALOC array & PSAOUT

 K AN,AN1,CNT,CNT1,CNT2,DA,DATA,DIC,DIE,DIR,PSA,PSAB,PSAC,PSACHK,PSACOMB,PSADEL,PSADRUG,PSADT,PSAERR,PSAI,PSAII,PSAINV,PSAIPS,PSAISIT,PSAISITN

 K PSAIT,PSAITY,PSAIV,PSAIVCHG,PSAIVLOC,PSALEN,PSALOC,PSALOCA,PSALOCI,PSALOCN,PSAMNU,PSANEW,PSANLN,PSANLN1,PSANLN2,PSANOW,PSANUM,PSAO,PSAOC,PSAOK,PSAONE,PSAOP,PSAOSIT,PSAOSITN,PSAOU,PSAOUT,PSAPVMEN

 K PSAQTY,PSASL,PSASTO,PSAT,PSATYP,PSAWARD,PSAY,X,X2,X3,XX,Y

ADD ;add locations

 W !,"New location set-up"

 S DIR(0)="S^1:INPATIENT;2:OUTPATIENT;3:COMBINED (IP/OP)",DIR("A")="Select Pharmacy type",DIR("?")="You can separate Inpatient and Outpatient or Combine into one location.",DIR("??")="PSA LOCATION EDIT"

 D ^DIR I $G(DIRUT)=1!($G(DUOUT)=1) W !,"bye" G EXIT

 S PSAITY=+Y,PSALOCN=Y(0) I $D(^PSD(58.8,"B",PSALOCN)) W !,"There is at least one entry setup with this name. Could we expand the name ?",!,"Something like "_PSALOCN_" (WEST WING) ?" D

NEWNM .;new Name

 .R !!,"Please add text for a more descriptive name: ",AN1:DTIME I AN1["^"!('$T)!(AN1="") S PSAOUT=1 Q

 .S AN=PSALOCN_" "_AN1

 .I AN=PSALOCN W !,"Sorry that is what I have already" S PSAOUT=1 Q

 .W !,"New name: "_AN

 .I AN'=PSALOCN S PSALOCN=AN D

 ..W !,"Are you sure ? YES// " R AN:DTIME I AN["^" S PSAOUT=1 Q

 ..I AN="" S AN="Y"

 ..S AN=$E(AN,1) I "Nn"[AN S PSAOUT=1 Q

 ..I '$D(^PSD(58.8,"B",AN)) S PSANEW=1 Q

 ..I $D(^PSD(58.8,"B",AN)) W "sorry, this one exists" S PSAOUT=1 Q

 I $G(PSAOUT)=1 G EXIT

 I '$D(^PSD(58.8,"B",PSALOCN)) S PSANEW=1

 I $G(PSANEW) S X=PSALOCN,DIC(0)="AEQMLZ",DLAYGO="58.8",DIC="^PSD(58.8," D FILE^DICN K DIC,DA S PSALOC=+Y,DIE="^PSD(58.8,",DA=+Y,DR="1////P" D ^DIE K DIE,DR,DA Q

HDR W @IOF,?20,"<<<<< PHARMACY LOCATION SETUP SCREEN  >>>>>  ",!!,"LOCATION TYPES : INPATIENT, OUTPATIENT & COMBINED (IP/OP)",!!,"#",?5,"LOCATION ",?25,"INPATIENT SITE",?50,"OUTPATIENT SITE(s)",! F X=1:1:(IOM-4) W "="

PSALOC    ;BIR/MNT,DB-Set Up/Edit a Pharmacy Location ;7/23/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97

 +2       ;

 +3       ;References to ^PS(59, are covered under IA #212

 +4       ;References to ^PS(59.4, are covered under IA #2505

 +5       ;Due to merging facilities, this functionality is being

 +6        KILL PSALOC,PSALOCA,PSAMNU

 +7        SET PSALOC=+$ORDER(^PSD(58.8,"ADISP","P",0))

 +8        IF 'PSALOC

               WRITE !!?5,"No Drug Accountability location has been created yet."

               GOTO ADD

 +9        DO HDR

 +10      ;

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                KILL PSAISIT,PSAOSIT

 +7                SET PSACNT=PSACNT+1

                   SET PSAONE=+PSALOC

 +8                SET PSALOCA($PIECE(^PSD(58.8,PSALOC,0),"^"),PSALOC)=$PIECE(^(0),"^",3)_"^"_$PIECE(^(0),"^",10)

                   IF $DATA(^PSD(58.8,PSALOC,7))

                       Begin DoDot:2

 +9       ;OP multiple has data

 +10                       SET X2=0

FOR

                               SET X2=$ORDER(^PSD(58.8,PSALOC,7,X2))

                               IF X2'>0

                                   QUIT

                               IF $PIECE(^PSD(58.8,PSALOC,0),"^",10)'=X2

                                   IF $PIECE($GET(^PSD(58.8,PSALOC,7,X2,0)),"^",2)=""

                                       SET PSALOCA($PIECE(^PSD(58.8,PSALOC,0),"^"),PSALOC)=PSALOCA($PIECE(^PSD(58.8,PSALOC,0),"^"),PSALOC)_"^"_X2

                       End DoDot:2

               End DoDot:1

 +11       SET PSACHK=$ORDER(PSALOCA(""))

           IF PSACHK=""

               GOTO ADD

 +12       IF $GET(PSACNT)=1

               GOTO DISP

 +13       GOTO DISP

 +14      ;

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

 +4        GOTO EXIT

 +5       ;

DISP      ;Displays the available pharmacy locations.

 +1        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)=PSALOCA(PSALOCN,PSALOC)

 +5                        WRITE !,$JUSTIFY(PSACNT,2),?5,PSALOCN

                           SET DATA=PSAMNU(PSACNT,PSALOCN,PSALOC)

                           IF $PIECE(DATA,"^",1)'=""

                               WRITE ?25,$PIECE($GET(^PS(59.4,$PIECE(DATA,"^",1),0)),"^")

                           IF $PIECE(DATA,"^",2)'=""

                               WRITE ?50,$PIECE($GET(^PS(59,$PIECE(DATA,"^",2),0)),"^")

 +6                        IF $PIECE(DATA,"^",3)'=""

                               FOR X3=3:1

                                   IF $PIECE(DATA,"^",X3)=""

                                       QUIT

                                   IF $PIECE(DATA,"^",2)'=""

                                       WRITE ","

                                   WRITE !,?50,$PIECE($GET(^PS(59,$PIECE(DATA,"^",X3),0)),"^")

 +7       ;I $D(^PSD(58.8,PSALOC,"I")) W !,"*****   INACTIVE   *****"

                       End DoDot:2

               End DoDot:1

 +8       ;S PSACNT=$G(PSACNT)+1 W !,$J(PSACNT,2),?5,"New Pharmacy Location",! S PSANEW=PSACNT

 +9       ;

SELECT     SET DIR(0)="L^1:"_PSACNT

           SET DIR("A")="Select PHARMACY LOCATION"

           SET DIR("??")="^D HELP^PSAUTL3"

 +1        KILL PSALOC

 +2        SET DIR("?")="Enter the number of the pharmacy location"

 +3        DO ^DIR

           KILL DIR

           IF 'Y

               SET PSAOUT=1

               GOTO EXIT

 +4        SET PSANUM=+Y

 +5       ;I +Y=PSANEW G ADD

 +6        SET PSALOCN=$ORDER(PSAMNU(+Y,""))

           SET PSALOC=+$ORDER(PSAMNU(+Y,PSALOCN,0))

           SET PSAITY=$SELECT($EXTRACT(PSALOCN)="C":3,$EXTRACT(PSALOCN)="I":1,$EXTRACT(PSALOCN)="O":2,1:"")

 +7        QUIT

 +8       ;

EXIT      ;Kills all variables except PSALOC array & PSAOUT

 +1        KILL AN,AN1,CNT,CNT1,CNT2,DA,DATA,DIC,DIE,DIR,PSA,PSAB,PSAC,PSACHK,PSACOMB,PSADEL,PSADRUG,PSADT,PSAERR,PSAI,PSAII,PSAINV,PSAIPS,PSAISIT,PSAISITN

 +2        KILL PSAIT,PSAITY,PSAIV,PSAIVCHG,PSAIVLOC,PSALEN,PSALOC,PSALOCA,PSALOCI,PSALOCN,PSAMNU,PSANEW,PSANLN,PSANLN1,PSANLN2,PSANOW,PSANUM,PSAO,PSAOC,PSAOK,PSAONE,PSAOP,PSAOSIT,PSAOSITN,PSAOU,PSAOUT,PSAPVMEN

 +3        KILL PSAQTY,PSASL,PSASTO,PSAT,PSATYP,PSAWARD,PSAY,X,X2,X3,XX,Y

 +4        QUIT

 +5        QUIT

 +6       ;

ADD       ;add locations

 +1        WRITE !,"New location set-up"

 +2        SET DIR(0)="S^1:INPATIENT;2:OUTPATIENT;3:COMBINED (IP/OP)"

           SET DIR("A")="Select Pharmacy type"

           SET DIR("?")="You can separate Inpatient and Outpatient or Combine into one location."

           SET DIR("??")="PSA LOCATION EDIT"

 +3        DO ^DIR

           IF $GET(DIRUT)=1!($GET(DUOUT)=1)

               WRITE !,"bye"

               GOTO EXIT

 +4        SET PSAITY=+Y

           SET PSALOCN=Y(0)

           IF $DATA(^PSD(58.8,"B",PSALOCN))

               WRITE !,"There is at least one entry setup with this name. Could we expand the name ?",!,"Something like "_PSALOCN_" (WEST WING) ?"

               Begin DoDot:1

NEWNM     ;new Name

 +1                READ !!,"Please add text for a more descriptive name: ",AN1:DTIME

                   IF AN1["^"!('$TEST)!(AN1="")

                       SET PSAOUT=1

                       QUIT

 +2                SET AN=PSALOCN_" "_AN1

 +3                IF AN=PSALOCN

                       WRITE !,"Sorry that is what I have already"

                       SET PSAOUT=1

                       QUIT

 +4                WRITE !,"New name: "_AN

 +5                IF AN'=PSALOCN

                       SET PSALOCN=AN

                       Begin DoDot:2

 +6                        WRITE !,"Are you sure ? YES// "

                           READ AN:DTIME

                           IF AN["^"

                               SET PSAOUT=1

                               QUIT

 +7                        IF AN=""

                               SET AN="Y"

 +8                        SET AN=$EXTRACT(AN,1)

                           IF "Nn"[AN

                               SET PSAOUT=1

                               QUIT

 +9                        IF '$DATA(^PSD(58.8,"B",AN))

                               SET PSANEW=1

                               QUIT

 +10                       IF $DATA(^PSD(58.8,"B",AN))

                               WRITE "sorry, this one exists"

                               SET PSAOUT=1

                               QUIT

                       End DoDot:2

               End DoDot:1

 +11       IF $GET(PSAOUT)=1

               GOTO EXIT

 +12       IF '$DATA(^PSD(58.8,"B",PSALOCN))

               SET PSANEW=1

 +13       IF $GET(PSANEW)

               SET X=PSALOCN

               SET DIC(0)="AEQMLZ"

               SET DLAYGO="58.8"

               SET DIC="^PSD(58.8,"

               DO FILE^DICN

               KILL DIC,DA

               SET PSALOC=+Y

               SET DIE="^PSD(58.8,"

               SET DA=+Y

               SET DR="1////P"

               DO ^DIE

               KILL DIE,DR,DA

               QUIT

 +14       QUIT

HDR        WRITE @IOF,?20,"<<<<< PHARMACY LOCATION SETUP SCREEN  >>>>>  ",!!,"LOCATION TYPES : INPATIENT, OUTPATIENT & COMBINED (IP/OP)",!!,"#",?5,"LOCATION ",?25,"INPATIENT SITE",?50,"OUTPATIENT SITE(s)",!

           FOR X=1:1:(IOM-4)

               WRITE "="

 +1        QUIT

PSALOC.m