- 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
