- PSALOC2 ;BIR/MNT,DB-Set Up/Edit a Pharmacy Location ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
- ;
- ;This routine is for taking a Combined IP/OP & making it
- ;an Inpatient Site & Outpatient Site
- K PSAISIT,PSAERR,PSAOSIT,PSACNTR
- I $E(PSALOCN)'="C" G CMBSETUP
- W !,"You will be prompted for an existing Inpatient & Outpatient location.",!,"Both types can be selected, or just one.",!!
- INPAT S PSATYPE="INPATIENT" D SETDIC S DIC("S")="I $E($P(^(0),U,1),1,5)=""INPAT""" D ^DIC S PSAISIT=+Y,PSAISIT(1)=$P(Y,"^",2) I $D(DIRUT) G Q
- OUTPA S PSATYPE="OUTPATIENT" D SETDIC S DIC("S")="I $E($P(^(0),U,1),1,5)=""OUTPA""" D ^DIC S PSAOSIT=+Y,PSAOSIT(1)=$P(Y,"^",2) I $D(DIRUT) G Q
- G STRDATA
- ;
- ;
- STRDATA ;store data
- I $G(PSAISIT(1))'="" W !,"Inpatient Site : "_PSAISIT(1) S PSACNTR=$G(PSACNTR)+1
- I $G(PSAOSIT(1))'="" W !,"Outpatient Site : "_PSAOSIT(1) S PSACNTR=$G(PSACNTR)+1
- I $G(PSAISIT)'>0,$G(PSAOSIT)'>0 W !,"No changes made" G Q
- I $G(PSACNTR)>1 G FINISH
- S PSANEWL=$S($G(PSAISIT)>0:PSAISIT,1:PSAOSIT)
- I $O(^PSD(58.8,PSANEWL,1,0))>0 G FINISH
- D DRUGS G Q:$G(PSAERR)=1
- ;
- ;
- FINISH ;done setting up location
- I $G(PSAISIT)>0,$G(PSAISIT(1))'="",$P(^PSD(58.8,PSAISIT,0),"^",3)="",$P(^PSD(58.8,PSALOC,0),"^",3)'="" D SETUPIP G Q:$G(PSAERR)'=""
- I $G(PSAOSIT)>0,$G(PSAOSIT(1))'="",$O(^PSD(58.8,PSALOC,7,0))'="",$O(^PSD(58.8,PSAOSIT,7,0))'>0 D SETUPOP G Q:$G(PSAERR)'=""
- ;
- DONEI W !,"Do you want to Inactivate "_PSALOCN_" now ? YES// " R AN:DTIME G Q:AN["^" S:AN="" AN="Y" S AN=$E(AN)
- I "YyNn"'[AN W !,"Since your setting up a new location, there is no point in keeping this one in",!,"an active state. Answer 'Y'es to inactivate this location.",! K AN G DONEI
- ;
- ;Inactivate original location
- I "yY"[AN W !,PSALOCN," is now inactive." S $P(^PSD(58.8,PSALOC,"I"),"^",1)=DT
- G Q
- ;
- ;
- SETUPIP W !,"Do you want to setup "_PSAISIT(1)_" with the same inpatient site",!,"already identified in "_PSALOCN
- W " ? YES // " R AN:DTIME I AN["^" S PSAERR=1 Q
- S AN=$E(AN) I "yYnN"'[AN W !,"Answer Yes, and the inpatient site currently assigned to the Combined location",!,"will be assigned to the inpatient site." K AN G SETUPIP
- I "nN"[AN Q
- S DIE="^PSD(58.8,",DA=PSAISIT,DR="2////^S X=$P(^PSD(58.8,PSALOC,0),U,2)" D ^DIE
- Q
- ;
- ;
- SETUPOP W !,"Do you want to setup "_PSAOSIT(1)_" with the same Outpatient location(s), ",!,"already defined for "_PSALOCN
- W " ? YES // " R AN:DTIME I AN["^" S PSAERR=1 Q
- S AN=$E(AN) I "yYnN"'[AN W !,"Answer Yes, and the outpatient site(s) assigned to the Combined location",!,"will be assigned to the Outpatient location." K AN G SETUPOP
- I "Nn"[AN Q
- S DIE="^PSD(58.8,",DA=PSAOSIT,DR="10////^S X=$P(^PSD(58.8,PSALOC,0),U,10)" D ^DIE
- S %X="^PSD(58.8,PSALOC,7,",%Y="^PSD(58.8,PSAOSIT,7," D XY^%RCR(%X,%Y)
- Q
- ;
- ;
- CMBSETUP ;Setup combined location
- S DIC("A")="Select Combined location: ",DIC(0)="AEQMZ",DIC="^PSD(58.8,",DIC("S")="I $E($P(^(0),U,1),1,5)=""COMBI""" D ^DIC
- G Q:+Y'>0 I $P($G(^PSD(58.8,+Y,"I")),"^")'="" W !,"Sorry, this is an inactive pharmacy location.",! K Y G CMBSETUP
- I $O(^PSD(58.8,+Y,1,0))="" S PSANEWL=+Y D DRUGS
- G FINISH
- ;
- ;
- DRUGS I $O(^PSD(58.8,PSALOC,1,0))="" Q
- I '$D(^PSD(58.8,PSALOC,1,0)) Q
- W !,"Do you want to transfer the drugs from "_PSALOCN_" to "_$P(^PSD(58.8,PSANEWL,0),"^")_" YES // " R AN:DTIME S:AN["^" PSAERR=1 Q:$G(PSAERR)=1 I AN="" S AN="Y"
- S AN=$E(AN) I "yYnN"'[AN W !!,"Since "_PSALOCN_" will be made inactive after setup is complete, you can",!,"transfer each drug and its balance information to the new location.",! G DRUGS
- I "Nn"[AN Q
- I "Yy"[AN S X1=0,^PSD(58.8,PSANEWL,1,0)=^PSD(58.8,PSALOC,1,0) F S X1=$O(^PSD(58.8,PSALOC,1,X1)) Q:X1'>0 S ^PSD(58.8,PSANEWL,1,X1,0)=^PSD(58.8,PSALOC,1,X1,0),^PSD(58.8,PSALOC,1,"B",X1,X1)="" W "."
- W !,"Drug transfer complete."
- Q
- ;
- ;
- SETDIC K DIC S DIC("A")="Select "_PSATYPE_" Pharmacy Location: ",DIC="^PSD(58.8,",DIC(0)="AEBQ"
- Q Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSALOC2 3951 printed Mar 13, 2025@20:54:12 Page 2
- PSALOC2 ;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 ;This routine is for taking a Combined IP/OP & making it
- +4 ;an Inpatient Site & Outpatient Site
- +5 KILL PSAISIT,PSAERR,PSAOSIT,PSACNTR
- +6 IF $EXTRACT(PSALOCN)'="C"
- GOTO CMBSETUP
- +7 WRITE !,"You will be prompted for an existing Inpatient & Outpatient location.",!,"Both types can be selected, or just one.",!!
- INPAT SET PSATYPE="INPATIENT"
- DO SETDIC
- SET DIC("S")="I $E($P(^(0),U,1),1,5)=""INPAT"""
- DO ^DIC
- SET PSAISIT=+Y
- SET PSAISIT(1)=$PIECE(Y,"^",2)
- IF $DATA(DIRUT)
- GOTO Q
- OUTPA SET PSATYPE="OUTPATIENT"
- DO SETDIC
- SET DIC("S")="I $E($P(^(0),U,1),1,5)=""OUTPA"""
- DO ^DIC
- SET PSAOSIT=+Y
- SET PSAOSIT(1)=$PIECE(Y,"^",2)
- IF $DATA(DIRUT)
- GOTO Q
- +1 GOTO STRDATA
- +2 ;
- +3 ;
- STRDATA ;store data
- +1 IF $GET(PSAISIT(1))'=""
- WRITE !,"Inpatient Site : "_PSAISIT(1)
- SET PSACNTR=$GET(PSACNTR)+1
- +2 IF $GET(PSAOSIT(1))'=""
- WRITE !,"Outpatient Site : "_PSAOSIT(1)
- SET PSACNTR=$GET(PSACNTR)+1
- +3 IF $GET(PSAISIT)'>0
- IF $GET(PSAOSIT)'>0
- WRITE !,"No changes made"
- GOTO Q
- +4 IF $GET(PSACNTR)>1
- GOTO FINISH
- +5 SET PSANEWL=$SELECT($GET(PSAISIT)>0:PSAISIT,1:PSAOSIT)
- +6 IF $ORDER(^PSD(58.8,PSANEWL,1,0))>0
- GOTO FINISH
- +7 DO DRUGS
- if $GET(PSAERR)=1
- GOTO Q
- +8 ;
- +9 ;
- FINISH ;done setting up location
- +1 IF $GET(PSAISIT)>0
- IF $GET(PSAISIT(1))'=""
- IF $PIECE(^PSD(58.8,PSAISIT,0),"^",3)=""
- IF $PIECE(^PSD(58.8,PSALOC,0),"^",3)'=""
- DO SETUPIP
- if $GET(PSAERR)'=""
- GOTO Q
- +2 IF $GET(PSAOSIT)>0
- IF $GET(PSAOSIT(1))'=""
- IF $ORDER(^PSD(58.8,PSALOC,7,0))'=""
- IF $ORDER(^PSD(58.8,PSAOSIT,7,0))'>0
- DO SETUPOP
- if $GET(PSAERR)'=""
- GOTO Q
- +3 ;
- DONEI WRITE !,"Do you want to Inactivate "_PSALOCN_" now ? YES// "
- READ AN:DTIME
- if AN["^"
- GOTO Q
- if AN=""
- SET AN="Y"
- SET AN=$EXTRACT(AN)
- +1 IF "YyNn"'[AN
- WRITE !,"Since your setting up a new location, there is no point in keeping this one in",!,"an active state. Answer 'Y'es to inactivate this location.",!
- KILL AN
- GOTO DONEI
- +2 ;
- +3 ;Inactivate original location
- +4 IF "yY"[AN
- WRITE !,PSALOCN," is now inactive."
- SET $PIECE(^PSD(58.8,PSALOC,"I"),"^",1)=DT
- +5 GOTO Q
- +6 ;
- +7 ;
- SETUPIP WRITE !,"Do you want to setup "_PSAISIT(1)_" with the same inpatient site",!,"already identified in "_PSALOCN
- +1 WRITE " ? YES // "
- READ AN:DTIME
- IF AN["^"
- SET PSAERR=1
- QUIT
- +2 SET AN=$EXTRACT(AN)
- IF "yYnN"'[AN
- WRITE !,"Answer Yes, and the inpatient site currently assigned to the Combined location",!,"will be assigned to the inpatient site."
- KILL AN
- GOTO SETUPIP
- +3 IF "nN"[AN
- QUIT
- +4 SET DIE="^PSD(58.8,"
- SET DA=PSAISIT
- SET DR="2////^S X=$P(^PSD(58.8,PSALOC,0),U,2)"
- DO ^DIE
- +5 QUIT
- +6 ;
- +7 ;
- SETUPOP WRITE !,"Do you want to setup "_PSAOSIT(1)_" with the same Outpatient location(s), ",!,"already defined for "_PSALOCN
- +1 WRITE " ? YES // "
- READ AN:DTIME
- IF AN["^"
- SET PSAERR=1
- QUIT
- +2 SET AN=$EXTRACT(AN)
- IF "yYnN"'[AN
- WRITE !,"Answer Yes, and the outpatient site(s) assigned to the Combined location",!,"will be assigned to the Outpatient location."
- KILL AN
- GOTO SETUPOP
- +3 IF "Nn"[AN
- QUIT
- +4 SET DIE="^PSD(58.8,"
- SET DA=PSAOSIT
- SET DR="10////^S X=$P(^PSD(58.8,PSALOC,0),U,10)"
- DO ^DIE
- +5 SET %X="^PSD(58.8,PSALOC,7,"
- SET %Y="^PSD(58.8,PSAOSIT,7,"
- DO XY^%RCR(%X,%Y)
- +6 QUIT
- +7 ;
- +8 ;
- CMBSETUP ;Setup combined location
- +1 SET DIC("A")="Select Combined location: "
- SET DIC(0)="AEQMZ"
- SET DIC="^PSD(58.8,"
- SET DIC("S")="I $E($P(^(0),U,1),1,5)=""COMBI"""
- DO ^DIC
- +2 if +Y'>0
- GOTO Q
- IF $PIECE($GET(^PSD(58.8,+Y,"I")),"^")'=""
- WRITE !,"Sorry, this is an inactive pharmacy location.",!
- KILL Y
- GOTO CMBSETUP
- +3 IF $ORDER(^PSD(58.8,+Y,1,0))=""
- SET PSANEWL=+Y
- DO DRUGS
- +4 GOTO FINISH
- +5 ;
- +6 ;
- DRUGS IF $ORDER(^PSD(58.8,PSALOC,1,0))=""
- QUIT
- +1 IF '$DATA(^PSD(58.8,PSALOC,1,0))
- QUIT
- +2 WRITE !,"Do you want to transfer the drugs from "_PSALOCN_" to "_$PIECE(^PSD(58.8,PSANEWL,0),"^")_" YES // "
- READ AN:DTIME
- if AN["^"
- SET PSAERR=1
- if $GET(PSAERR)=1
- QUIT
- IF AN=""
- SET AN="Y"
- +3 SET AN=$EXTRACT(AN)
- IF "yYnN"'[AN
- WRITE !!,"Since "_PSALOCN_" will be made inactive after setup is complete, you can",!,"transfer each drug and its balance information to the new location.",!
- GOTO DRUGS
- +4 IF "Nn"[AN
- QUIT
- +5 IF "Yy"[AN
- SET X1=0
- SET ^PSD(58.8,PSANEWL,1,0)=^PSD(58.8,PSALOC,1,0)
- FOR
- SET X1=$ORDER(^PSD(58.8,PSALOC,1,X1))
- if X1'>0
- QUIT
- SET ^PSD(58.8,PSANEWL,1,X1,0)=^PSD(58.8,PSALOC,1,X1,0)
- SET ^PSD(58.8,PSALOC,1,"B",X1,X1)=""
- WRITE "."
- +6 WRITE !,"Drug transfer complete."
- +7 QUIT
- +8 ;
- +9 ;
- SETDIC KILL DIC
- SET DIC("A")="Select "_PSATYPE_" Pharmacy Location: "
- SET DIC="^PSD(58.8,"
- SET DIC(0)="AEBQ"
- Q QUIT
