- PSDDWKE ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ; 24 Aug 93
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- EDIT ;ask/edit dispensing info
- W ! S (PSDOUT,MSG)=0
- K DA,DIE,DR,DTOUT,Y S DA=PSDN,DIE=58.85,DR="14T//^S X=PSDBYN;I $D(OKD) S Y=""@1"";1//^S X=ORDSN;@1" D ^DIE K DIE I $D(DTOUT) S PSDOUT=1 D MSG Q
- I $D(Y),ACT'="E" S PSDOUT=1 D MSG Q
- S ORDS=+$P($G(^PSD(58.85,PSDN,0)),"^",2),ORDSN=$P($G(^PSD(58.8,+ORDS,0)),"^"),NEW=$S(ORDS'=+PSDS:1,1:0)
- S QTY=$S($P($G(^PSD(58.85,PSDN,0)),"^",17):+$P($G(^(0)),"^",17),1:+$P($G(^(0)),"^",6))
- D:NEW SET I '$D(^PSD(58.8,+ORDS,1,+PSDR,0)) D MSG1 Q
- I 'NPKG!(NBKU']"") S MSG=1 D MSG1 Q
- I $D(Y),ACT="E" S PSDOUT=0 Q
- K DA,DIR,DIRUT,DTOUT,DUOUT,Y S DIR("B")=QTY,DIR(0)="58.85,18",DIR("A")="QUANTITY DISPENSED ("_NBKU_"/"_NPKG_")" D ^DIR K DIR I $D(DTOUT) S PSDOUT=1 D MSG Q
- I ACT'="E",$D(DIRUT) S PSDOUT=1 D MSG Q
- I 'Y!$D(DUOUT) S PSDOUT=0 Q
- S $P(^PSD(58.85,PSDN,0),"^",17)=Y
- I ACT="E" D DIE G EDIT1
- I 'NEW,PSDM D DIE
- I NEW,PSDMN D DIE
- EDIT1 S QTY=+$P($G(^PSD(58.85,PSDN,0)),"^",17),STAT=+$P($G(^(0)),"^",7),PSDBY=+$P($G(^(0)),"^",13),PSDBYN="" S:PSDBY PSDBYN=$P($G(^VA(200,PSDBY,0)),"^")
- Q:ACT=""
- W !!,"Updating your order..."
- I $P($G(^PSD(58.85,PSDN,0)),"^",8) K DA,DIE,DR S DA=+$P(^(0),"^",8),DIE=58.81,DR="2////"_+ORDS_";5////"_QTY_";10////"_STAT_";12////"_MFG_";13////"_LOT_";14////"_EXP_";17////"_NAOU_";18////"_PSDBY D ^DIE K DA,DIE,DR
- W "still updating..."
- K DA,DIE,DR S DA=REQ,DA(1)=PSDR,DA(2)=NAOU,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",3,"
- S DR="2////"_ORDS_";10////"_STAT_";19////"_QTY D ^DIE K DA,DIE,DR
- W "done.",!
- Q
- DIE ;edit mfg/lot #/exp
- S Y=EXP X ^DD("DD") S EXPD=Y
- K DA,DIE,DR S DA=PSDN,DIE=58.85,DR="9//^S X=MFG;10//^S X=LOT;11//^S X=EXPD" D ^DIE K DA,DIE,DR
- K TMFG,TLOT,TEXP S:$P(^PSD(58.85,PSDN,0),"^",9)'=MFG TMFG=$P(^PSD(58.85,PSDN,0),"^",9) S:$P(^(0),"^",10)'=LOT TLOT=$P(^(0),"^",10) S:$P(^(0),"^",11)'=EXP TEXP=$P(^(0),"^",11)
- I $D(TMFG)!($D(TLOT))!($D(TEXP)) K DA,DIE,DR S DA=+PSDR,DA(1)=+ORDS,DIE="^PSD(58.8,"_DA(1)_",1,",DR="9////"_$S($D(TMFG):TMFG,1:MFG)_";10////"_$S($D(TLOT):TLOT,1:LOT)_";11////"_$S($D(TEXP):TEXP,1:EXP) D ^DIE K DA,DIE,DR,TEXP,TLOT,TMFG
- S MFG=$P(^PSD(58.85,PSDN,0),"^",9),LOT=$P(^(0),"^",10),EXP=$P(^(0),"^",11) S Y=EXP X ^DD("DD") S EXPD=Y
- Q
- SET ;sets disp data if disp site changes
- S (MFG,LOT,EXP,NBKU,NPKG)=""
- S PSDMN=+$P($G(^PSD(58.8,+ORDS,0)),"^",5)
- S PSDAGN=+$P($G(^PSD(58.8,+ORDS,2)),"^"),PSDRGN=+$P($G(^(2)),"^",5),PSDGSN=+$P($G(^(2)),"^",6)
- I $D(^PSD(58.8,+ORDS,1,+PSDR,0)) S NBKU=$P(^(0),"^",8),NPKG=+$P(^(0),"^",9) S:PSDMN MFG=$P(^(0),"^",10),LOT=$P(^(0),"^",11),EXP=$P(^(0),"^",12)
- S PRT=$P($G(^PSD(58.85,PSDN,2)),"^") K ^PSD(58.85,"AW",+ORDS,+PRT,PSDN) S ^PSD(58.85,PSDN,2)=""
- Q
- MSG1 W $C(7),!!,"This order cannot be processed. ",PSDRN," is ",!,$S(MSG:"missing breakdown unit or package size",1:"not stocked")," in ",ORDSN,".",! S PSDNO=1
- MSG W !!,"Press <RET> to continue" R X:DTIME W !!
- I '$T!(X["^") S PSDOUT=1
- Q
- PSDDWKE ;BIR/JPW-Pharm Dispensing Worksheet (cont'd) ; 24 Aug 93
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- EDIT ;ask/edit dispensing info
- +1 WRITE !
- SET (PSDOUT,MSG)=0
- +2 KILL DA,DIE,DR,DTOUT,Y
- SET DA=PSDN
- SET DIE=58.85
- SET DR="14T//^S X=PSDBYN;I $D(OKD) S Y=""@1"";1//^S X=ORDSN;@1"
- DO ^DIE
- KILL DIE
- IF $DATA(DTOUT)
- SET PSDOUT=1
- DO MSG
- QUIT
- +3 IF $DATA(Y)
- IF ACT'="E"
- SET PSDOUT=1
- DO MSG
- QUIT
- +4 SET ORDS=+$PIECE($GET(^PSD(58.85,PSDN,0)),"^",2)
- SET ORDSN=$PIECE($GET(^PSD(58.8,+ORDS,0)),"^")
- SET NEW=$SELECT(ORDS'=+PSDS:1,1:0)
- +5 SET QTY=$SELECT($PIECE($GET(^PSD(58.85,PSDN,0)),"^",17):+$PIECE($GET(^(0)),"^",17),1:+$PIECE($GET(^(0)),"^",6))
- +6 IF NEW
- DO SET
- IF '$DATA(^PSD(58.8,+ORDS,1,+PSDR,0))
- DO MSG1
- QUIT
- +7 IF 'NPKG!(NBKU']"")
- SET MSG=1
- DO MSG1
- QUIT
- +8 IF $DATA(Y)
- IF ACT="E"
- SET PSDOUT=0
- QUIT
- +9 KILL DA,DIR,DIRUT,DTOUT,DUOUT,Y
- SET DIR("B")=QTY
- SET DIR(0)="58.85,18"
- SET DIR("A")="QUANTITY DISPENSED ("_NBKU_"/"_NPKG_")"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)
- SET PSDOUT=1
- DO MSG
- QUIT
- +10 IF ACT'="E"
- IF $DATA(DIRUT)
- SET PSDOUT=1
- DO MSG
- QUIT
- +11 IF 'Y!$DATA(DUOUT)
- SET PSDOUT=0
- QUIT
- +12 SET $PIECE(^PSD(58.85,PSDN,0),"^",17)=Y
- +13 IF ACT="E"
- DO DIE
- GOTO EDIT1
- +14 IF 'NEW
- IF PSDM
- DO DIE
- +15 IF NEW
- IF PSDMN
- DO DIE
- EDIT1 SET QTY=+$PIECE($GET(^PSD(58.85,PSDN,0)),"^",17)
- SET STAT=+$PIECE($GET(^(0)),"^",7)
- SET PSDBY=+$PIECE($GET(^(0)),"^",13)
- SET PSDBYN=""
- IF PSDBY
- SET PSDBYN=$PIECE($GET(^VA(200,PSDBY,0)),"^")
- +1 IF ACT=""
- QUIT
- +2 WRITE !!,"Updating your order..."
- +3 IF $PIECE($GET(^PSD(58.85,PSDN,0)),"^",8)
- KILL DA,DIE,DR
- SET DA=+$PIECE(^(0),"^",8)
- SET DIE=58.81
- SET DR="2////"_+ORDS_";5////"_QTY_";10////"_STAT_";12////"_MFG_";13////"_LOT_";14////"_EXP_";17////"_NAOU_";18////"_PSDBY
- DO ^DIE
- KILL DA,DIE,DR
- +4 WRITE "still updating..."
- +5 KILL DA,DIE,DR
- SET DA=REQ
- SET DA(1)=PSDR
- SET DA(2)=NAOU
- SET DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",3,"
- +6 SET DR="2////"_ORDS_";10////"_STAT_";19////"_QTY
- DO ^DIE
- KILL DA,DIE,DR
- +7 WRITE "done.",!
- +8 QUIT
- DIE ;edit mfg/lot #/exp
- +1 SET Y=EXP
- XECUTE ^DD("DD")
- SET EXPD=Y
- +2 KILL DA,DIE,DR
- SET DA=PSDN
- SET DIE=58.85
- SET DR="9//^S X=MFG;10//^S X=LOT;11//^S X=EXPD"
- DO ^DIE
- KILL DA,DIE,DR
- +3 KILL TMFG,TLOT,TEXP
- IF $PIECE(^PSD(58.85,PSDN,0),"^",9)'=MFG
- SET TMFG=$PIECE(^PSD(58.85,PSDN,0),"^",9)
- IF $PIECE(^(0),"^",10)'=LOT
- SET TLOT=$PIECE(^(0),"^",10)
- IF $PIECE(^(0),"^",11)'=EXP
- SET TEXP=$PIECE(^(0),"^",11)
- +4 IF $DATA(TMFG)!($DATA(TLOT))!($DATA(TEXP))
- KILL DA,DIE,DR
- SET DA=+PSDR
- SET DA(1)=+ORDS
- SET DIE="^PSD(58.8,"_DA(1)_",1,"
- SET DR="9////"_$SELECT($DATA(TMFG):TMFG,1:MFG)_";10////"_$SELECT($DATA(TLOT):TLOT,1:LOT)_";11////"_$SELECT($DATA(TEXP):TEXP,1:EXP)
- DO ^DIE
- KILL DA,DIE,DR,TEXP,TLOT,TMFG
- +5 SET MFG=$PIECE(^PSD(58.85,PSDN,0),"^",9)
- SET LOT=$PIECE(^(0),"^",10)
- SET EXP=$PIECE(^(0),"^",11)
- SET Y=EXP
- XECUTE ^DD("DD")
- SET EXPD=Y
- +6 QUIT
- SET ;sets disp data if disp site changes
- +1 SET (MFG,LOT,EXP,NBKU,NPKG)=""
- +2 SET PSDMN=+$PIECE($GET(^PSD(58.8,+ORDS,0)),"^",5)
- +3 SET PSDAGN=+$PIECE($GET(^PSD(58.8,+ORDS,2)),"^")
- SET PSDRGN=+$PIECE($GET(^(2)),"^",5)
- SET PSDGSN=+$PIECE($GET(^(2)),"^",6)
- +4 IF $DATA(^PSD(58.8,+ORDS,1,+PSDR,0))
- SET NBKU=$PIECE(^(0),"^",8)
- SET NPKG=+$PIECE(^(0),"^",9)
- IF PSDMN
- SET MFG=$PIECE(^(0),"^",10)
- SET LOT=$PIECE(^(0),"^",11)
- SET EXP=$PIECE(^(0),"^",12)
- +5 SET PRT=$PIECE($GET(^PSD(58.85,PSDN,2)),"^")
- KILL ^PSD(58.85,"AW",+ORDS,+PRT,PSDN)
- SET ^PSD(58.85,PSDN,2)=""
- +6 QUIT
- MSG1 WRITE $CHAR(7),!!,"This order cannot be processed. ",PSDRN," is ",!,$SELECT(MSG:"missing breakdown unit or package size",1:"not stocked")," in ",ORDSN,".",!
- SET PSDNO=1
- MSG WRITE !!,"Press <RET> to continue"
- READ X:DTIME
- WRITE !!
- +1 IF '$TEST!(X["^")
- SET PSDOUT=1
- +2 QUIT
