APSPDR4 ;IHS/OHPRD/JCM - PHARMACY DRUG RECALL PRINT;14-Oct-2009 14:35;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23, 2004
;THIS ROUTINE PRINTS THE PHARMACY DRUG RECALL LIST
;IT IS CALLED BY APSPDR3
;
; IHS/MSC/PLS - 01/02/09 - Routine updated
Q
EN ;EP
N APSPPG,APSPDT,DFN,RDATE,RX,DIV,NXT
S (DX,DY)=1 X:$D(^%ZOSF("XY"))#2 ^("XY")
U IO
S APSPPG=0
S DIV=0 F S DIV=$O(^TMP($J,"PSODR",DIV)) Q:'DIV D
.D HDR
.S DFN=0 F S DFN=$O(^TMP($J,"PSODR",DIV,DFN)) Q:'DFN D DATE
I $E(IOST,1,2)'="P-" W !,"Press Return to Continue...." R X:DTIME Q:X="^"!($D(DTOUT))
;
I $E(IOST,1,2)="P-" W !,@IOF
Q
DATE ;
S RDATE=0 F S RDATE=$O(^TMP($J,"PSODR",DIV,DFN,RDATE)) Q:'RDATE D RX
Q
RX ;
S RX=0 F S RX=$O(^TMP($J,"PSODR",DIV,DFN,RDATE,RX)) Q:'RX D
.S NXT=0 F S NXT=$O(^TMP($J,"PSODR",DIV,DFN,RDATE,RX,NXT)) Q:'NXT D PRINT 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
Q
;
PRINT ;
N DATA,HPHN,AD1,AD2,AD3,CITY,STATE,ZIP
I $E(IOST,1,2)'="P-",$Y+4>IOSL W @IOF D HDR
S DATA=^TMP($J,"DATA",NXT)
S HPHN=$$GET1^DIQ(2,DFN,.131)
S:'$L(HPHN) HPHN="UNKNOWN"
S AD1=$$GET1^DIQ(2,DFN,.111) S:'$L(AD1) AD1="UNKNOWN"
I AD1'="UNKNOWN" D
.S AD2=$$GET1^DIQ(2,DFN,.112)
.S AD3=$$GET1^DIQ(2,DFN,.113)
.S CITY=$$GET1^DIQ(2,DFN,.114)
.S STATE=$$GET1^DIQ(2,DFN,.115)
.S STATE=$$GET1^DIQ(5,STATE,.01)
.S ZIP=$$GET1^DIQ(2,DFN,.116)
W !,$$FMTPHN^APSPFUNC(HPHN) ;HOME PHONE
W ?16,$$GET1^DIQ(2,DFN,.01) ;PAT NAME
W ?48,$J($$HRN^AUPNPAT(DFN,DUZ(2)),7) ;CHART NUMBER
W ?58,$$FMTE^XLFDT(RDATE,"5ZD")
W ?72,$P(DATA,U,4) ;QTY
W !,"ADDRESS: ",AD1," ",$G(AD2)
W " ",$G(AD3)," ",$G(CITY)," "
W $G(STATE)," ",$G(ZIP)
W !
Q
HDR ;
S APSPPG=APSPPG+1
S APSPDV=$P(^PS(59,DIV,0),U)
W !!,$S($G(DUZ(2)):$P(^DIC(4,DUZ(2),0),U)_" ",1:""),"DRUG RECALL LIST"
W ?73,"Page ",APSPPG
W !,"DATE OF LISTING: "_$$FMTE^XLFDT($$DT^XLFDT(),"5Z")
I APSPDIV="*" W !,"All Divisions for: ",$P(^DIC(4,DUZ(2),0),U,1)
W !,"Division: ",$G(APSPDV)
W !,?25,"CONFIDENTIAL PATIENT INFORMATION"
W !!,"This list will include all Outpatients dispensed one or any"
W " combination ",!,"of the following drug(s) from "
W APSPBDF," through ",APSPEDF,!!
S (DN,CT)=0
F S DN=$O(APSPDARY(DN)) Q:'DN W $P(^PSDRUG(DN,0),U),", " S CT=CT+1 I CT=3 W ! S CT=0
W !!,"HOME",?16,"PATIENT",?48,"CHART",?58,"DATE",?72,"QTY"
W !,"PHONE",?16,"NAME",?48,"NUMBER",?58,"DISPENSED"
W ! F I=1:1:IOM W "_"
I '$D(^TMP($J,"PSODR")) W !!?20,"NO PATIENTS RECEIVED MEDICATION"
W !
Q
APSPDR4 ;IHS/OHPRD/JCM - PHARMACY DRUG RECALL PRINT;14-Oct-2009 14:35;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23, 2004
+2 ;THIS ROUTINE PRINTS THE PHARMACY DRUG RECALL LIST
+3 ;IT IS CALLED BY APSPDR3
+4 ;
+5 ; IHS/MSC/PLS - 01/02/09 - Routine updated
+6 QUIT
EN ;EP
+1 NEW APSPPG,APSPDT,DFN,RDATE,RX,DIV,NXT
+2 SET (DX,DY)=1
IF $DATA(^%ZOSF("XY"))#2
XECUTE ^("XY")
+3 USE IO
+4 SET APSPPG=0
+5 SET DIV=0
FOR
SET DIV=$ORDER(^TMP($JOB,"PSODR",DIV))
IF 'DIV
QUIT
Begin DoDot:1
+6 DO HDR
+7 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"PSODR",DIV,DFN))
IF 'DFN
QUIT
DO DATE
End DoDot:1
+8 IF $EXTRACT(IOST,1,2)'="P-"
WRITE !,"Press Return to Continue...."
READ X:DTIME
IF X="^"!($DATA(DTOUT))
QUIT
+9 ;
+10 IF $EXTRACT(IOST,1,2)="P-"
WRITE !,@IOF
+11 QUIT
DATE ;
+1 SET RDATE=0
FOR
SET RDATE=$ORDER(^TMP($JOB,"PSODR",DIV,DFN,RDATE))
IF 'RDATE
QUIT
DO RX
+2 QUIT
RX ;
+1 SET RX=0
FOR
SET RX=$ORDER(^TMP($JOB,"PSODR",DIV,DFN,RDATE,RX))
IF 'RX
QUIT
Begin DoDot:1
+2 SET NXT=0
FOR
SET NXT=$ORDER(^TMP($JOB,"PSODR",DIV,DFN,RDATE,RX,NXT))
IF 'NXT
QUIT
DO PRINT
IF $Y+4>IOSL
IF IOST["C-"
SET DIR("A")="ENTER '^' TO HALT"
SET DIR(0)="FO"
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
WRITE @IOF
End DoDot:1
+3 QUIT
+4 ;
PRINT ;
+1 NEW DATA,HPHN,AD1,AD2,AD3,CITY,STATE,ZIP
+2 IF $EXTRACT(IOST,1,2)'="P-"
IF $Y+4>IOSL
WRITE @IOF
DO HDR
+3 SET DATA=^TMP($JOB,"DATA",NXT)
+4 SET HPHN=$$GET1^DIQ(2,DFN,.131)
+5 IF '$LENGTH(HPHN)
SET HPHN="UNKNOWN"
+6 SET AD1=$$GET1^DIQ(2,DFN,.111)
IF '$LENGTH(AD1)
SET AD1="UNKNOWN"
+7 IF AD1'="UNKNOWN"
Begin DoDot:1
+8 SET AD2=$$GET1^DIQ(2,DFN,.112)
+9 SET AD3=$$GET1^DIQ(2,DFN,.113)
+10 SET CITY=$$GET1^DIQ(2,DFN,.114)
+11 SET STATE=$$GET1^DIQ(2,DFN,.115)
+12 SET STATE=$$GET1^DIQ(5,STATE,.01)
+13 SET ZIP=$$GET1^DIQ(2,DFN,.116)
End DoDot:1
+14 ;HOME PHONE
WRITE !,$$FMTPHN^APSPFUNC(HPHN)
+15 ;PAT NAME
WRITE ?16,$$GET1^DIQ(2,DFN,.01)
+16 ;CHART NUMBER
WRITE ?48,$JUSTIFY($$HRN^AUPNPAT(DFN,DUZ(2)),7)
+17 WRITE ?58,$$FMTE^XLFDT(RDATE,"5ZD")
+18 ;QTY
WRITE ?72,$PIECE(DATA,U,4)
+19 WRITE !,"ADDRESS: ",AD1," ",$GET(AD2)
+20 WRITE " ",$GET(AD3)," ",$GET(CITY)," "
+21 WRITE $GET(STATE)," ",$GET(ZIP)
+22 WRITE !
+23 QUIT
HDR ;
+1 SET APSPPG=APSPPG+1
+2 SET APSPDV=$PIECE(^PS(59,DIV,0),U)
+3 WRITE !!,$SELECT($GET(DUZ(2)):$PIECE(^DIC(4,DUZ(2),0),U)_" ",1:""),"DRUG RECALL LIST"
+4 WRITE ?73,"Page ",APSPPG
+5 WRITE !,"DATE OF LISTING: "_$$FMTE^XLFDT($$DT^XLFDT(),"5Z")
+6 IF APSPDIV="*"
WRITE !,"All Divisions for: ",$PIECE(^DIC(4,DUZ(2),0),U,1)
+7 WRITE !,"Division: ",$GET(APSPDV)
+8 WRITE !,?25,"CONFIDENTIAL PATIENT INFORMATION"
+9 WRITE !!,"This list will include all Outpatients dispensed one or any"
+10 WRITE " combination ",!,"of the following drug(s) from "
+11 WRITE APSPBDF," through ",APSPEDF,!!
+12 SET (DN,CT)=0
+13 FOR
SET DN=$ORDER(APSPDARY(DN))
IF 'DN
QUIT
WRITE $PIECE(^PSDRUG(DN,0),U),", "
SET CT=CT+1
IF CT=3
WRITE !
SET CT=0
+14 WRITE !!,"HOME",?16,"PATIENT",?48,"CHART",?58,"DATE",?72,"QTY"
+15 WRITE !,"PHONE",?16,"NAME",?48,"NUMBER",?58,"DISPENSED"
+16 WRITE !
FOR I=1:1:IOM
WRITE "_"
+17 IF '$DATA(^TMP($JOB,"PSODR"))
WRITE !!?20,"NO PATIENTS RECEIVED MEDICATION"
+18 WRITE !
+19 QUIT
