APSPDRX ; IHS/DSD/ENM/PLS - DAILY RX LOG;11-Jun-2013 18:05;PLS
;;7.0;IHS PHARMACY MODIFICATIONS;**1008,1016**;Sep 23, 2004;Build 74
EP ;ENTRY POINT
INIT ;
D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W !,"No Site Param's Defined!..quitting." Q
N APSPBD,APSPED,APSBDF,APSPEDF,APSPDIV
;S APSPDIV=$S($D(^PS(59,PSOSITE,0)):$P(^(0),U,6),1:"") ;SITE NBR
W @IOF
W "Pharmacy Daily Rx Report",!!
D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
Q:APSPQ
S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
S APSPBD=APSPBD-.01,APSPED=APSPED+.99
;SELECT DIVISION
S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
Q:APSPQ
I APSPDIV D
.S APSPDIV="*"
E D Q:APSPQ
.S APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
Q:APSPQ
D DEV
Q
DEV ;
N XBRP,XBNS
S XBRP="OUT^APSPDRX"
S XBNS="APS*"
D ^XBDBQUE
Q
OUT N APSPG,APSPDT,APSPRN,APSPLN,FTYPE,APSPOUT,APSPRX
N APSPDFN,APSPDG,APSPNM,APSPPRV,DIV,APSPSTN,QTY
U IO
K ^TMP($J,"APSPX")
S APSPG=0,APSPOUT=""
S APSPDT=APSPBD F S APSPDT=$O(^PSRX("ZAL",APSPDT)) Q:'APSPDT!(APSPDT>APSPED) D PRT
D PRNT W !!,"End of Report"
Q
PRT ;
S RXIEN=0 F S RXIEN=$O(^PSRX("ZAL",APSPDT,RXIEN)) Q:'RXIEN D PR1
Q
PR1 S APSPLN=0 F S APSPLN=$O(^PSRX("ZAL",APSPDT,RXIEN,APSPLN)) Q:'APSPLN D PR2
Q
PR2 S FTYPE="" F S FTYPE=$O(^PSRX("ZAL",APSPDT,RXIEN,APSPLN,FTYPE)) Q:FTYPE="" D DSET
Q
DSET ;
N NXT
S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
S NXT=NXT+1
S APSPRX=$P($G(^PSRX(RXIEN,0)),U)
S APSPDFN=$P($G(^(0)),U,2)
S APSPDG=$P($G(^(0)),U,6)
S APSPDRG=$P($G(^PSDRUG(APSPDG,0)),U)
S APSPPRV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:APSPLN_","_RXIEN_",",1:RXIEN),$S(FTYPE="P":6,FTYPE="R":15,1:4),"I")
S DIV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:APSPLN_","_RXIEN_",",1:RXIEN),$S(FTYPE="P":.09,FTYPE="R":8,1:20),"I") ; Pharmacy Division IEN
S QTY=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:APSPLN_","_RXIEN_",",1:RXIEN),$S(FTYPE="P":.04,FTYPE="R":1,1:7))
Q:'$$DIVVRY(DIV,APSPDIV)
;S APSPCN=$$HRN^AUPNPAT(APSPDFN,$$GET1^DIQ(59,DIV,.06,"I"))
S APSPCN=$$HRN^AUPNPAT(APSPDFN,$$GET1^DIQ(59,DIV,100,"I")) ;IHS/MSC/PLS - 06/11/13
S ^TMP($J,"APSPX",DIV,APSPDT,APSPRX,NXT)=""
S ^TMP($J,"DATA",NXT)=APSPRX_U_APSPDFN_U_APSPDRG_U_APSPPRV_U_QTY_U_APSPCN_U_FTYPE
Q
; Return boolean flag indicating valid pharmacy division
DIVVRY(RXDIV,RPTDIV) ;EP
Q:RPTDIV="*" 1
Q RXDIV=RPTDIV
PRNT S (APSPDP,APSPZX)="" D HDR,DSPL
Q
DSPL ;GET DATA FROM TMP GBL
N DIV,DIVNM,APSP,APSPDT,APSPRX,APSPNM,NXT
S DIV="" F S DIV=$O(^TMP($J,"APSPX",DIV)) Q:'DIV D ;GET DIVISION
.S DIVNM=$$GET1^DIQ(59,DIV,.01)
.S APSPDT=0 F S APSPDT=$O(^TMP($J,"APSPX",DIV,APSPDT)) Q:'APSPDT!($G(APSPOUT)) D
..S APSPRX="" F S APSPRX=$O(^TMP($J,"APSPX",DIV,APSPDT,APSPRX)) Q:'$L(APSPRX)!($G(APSPOUT)) D
...S NXT=0 F S NXT=$O(^TMP($J,"APSPX",DIV,APSPDT,APSPRX,NXT)) Q:'NXT D DSPS Q:$G(APSPOUT)
Q
DSPS S APSP=^TMP($J,"DATA",NXT)
S APSPNM=$$GET1^DIQ(2,+$P(APSP,U,2),.01)
S APSPP=$P(APSP,U,4)
S APSPQ=$P(APSP,U,5)
S APSPCN=$P(APSP,U,6)
S FTYPE=$P(APSP,U,7)
D:$Y+4>IOSL HDR Q:$G(APSPOUT)
S APSPTYP=$S(FTYPE="N":"NEW RX",FTYPE="R":"REFILL",FTYPE="P":"PARTIAL",1:"")
W !,"Rx #: "_APSPRX,?17,"Name: "_APSPNM,?54,"Chart #: "_$P(APSP,U,6)
W !,"DRUG: "_$P(APSP,U,3),?37,"Qty: "_$P(APSP,U,5),?47,"Provider: "_$$GET1^DIQ(200,$P(APSP,U,4),.01)
W !,"Division: "_DIVNM,?37,APSPTYP,?53,"D/Time: "_$TR($$FMTE^XLFDT($E(APSPDT,1,12),"5Z"),"@"," ")
W !
Q
HDR I APSPG,$E(IOST)="C" K DIR S DIR(0)="FO",DIR("A")="Press Return to Continue or ""^"" to Exit" D ^DIR I X["^" S APSPOUT=1 Q
S APSPG=APSPG+1
W @IOF,?38,"(",APSPG,")",!,"DAILY PRESCRIPTION ACTIVITY REPORT"
W ?51,"Print Date: ",?59,$TR($$FMTE^XLFDT($E($$NOW^XLFDT(),1,12),"5Z"),"@"," "),!
W ?5,"Pharmacy Division: "_$S(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All"),!
F I=1:1:80 W "."
W !,?10,"For Rx's dispensed from "_APSPBDF_" to "_APSPEDF,!!
Q
APSPDRX ; IHS/DSD/ENM/PLS - DAILY RX LOG;11-Jun-2013 18:05;PLS
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1008,1016**;Sep 23, 2004;Build 74
EP ;ENTRY POINT
INIT ;
+1 IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE !,"No Site Param's Defined!..quitting."
QUIT
+2 NEW APSPBD,APSPED,APSBDF,APSPEDF,APSPDIV
+3 ;S APSPDIV=$S($D(^PS(59,PSOSITE,0)):$P(^(0),U,6),1:"") ;SITE NBR
+4 WRITE @IOF
+5 WRITE "Pharmacy Daily Rx Report",!!
+6 DO ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
+7 IF APSPQ
QUIT
+8 SET APSPBDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
+9 SET APSPEDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
+10 SET APSPBD=APSPBD-.01
SET APSPED=APSPED+.99
+11 ;SELECT DIVISION
+12 SET APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
+13 IF APSPQ
QUIT
+14 IF APSPDIV
Begin DoDot:1
+15 SET APSPDIV="*"
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
End DoDot:1
IF APSPQ
QUIT
+18 IF APSPQ
QUIT
+19 DO DEV
+20 QUIT
DEV ;
+1 NEW XBRP,XBNS
+2 SET XBRP="OUT^APSPDRX"
+3 SET XBNS="APS*"
+4 DO ^XBDBQUE
+5 QUIT
OUT NEW APSPG,APSPDT,APSPRN,APSPLN,FTYPE,APSPOUT,APSPRX
+1 NEW APSPDFN,APSPDG,APSPNM,APSPPRV,DIV,APSPSTN,QTY
+2 USE IO
+3 KILL ^TMP($JOB,"APSPX")
+4 SET APSPG=0
SET APSPOUT=""
+5 SET APSPDT=APSPBD
FOR
SET APSPDT=$ORDER(^PSRX("ZAL",APSPDT))
IF 'APSPDT!(APSPDT>APSPED)
QUIT
DO PRT
+6 DO PRNT
WRITE !!,"End of Report"
+7 QUIT
PRT ;
+1 SET RXIEN=0
FOR
SET RXIEN=$ORDER(^PSRX("ZAL",APSPDT,RXIEN))
IF 'RXIEN
QUIT
DO PR1
+2 QUIT
PR1 SET APSPLN=0
FOR
SET APSPLN=$ORDER(^PSRX("ZAL",APSPDT,RXIEN,APSPLN))
IF 'APSPLN
QUIT
DO PR2
+1 QUIT
PR2 SET FTYPE=""
FOR
SET FTYPE=$ORDER(^PSRX("ZAL",APSPDT,RXIEN,APSPLN,FTYPE))
IF FTYPE=""
QUIT
DO DSET
+1 QUIT
DSET ;
+1 NEW NXT
+2 SET NXT=$ORDER(^TMP($JOB,"DATA",$CHAR(1)),-1)
+3 SET NXT=NXT+1
+4 SET APSPRX=$PIECE($GET(^PSRX(RXIEN,0)),U)
+5 SET APSPDFN=$PIECE($GET(^(0)),U,2)
+6 SET APSPDG=$PIECE($GET(^(0)),U,6)
+7 SET APSPDRG=$PIECE($GET(^PSDRUG(APSPDG,0)),U)
+8 SET APSPPRV=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:APSPLN_","_RXIEN_",",1:RXIEN),$SELECT(FTYPE="P":6,FTYPE="R":15,1:4),"I")
+9 ; Pharmacy Division IEN
SET DIV=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:APSPLN_","_RXIEN_",",1:RXIEN),$SELECT(FTYPE="P":.09,FTYPE="R":8,1:20),"I")
+10 SET QTY=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:APSPLN_","_RXIEN_",",1:RXIEN),$SELECT(FTYPE="P":.04,FTYPE="R":1,1:7))
+11 IF '$$DIVVRY(DIV,APSPDIV)
QUIT
+12 ;S APSPCN=$$HRN^AUPNPAT(APSPDFN,$$GET1^DIQ(59,DIV,.06,"I"))
+13 ;IHS/MSC/PLS - 06/11/13
SET APSPCN=$$HRN^AUPNPAT(APSPDFN,$$GET1^DIQ(59,DIV,100,"I"))
+14 SET ^TMP($JOB,"APSPX",DIV,APSPDT,APSPRX,NXT)=""
+15 SET ^TMP($JOB,"DATA",NXT)=APSPRX_U_APSPDFN_U_APSPDRG_U_APSPPRV_U_QTY_U_APSPCN_U_FTYPE
+16 QUIT
+17 ; Return boolean flag indicating valid pharmacy division
DIVVRY(RXDIV,RPTDIV) ;EP
+1 IF RPTDIV="*"
QUIT 1
+2 QUIT RXDIV=RPTDIV
PRNT SET (APSPDP,APSPZX)=""
DO HDR
DO DSPL
+1 QUIT
DSPL ;GET DATA FROM TMP GBL
+1 NEW DIV,DIVNM,APSP,APSPDT,APSPRX,APSPNM,NXT
+2 ;GET DIVISION
SET DIV=""
FOR
SET DIV=$ORDER(^TMP($JOB,"APSPX",DIV))
IF 'DIV
QUIT
Begin DoDot:1
+3 SET DIVNM=$$GET1^DIQ(59,DIV,.01)
+4 SET APSPDT=0
FOR
SET APSPDT=$ORDER(^TMP($JOB,"APSPX",DIV,APSPDT))
IF 'APSPDT!($GET(APSPOUT))
QUIT
Begin DoDot:2
+5 SET APSPRX=""
FOR
SET APSPRX=$ORDER(^TMP($JOB,"APSPX",DIV,APSPDT,APSPRX))
IF '$LENGTH(APSPRX)!($GET(APSPOUT))
QUIT
Begin DoDot:3
+6 SET NXT=0
FOR
SET NXT=$ORDER(^TMP($JOB,"APSPX",DIV,APSPDT,APSPRX,NXT))
IF 'NXT
QUIT
DO DSPS
IF $GET(APSPOUT)
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
DSPS SET APSP=^TMP($JOB,"DATA",NXT)
+1 SET APSPNM=$$GET1^DIQ(2,+$PIECE(APSP,U,2),.01)
+2 SET APSPP=$PIECE(APSP,U,4)
+3 SET APSPQ=$PIECE(APSP,U,5)
+4 SET APSPCN=$PIECE(APSP,U,6)
+5 SET FTYPE=$PIECE(APSP,U,7)
+6 IF $Y+4>IOSL
DO HDR
IF $GET(APSPOUT)
QUIT
+7 SET APSPTYP=$SELECT(FTYPE="N":"NEW RX",FTYPE="R":"REFILL",FTYPE="P":"PARTIAL",1:"")
+8 WRITE !,"Rx #: "_APSPRX,?17,"Name: "_APSPNM,?54,"Chart #: "_$PIECE(APSP,U,6)
+9 WRITE !,"DRUG: "_$PIECE(APSP,U,3),?37,"Qty: "_$PIECE(APSP,U,5),?47,"Provider: "_$$GET1^DIQ(200,$PIECE(APSP,U,4),.01)
+10 WRITE !,"Division: "_DIVNM,?37,APSPTYP,?53,"D/Time: "_$TRANSLATE($$FMTE^XLFDT($EXTRACT(APSPDT,1,12),"5Z"),"@"," ")
+11 WRITE !
+12 QUIT
HDR IF APSPG
IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Press Return to Continue or ""^"" to Exit"
DO ^DIR
IF X["^"
SET APSPOUT=1
QUIT
+1 SET APSPG=APSPG+1
+2 WRITE @IOF,?38,"(",APSPG,")",!,"DAILY PRESCRIPTION ACTIVITY REPORT"
+3 WRITE ?51,"Print Date: ",?59,$TRANSLATE($$FMTE^XLFDT($EXTRACT($$NOW^XLFDT(),1,12),"5Z"),"@"," "),!
+4 WRITE ?5,"Pharmacy Division: "_$SELECT(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All"),!
+5 FOR I=1:1:80
WRITE "."
+6 WRITE !,?10,"For Rx's dispensed from "_APSPBDF_" to "_APSPEDF,!!
+7 QUIT
