AZQ2RXP1 ;IHS/ASU/RPL;PRINT PVT INS. AND PRESCRIPTION INFO; ; 8/31/89 10:33 AM
;Version 1.1
;Called from AZQ2RXP
START ;
S AZQ280D="--------------------------------------------------------------------------------" ;80 DASHES
S Y=AZQ2SD X ^DD("DD") S AZQ2SDY=Y S Y=AZQ2FD X ^DD("DD") S AZQ2FDY=Y S Y=DT X ^DD("DD") S AZQ2DTP=Y
S AZQ2PG=0 D HEAD
S AZQ2DFN="" F I=0:0 S AZQ2DFN=$O(^UTILITY($J,AZQ2DFN)) G:AZQ2DFN=""!($D(AZQ2QUIT)) DONE D C1
C1 S AZQ2HRN=$P(AZQ2DFN,"."),DFN=$P(AZQ2DFN,".",2)
S AZQ2DPT=^DPT(DFN,0),AZQ2NAME=$P(AZQ2DPT,"^"),Y=$P(AZQ2DPT,"^",3) X ^DD("DD")
I $Y>(IOSL-8) D HEAD Q:$D(AZQ2QUIT)
W !!,$J(AZQ2HRN,6),?8,AZQ2NAME,?40,Y
SCRIP S AZQ2DT="" F K=0:0 S AZQ2DT=$O(^UTILITY($J,AZQ2DFN,AZQ2DT)) Q:AZQ2DT'=+AZQ2DT!($D(AZQ2QUIT)) D C2
Q
C2 S AZQ2PRVI=0 F J=0:0 S AZQ2PRVI=$O(^AUPNPRVT(DFN,11,AZQ2PRVI)) Q:AZQ2PRVI'=+AZQ2PRVI!($D(AZQ2QUIT)) D PI
D SUBHD Q:$D(AZQ2QUIT)
S AZQ2PDFN="" F L=0:0 S AZQ2PDFN=$O(^UTILITY($J,AZQ2DFN,AZQ2DT,AZQ2PDFN)) Q:AZQ2PDFN'=+AZQ2PDFN!($D(AZQ2QUIT)) D PRNT
W ! Q
PI S AZQ2PRV=^AUPNPRVT(DFN,11,AZQ2PRVI,0)
S AZQ2PRVE=$P(AZQ2PRV,"^",7),AZQ2PRVS=$P(AZQ2PRV,"^",6) I AZQ2PRVE]"",AZQ2PRVE<AZQ2S Q
Q:AZQ2PRVS>AZQ2DT
I $Y>(IOSL-6) D HEAD
W !!,?8,$P(^AUTNINS(+AZQ2PRV,0),"^"),?40,$P(AZQ2PRV,"^",2)
W !,?8,$P(AZQ2PRV,"^",4) I $P(AZQ2PRV,"^",5)]"" W ?40,$P(^AUTTRLSH($P(AZQ2PRV,"^",5),0),"^")
W ! Q
PRNT I $Y>(IOSL-5) D HEAD Q:$D(AZQ2QUIT)
S AZQ2N0=^PSRX(AZQ2PDFN,0),AZQ2DDFN=$P(AZQ2N0,"^",6),AZQ2QTY=$P(AZQ2N0,"^",7)
S Y=AZQ2DT X ^DD("DD")
W !,?8,Y
W ?21,$P(^PSDRUG(AZQ2DDFN,0),"^")
I $D(^PSDRUG(AZQ2DDFN,2)) S AZQ2NDC=$P(^(2),"^",4) W ?50,AZQ2NDC
S AZQ2PPDU=$S($P(^PSRX(AZQ2PDFN,0),"^",17)>0:$P(^(0),"^",17),$D(^PSDRUG(AZQ2DDFN,660)):$P(^(660),"^",6),1:0),AZQ2CST=AZQ2QTY*AZQ2PPDU,AZQ2DU=$S($D(^PSDRUG(AZQ2DDFN,660)):$P(^(660),"^",8),1:""),AZQ2BILL=4.5+AZQ2CST
W !,?21,AZQ2QTY_" "_AZQ2DU_" at $"_$J(AZQ2PPDU,6,3)_" each",?64,$J(AZQ2CST,6,2),?72,$J(AZQ2BILL,6,2),!
Q
HEAD S AZQ2PG=AZQ2PG+1 G:AZQ2PG=1 HEAD1
I $E(IOST)="C",IO=IO(0) R "Press <RETURN> to continue. ",X:DTIME I $E(X)="^"!('$T) S AZQ2QUIT="" Q
HEAD1 W @IOF
W $P(^DIC(4,DUZ(2),0),"^"),?59,AZQ2DTP,?73,"Page ",AZQ2PG,!
W !,"Prescriptions between "_AZQ2SDY_" and "_AZQ2FDY_" for Prvt. Insurance Eligibles."
W !!,?2,"HRCN",?8,"Patient Name",?40,"DOB",!!,?8,"Insurer",?40,"Policy Number",!,?8,"Name of Insured",?40,"Relationship"
W !,AZQ280D
Q
SUBHD I $Y>(IOSL-8) D HEAD Q:$D(AZQ2QUIT)
W !,?8,"Fill Date",?21,"Drug",?50,"NDC Code",?66,"Cost",?74,"Bill",!,?8,"-----------",?21,"---------------------------",?50,"------------",?64,"------",?72,"------"
Q
DONE Q:$D(AZQ2QUIT) I $E(IOST)="C",IO=IO(0) R "End of Report. Press <RETURN> to continue. ",X:DTIME
Q
AZQ2RXP1 ;IHS/ASU/RPL;PRINT PVT INS. AND PRESCRIPTION INFO; ; 8/31/89 10:33 AM
+1 ;Version 1.1
+2 ;Called from AZQ2RXP
START ;
+1 ;80 DASHES
SET AZQ280D="--------------------------------------------------------------------------------"
+2 SET Y=AZQ2SD
XECUTE ^DD("DD")
SET AZQ2SDY=Y
SET Y=AZQ2FD
XECUTE ^DD("DD")
SET AZQ2FDY=Y
SET Y=DT
XECUTE ^DD("DD")
SET AZQ2DTP=Y
+3 SET AZQ2PG=0
DO HEAD
+4 SET AZQ2DFN=""
FOR I=0:0
SET AZQ2DFN=$ORDER(^UTILITY($JOB,AZQ2DFN))
IF AZQ2DFN=""!($DATA(AZQ2QUIT))
GOTO DONE
DO C1
C1 SET AZQ2HRN=$PIECE(AZQ2DFN,".")
SET DFN=$PIECE(AZQ2DFN,".",2)
+1 SET AZQ2DPT=^DPT(DFN,0)
SET AZQ2NAME=$PIECE(AZQ2DPT,"^")
SET Y=$PIECE(AZQ2DPT,"^",3)
XECUTE ^DD("DD")
+2 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(AZQ2QUIT)
QUIT
+3 WRITE !!,$JUSTIFY(AZQ2HRN,6),?8,AZQ2NAME,?40,Y
SCRIP SET AZQ2DT=""
FOR K=0:0
SET AZQ2DT=$ORDER(^UTILITY($JOB,AZQ2DFN,AZQ2DT))
IF AZQ2DT'=+AZQ2DT!($DATA(AZQ2QUIT))
QUIT
DO C2
+1 QUIT
C2 SET AZQ2PRVI=0
FOR J=0:0
SET AZQ2PRVI=$ORDER(^AUPNPRVT(DFN,11,AZQ2PRVI))
IF AZQ2PRVI'=+AZQ2PRVI!($DATA(AZQ2QUIT))
QUIT
DO PI
+1 DO SUBHD
IF $DATA(AZQ2QUIT)
QUIT
+2 SET AZQ2PDFN=""
FOR L=0:0
SET AZQ2PDFN=$ORDER(^UTILITY($JOB,AZQ2DFN,AZQ2DT,AZQ2PDFN))
IF AZQ2PDFN'=+AZQ2PDFN!($DATA(AZQ2QUIT))
QUIT
DO PRNT
+3 WRITE !
QUIT
PI SET AZQ2PRV=^AUPNPRVT(DFN,11,AZQ2PRVI,0)
+1 SET AZQ2PRVE=$PIECE(AZQ2PRV,"^",7)
SET AZQ2PRVS=$PIECE(AZQ2PRV,"^",6)
IF AZQ2PRVE]""
IF AZQ2PRVE<AZQ2S
QUIT
+2 IF AZQ2PRVS>AZQ2DT
QUIT
+3 IF $Y>(IOSL-6)
DO HEAD
+4 WRITE !!,?8,$PIECE(^AUTNINS(+AZQ2PRV,0),"^"),?40,$PIECE(AZQ2PRV,"^",2)
+5 WRITE !,?8,$PIECE(AZQ2PRV,"^",4)
IF $PIECE(AZQ2PRV,"^",5)]""
WRITE ?40,$PIECE(^AUTTRLSH($PIECE(AZQ2PRV,"^",5),0),"^")
+6 WRITE !
QUIT
PRNT IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AZQ2QUIT)
QUIT
+1 SET AZQ2N0=^PSRX(AZQ2PDFN,0)
SET AZQ2DDFN=$PIECE(AZQ2N0,"^",6)
SET AZQ2QTY=$PIECE(AZQ2N0,"^",7)
+2 SET Y=AZQ2DT
XECUTE ^DD("DD")
+3 WRITE !,?8,Y
+4 WRITE ?21,$PIECE(^PSDRUG(AZQ2DDFN,0),"^")
+5 IF $DATA(^PSDRUG(AZQ2DDFN,2))
SET AZQ2NDC=$PIECE(^(2),"^",4)
WRITE ?50,AZQ2NDC
+6 SET AZQ2PPDU=$SELECT($PIECE(^PSRX(AZQ2PDFN,0),"^",17)>0:$PIECE(^(0),"^",17),$DATA(^PSDRUG(AZQ2DDFN,660)):$PIECE(^(660),"^",6),1:0)
SET AZQ2CST=AZQ2QTY*AZQ2PPDU
SET AZQ2DU=$SELECT($DATA(^PSDRUG(AZQ2DDFN,660)):$PIECE(^(660),"^",8),1:"")
SET AZQ2BILL=4.5+AZQ2CST
+7 WRITE !,?21,AZQ2QTY_" "_AZQ2DU_" at $"_$JUSTIFY(AZQ2PPDU,6,3)_" each",?64,$JUSTIFY(AZQ2CST,6,2),?72,$JUSTIFY(AZQ2BILL,6,2),!
+8 QUIT
HEAD SET AZQ2PG=AZQ2PG+1
IF AZQ2PG=1
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
READ "Press <RETURN> to continue. ",X:DTIME
IF $EXTRACT(X)="^"!('$TEST)
SET AZQ2QUIT=""
QUIT
HEAD1 WRITE @IOF
+1 WRITE $PIECE(^DIC(4,DUZ(2),0),"^"),?59,AZQ2DTP,?73,"Page ",AZQ2PG,!
+2 WRITE !,"Prescriptions between "_AZQ2SDY_" and "_AZQ2FDY_" for Prvt. Insurance Eligibles."
+3 WRITE !!,?2,"HRCN",?8,"Patient Name",?40,"DOB",!!,?8,"Insurer",?40,"Policy Number",!,?8,"Name of Insured",?40,"Relationship"
+4 WRITE !,AZQ280D
+5 QUIT
SUBHD IF $Y>(IOSL-8)
DO HEAD
IF $DATA(AZQ2QUIT)
QUIT
+1 WRITE !,?8,"Fill Date",?21,"Drug",?50,"NDC Code",?66,"Cost",?74,"Bill",!,?8,"-----------",?21,"---------------------------",?50,"------------",?64,"------",?72,"------"
+2 QUIT
DONE IF $DATA(AZQ2QUIT)
QUIT
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
READ "End of Report. Press <RETURN> to continue. ",X:DTIME
+1 QUIT
