PSORXPR1 ;BHAM ISC/SAB - CONTINUATION OF VIEW PRESCRIPTION ;29-May-2012 15:13;PLS
;;7.0;OUTPATIENT PHARMACY;**258,1015**;DEC 1997;Build 62
; Modified - IHS/CIA/PLS - 01/08/04 - Lines RF+1 and RF+9
RF D HEAD F N=0:0 S N=$O(^PSRX(DA,1,N)) Q:'N S P1=^(N,0) D Q:$D(DIRUT)
.; IHS/CIA/PLS - 01/08/04 - Setup IHS variables
.S P9999999=$G(^PSRX(DA,1,N,9999999))
.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),!
.; IHS/CIA/PLS - 01/08/04 - IHS Output next two lines
.W:$P(P1,"^",13)'="" !?5,"NDC: ",$P(P1,"^",13) ; IHS/CIA/PLS - 01/08/04 - NDC
.W " ("_$P(P9999999,"^",6)_") ("_$P(P1,"^",11)_")" ; IHS/CIA/PLS - 01/08/04 - Cost
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=$P(^DD(52,99,0),"^",3),HLDR=$S($P(^PSRX(DA,"H"),"^")'>8:$P(HLDR,";",$P(^PSRX(DA,"H"),"^")),1:$P(HLDR,";",9)),HLDR=$P(HLDR,":",2)
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
PSORXPR1 ;BHAM ISC/SAB - CONTINUATION OF VIEW PRESCRIPTION ;29-May-2012 15:13;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**258,1015**;DEC 1997;Build 62
+2 ; Modified - IHS/CIA/PLS - 01/08/04 - Lines RF+1 and RF+9
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 ; IHS/CIA/PLS - 01/08/04 - Setup IHS variables
+2 SET P9999999=$GET(^PSRX(DA,1,N,9999999))
+3 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
+4 SET DTT=$PIECE(P1,"^")
DO DAT
WRITE DAT,?22,$PIECE(P1,"^",4),?36
+5 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
+6 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:"")
+7 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:""))
+8 IF $PIECE(P1,"^",3)'=""
WRITE !?5,"REMARKS: ",$PIECE(P1,"^",3),!
+9 ; IHS/CIA/PLS - 01/08/04 - IHS Output next two lines
+10 ; IHS/CIA/PLS - 01/08/04 - NDC
IF $PIECE(P1,"^",13)'=""
WRITE !?5,"NDC: ",$PIECE(P1,"^",13)
+11 ; IHS/CIA/PLS - 01/08/04 - Cost
WRITE " ("_$PIECE(P9999999,"^",6)_") ("_$PIECE(P1,"^",11)_")"
End DoDot:1
IF $DATA(DIRUT)
QUIT
+12 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=$PIECE(^DD(52,99,0),"^",3)
SET HLDR=$SELECT($PIECE(^PSRX(DA,"H"),"^")'>8:$PIECE(HLDR,";",$PIECE(^PSRX(DA,"H"),"^")),1:$PIECE(HLDR,";",9))
SET HLDR=$PIECE(HLDR,":",2)
+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
