- APSPMED3 ; IHS/DSD/ENM - PRINTS SHORT MEDICATION PROFILE ; [ 09/03/97 1:30 PM ]
- ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
- K RX,DTOUT,DIRUT,DIROUT,DUOUT
- D HD S DRUG="" F I=0:0 S DRUG=$O(^TMP($J,DRUG)) Q:DRUG="" F J=0:0 S J=$O(^TMP($J,DRUG,J)) Q:'J!($D(DTOUT))!($D(DUOUT))!($D(DIROUT)) S RX0=^(J),RX2=$G(^PSRX(J,2)),ST=+$P(RX0,"^",15) S:$P(RX2,"^",15) RST($P(RX2,"^",2))=1 D W
- Q
- Q ;D ^%ZISC K ^TMP($J),PSODTCT,ST,D0,DIC,DIR,DIRUT,DUOUT,G,II,K,RXD,RXF,ZX,DRUG,X,DFN,PHYS,PSRT,CT,AL,I1,PLS,REF,LMI,PI,FN,Y,I,J,RX,DRX,ST,RX0,RX2,DA S:$D(ZTQUEUED) ZTREQ="@" Q
- Q
- W ;I $Y+4>IOSL,IOST["C-" S DIR("A")="ENTER '^' TO HALT",DIR(0)="FO" D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT)) W @IOF
- I $Y+4>IOSL,IOST["C-" S DIR("A")="ENTER '^' TO HALT",DIR(0)="E" D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT)) W @IOF D HD ;IHS/DSD/ENM 02/20/97
- ;U IO I IO'=IO(0),$Y+4>IOSL W @IOF
- D STAT^PSOFUNC W !,$P(RX0,"^"),?8,$S(PSRT="DRUG":DRUG,$D(^PSDRUG(+$P(RX0,"^",6),0)):$P(^(0),"^"),1:"NOT ON FILE"),?44,$E(ST,1),?47,$J($P(RX0,"^",7),6)
- S RXD=$P(^PSRX(J,3),"^"),RXF=$P(RX0,"^",9) F II=0:0 S II=$O(^PSRX(J,1,II)) Q:'II S RXF=RXF-1 S:$P(^PSRX(J,1,II,0),"^",16) RST($P(^(0),"^"))=1
- W ?55,$E($P(RX0,"^",13),4,5)_"-"_$E($P(RX0,"^",13),6,7)_"-"_$E($P(RX0,"^",13),2,3) W:RXD ?65,$E(RXD,4,5)_"-"_$E(RXD,6,7)_"-"_$E(RXD,2,3)_$S($G(RST(RXD)):"R",1:"") W ?75,"("_RXF_")"
- W !?10,$P(RX0,"^",10) K RST Q
- HD U IO W !!,"RX# DRUG",?42,"STAT QTY",?55,"ISSUED ",?65,"LAST FILL REM"
- Q
- APSPMED3 ; IHS/DSD/ENM - PRINTS SHORT MEDICATION PROFILE ; [ 09/03/97 1:30 PM ]
- +1 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
- +2 KILL RX,DTOUT,DIRUT,DIROUT,DUOUT
- +3 DO HD
- SET DRUG=""
- FOR I=0:0
- SET DRUG=$ORDER(^TMP($JOB,DRUG))
- IF DRUG=""
- QUIT
- FOR J=0:0
- SET J=$ORDER(^TMP($JOB,DRUG,J))
- IF 'J!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIROUT))
- QUIT
- SET RX0=^(J)
- SET RX2=$GET(^PSRX(J,2))
- SET ST=+$PIECE(RX0,"^",15)
- IF $PIECE(RX2,"^",15)
- SET RST($PIECE(RX2,"^",2))=1
- DO W
- +4 QUIT
- Q ;D ^%ZISC K ^TMP($J),PSODTCT,ST,D0,DIC,DIR,DIRUT,DUOUT,G,II,K,RXD,RXF,ZX,DRUG,X,DFN,PHYS,PSRT,CT,AL,I1,PLS,REF,LMI,PI,FN,Y,I,J,RX,DRX,ST,RX0,RX2,DA S:$D(ZTQUEUED) ZTREQ="@" Q
- +1 QUIT
- W ;I $Y+4>IOSL,IOST["C-" S DIR("A")="ENTER '^' TO HALT",DIR(0)="FO" D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT)) W @IOF
- +1 ;IHS/DSD/ENM 02/20/97
- IF $Y+4>IOSL
- IF IOST["C-"
- SET DIR("A")="ENTER '^' TO HALT"
- SET DIR(0)="E"
- DO ^DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
- QUIT
- WRITE @IOF
- DO HD
- +2 ;U IO I IO'=IO(0),$Y+4>IOSL W @IOF
- +3 DO STAT^PSOFUNC
- WRITE !,$PIECE(RX0,"^"),?8,$SELECT(PSRT="DRUG":DRUG,$DATA(^PSDRUG(+$PIECE(RX0,"^",6),0)):$PIECE(^(0),"^"),1:"NOT ON FILE"),?44,$EXTRACT(ST,1),?47,$JUSTIFY($PIECE(RX0,"^",7),6)
- +4 SET RXD=$PIECE(^PSRX(J,3),"^")
- SET RXF=$PIECE(RX0,"^",9)
- FOR II=0:0
- SET II=$ORDER(^PSRX(J,1,II))
- IF 'II
- QUIT
- SET RXF=RXF-1
- IF $PIECE(^PSRX(J,1,II,0),"^",16)
- SET RST($PIECE(^(0),"^"))=1
- +5 WRITE ?55,$EXTRACT($PIECE(RX0,"^",13),4,5)_"-"_$EXTRACT($PIECE(RX0,"^",13),6,7)_"-"_$EXTRACT($PIECE(RX0,"^",13),2,3)
- IF RXD
- WRITE ?65,$EXTRACT(RXD,4,5)_"-"_$EXTRACT(RXD,6,7)_"-"_$EXTRACT(RXD,2,3)_$SELECT($GET(RST(RXD)):"R",1:"")
- WRITE ?75,"("_RXF_")"
- +6 WRITE !?10,$PIECE(RX0,"^",10)
- KILL RST
- QUIT
- HD USE IO
- WRITE !!,"RX# DRUG",?42,"STAT QTY",?55,"ISSUED ",?65,"LAST FILL REM"
- +1 QUIT
