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

APSPCTR.m

Go to the documentation of this file.
  1. APSPCTR ; IHS/DSD/ENM/BAO/DMH/CIA/PLS - CONTROLLED DRUG LIST BY DIV;10-Nov-2011 13:16;PLS
  1. ;;7.0;IHS PHARMACY MODIFICATIONS;**1004,1006,1008,1009,1013**;Sep 23, 2004;Build 33
  1. ; Modified - IHS/CIA/PLS - 01/13/04 - Updated version
  1. ; Modified - IHS/CIA/PLS - 02/24/06 - Patch 1004
  1. ; Modified - IHS/MSC/PLS - 09/26/07 - Patch 1006 - Added CHKSTAT check and business rule for DE date=Fill date for exclusion
  1. ; IHS/MSC/PLS - 12/30/08 - Patch 1008 - Routine updated
  1. ; - 08/31/09 - Patch 1008 - Added DSPRDT for release date check
  1. ; - 12/14/09 - Patch 1009 - removed check for $$DIVVRY in the inital loop of Find.
  1. ; - 11/10/11 - Patch 1013 - TallMan support
  1. EN ;EP
  1. N APSP,APSPAT,APSPATN,APSPBD,APSPCHN,APSPD,APSPDES,APSPDR,APSPBD,APSPED,APSPX,APSPN,APSPRX,APSPSH,DIC,APSPANS,APSPDTDR
  1. N APSPDRUG,APSPED,APSPGO,APSPITM,APSPMD,APSPMSG,APSPOP,APSPQTY,APSPRN,APSPRXN,APSPZZ,APSPBD,APSPCLER,APSPDIV,APSPDV
  1. N APSPGT,APSPT,APSPC9,%ZIS,%DT,POP,APSPQ,APSPBDF,APSPEDF
  1. W @IOF,!!,"Pharmacy Controlled Drug List by Division"
  1. W !,*7,?10,"132 Character Format!",!
  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. ;SELECT DIVISION
  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. S APSPDTDR=$$DIR^APSPUTIL("S^1:Date;2:Drug","Sort Report by",,,.APSPQ)
  1. Q:APSPQ
  1. D Q:APSPQ
  1. .S APSPDCLS=$$DIR^APSPUTIL("S^1:C-2'S;2:C-3'S to C5'S;3:All","Drug Class Types","",,.APSPQ)
  1. .S APSPDCT(1)="2",APSPDCT(3)="2345",APSPDCT(2)="345"
  1. .S APSPDCTN(1)="C-II",APSPDCTN(2)="C-III through C-V",APSPDCTN(3)="C-II through C-V"
  1. D DEV
  1. Q
  1. DEV ;
  1. N XBRP,XBNS
  1. S XBRP="OUT^APSPCTR"
  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 PRINT^APSPCTR1
  1. K ^TMP($J)
  1. Q
  1. ;
  1. FIND(SDT,EDT,XREF,DCLS) ;EP
  1. N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN
  1. S FDTLP=SDT-.01
  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:$$CHKSTAT(RXIEN) ; check prescription status
  1. ..;Q:'$$DIVVRY(RXIEN,APSPDIV) ;check division ;Patch 1009 commented out
  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. ..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. ...D SET(FDTLP,RXIEN,XREF,IEN)
  1. Q
  1. ; Check status business rules
  1. ; Input: RX - Prescription IEN
  1. ; Output: 0 - Prescription status OK, 1- Failed check
  1. CHKSTAT(RX) ; EP
  1. N STA
  1. S STA=$P($G(^PSRX(RX,"STA")),U)
  1. Q:STA=13 1 ;Deleted
  1. ;Q:STA=5 1 ;Suspended
  1. ; Discontinue/Edit Status and (Fill Date = Order D/C Date) per PSG
  1. I STA=15,$$GET1^DIQ(52,RX,22,"I")=$P($$GET1^DIQ(100,$$GET1^DIQ(52,RX,39.3,"I"),63,"I"),".") Q 1
  1. Q 0
  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. ; Set data into ^TMP global for output
  1. SET(FDT,RX,XREF,SIEN) ;EP
  1. N LSTDSPDT,NODE0,NODE2,NODE3,DIV,DCLS,RTSDATE,DRUG,RDT,RIFLG,FTYPE
  1. N PNM,DFN,DAYS,OPRV,PHRM,QTY,OPRVNM,CLERK,EDCLS,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 EDCLS=$$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 CLERK=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.07,FTYPE="R":6,1:16),"I")
  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
  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^Clerk
  1. S ^TMP($J,"DATA",NXT)=RXIEN_U_FDT_U_XREF_U_SIEN_U_$P(NODE0,U)_U_QTY_U_EDCLS_U_DRGNM_U_FTYPE_U_RIFLG_U_DRUG_U_DIV_U_DAYS_U_OPRV_U_PHRM_U_CLERK
  1. S DRGNM=$$UP^XLFSTR(DRGNM) ;1013
  1. S ^TMP($J,"XREF",DIV,"FDT",FDT,DCLS,DRGNM,NXT)=""
  1. S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,DCLS,FDT,NXT)=""
  1. S ^TMP($J,"XREF","RX",RX,FTYPE,SIEN)=NXT
  1. Q
  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"