Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPRRTS

APSPRRTS.m

Go to the documentation of this file. 
  1. APSPRRTS ; IHS/MSC/PLS - RETURN TO STOCK REPORT ;23-Sep-2010 18:27;SM
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1006,1007,1008,1009**;Sep 23, 2004
  1.  ;
  1. EN ;EP
  1.  N APSPBD,APSPED,APSPDIV,APSPRTYP,APSPQ,APSPDSUB,APSPDCLS
  1.  N APSPDCT,APSPDCTN,APSPDRG,APSPBDF,APSPEDF
  1.  S APSPDIV="",APSPDRG="",APSPQ=0,APSPDSUB=0
  1.  W @IOF
  1.  W !!,"Pharmacy Return to Stock report by Division"
  1.  D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
  1.  Q:APSPQ
  1.  S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
  1.  S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
  1.  S APSPBD=APSPBD-.01,APSPED=APSPED+.99
  1.  S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPDIV D
  1.  .S APSPDIV="*"
  1.  E  D  Q:APSPQ
  1.  .S APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
  1.  S APSPRTYP=+$$DIR^APSPUTIL("S^1:Specific Drug Name;2:Drug Class;3:All Drugs","Sort report by",,,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPRTYP=1 D  Q:APSPQ
  1.  .S APSPDRG=$$GETIEN^APSPUTIL(50,"Select Drug Name: ",.APSPQ)
  1.  E  I APSPRTYP=2 D  Q:APSPQ
  1.  .S APSPDCLS=$$DIR^APSPUTIL("S^1:C-II;2:C-II through C-V;3:C-III through C-V","Drug Class Types","",,.APSPQ)
  1.  .Q:APSPQ
  1.  .S APSPDSUB=1  ;$$DIR^APSPUTIL("Y","Secondary sort by drug name",,,.APSPQ)
  1.  .S APSPDCT(1)="2",APSPDCT(2)="2345",APSPDCT(3)="345"
  1.  .S APSPDCTN(1)="C-II",APSPDCTN(2)="C-II through C-V",APSPDCTN(3)="C-III through C-V"
  1.  E  D
  1.  .S APSPDRG="*"
  1.  .S APSPDSUB=$$DIR^APSPUTIL("Y","Sort by generic drug name","No",,.APSPQ)
  1.  D DEV
  1.  Q
  1. DEV ;
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^APSPRRTS"
  1.  S XBNS="APS*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP
  1.  K ^TMP($J)
  1.  D FIND($G(APSPDCLS))
  1.  D PRINT
  1.  Q
  1.  ;
  1. FIND(DCLS) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,FILLDT,A0
  1.  S RXIEN=0
  1.  F  S RXIEN=$O(^PSRX(RXIEN)) Q:'RXIEN  D
  1.  .Q:'$D(^PSRX(RXIEN,0))       ; Prescription must have a zero node
  1.  .Q:'$$DIVVRY(RXIEN,APSPDIV)  ;check division
  1.  .Q:'$P(^PSRX(RXIEN,0),U,6)   ; Prescription must have a drug
  1.  .I APSPRTYP=1 Q:'$$DRGVRY(APSPDRG,RXIEN)  ; Check for matching drug
  1.  .I APSPRTYP=2 Q:'$$DCVRY(DCLS,RXIEN)  ;Quit if Drug Class search and drug doesn't match class
  1.  .S ACTIEN=0
  1.  .F  S ACTIEN=$O(^PSRX(RXIEN,"A",ACTIEN)) Q:'ACTIEN  D
  1.  ..S A0=$G(^PSRX(RXIEN,"A",ACTIEN,0))
  1.  ..Q:$P(A0,U,2)'="I"  ; Check for RETURN reason
  1.  ..Q:+A0<APSPBD!(+A0>APSPED)  ;Check activity date against report date parameters
  1.  ..D SET(RXIEN,ACTIEN)
  1.  Q
  1.  ;
  1. PRINT ;EP
  1.  N APSPPG,DFLG
  1.  S (APSPPG,DFLG)=0
  1.  D HDR
  1.  D PRINT1
  1.  W:'DFLG !,"No data found..."
  1.  Q
  1.  ;
  1. PRINT1 ;EP
  1.  ;This EP makes use of the MUMPS naked reference syntax.
  1.  N DIV,SUB1,SUB2,SUB3,SUB4,VAL
  1.  S DIV=0 F  S DIV=$O(^TMP($J,"XREF",DIV)) Q:'DIV  D
  1.  .I APSPDIV="*" W !,"|"_$$GET1^DIQ(59,DIV,.01)_"|" D PRINT3
  1.  .I APSPRTYP=1!(APSPRTYP=3&APSPDSUB) D
  1.  ..S SUB1="" F  S SUB1=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1)) Q:'$L(SUB1)  D
  1.  ...S SUB2=0 F  S SUB2=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1,SUB2)) Q:'SUB2  D
  1.  ....S SUB3=0 F  S SUB3=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1,SUB2,SUB3)) Q:'SUB3  D
  1.  .....S VAL=^(SUB3)
  1.  .....D PRINT2(^TMP($J,"DATA",VAL))
  1.  .....S DFLG=1
  1.  .E  I 'APSPDSUB D
  1.  ..S SUB1=0 F  S SUB1=$O(^TMP($J,"XREF",DIV,"RTS",SUB1)) Q:'SUB1  D
  1.  ...S SUB2=0 F  S SUB2=$O(^TMP($J,"XREF",DIV,"RTS",SUB1,SUB2)) Q:'SUB2  D
  1.  ....S VAL=^(SUB2)
  1.  ....D PRINT2(^TMP($J,"DATA",VAL))
  1.  ....S DFLG=1
  1.  .E  I APSPRTYP=2 D
  1.  ..S SUB1="" F  S SUB1=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1)) Q:'$L(SUB1)  D
  1.  ...S SUB2="" F  S SUB2=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1,SUB2)) Q:'$L(SUB2)  D
  1.  ....S SUB3=0 F  S SUB3=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1,SUB2,SUB3)) Q:'SUB3  D
  1.  .....S SUB4=0 F  S SUB4=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1,SUB2,SUB3,SUB4)) Q:'SUB4  D
  1.  ......S VAL=^(SUB4)
  1.  ......D PRINT2(^TMP($J,"DATA",VAL))
  1.  ......S DFLG=1
  1.  Q
  1.  ; Print the line
  1. PRINT2(DATA) ;EP
  1.  W !,$P($TR($$FMTE^XLFDT($P(DATA,U),"5Z"),"@"," "),":",1,2)_$P(DATA,U,8),?20,$P(DATA,U,9)_$P(DATA,U,3),?38,$P(DATA,U,7),?53,$E($P(DATA,U,6),1,34),?95,$P(DATA,U,4),?101,$$FMTE^XLFDT($P(DATA,U,2),"5Z"),?116,$P(DATA,U,10)
  1.  D PRINT3 ;check page length
  1.  Q
  1.  ; Check page length
  1. PRINT3 ;EP
  1.  D:$Y+8>IOSL HDR
  1.  Q
  1.  ; Set data into ^TMP global for output
  1. SET(RX,ACT) ;EP
  1.  N LSTDSPDT,NODE0,NODE2,NODE3,DIV,DCLS,RTSDATE,DRUG,RDT,RIFLG
  1.  N ACT0,ACTREF,HRN
  1.  S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
  1.  S NXT=NXT+1
  1.  S NODE0=^PSRX(RX,0)
  1.  S NODE2=$G(^PSRX(RX,2))  ; IHS/MSC/PLS - 06/20/08 - Added $G
  1.  S NODE3=$G(^PSRX(RX,3))  ; IHS/MSC/PLS - 06/20/08 - Added $G
  1.  S DIV=$P(NODE2,U,9)
  1.  S DRUG=$P(NODE0,U,6)
  1.  S DRGNM=$P(^PSDRUG(DRUG,0),U)
  1.  S DCLS=+$P(^PSDRUG(DRUG,0),U,3)
  1.  S DCLS=$$CVTDCLS(DCLS)
  1.  S LSTDSPDT=+NODE3
  1.  S RIFLG=""
  1.  S ACT0=$G(^PSRX(RX,"A",ACT,0))
  1.  S RTSDATE=$P(+ACT0,".")  ; IHS/MSC/PLS - 06/20/08 - Added $G
  1.  S HRN=$$HRN^AUPNPAT($P(NODE0,U,2),$$GET1^DIQ(59,DIV,100,"I"))  ;IHS/MSC/PLS - 06/29/10 - Added line
  1.  S ACTREF=$P(ACT0,U,4)  ;RX Reference - 6=partial
  1.  S RDT=$$GET1^DIQ(52,RX,31,"I")  ;Release Date
  1.  I RDT>APSPBD,RDT<APSPED D
  1.  .S:'$$GET1^DIQ(52.3,ACT_","_RX_",",.04,"I") RIFLG="*"
  1.  S ^TMP($J,"DATA",NXT)=RTSDATE_U_LSTDSPDT_U_$P(NODE0,U)_U_$S(ACTREF=6:"#",1:$P(NODE0,U,7))_U_DCLS_U_DRGNM_U_$$GET1^DIQ(52.3,ACT_","_RX_",",.04)_U_RIFLG_U_$$DELFLG(RX)_U_HRN
  1.  S ^TMP($J,"XREF",DIV,"RTS",RTSDATE,RX)=NXT
  1.  S ^TMP($J,"XREF",DIV,"DCLS",DCLS,DRGNM,RTSDATE,RX)=NXT
  1.  S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,RTSDATE,RX)=NXT
  1.  Q
  1.  ; Return boolean flag indicating prescription drug matches selected drug
  1. DRGVRY(DRUG,RX) ;EP
  1.  Q $P($G(^PSRX(RX,0)),U,6)=DRUG
  1.  ; Return boolean flag indicating prescription drug matches selected report drug class
  1.  ; Input:  DCLS - Drug Class based on input selected by user
  1.  ;         RX - Prescription IEN
  1. DCVRY(DCLS,RX) ;EP
  1.  N RXRTSDT,DRGIEN,DCLSVAL
  1.  S RXRTSDT=$P($G(^PSRX(RXIEN,2)),U,15)
  1.  S DRGIEN=$P(^PSRX(RX,0),U,6)
  1.  Q:'$D(^PSDRUG(DRGIEN,0)) 0  ; Check for missing drug entry
  1.  S DCLSVAL=$P(^PSDRUG(DRGIEN,0),U,3)
  1.  Q APSPDCT(DCLS)[+DCLSVAL
  1.  ; Return boolean flag indicating valid pharmacy division
  1. DIVVRY(RX,DIV) ;EP
  1.  Q:DIV="*" 1
  1.  Q DIV=+$P($G(^PSRX(RX,2)),U,9)  ; IHS/MSC/PLS -06/20/08 - Added $G
  1.  ;
  1. CVTDCLS(DCLS) ; EP
  1.  Q:DCLS=2 "C-II"
  1.  Q:DCLS=3 "C-III"
  1.  Q:DCLS=4 "C-IV"
  1.  Q:DCLS=5 "C-V"
  1.  Q "C-UNKNOWN"
  1.  ;
  1.  ; Return '*' flag indicated prescription has been deleted
  1. DELFLG(RX) ;EP
  1.  Q $S($G(^PSRX(RX,"STA"))=13:"*",1:" ")
  1. HDR ;EP
  1.  W @IOF
  1.  S APSPPG=APSPPG+1
  1.  W !,"Returned to Stock Report",?35,$P($TR($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG
  1.  W !,"Report Criteria:                  (An '*' after RTS Date indicates a reissued original Rx.)"
  1.  W !,"                                  (An '*' prior to the Rx Number indicates a deleted prescription.)"
  1.  W !,"                                  (A '#' indicates that quantity is unknown for returned partial fill.)"
  1.  W !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF
  1.  W !,?5,"Pharmacy Division: "_$S(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All")
  1.  W !,?5,"Type of Search: "_$S(APSPRTYP=3:"All Drugs",APSPRTYP=2:"Drug Class ("_APSPDCTN(APSPDCLS)_")",APSPRTYP=1:"Specific Drug ("_$$GET1^DIQ(50,APSPDRG,.01)_")",1:"")
  1.  W !,?5,"Sorted by: "_$S($G(APSPDCLS):"Drug Class then Drug Name then RTS Date/Time",$G(APSPDSUB):"Drug Name then RTS Date/Time",1:"RTS Date/Time")
  1.  D HDR1
  1.  Q
  1.  ;
  1. HDR1 ;EP
  1.  D DASH
  1.  W "RTS Date/Time",?20,"Rx Number",?38,"Act Reference",?53,"Drug Name",?95,"Qty",?101,"Last Disp Date",?116,"Pt ID"
  1.  D DASH
  1.  Q
  1.  ;
  1. DASH ;EP
  1.  N DASH
  1.  W ! F DASH=1:1:IOM W "-"
  1.  W !
  1.  Q