| [613] | 1 | PSAENT ;BIR/LTL,JMB-Set Up/Edit a Pharmacy Location ;7/23/97
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
|
|---|
| 3 | ;
|
|---|
| 4 | ;References to ^PS(59.4, are covered under IA #2505
|
|---|
| 5 | START D DT^DICRW
|
|---|
| 6 | N D0,D1,DA,DIE,DIC,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,PSA,PSAB,PSAC,PSADRUG,PSAII,PSAIT,PSAIPS,PSAINV,PSAISIT,PSAIVLOC,PSALOC,PSAOC,PSALOCN,PSAOSIT,PSASTO,PSAITY,PSANOW,PSAOP,PSAO,PSAI,PSAOU,X,Y
|
|---|
| 7 | ;pick type
|
|---|
| 8 | 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"
|
|---|
| 9 | D ^DIR K DIR Q:'Y S PSAITY=+Y,PSALOCN=Y(0)
|
|---|
| 10 | ;new IP or combined
|
|---|
| 11 | D:'$O(^PSD(58.8,"ADISP","P",0))
|
|---|
| 12 | .W !!,"Creating ",PSALOCN H 1
|
|---|
| 13 | .S DIC="^PSD(58.8,",DIC(0)="L",DLAYGO=58.8,X=PSALOCN,DIC("DR")="1////P",DIC("S")="I $S($P($G(^(0)),U,2)]"""":$P($G(^(0)),U,2)=""P"",1:1)" D ^DIC K DIC S PSALOC=+Y
|
|---|
| 14 | D:PSAITY'=2
|
|---|
| 15 | .;check for more than one IP site
|
|---|
| 16 | .S (PSA(1),PSA(2))=0 F S PSA(1)=$O(^PS(59.4,PSA(1))) Q:'PSA(1) S:$P($G(^(PSA(1),0)),U,26)=1 PSA(2)=PSA(2)+1,PSAB=PSA(1)
|
|---|
| 17 | .I PSA(2)<1 W !!,"An Inpatient Site has not been identified for AR/WS.",!!,"AR/WS dispensing data may not be gathered.",!! S:PSAITY=3 PSAO=1 S:PSAITY=1 PSAOU=1 Q
|
|---|
| 18 | .S:PSA(2)=1 PSAISIT=PSAB
|
|---|
| 19 | .D:PSA(2)>1 I Y<1 S PSAOU=1 Q
|
|---|
| 20 | ..W !!,"Because there is more than one Inpatient Site at this facility, I need you to"
|
|---|
| 21 | ..S DIC="^PS(59.4,",DIC(0)="AEMQZ",DIC("A")="select an AR/WS Inpatient Site Name: ",DIC("S")="I $P($G(^(0)),U,26)=1" D ^DIC K DIC S:$D(DUOUT)!($D(DTOUT))!(X="") PSAOU=1 S:PSAITY=3&(Y<1) PSAO=1 Q:Y<1 S PSAISIT=+Y
|
|---|
| 22 | .I $D(PSALOC) D Q
|
|---|
| 23 | ..S DIE="^PSD(58.8,",DA=PSALOC,DR="2////^S X=PSAISIT" D ^DIE K DIE S Y=0
|
|---|
| 24 | .S PSALOC=""
|
|---|
| 25 | .F S PSALOC=$O(^PSD(58.8,"ASITE",PSAISIT,"P",PSALOC)) Q:'PSALOC I $S('$G(^PSD(58.8,+PSALOC,"I")):1,+^("I")>DT:1,1:0) Q
|
|---|
| 26 | .D:'PSALOC
|
|---|
| 27 | ..K DD,DO S DIC="^PSD(58.8,",DIC(0)="LZ",X=PSALOCN,DIC("DR")="1////P;2////^S X=PSAISIT" D FILE^DICN K DIC S PSALOC=+Y,PSALOCN=Y(0,0)
|
|---|
| 28 | .I PSALOC S PSALOCN=$P($G(^PSD(58.8,+PSALOC,0)),U) D Q:'Y
|
|---|
| 29 | ..W !!,PSALOCN," is set up to gather AR/WS dispensing data for ",$P($G(^PS(59.4,PSAISIT,0)),U)
|
|---|
| 30 | ..;PSA*3*21 (Dave B 0 Allow selection of linking/unlinking rooms)
|
|---|
| 31 | ..S DIR(0)="Y",DIR("A")="Do you wish to change this",DIR("B")="No" D ^DIR K DIR S:'Y PSAO=1 S:$D(DIRUT) PSAOU=1 Q:'Y
|
|---|
| 32 | ..S DIR(0)="Y",DIR("A")="Do you want to change "_PSALOCN_" to "_$S($E(PSALOCN)="I":"COMBINED (IP/OP)",$E(PSALOCN)="C":"INPATIENT",1:""),DIR("B")="No" D ^DIR K DIR S:'Y PSAO=1 S:$D(DIRUT) PSAOU=1 Q:'Y D
|
|---|
| 33 | ...S DIE="^PSD(58.8,",DA=PSALOC,DR=$S($E(PSALOCN)="I":".01////COMBINED (IP/OP)",$E(PSALOCN)="C":".01////INPATIENT;20////@",1:"") D ^DIE K DIE,DA S Y=1 I $E(PSALOCN)="I" S PSAO=1,PSAOC=1
|
|---|
| 34 | ...S PSALOCN=$P($G(^PSD(58.8,+PSALOC,0)),U)
|
|---|
| 35 | D:PSAITY'=2&('$G(PSAOU)) ^PSAWARD S:PSAITY=2 PSAO=1 Q:$D(PSAOU)
|
|---|
| 36 | I $D(PSAO) D OP^PSAENTO G QUIT
|
|---|
| 37 | D:'$G(PSAPVMEN) ED^PSAENTO D:$G(PSAPVMEN) DRUGS^PSAENTO
|
|---|
| 38 | QUIT Q:'$D(PSALOC)
|
|---|
| 39 | W ! S DIE="^PSD(58.8,",DA=PSALOC,DR=$S(+$G(PSAPVMEN):"34Maintain reorder levels;35Days to keep invoice data;4Inactive Date",1:"4Inactive Date") D ^DIE K DIE
|
|---|
| 40 | Q
|
|---|
