- PSAENTO ;BIR/LTL,JMB-Set Up/Edit a Pharmacy Location - CONT'D ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,43,63**; 10/24/97;Build 10
- ;This routines is called by PSAENT.
- ;
- ;References to global ^PRC(441 are covered by IA #214
- ;References to global ^PRCP(445 are covered by IA #214
- ;References to global ^PS(52.6, are covered by IA #270
- ;References to global ^PS(52.7 are covered by IA #770
- ;References to global ^PS(59, are covered by IA #212
- ;References to global ^PS(59.5 are covered by IA #1884
- ;References to global ^PSDRUG( are covered by IA #2095
- ;References to global ^PSDRUG("AB" are covered by IA #2095
- ;
- ;External references to $$DESCR^PRCPUX1 are covered by IA #259
- ;External references to $$INVNAME^PRCPUX1 are covered by IA #259
- ;
- ;
- ;
- OP G:$P($G(^PSD(58.8,+$G(PSALOC),0)),U,10) OPC
- S Y=1 S PSA=$O(^PS(59,0)) D:$O(^PS(59,PSA)) G:Y<0 QUIT
- .;more than one OP site
- .W !!,"Because there is more than one Outpatient Site at this facility, I need you to "
- .S DIC="^PS(59,",DIC(0)="AEMQ",DIC("A")="select an Outpatient Site: " D ^DIC K DIC S PSAOSIT=+Y
- S:'$D(PSAOSIT) PSAOSIT=+$O(^PS(59,0))
- ;if IP changed to combined, check for existing OP and zap
- I +$G(PSALOC),+$G(PSAOC),$O(^PSD(58.8,"AOP",+PSAOSIT,"")),($O(^PSD(58.8,"AOP",+PSAOSIT,""))'=$G(PSALOC)) S DIE="^PSD(58.8,",DA=$O(^PSD(58.8,"AOP",+PSAOSIT,"")),DR="20////@" D ^DIE K DIE
- I $G(PSALOC),'$O(^PSD(58.8,"AOP",+PSAOSIT,"")) S DIE="^PSD(58.8,",DA=PSALOC,DR="20////^S X=+PSAOSIT" D ^DIE K DIE
- DAVEB I '$O(^PSD(58.8,"AOP",+PSAOSIT,"")) D G:Y<0 QUIT
- .;DAVE B (PSA*3*12) dic(0) was AEMQLZ; *43 added back Z
- .S DIC="^PSD(58.8,",DIC(0)="AELXZ",DLAYGO=58.8,DIC("A")="Please select Location: ",DIC("B")=$S(PSAITY=2:"OUTPATIENT",PSAITY=3:"COMBINED (IP/OP)",1:"")
- .S DIC("DR")="1////P;20////^S X=+PSAOSIT",DIC("S")="I $P($G(^(0)),U,2)=""P"",$S($P($G(^(0)),U,10):$P($G(^(0)),U,10)=+PSAOSIT,1:1)"
- .S:PSAITY=3 DIC("W")="W ?30,""IP SITE: "",$P($G(^PS(59.4,+$P($G(^(0)),U,3),0)),U)"
- .D ^DIC K DIC,DLAYGO S:Y>0 PSALOC=+Y,PSALOCN=Y(0,0)
- S:'$D(PSALOC) PSALOC=$O(^PSD(58.8,"AOP",+PSAOSIT,"")),PSALOCN=$P($G(^PSD(58.8,+PSALOC,0)),U)
- OPC W !!,"Outpatient site selection affects the collection of dispensing data.",!
- S DIE="^PSD(58.8,",DA=PSALOC,DR="20//^S X=$P($G(^PS(59,+PSAOSIT,0)),U)" D ^DIE K DIE I $D(DTOUT)!($D(Y)) G QUIT ;; <3*63 RJS>
- S PSAOSIT=+$P($G(^PSD(58.8,PSALOC,0)),"^",10)
- G:'PSALOC QUIT
- N PSADT,PSAT,PSAQTY,PSAY
- G:$G(PSAPVMEN) DRUGS
- ED S DIE=58.8,DA=PSALOC,DR="[PSAENT]" D ^DIE K DIE,DA G:$D(Y) QUIT G:'$D(PSAINV) DRUGS D:$O(^PRCP(445,PSAINV,1,0)) G:$D(DIRUT) QUIT
- QUES .S DIR(0)="Y",DIR("A",1)="Would you like to loop through "_$$INVNAME^PRCPUX1($G(PSAINV))_"'S",DIR("A")="items to check for any new entries that are ready to load"
- .S DIR("?")="I will check for items that are linked to the DRUG file but not yet stocked."
- .W ! D ^DIR K DIR Q:'Y S PSAIT=0 D
- ..S DIR(0)="Y",DIR("A")="Load inventory quantities also",DIR("B")="Yes",DIR("?")="Inventory quantities will be multiplied by the dispensing unit conversion factor." D ^DIR K DIR Q:$D(DIRUT) S:Y=1 PSAY=1
- ..S:'$D(^PSD(58.8,+PSALOC,1,0)) ^(0)="^58.8001IP^^"
- LOOP ..F S PSAIT=$O(^PRCP(445,+PSAINV,1,PSAIT)) Q:'PSAIT I '$G(^PRC(441,PSAIT,3)),$O(^PSDRUG("AB",+PSAIT,0)) S PSADRUG=$O(^PSDRUG("AB",PSAIT,0)) D:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,0)) Q:$D(DIRUT)
- ...Q:'$S('$D(^PSDRUG(PSADRUG,"I")):1,+^("I")>DT:1,1:0)
- ...S DIR(0)="Y",DIR("A",1)="OK to load "_$P($G(^PSDRUG(PSADRUG,0)),U)_" from the DRUG file",DIR("A")="linked to inventory item: "_$$DESCR^PRCPUX1($G(PSAINV),$G(PSAIT)),DIR("B")="Yes" D ^DIR K DIR Q:Y<1 S X=PSADRUG
- ...S:$G(PSAY) DIC("DR")="3//^S X=PSAQTY;S PSAQTY=X"
- ITEM ...S DA(1)=PSALOC,DIC="^PSD(58.8,PSALOC,1,",DIC(0)="EMQL",DLAYGO=58.8,PSAQTY=$P($G(^PRCP(445,+PSAINV,1,PSAIT,0)),U,7)*$S($P($G(^(0)),U,29):$P(^(0),U,29),1:1) D ^DIC K DIC,DLAYGO Q:Y<0
- ...Q:'$G(PSAY)
- ...W !,"Updating Beginning balance and transaction history.",!
- ...D NOW^%DTC S PSADT=+$E(%,1,12) K %
- ...S ^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)="^58.801A^^"
- ...S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,",DIC(0)="LM",(X,DINUM)=$E(DT,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRUG,DIC("DR")="1////^S X=$G(PSAQTY);5////^S X=$G(PSAQTY)",DLAYGO=58.8 D ^DIC K DIC,DLAYGO
- ...F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
- FIND ...S PSAT=$P(^PSD(58.81,0),U,3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),U,3)=$P(^PSD(58.81,0),U,3)+1 G FIND
- ...S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DLAYGO L -^PSD(58.81,0)
- ...S DIE="^PSD(58.81,",DA=PSAT,DR="1////11;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRUG;5////^S X=PSAQTY;6////^S X=DUZ;9////0" D ^DIE K DIE
- ...S:'$D(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0)) ^(0)="^58.800119PA^^"
- ...S DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,4,",DLAYGO=58.8,DIC(0)="L",(X,DINUM)=PSAT
- ...S DA(2)=PSALOC,DA(1)=PSADRUG D ^DIC K DA,DIC,DLAYGO
- ...I $O(^PS(52.6,"AC",+PSADRUG,0))!($O(^PS(52.7,"AC",+PSADRUG,0))) S PSAIT(1)=PSAIT,PSAIT(2)=$P($G(^PSDRUG(+PSADRUG,0)),U),PSAIT(4)=$G(^PSDRUG(+PSADRUG,660)),PSAIT=PSADRUG D ^PSAPSI4 S PSAIT=PSAIT(1)
- DRUGS W ! S DIR(0)="Y",DIR("A")="Add/edit drugs",DIR("B")="No" D ^DIR K DIR D:Y=1 ^PSADRUG
- Q:'+$G(PSAOSIT)
- IV I '$O(^PSD(58.8,PSALOC,3.5,0)) W ! S DIR(0)="Y",DIR("A")="Does the outpatient site dispense IVs to IV rooms",DIR("B")="No" D ^DIR K DIR G:Y=0 QUIT
- S PSALEN=$L($P($G(^PS(59,+PSAOSIT,0)),"^")),PSALEN=PSALEN+16
- IV1 W @IOF,!?((80-PSALEN)/2),$P($G(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!!
- I $O(^PSD(58.8,PSALOC,3.5,0)) D
- .W "Currently linked IV Rooms:" S PSANOW=0
- .F S PSANOW=$O(^PSD(58.8,PSALOC,3.5,PSANOW)) Q:'PSANOW S PSANOW($P($G(^PS(59.5,PSANOW,0)),"^"))=""
- .S PSANOW="" F S PSANOW=$O(PSANOW(PSANOW)) Q:PSANOW="" W ?27,PSANOW,!
- S DIR(0)="SAO^L:Link;U:Unlink",DIR("A")="Link or unlink IV rooms (L/U): " D ^DIR K DIR G:$G(DIRUT) QUIT G:Y="U" UNLINK
- W !!,"Enter the IV rooms that receive IVs from the outpatient site.",!
- K DIC S DIC="^PS(59.5,",DIC(0)="AEQZ"
- F D ^DIC Q:$G(DTOUT)!($G(DUOUT))!(Y<0) D
- .S PSAIVLOC=+$O(^PSD(58.8,"AIV",+Y,0))
- .I PSAIVLOC,PSAIVLOC'=PSALOC W !!,"<< "_Y(0,0)_" is already linked to the "_$P($G(^PS(59,+$P($G(^PSD(58.8,PSALOC,0)),"^",10),0)),"^"),!?4,"outpatient site in the "_$P($G(^PSD(58.8,PSALOC,0)),"^")_" pharmacy location. >>",! K Y Q
- .I PSAIVLOC,PSAIVLOC=PSALOC W !!,"<< "_Y(0,0)_" is already linked to this outpatient site. >>",! K Y Q
- .S:$D(Y(0,0)) PSAIV(Y(0,0))=+Y
- K DIC S PSAIV=$O(PSAIV("")) I PSAIV="" W !!,"<< No IV rooms were selected to be linked to the Outpatient site. >>",! G QUIT
- W @IOF W !?((80-PSALEN)/2),$P($G(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!!,"IV rooms to be linked:"
- S PSAIV="" F S PSAIV=$O(PSAIV(PSAIV)) Q:PSAIV="" W ?23,PSAIV,!
- S DIR(0)="Y",DIR("A")="Should the IV rooms be linked",DIR("B")="N" D ^DIR K DIR I 'Y K PSAIV G IV1
- S:'$D(^PSD(58.8,PSALOC,3.5,0)) ^PSD(58.8,PSALOC,3.5,0)="^58.831P^^"
- W ! S DIC="^PSD(58.8,"_PSALOC_",3.5,",DIC(0)="ML",PSAIV="" K DD,DO
- W !,"Linking IV rooms"
- F S PSAIV=$O(PSAIV(PSAIV)) Q:PSAIV="" K DD,DO S (X,DINUM)=PSAIV(PSAIV),DA(1)=PSALOC D FILE^DICN W "."
- W !,"The IV rooms were linked successfully."
- K DIC,PSAIV,DINUM,X
- QUIT Q
- UNLINK ;Unlink IV Rooms
- S DIR(0)="Y",DIR("B")="N",PSANOW="" W !
- F S PSANOW=$O(PSANOW(PSANOW)) Q:PSANOW="" S DIR("A")="Unlink "_PSANOW D ^DIR Q:$G(DIRUT) I Y S PSANOW(PSANOW)=Y,PSADEL(PSANOW)=""
- S PSANOW="",PSADEL=$O(PSADEL(PSANOW))
- W @IOF,!?((80-PSALEN)/2),$P($G(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!!
- I PSADEL'="" W !,"To be unlinked:" S PSANOW="" D
- .F S PSANOW=$O(PSADEL(PSANOW)) Q:PSANOW="" W ?16,PSANOW,!
- .W ! S DIR(0)="Y",DIR("B")="N",DIR("A")="Okay to unlink the IV Rooms" D ^DIR K DIR Q:$G(DIRUT) I 'Y W !,"No IV rooms were unlinked." Q
- .W !,"Unlinking IV rooms"
- .S PSANOW="",DIE="^PSD(58.8,"_PSALOC_",3.5,",DA(1)=PSALOC F S PSANOW=$O(PSADEL(PSANOW)) Q:PSANOW="" S DA=$O(^PS(59.5,"B",PSANOW,0)),DR=".01///@" D ^DIE W "."
- .K DIE W !,"IV rooms unlinked."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAENTO 8012 printed Mar 13, 2025@20:53:55 Page 2
- PSAENTO ;BIR/LTL,JMB-Set Up/Edit a Pharmacy Location - CONT'D ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,43,63**; 10/24/97;Build 10
- +2 ;This routines is called by PSAENT.
- +3 ;
- +4 ;References to global ^PRC(441 are covered by IA #214
- +5 ;References to global ^PRCP(445 are covered by IA #214
- +6 ;References to global ^PS(52.6, are covered by IA #270
- +7 ;References to global ^PS(52.7 are covered by IA #770
- +8 ;References to global ^PS(59, are covered by IA #212
- +9 ;References to global ^PS(59.5 are covered by IA #1884
- +10 ;References to global ^PSDRUG( are covered by IA #2095
- +11 ;References to global ^PSDRUG("AB" are covered by IA #2095
- +12 ;
- +13 ;External references to $$DESCR^PRCPUX1 are covered by IA #259
- +14 ;External references to $$INVNAME^PRCPUX1 are covered by IA #259
- +15 ;
- +16 ;
- +17 ;
- OP if $PIECE($GET(^PSD(58.8,+$GET(PSALOC),0)),U,10)
- GOTO OPC
- +1 SET Y=1
- SET PSA=$ORDER(^PS(59,0))
- if $ORDER(^PS(59,PSA))
- Begin DoDot:1
- +2 ;more than one OP site
- +3 WRITE !!,"Because there is more than one Outpatient Site at this facility, I need you to "
- +4 SET DIC="^PS(59,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="select an Outpatient Site: "
- DO ^DIC
- KILL DIC
- SET PSAOSIT=+Y
- End DoDot:1
- if Y<0
- GOTO QUIT
- +5 if '$DATA(PSAOSIT)
- SET PSAOSIT=+$ORDER(^PS(59,0))
- +6 ;if IP changed to combined, check for existing OP and zap
- +7 IF +$GET(PSALOC)
- IF +$GET(PSAOC)
- IF $ORDER(^PSD(58.8,"AOP",+PSAOSIT,""))
- IF ($ORDER(^PSD(58.8,"AOP",+PSAOSIT,""))'=$GET(PSALOC))
- SET DIE="^PSD(58.8,"
- SET DA=$ORDER(^PSD(58.8,"AOP",+PSAOSIT,""))
- SET DR="20////@"
- DO ^DIE
- KILL DIE
- +8 IF $GET(PSALOC)
- IF '$ORDER(^PSD(58.8,"AOP",+PSAOSIT,""))
- SET DIE="^PSD(58.8,"
- SET DA=PSALOC
- SET DR="20////^S X=+PSAOSIT"
- DO ^DIE
- KILL DIE
- DAVEB IF '$ORDER(^PSD(58.8,"AOP",+PSAOSIT,""))
- Begin DoDot:1
- +1 ;DAVE B (PSA*3*12) dic(0) was AEMQLZ; *43 added back Z
- +2 SET DIC="^PSD(58.8,"
- SET DIC(0)="AELXZ"
- SET DLAYGO=58.8
- SET DIC("A")="Please select Location: "
- SET DIC("B")=$SELECT(PSAITY=2:"OUTPATIENT",PSAITY=3:"COMBINED (IP/OP)",1:"")
- +3 SET DIC("DR")="1////P;20////^S X=+PSAOSIT"
- SET DIC("S")="I $P($G(^(0)),U,2)=""P"",$S($P($G(^(0)),U,10):$P($G(^(0)),U,10)=+PSAOSIT,1:1)"
- +4 if PSAITY=3
- SET DIC("W")="W ?30,""IP SITE: "",$P($G(^PS(59.4,+$P($G(^(0)),U,3),0)),U)"
- +5 DO ^DIC
- KILL DIC,DLAYGO
- if Y>0
- SET PSALOC=+Y
- SET PSALOCN=Y(0,0)
- End DoDot:1
- if Y<0
- GOTO QUIT
- +6 if '$DATA(PSALOC)
- SET PSALOC=$ORDER(^PSD(58.8,"AOP",+PSAOSIT,""))
- SET PSALOCN=$PIECE($GET(^PSD(58.8,+PSALOC,0)),U)
- OPC WRITE !!,"Outpatient site selection affects the collection of dispensing data.",!
- +1 ;; <3*63 RJS>
- SET DIE="^PSD(58.8,"
- SET DA=PSALOC
- SET DR="20//^S X=$P($G(^PS(59,+PSAOSIT,0)),U)"
- DO ^DIE
- KILL DIE
- IF $DATA(DTOUT)!($DATA(Y))
- GOTO QUIT
- +2 SET PSAOSIT=+$PIECE($GET(^PSD(58.8,PSALOC,0)),"^",10)
- +3 if 'PSALOC
- GOTO QUIT
- +4 NEW PSADT,PSAT,PSAQTY,PSAY
- +5 if $GET(PSAPVMEN)
- GOTO DRUGS
- ED SET DIE=58.8
- SET DA=PSALOC
- SET DR="[PSAENT]"
- DO ^DIE
- KILL DIE,DA
- if $DATA(Y)
- GOTO QUIT
- if '$DATA(PSAINV)
- GOTO DRUGS
- if $ORDER(^PRCP(445,PSAINV,1,0))
- Begin DoDot:1
- QUES SET DIR(0)="Y"
- SET DIR("A",1)="Would you like to loop through "_$$INVNAME^PRCPUX1($GET(PSAINV))_"'S"
- SET DIR("A")="items to check for any new entries that are ready to load"
- +1 SET DIR("?")="I will check for items that are linked to the DRUG file but not yet stocked."
- +2 WRITE !
- DO ^DIR
- KILL DIR
- if 'Y
- QUIT
- SET PSAIT=0
- Begin DoDot:2
- +3 SET DIR(0)="Y"
- SET DIR("A")="Load inventory quantities also"
- SET DIR("B")="Yes"
- SET DIR("?")="Inventory quantities will be multiplied by the dispensing unit conversion factor."
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- if Y=1
- SET PSAY=1
- +4 if '$DATA(^PSD(58.8,+PSALOC,1,0))
- SET ^(0)="^58.8001IP^^"
- LOOP FOR
- SET PSAIT=$ORDER(^PRCP(445,+PSAINV,1,PSAIT))
- if 'PSAIT
- QUIT
- IF '$GET(^PRC(441,PSAIT,3))
- IF $ORDER(^PSDRUG("AB",+PSAIT,0))
- SET PSADRUG=$ORDER(^PSDRUG("AB",PSAIT,0))
- if '$DATA(^PSD(58.8,+PSALOC,1,+PSADRUG,0))
- Begin DoDot:3
- +1 if '$SELECT('$DATA(^PSDRUG(PSADRUG,"I"))
- QUIT
- +2 SET DIR(0)="Y"
- SET DIR("A",1)="OK to load "_$PIECE($GET(^PSDRUG(PSADRUG,0)),U)_" from the DRUG file"
- SET DIR("A")="linked to inventory item: "_$$DESCR^PRCPUX1($GET(PSAINV),$GET(PSAIT))
- SET DIR("B")="Yes"
- DO ^DIR
- KILL DIR
- if Y<1
- QUIT
- SET X=PSADRUG
- +3 if $GET(PSAY)
- SET DIC("DR")="3//^S X=PSAQTY;S PSAQTY=X"
- ITEM SET DA(1)=PSALOC
- SET DIC="^PSD(58.8,PSALOC,1,"
- SET DIC(0)="EMQL"
- SET DLAYGO=58.8
- SET PSAQTY=$PIECE($GET(^PRCP(445,+PSAINV,1,PSAIT,0)),U,7)*$SELECT($PIECE($GET(^(0)),U,29):$PIECE(^(0),U,29),1:1)
- DO ^DIC
- KILL DIC,DLAYGO
- if Y<0
- QUIT
- +1 if '$GET(PSAY)
- QUIT
- +2 WRITE !,"Updating Beginning balance and transaction history.",!
- +3 DO NOW^%DTC
- SET PSADT=+$EXTRACT(%,1,12)
- KILL %
- +4 SET ^PSD(58.8,+PSALOC,1,+PSADRUG,5,0)="^58.801A^^"
- +5 SET DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,5,"
- SET DIC(0)="LM"
- SET (X,DINUM)=$EXTRACT(DT,1,5)*100
- SET DA(2)=PSALOC
- SET DA(1)=PSADRUG
- SET DIC("DR")="1////^S X=$G(PSAQTY);5////^S X=$G(PSAQTY)"
- SET DLAYGO=58.8
- DO ^DIC
- KILL DIC,DLAYGO
- +6 FOR
- LOCK +^PSD(58.81,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF $TEST
- QUIT
- FIND SET PSAT=$PIECE(^PSD(58.81,0),U,3)+1
- IF $DATA(^PSD(58.81,PSAT))
- SET $PIECE(^PSD(58.81,0),U,3)=$PIECE(^PSD(58.81,0),U,3)+1
- GOTO FIND
- +1 SET DIC="^PSD(58.81,"
- SET DIC(0)="L"
- SET DLAYGO=58.81
- SET (DINUM,X)=PSAT
- DO ^DIC
- KILL DIC,DLAYGO
- LOCK -^PSD(58.81,0)
- +2 SET DIE="^PSD(58.81,"
- SET DA=PSAT
- SET DR="1////11;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRUG;5////^S X=PSAQTY;6////^S X=DUZ;9////0"
- DO ^DIE
- KILL DIE
- +3 if '$DATA(^PSD(58.8,+PSALOC,1,+PSADRUG,4,0))
- SET ^(0)="^58.800119PA^^"
- +4 SET DIC="^PSD(58.8,+PSALOC,1,+PSADRUG,4,"
- SET DLAYGO=58.8
- SET DIC(0)="L"
- SET (X,DINUM)=PSAT
- +5 SET DA(2)=PSALOC
- SET DA(1)=PSADRUG
- DO ^DIC
- KILL DA,DIC,DLAYGO
- +6 IF $ORDER(^PS(52.6,"AC",+PSADRUG,0))!($ORDER(^PS(52.7,"AC",+PSADRUG,0)))
- SET PSAIT(1)=PSAIT
- SET PSAIT(2)=$PIECE($GET(^PSDRUG(+PSADRUG,0)),U)
- SET PSAIT(4)=$GET(^PSDRUG(+PSADRUG,660))
- SET PSAIT=PSADRUG
- DO ^PSAPSI4
- SET PSAIT=PSAIT(1)
- End DoDot:3
- if $DATA(DIRUT)
- QUIT
- End DoDot:2
- End DoDot:1
- if $DATA(DIRUT)
- GOTO QUIT
- DRUGS WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Add/edit drugs"
- SET DIR("B")="No"
- DO ^DIR
- KILL DIR
- if Y=1
- DO ^PSADRUG
- +1 if '+$GET(PSAOSIT)
- QUIT
- IV IF '$ORDER(^PSD(58.8,PSALOC,3.5,0))
- WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Does the outpatient site dispense IVs to IV rooms"
- SET DIR("B")="No"
- DO ^DIR
- KILL DIR
- if Y=0
- GOTO QUIT
- +1 SET PSALEN=$LENGTH($PIECE($GET(^PS(59,+PSAOSIT,0)),"^"))
- SET PSALEN=PSALEN+16
- IV1 WRITE @IOF,!?((80-PSALEN)/2),$PIECE($GET(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!!
- +1 IF $ORDER(^PSD(58.8,PSALOC,3.5,0))
- Begin DoDot:1
- +2 WRITE "Currently linked IV Rooms:"
- SET PSANOW=0
- +3 FOR
- SET PSANOW=$ORDER(^PSD(58.8,PSALOC,3.5,PSANOW))
- if 'PSANOW
- QUIT
- SET PSANOW($PIECE($GET(^PS(59.5,PSANOW,0)),"^"))=""
- +4 SET PSANOW=""
- FOR
- SET PSANOW=$ORDER(PSANOW(PSANOW))
- if PSANOW=""
- QUIT
- WRITE ?27,PSANOW,!
- End DoDot:1
- +5 SET DIR(0)="SAO^L:Link;U:Unlink"
- SET DIR("A")="Link or unlink IV rooms (L/U): "
- DO ^DIR
- KILL DIR
- if $GET(DIRUT)
- GOTO QUIT
- if Y="U"
- GOTO UNLINK
- +6 WRITE !!,"Enter the IV rooms that receive IVs from the outpatient site.",!
- +7 KILL DIC
- SET DIC="^PS(59.5,"
- SET DIC(0)="AEQZ"
- +8 FOR
- DO ^DIC
- if $GET(DTOUT)!($GET(DUOUT))!(Y<0)
- QUIT
- Begin DoDot:1
- +9 SET PSAIVLOC=+$ORDER(^PSD(58.8,"AIV",+Y,0))
- +10 IF PSAIVLOC
- IF PSAIVLOC'=PSALOC
- WRITE !!,"<< "_Y(0,0)_" is already linked to the "_$PIECE($GET(^PS(59,+$PIECE($GET(^PSD(58.8,PSALOC,0)),"^",10),0)),"^"),!?4,"outpatient site in the "_$PIECE($GET(^PSD(58.8,PSALOC,0)),"^")_" pharmacy location. >>",!
- KILL Y
- QUIT
- +11 IF PSAIVLOC
- IF PSAIVLOC=PSALOC
- WRITE !!,"<< "_Y(0,0)_" is already linked to this outpatient site. >>",!
- KILL Y
- QUIT
- +12 if $DATA(Y(0,0))
- SET PSAIV(Y(0,0))=+Y
- End DoDot:1
- +13 KILL DIC
- SET PSAIV=$ORDER(PSAIV(""))
- IF PSAIV=""
- WRITE !!,"<< No IV rooms were selected to be linked to the Outpatient site. >>",!
- GOTO QUIT
- +14 WRITE @IOF
- WRITE !?((80-PSALEN)/2),$PIECE($GET(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!!,"IV rooms to be linked:"
- +15 SET PSAIV=""
- FOR
- SET PSAIV=$ORDER(PSAIV(PSAIV))
- if PSAIV=""
- QUIT
- WRITE ?23,PSAIV,!
- +16 SET DIR(0)="Y"
- SET DIR("A")="Should the IV rooms be linked"
- SET DIR("B")="N"
- DO ^DIR
- KILL DIR
- IF 'Y
- KILL PSAIV
- GOTO IV1
- +17 if '$DATA(^PSD(58.8,PSALOC,3.5,0))
- SET ^PSD(58.8,PSALOC,3.5,0)="^58.831P^^"
- +18 WRITE !
- SET DIC="^PSD(58.8,"_PSALOC_",3.5,"
- SET DIC(0)="ML"
- SET PSAIV=""
- KILL DD,DO
- +19 WRITE !,"Linking IV rooms"
- +20 FOR
- SET PSAIV=$ORDER(PSAIV(PSAIV))
- if PSAIV=""
- QUIT
- KILL DD,DO
- SET (X,DINUM)=PSAIV(PSAIV)
- SET DA(1)=PSALOC
- DO FILE^DICN
- WRITE "."
- +21 WRITE !,"The IV rooms were linked successfully."
- +22 KILL DIC,PSAIV,DINUM,X
- QUIT QUIT
- UNLINK ;Unlink IV Rooms
- +1 SET DIR(0)="Y"
- SET DIR("B")="N"
- SET PSANOW=""
- WRITE !
- +2 FOR
- SET PSANOW=$ORDER(PSANOW(PSANOW))
- if PSANOW=""
- QUIT
- SET DIR("A")="Unlink "_PSANOW
- DO ^DIR
- if $GET(DIRUT)
- QUIT
- IF Y
- SET PSANOW(PSANOW)=Y
- SET PSADEL(PSANOW)=""
- +3 SET PSANOW=""
- SET PSADEL=$ORDER(PSADEL(PSANOW))
- +4 WRITE @IOF,!?((80-PSALEN)/2),$PIECE($GET(^PS(59,+PSAOSIT,0)),"^")_" Outpatient Site",!!
- +5 IF PSADEL'=""
- WRITE !,"To be unlinked:"
- SET PSANOW=""
- Begin DoDot:1
- +6 FOR
- SET PSANOW=$ORDER(PSADEL(PSANOW))
- if PSANOW=""
- QUIT
- WRITE ?16,PSANOW,!
- +7 WRITE !
- SET DIR(0)="Y"
- SET DIR("B")="N"
- SET DIR("A")="Okay to unlink the IV Rooms"
- DO ^DIR
- KILL DIR
- if $GET(DIRUT)
- QUIT
- IF 'Y
- WRITE !,"No IV rooms were unlinked."
- QUIT
- +8 WRITE !,"Unlinking IV rooms"
- +9 SET PSANOW=""
- SET DIE="^PSD(58.8,"_PSALOC_",3.5,"
- SET DA(1)=PSALOC
- FOR
- SET PSANOW=$ORDER(PSADEL(PSANOW))
- if PSANOW=""
- QUIT
- SET DA=$ORDER(^PS(59.5,"B",PSANOW,0))
- SET DR=".01///@"
- DO ^DIE
- WRITE "."
- +10 KILL DIE
- WRITE !,"IV rooms unlinked."
- End DoDot:1
- +11 QUIT
