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

APSPCSM.m

Go to the documentation of this file. 
  1. APSPCSM ; IHS/MSC/PLS - CONTROLLED SUBSTANCE MANAGEMENT REPORT ;24-May-2013 08:49;PLS
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1007,1008,1011,1013,1015**;Sep 23, 2004;Build 74
  1.  ;
  1.  ; IHS/MSC/PLS - 12/29/2008 - Line OUT+4 - Fixed variable name
  1.  ;               04/21/2009 - Line FIND+10 - Fixed issue with external vs internal value
  1.  ;               08/31/2009 - Added DSPRDT API for check of release date
  1.  ;               05/16/2011 - Added Remaining Refills to data store
  1.  ;               09/16/2011 - Added ENTSK EP
  1.  ;               06/29/2012 - Added CMOP field
  1. EN ;EP
  1.  N APSPBD,APSPED,APSPBDF,APSPEDF,APSPDIV,APSPRTYP,APSPQ,APSPDSUB,APSPDCLS
  1.  N APSPDCT,APSPDCTN,APSPDRG,APSPDET,APSPSORT,STATS,APSPDOSE,APSPXML,APSPPRV
  1.  N APSPETOT,APSPPAT,APSPRTOT,APSPCMOP
  1.  S APSPDIV="",APSPDRG="",APSPQ=0,APSPDSUB=0,APSPDOSE=0,APSPXML=0,APSPPRV=""
  1.  S APSPETOT=1,APSPPAT=""
  1.  W @IOF
  1.  W !!,"Controlled Substance Management Report"
  1.  D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,$$FMADD^XLFDT(DT,-1),$$FMADD^XLFDT(DT,-1))
  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.  Q:APSPQ
  1.  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",2,,.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.  S APSPRTYP=+$$DIR^APSPUTIL("S^1:Summary;2:Detail","Report Type",2,,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPDET=APSPRTYP>1
  1.  S APSPSORT=+$$DIR^APSPUTIL("S^1:Drug Name;2:Fill Date;"_$S(APSPDET:"3:Drug Schedule/Drug Name;4:Patient;5:Prescriber",1:""),"Sort report by",$S(APSPDET:3,1:""),,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPPAT="*"
  1.  I APSPSORT=4 D
  1.  .S APSPPAT=$$DIR^APSPUTIL("Y","Would you like all patients","Yes",,.APSPQ)
  1.  .Q:APSPQ
  1.  .I APSPPAT D
  1.  ..S APSPPAT="*"
  1.  .E  D  Q:APSPQ
  1.  ..S APSPPAT=+$$DIR^APSPUTIL("9000001,.01","Select Patient: ",,,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPPRV="*"
  1.  I APSPSORT=5 D
  1.  .S APSPPRV=$$DIR^APSPUTIL("Y","Would you like all prescribers","Yes",,.APSPQ)
  1.  .Q:APSPQ
  1.  .I APSPPRV D
  1.  ..S APSPPRV="*"
  1.  .E  D  Q:APSPQ
  1.  ..S APSPPRV=+$$DIR^APSPUTIL("52,4","Select Prescriber: ",,,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPXML=+$$DIR^APSPUTIL("S^1:Standard Report;2:Data Export","Output Mode",1,,.APSPQ)
  1.  Q:APSPQ
  1.  S APSPXML=APSPXML=2
  1.  S:APSPXML&APSPDET APSPETOT=+$$DIR^APSPUTIL("Y","Export report totals","No",,.APSPQ)
  1.  Q:APSPQ
  1.  S:APSPDET&'APSPXML APSPDOSE=+$$DIR^APSPUTIL("Y","Would you like dosing information included","Yes",,.APSPQ)
  1.  Q:APSPQ
  1.  ;IHS/MSC/MGH 1016 added CMOP
  1.  S APSPCMOP=$$DIRYN^APSPUTIL("Do you want CMOP fills included","Yes","Enter a 'YES' or 'NO' to include or not include CMOP fills in your search",.APSPQ)
  1.  Q:APSPQ
  1.  D DEV
  1.  Q
  1. DEV ;
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^APSPCSM"
  1.  S XBNS="APS*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP
  1.  U IO
  1.  K ^TMP($J)
  1.  D FIND(APSPBD,APSPED,"AD",$G(APSPDCLS))  ; Regular and Refill
  1.  D FIND(APSPBD,APSPED,"ADP",$G(APSPDCLS))  ; Partial
  1.  ;D:APSPRTYP=1 STATS
  1.  D SORT
  1.  D PRINT^APSPCSM1
  1.  K ^TMP($J)
  1.  Q
  1.  ;
  1. FIND(SDT,EDT,XREF,DCLS) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,CMOP
  1.  S FDTLP=SDT-.01
  1.  S CMOP=""
  1.  F  S FDTLP=$O(^PSRX(XREF,FDTLP)) Q:'FDTLP!(FDTLP>EDT)  D
  1.  .S RXIEN=0
  1.  .F  S RXIEN=$O(^PSRX(XREF,FDTLP,RXIEN)) Q:'RXIEN  D
  1.  ..Q:'$$PATVRY(RXIEN,APSPPAT)  ;check patient
  1.  ..;Q:'$$DIVVRY(RXIEN,APSPDIV)  ;check division  ;patch 1008
  1.  ..Q:'$P(^PSRX(RXIEN,0),U,6)   ; Prescription must have a drug
  1.  ..Q:'$$DCVRY(APSPDCLS,RXIEN)  ;Quit if Drug Class search and drug doesn't match class
  1.  ..Q:$$GET1^DIQ(52,RXIEN,100,"I")=13  ; Quit if Deleted status
  1.  ..;Q:$$GET1^DIQ(52,RXIEN,100,"I")=5   ; Quit if Suspended status
  1.  ..S IEN="" F  S IEN=$O(^PSRX(XREF,FDTLP,RXIEN,IEN)) Q:IEN=""  D
  1.  ...Q:'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I"))  ; Quit if original fill and a return to stock date exists
  1.  ...Q:'$$DIVVRY(RXIEN,APSPDIV,XREF,IEN)  ;check division
  1.  ...Q:'$$DSPRDT(RXIEN,XREF,IEN)  ;check for release date
  1.  ...Q:'$$PRVVRY(RXIEN,APSPPRV,XREF,IEN)  ;check provider
  1.  ...;IHS/MSC/MGH 06/29/2012
  1.  ...I XREF="AD" S CMOP=$$CMOP(RXIEN,IEN)
  1.  ...I CMOP=""!(CMOP="M") D SET(FDTLP,RXIEN,XREF,IEN,CMOP)
  1.  ...I CMOP="C"&APSPCMOP D SET(FDTLP,RXIEN,XREF,IEN,CMOP)
  1.  Q
  1.  ;
  1.  ; Calculate statistics
  1. STATS(DAT) ;EP -
  1.  N LP,RX,DRUG,DRUGN,QTY,FDT,RXCNT,DRUGNU
  1.  S RX=$P(DAT,U)
  1.  S DRUG=$P(DAT,U,11)
  1.  S DRUGN=$P(DAT,U,8)
  1.  S DRUGNU=$$UP^XLFSTR(DRUGN)  ;P1013
  1.  S QTY=+$P(DAT,U,6)
  1.  S FDT=$P(DAT,U,2)
  1.  S DIV=+$P(DAT,U,12)
  1.  S STATS("FILLS")=+$G(STATS("FILLS"))+1
  1.  S APSPRTOT("FILLS")=$G(APSPRTOT("FILLS"))+1
  1.  S STATS("DRUG",DRUG)=+$G(STATS("DRUG",DRUG))+QTY
  1.  S APSPRTOT("DRUG",DRUG)=+$G(APSPRTOT("DRUG",DRUG))+QTY
  1.  S STATS("DRUGN",DRUGNU)=DRUG_U_$$GET1^DIQ(50,DRUG,14.5)_U_DRUGN
  1.  S APSPRTOT("DRUGN",DRUGNU)=DRUG_U_$$GET1^DIQ(50,DRUG,14.5)_U_DRUGN
  1.  I '$G(STATS("RXS",RX)) D
  1.  .S APSPRTOT("RXCNT")=+$G(APSPRTOT("RXCNT"))+1
  1.  .S STATS("RXCNT")=+$G(STATS("RXCNT"))+1
  1.  I '$G(STATS("RXS",RX)) D
  1.  .S APSPRTOT("RXDRUG",DRUGNU)=+$G(APSPRTOT("RXDRUG",DRUGNU))+1
  1.  .S STATS("RXDRUG",DRUGNU)=+$G(STATS("RXDRUG",DRUGN))+1  ; Holds number for prescriptions for a given drug
  1.  S APSPRTOT("RXS",RX)=+$G(STATS("RXS",RX))+1
  1.  S STATS("RXS",RX)=+$G(STATS("RXS",RX))+1  ; Holds number of fills per RX
  1.  Q
  1. SORT ;EP -
  1.  Q
  1.  ; Set data into ^TMP global for output
  1. SET(FDT,RX,XREF,SIEN,CMOP) ;EP
  1.  N LSTDSPDT,NODE0,NODE2,NODE3,DIV,DCLS,RTSDATE,DRUG,RDT,RIFLG,FTYPE
  1.  N PNM,DFN,DAYS,OPRV,PHRM,QTY,OPRVNM,NXT
  1.  S FTYPE=$S(XREF="ADP":"P",SIEN:"R",1:"F")
  1.  S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
  1.  S NXT=NXT+1
  1.  S NODE0=^PSRX(RX,0)
  1.  S NODE2=^PSRX(RX,2)
  1.  S NODE3=^PSRX(RX,3)
  1.  S DRUG=$P(NODE0,U,6)
  1.  S DFN=$P(NODE0,U,2)
  1.  S PNM=$$GET1^DIQ(2,DFN,.01)
  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 DIV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.09,FTYPE="R":8,1:20),"I")  ; Pharmacy Division IEN
  1.  S RDT=$$GET1^DIQ(52,RX,31,"I")  ;Release Date
  1.  S QTY=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.04,FTYPE="R":1,1:7))
  1.  S DAYS=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.041,FTYPE="R":1.1,1:8))
  1.  S OPRV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":6,FTYPE="R":15,1:4),"I")
  1.  S OPRVNM=$$GET1^DIQ(200,OPRV,.01)
  1.  S:'$L(OPRVNM) OPRVNM="NONAME"
  1.  S PHRM=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.05,FTYPE="R":4,1:23),"I")
  1.  ;                1            2             3                  4             5            6       7         8         9       10      11         12          13          14        15          16           17
  1.  ;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Prescription Number^QTY^Drug Class^Drug Name^Fill Type^RI Flg^Drug IEN^RX Division^Days Supply^Prescriber^Pharmacist^RemainingRefills^CMOP
  1.  S ^TMP($J,"DATA",NXT)=RXIEN_U_FDT_U_XREF_U_SIEN_U_$P(NODE0,U)_U_QTY_U_DCLS_U_DRGNM_U_FTYPE_U_RIFLG_U_DRUG_U_DIV_U_DAYS_U_OPRV_U_PHRM_U_+$$RMNRFL^APSPFUNC(RXIEN,FDT)_U_CMOP
  1.  S DRGNM=$$UP^XLFSTR(DRGNM)  ;P1013
  1.  S ^TMP($J,"XREF",DIV,"FDT",FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,FDT,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"S-DRUG",DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"S-FDT",FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"DCLS",DCLS,DRGNM,FDT,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"PAT",PNM,FDT,DRGNM,NXT)=""
  1.  S ^TMP($J,"XREF",DIV,"PRV",OPRVNM,DRGNM,FDT,NXT)=""
  1.  S ^TMP($J,"XREF","RX",RX,FTYPE,SIEN)=NXT
  1.  Q
  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))  ; 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,TYP,SIEN) ;EP
  1.  Q:DIV="*" 1
  1.  Q $S($G(SIEN):DIV=+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,9),1:DIV=+$P(^PSRX(RX,2),U,9))
  1.  ; Return release date for dispense
  1. DSPRDT(RX,TYP,SIEN) ;EP
  1.  Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))
  1.  ; Return boolean flag indicating valide provider
  1. PRVVRY(RX,PRV,TYP,SIEN) ;EP
  1.  Q:PRV="*" 1
  1.  Q $S($G(SIEN):PRV=+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,17),1:PRV=$P(^PSRX(RX,0),U,4))
  1.  ; Return boolean flag indicating valid patient
  1. PATVRY(RX,PAT) ;EP
  1.  Q:PAT="*" 1
  1.  Q +$P($G(^PSRX(RX,0)),U,2)=PAT
  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.  ;Entry point called by APSP CSM REPORT TASK option to autorun with defaults
  1. ENTSK ;EP-
  1.  N APSPBD,APSPBDF,APSPDCLS,APSPDCTN,APSPDET,APSPDIV,APSPDOSE
  1.  N APSPDRG,APSPDSUB,APSPED,APSPEDF,APSPETOT,APSPPAT,APSPPRV,APSPQ
  1.  N APSPRTYP,APSPSORT,APSPXML,APSPCMOP
  1.  N LP,X
  1.  S APSPBD=$$FMADD^XLFDT(DT,-1)
  1.  S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
  1.  S APSPBD=APSPBD-.01
  1.  S APSPDCLS=2
  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.  S APSPDET=1
  1.  S APSPDIV="*"
  1.  S APSPDOSE=1
  1.  S APSPDRG=""
  1.  S APSPDSUB=1
  1.  S APSPED=$$FMADD^XLFDT(DT,-1)
  1.  S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
  1.  S APSPED=APSPED+.99
  1.  S APSPETOT=1
  1.  S APSPPAT="*"
  1.  S APSPPRV="*"
  1.  S APSPQ=0
  1.  S APSPRTYP=2
  1.  S APSPSORT=3
  1.  S APSPXML=0
  1.  S APSPCMOP=1
  1.  D OUT^APSPCSM
  1.  Q
  1.  ; IHS/MSC/PLS - 09/16/2011
  1. AUTOQ ;EP - ENTRY POINT FOR AUTO QUEUEING OF APSP CSM REPORT TASK OPTION
  1.  Q:'$$FIND1^DIC(19,"","MX","APSP CSM REPORT TASK")
  1.  I $$FIND1^DIC(19.2,"","MX","APSP CSM REPORT TASK") D
  1.  .D EDIT^XUTMOPT("APSP CSM REPORT TASK")
  1.  E  D
  1.  .D RESCH^XUTMOPT("APSP CSM REPORT TASK","","","24H","L")
  1.  .D EDIT^XUTMOPT("APSP CSM REPORT TASK")
  1.  Q
  1.  ;IHS/MSC/MGH - 06/29/2012
  1. CMOP(RX,FILL) ;
  1.  N MW,CMOP,RFL,IEN,STOP,DATA
  1.  S CMOP=""
  1.  S RFL=$$LSTRFL^PSOBPSU1(RX)
  1.  S MW=$S('RFL:$$GET1^DIQ(52,RX,11,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,2,"I"))
  1.  S STOP=0
  1.  S IEN=0 F  S IEN=$O(^PSRX(RX,4,IEN)) Q:'+IEN!(STOP=1)  D
  1.  .S DATA=$P($G(^PSRX(RX,4,IEN,0)),U,3)
  1.  .I FILL=DATA S STOP=1 S CMOP="C"
  1.  I CMOP=""&(MW="M") S CMOP=MW
  1.  Q CMOP