APSPDUR1 ;IHS/DSD/JCM/ENM - PHARMACY DUR PRINT;14-Oct-2009 14:36;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23, 2004
;THIS ROUTINE PRINTS THE PHARMACY DUR LISTING
;IT IS CALLED BY APSPDUR
;
;IHS/MSC/PLS - 01/02/09 - Routine updated
;
Q
EN ;EP
N APSPPG,APSPDT,DFN,RDATE,RX,TOTAL,DIV,NXT
S (DX,DY)=1 X:$D(^%ZOSF("XY"))#2 ^("XY")
U IO
S (APSPPG,TOTAL)=0
S DIV=0 F S DIV=$O(^TMP($J,"PSODUR",DIV)) Q:'DIV D
.D HDR
.S DFN=0 F S DFN=$O(^TMP($J,"PSODUR",DIV,DFN)) Q:'DFN D DATE
I $E(IOST,1,2)'="P-" W !,"Press Return to Continue...." R X:DTIME Q:X="^"!($D(DTOUT))
W !!,"TOTAL NUMBER OF ISSUES : ",TOTAL
I $E(IOST,1,2)="P-" W !,@IOF
Q
DATE ;EP
S RDATE=0 F S RDATE=$O(^TMP($J,"PSODUR",DIV,DFN,RDATE)) Q:'RDATE D RX
Q
RX ;EP
S RX=0 F S RX=$O(^TMP($J,"PSODUR",DIV,DFN,RDATE,RX)) Q:'RX D
.S NXT=0 F S NXT=$O(^TMP($J,"PSODUR",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 ;EP
N DATA,REM
I $Y+4>IOSL W @IOF D HDR
S DATA=^TMP($J,"DATA",NXT)
W !,$$GET1^DIQ(2,DFN,.01) ; Patient Name
W ?35,$J($$HRN^AUPNPAT(DFN,DUZ(2)),7) ;Chart Number
W ?45,$$FMTE^XLFDT(RDATE,"5ZD") ; Release Date
W ?55,$J($P(DATA,U,4),4) ;QTY
W ?61,$E($$GET1^DIQ(200,$P(DATA,U,6),.01),1,18) ;Provider
S REM=$P(DATA,U,7)
I $L(REM),REM'["RENEWED FROM" W !,"Remarks: ",REM,! ;Remarks
S TOTAL=TOTAL+1
Q
HDR ;
N DN,CT,APSPDV
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 USE EVALUATION 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 !!,"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 !!,"PATIENT",?35,"CHART",?45,"DATE"
W !,"NAME",?35,"NUMBER",?45,"DISPENSED",?55,"QTY",?61,"MD"
W ! F I=1:1:IOM W "_"
I '$D(^TMP($J,"PSODUR")) W !!?20,"NO PATIENTS RECEIVED MEDICATION"
W !
Q
APSPDUR1 ;IHS/DSD/JCM/ENM - PHARMACY DUR PRINT;14-Oct-2009 14:36;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23, 2004
+2 ;THIS ROUTINE PRINTS THE PHARMACY DUR LISTING
+3 ;IT IS CALLED BY APSPDUR
+4 ;
+5 ;IHS/MSC/PLS - 01/02/09 - Routine updated
+6 ;
+7 QUIT
EN ;EP
+1 NEW APSPPG,APSPDT,DFN,RDATE,RX,TOTAL,DIV,NXT
+2 SET (DX,DY)=1
IF $DATA(^%ZOSF("XY"))#2
XECUTE ^("XY")
+3 USE IO
+4 SET (APSPPG,TOTAL)=0
+5 SET DIV=0
FOR
SET DIV=$ORDER(^TMP($JOB,"PSODUR",DIV))
IF 'DIV
QUIT
Begin DoDot:1
+6 DO HDR
+7 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"PSODUR",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 WRITE !!,"TOTAL NUMBER OF ISSUES : ",TOTAL
+10 IF $EXTRACT(IOST,1,2)="P-"
WRITE !,@IOF
+11 QUIT
DATE ;EP
+1 SET RDATE=0
FOR
SET RDATE=$ORDER(^TMP($JOB,"PSODUR",DIV,DFN,RDATE))
IF 'RDATE
QUIT
DO RX
+2 QUIT
RX ;EP
+1 SET RX=0
FOR
SET RX=$ORDER(^TMP($JOB,"PSODUR",DIV,DFN,RDATE,RX))
IF 'RX
QUIT
Begin DoDot:1
+2 SET NXT=0
FOR
SET NXT=$ORDER(^TMP($JOB,"PSODUR",DIV,DFN,RDATE,RX,NXT))
IF 'NXT
QUIT
DO PRINT
End DoDot:1
+3 ;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
+4 QUIT
PRINT ;EP
+1 NEW DATA,REM
+2 IF $Y+4>IOSL
WRITE @IOF
DO HDR
+3 SET DATA=^TMP($JOB,"DATA",NXT)
+4 ; Patient Name
WRITE !,$$GET1^DIQ(2,DFN,.01)
+5 ;Chart Number
WRITE ?35,$JUSTIFY($$HRN^AUPNPAT(DFN,DUZ(2)),7)
+6 ; Release Date
WRITE ?45,$$FMTE^XLFDT(RDATE,"5ZD")
+7 ;QTY
WRITE ?55,$JUSTIFY($PIECE(DATA,U,4),4)
+8 ;Provider
WRITE ?61,$EXTRACT($$GET1^DIQ(200,$PIECE(DATA,U,6),.01),1,18)
+9 SET REM=$PIECE(DATA,U,7)
+10 ;Remarks
IF $LENGTH(REM)
IF REM'["RENEWED FROM"
WRITE !,"Remarks: ",REM,!
+11 SET TOTAL=TOTAL+1
+12 QUIT
HDR ;
+1 NEW DN,CT,APSPDV
+2 SET APSPPG=APSPPG+1
+3 SET APSPDV=$PIECE(^PS(59,DIV,0),U)
+4 WRITE !!,$SELECT($GET(DUZ(2)):$PIECE(^DIC(4,DUZ(2),0),U)_" ",1:""),"DRUG USE EVALUATION LIST"
+5 WRITE ?73,"Page ",APSPPG
+6 WRITE !,"DATE OF LISTING: "_$$FMTE^XLFDT($$DT^XLFDT(),"5Z")
+7 IF APSPDIV="*"
WRITE !,"All Divisions for: ",$PIECE(^DIC(4,DUZ(2),0),U,1)
+8 WRITE !,"Division: ",$GET(APSPDV)
+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 !!,"PATIENT",?35,"CHART",?45,"DATE"
+15 WRITE !,"NAME",?35,"NUMBER",?45,"DISPENSED",?55,"QTY",?61,"MD"
+16 WRITE !
FOR I=1:1:IOM
WRITE "_"
+17 IF '$DATA(^TMP($JOB,"PSODUR"))
WRITE !!?20,"NO PATIENTS RECEIVED MEDICATION"
+18 WRITE !
+19 QUIT
