- 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
