PSORXPR1 ;BHAM ISC/SAB - CONTINUATION OF VIEW PRESCRIPTION ; 10/01/92
;;7.0;OUTPATIENT PHARMACY;**258,386**;DEC 1997;Build 4
RF D HEAD F N=0:0 S N=$O(^PSRX(DA,1,N)) Q:'N S P1=^(N,0) D Q:$D(DIRUT)
.D CON:$Y>20 Q:$D(DIRUT) D:FFX HEAD W !,N,?3 S DTT=$P(P1,"^",8)\1 D DAT W DAT,?12
.S DTT=$P(P1,"^") D DAT W DAT,?22,$P(P1,"^",4),?36
.S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"UNKNOWN"),X=$P(P1,"^",2),X=$F("MWIBD",X)-1 W:X $P("M^W^INP","^",X),?40,$P(P1,"^",6),?52,$E($S($D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16),?70,PSDIV
.W !," DISPENSED: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")
.W ?$X+10,$S($P(P1,"^",16):" RETURNED TO STOCK: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" RELEASED: "_$S($P(P1,"^",18):$E($P(P1,"^",18),4,5)_"/"_$E($P(P1,"^",18),6,7)_"/"_$E($P(P1,"^",18),2,3),1:""))
.W:$P(P1,"^",3)'="" !?5,"REMARKS: ",$P(P1,"^",3),!
Q
PAR I $O(^PSRX(DA,"P",0)) D CON:$Y>20 Q:$D(DIRUT) D PARL S N=0 F S N=$O(^PSRX(DA,"P",N)) Q:'N S P1=^(N,0) D Q:$D(DIRUT)
.D CON:$Y>20 Q:$D(DIRUT) D:FFX PAR W !,N,?3 S DTT=$P(P1,"^",8)\1 D DAT W DAT,?14
.S DTT=$P(P1,"^") D DAT W DAT,?27,$P(P1,"^",4),?32
.S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"UNKNOWN"),X=$P(P1,"^",2),X=$F("MWIBD",X)-1 W:X $P("MAIL^WINDOW^INPATIENT","^",X)
.W ?40,$P(P1,"^",6),?52,$E($S($D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16),?70,PSDIV
.W ?$X+10,$S($P(P1,"^",16):" RETURNED TO STOCK: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" RELEASED: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:""))
.W:$P(P1,"^",3)'="" !?5,"REMARKS: ",$P(P1,"^",3)
Q
HLD ;prints hold info
S DTT=$P(^PSRX(DA,"H"),"^",3) D DAT S HLDR=$$GET1^DIQ(52,DA,99)
W !!,"HOLD REASON: "_HLDR,?60,"HOLD DATE: "_DAT W:$P(^PSRX(DA,"H"),"^",2)]"" !,"HOLD COMMENTS: "_$P(^PSRX(DA,"H"),"^",2)
K DAT,DTT,HLDR
Q
HEAD I FFX W @IOF
W !,"#",?3,"LOG DATE",?12,"REF DATE",?22,"QTY",?35,"ROUT",?40,"LOT #",?52,"PHARMACIST",?70,"DIVISION",! F I=1:1:79 W "="
S FFX=0 W ! Q
DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
Q
PARL I FFX W @IOF
W !,"PARTIAL FILLS:",!,"#",?3,"LOG DATE",?14,"DATE",?27,"QTY",?32,"ROUTING",?40,"LOT #",?55,"PHARMACIST",?70,"DIVISION",! F I=1:1:79 W "="
S FFX=0 W ! Q
CON K DTOUT,DIRUT,DUOUT,DIR S DIR(0)="E" D ^DIR S FFX=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORXPR1 2484 printed Dec 13, 2024@02:34:37 Page 2
PSORXPR1 ;BHAM ISC/SAB - CONTINUATION OF VIEW PRESCRIPTION ; 10/01/92
+1 ;;7.0;OUTPATIENT PHARMACY;**258,386**;DEC 1997;Build 4
RF DO HEAD
FOR N=0:0
SET N=$ORDER(^PSRX(DA,1,N))
if 'N
QUIT
SET P1=^(N,0)
Begin DoDot:1
+1 if $Y>20
DO CON
if $DATA(DIRUT)
QUIT
if FFX
DO HEAD
WRITE !,N,?3
SET DTT=$PIECE(P1,"^",8)\1
DO DAT
WRITE DAT,?12
+2 SET DTT=$PIECE(P1,"^")
DO DAT
WRITE DAT,?22,$PIECE(P1,"^",4),?36
+3 SET PSDIV=$SELECT($DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^",6),1:"UNKNOWN")
SET X=$PIECE(P1,"^",2)
SET X=$FIND("MWIBD",X)-1
if X
WRITE $PIECE("M^W^INP","^",X),?40,$PIECE(P1,"^",6),?52,$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(P1,"^",5),0)):$PIECE(^(0),"^"),1:""),1,16),?70,PSDIV
+4 WRITE !," DISPENSED: "_$SELECT($PIECE(P1,"^",19):$EXTRACT($PIECE(P1,"^",19),4,5)_"/"_$EXTRACT($PIECE(P1,"^",19),6,7)_"/"_$EXTRACT($PIECE(P1,"^",19),2,3),1:"")
+5 WRITE ?$X+10,$SELECT($PIECE(P1,"^",16):" RETURNED TO STOCK: "_$EXTRACT(...
... $PIECE(P1,"^",16),4,5)_"/"_$EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:" RELEASED: "_$SELECT($PIECE(P1,"^",18):$EXTRACT($PIECE(P1,"^",18),4,5)_"/"_$EXTRACT($PIECE(P1,"^",18),6,7)_"/"_$EXTRACT($PIECE(P1,"^",
18),2,3),1:""))
+6 if $PIECE(P1,"^",3)'=""
WRITE !?5,"REMARKS: ",$PIECE(P1,"^",3),!
End DoDot:1
if $DATA(DIRUT)
QUIT
+7 QUIT
PAR IF $ORDER(^PSRX(DA,"P",0))
if $Y>20
DO CON
if $DATA(DIRUT)
QUIT
DO PARL
SET N=0
FOR
SET N=$ORDER(^PSRX(DA,"P",N))
if 'N
QUIT
SET P1=^(N,0)
Begin DoDot:1
+1 if $Y>20
DO CON
if $DATA(DIRUT)
QUIT
if FFX
DO PAR
WRITE !,N,?3
SET DTT=$PIECE(P1,"^",8)\1
DO DAT
WRITE DAT,?14
+2 SET DTT=$PIECE(P1,"^")
DO DAT
WRITE DAT,?27,$PIECE(P1,"^",4),?32
+3 SET PSDIV=$SELECT($DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^",6),1:"UNKNOWN")
SET X=$PIECE(P1,"^",2)
SET X=$FIND("MWIBD",X)-1
if X
WRITE $PIECE("MAIL^WINDOW^INPATIENT","^",X)
+4 WRITE ?40,$PIECE(P1,"^",6),?52,$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(P1,"^",5),0)):$PIECE(^(0),"^"),1:""),1,16),?70,PSDIV
+5 WRITE ?$X+10,$SELECT($PIECE(P1,"^",16):" RETURNED TO STOCK: "_$EXTRACT(...
... $PIECE(P1,"^",16),4,5)_"/"_$EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:" RELEASED: "_$SELECT($PIECE(P1,"^",19):$EXTRACT($PIECE(P1,"^",19),4,5)_"/"_$EXTRACT($PIECE(P1,"^",19),6,7)_"/"_$EXTRACT($PIECE(P1,
"^",19),2,3),1:""))
+6 if $PIECE(P1,"^",3)'=""
WRITE !?5,"REMARKS: ",$PIECE(P1,"^",3)
End DoDot:1
if $DATA(DIRUT)
QUIT
+7 QUIT
HLD ;prints hold info
+1 SET DTT=$PIECE(^PSRX(DA,"H"),"^",3)
DO DAT
SET HLDR=$$GET1^DIQ(52,DA,99)
+2 WRITE !!,"HOLD REASON: "_HLDR,?60,"HOLD DATE: "_DAT
if $PIECE(^PSRX(DA,"H"),"^",2)]""
WRITE !,"HOLD COMMENTS: "_$PIECE(^PSRX(DA,"H"),"^",2)
+3 KILL DAT,DTT,HLDR
+4 QUIT
HEAD IF FFX
WRITE @IOF
+1 WRITE !,"#",?3,"LOG DATE",?12,"REF DATE",?22,"QTY",?35,"ROUT",?40,"LOT #",?52,"PHARMACIST",?70,"DIVISION",!
FOR I=1:1:79
WRITE "="
+2 SET FFX=0
WRITE !
QUIT
DAT SET DAT=""
SET DTT=DTT\1
if DTT'?7N
QUIT
SET DAT=$EXTRACT(DTT,4,5)_"/"_$EXTRACT(DTT,6,7)_"/"_$EXTRACT(DTT,2,3)
+1 QUIT
PARL IF FFX
WRITE @IOF
+1 WRITE !,"PARTIAL FILLS:",!,"#",?3,"LOG DATE",?14,"DATE",?27,"QTY",?32,"ROUTING",?40,"LOT #",?55,"PHARMACIST",?70,"DIVISION",!
FOR I=1:1:79
WRITE "="
+2 SET FFX=0
WRITE !
QUIT
CON KILL DTOUT,DIRUT,DUOUT,DIR
SET DIR(0)="E"
DO ^DIR
SET FFX=1
QUIT
