- 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 Feb 19, 2025@00:01:02 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