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

APSPESR2.m

Go to the documentation of this file. 
  1. APSPESR2 ; IHS/MSC/MGH - EXTERNAL PHARMACY PRESCRIPTIONS REPORT ;12-May-2011 16:15;DU
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1011**;Sep 23, 2004;Build 17
  1.  ;
  1. EN ;EP
  1.  N APSPBD,APSPED,APSPDIV,APSPRTYP,APSPQ,APSPDSUB,APSPDCLS,APSPSRT,APSPSRT2
  1.  N APSPDCT,APSPDCTN,APSPDRG,APSPBDF,APSPEDF,APSPFIL,APSPGRP,APSPOUT
  1.  S APSPDIV="",APSPDRG="",APSPQ=0,APSPDSUB=0
  1.  W @IOF
  1.  W !!,"Electronic Prescription failure 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.  ;Get filter criteria
  1.  S APSPFIL=$$DIR^APSPUTIL("S^T:Transmitted;F:Failed Transmission;X:Retransmitted;P:Printed;R:Reprinted;A:All","Filter by","A",,.APSPQ)
  1.  Q:APSPQ
  1.  ;Get primary sort criteria
  1.  S APSPSRT=+$$DIR^APSPUTIL("S^1:Print Date;2:DEA Schedule;3:Prescriber;4:User who printed/transmitted","Primary sort",,,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPSRT=1 D
  1.  .S APSPSRT2=+$$DIR^APSPUTIL("S^1:DEA Schedule;2:Prescriber;3:User","Within Date,sort by",,,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPSRT=2 D
  1.  .S APSPSRT2=1  ;Drug name
  1.  Q:APSPQ
  1.  I APSPSRT=3 D
  1.  .S APSPSRT2=+$$DIR^APSPUTIL("S^1:DEA Schedule;2:Print Date","Within Prescriber,sort by",,,.APSPQ)
  1.  Q:APSPQ
  1.  I APSPSRT=4 D
  1.  .S APSPSRT2=+$$DIR^APSPUTIL("S^1:DEA Schedule;2:Print Date","Within User,sort by",,,.APSPQ)
  1.  Q:APSPQ
  1.  ;Ask about divisions
  1.  S APSPGRP=0
  1.  I APSPDIV="*" S APSPGRP=+$$DIR^APSPUTIL("S^1:Yes;0:No","Display by divison?",,,.APSPQ)
  1.  Q:APSPQ
  1.  ;Ask about output
  1.  S APSPOUT=0
  1.  S APSPOUT=+$$DIR^APSPUTIL("S^1:Detailed;2:Columnar;3:Delimited","Output format: ",,,.APSPQ)
  1.  Q:APSPQ
  1.  D DEV
  1.  Q
  1. DEV ;
  1.  N XBRP,XBNS
  1.  S XBRP="OUT^APSPESR2"
  1.  S XBNS="APS*"
  1.  D ^XBDBQUE
  1.  Q
  1. OUT ;EP
  1.  N TYPE
  1.  K ^TMP("APSPERS",$J)
  1.  D FIND($G(APSPBD),$G(APSPED),$G(APSPFIL),$G(APSPSRT),$G(APSPSRT2))
  1.  D PRINT
  1.  K ^TMP("APSPESR",$J)
  1.  Q
  1.  ;
  1. FIND(APSPBD,APSPED,APSPFIL,APSPSRT,APSPSRT2) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,DIV,ACT,CNT,AUTO
  1.  K ^TMP("APSPESR",$J)
  1.  S CNT=0
  1.  S RXIEN=0,RTSDT=APSPBD
  1.  F  S RTSDT=$O(^PSRX("AC",RTSDT)) Q:'+RTSDT!(RTSDT>APSPED)  D
  1.  .F  S RXIEN=$O(^PSRX("AC",RTSDT,RXIEN)) Q:'+RXIEN  D
  1.  ..Q:'$D(^PSRX(RXIEN,0))       ; Prescription must have a zero node
  1.  ..;Only want autofinished meds
  1.  ..S AUTO=$P($G(^PSRX(RXIEN,999999921)),U,3)
  1.  ..Q:'+AUTO
  1.  ..S DIV=$$DIVVRY(RXIEN,APSPDIV)  ;check division
  1.  ..Q:'DIV
  1.  ..Q:'$P(^PSRX(RXIEN,0),U,6)        ;  Prescription must have a drug
  1.  ..;Now let's check the activity log of this prescription
  1.  ..S ACT=0 F  S ACT=$O(^PSRX(RXIEN,"A",ACT)) Q:'+ACT  D
  1.  ...S TYPE=$P($G(^PSRX(RXIEN,"A",ACT,9999999)),U,2)
  1.  ...I TYPE="X" D
  1.  ....I APSPFIL="X"!(APSPFIL="A") D SET(RXIEN,ACT,TYPE)
  1.  ...I TYPE="R" D
  1.  ....I APSPFIL="R"!(APSPFIL="A") D SET(RXIEN,ACT,TYPE)
  1.  ...I TYPE="P" D
  1.  ....I APSPFIL="P"!(APSPFIL="A") D SET(RXIEN,ACT,TYPE)
  1.  ...I TYPE="T" D
  1.  ....I APSPFIL="T"!(APSPFIL="A") D SET(RXIEN,ACT,TYPE)
  1.  ...I TYPE="F" D
  1.  ....I APSPFIL="F"!(APSPFIL="A") D SET(RXIEN,ACT,TYPE)
  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.  I APSPDIV="*"&(APSPGRP=1) D PRINT2
  1.  E  D PRINT3
  1.  Q
  1. PRINT2 ;Print out by division
  1.  N DIV,SUB1,SUB2,VAL,DIVCT,TOT,NUM
  1.  S TOT=0
  1.  S DIV=0 F  S DIV=$O(^TMP("APSPESR",$J,DIV)) Q:'DIV  D
  1.  .S DIVCT=0
  1.  .I APSPDIV="*" W !,"Division: "_$$GET1^DIQ(59,DIV,.01) D PRINT5
  1.  .S SUB1=0 F  S SUB1=$O(^TMP("APSPESR",$J,DIV,SUB1)) Q:'SUB1  D
  1.  ..D HDR1(SUB1)
  1.  ..S SUB2=0 F  S SUB2=$O(^TMP("APSPESR",$J,DIV,SUB1,SUB2)) Q:'SUB2  D
  1.  ...D HDR2(SUB2)
  1.  ...S NUM=0 F  S NUM=$O(^TMP("APSPESR",$J,DIV,SUB1,SUB2,NUM)) Q:'NUM  D
  1.  ....S VAL=$G(^TMP("APSPESR",$J,DIV,SUB1,SUB2,NUM))
  1.  ....D PRINT4(VAL,DIV)
  1.  ....S DFLG=1
  1.  ....S TOT=TOT+1,DIVCT=DIVCT+1
  1.  .W !,"Division Count: "_DIVCT
  1.  W !,"TOTAL Count: "_TOT
  1.  Q
  1. PRINT3 ;No divisional counts
  1.  N SUB1,SUB2,VAL,TOT,DIV,NUM
  1.  S TOT=0
  1.  S SUB1=0 F  S SUB1=$O(^TMP("APSPESR",$J,SUB1)) Q:'SUB1  D
  1.  .D HDR1(SUB1)
  1.  .S SUB2=0 F  S SUB2=$O(^TMP("APSPESR",$J,SUB1,SUB2)) Q:'SUB2  D
  1.  ..D HDR2(SUB2)
  1.  ..S DIV=0 F  S DIV=$O(^TMP("APSPESR",$J,SUB1,SUB2,DIV)) Q:'DIV  D
  1.  ...S NUM=0 F  S NUM=$O(^TMP("APSPESR",$J,SUB1,SUB2,DIV,NUM)) Q:'NUM  D
  1.  ....S DFLG=1
  1.  ....S VAL=$G(^TMP("APSPESR",$J,SUB1,SUB2,DIV,NUM))
  1.  ....D PRINT4(VAL,DIV)
  1.  ....S TOT=TOT+1
  1.  W !,"TOTAL Count: "_TOT
  1.  ; Print the line
  1. PRINT4(DATA,DIV) ;EP
  1.  N RXIEN,NODE0,NODE6,AIEN,IENS,QTY,SCH,DAYS,X,CLINIC,HRN,DRUG,DEA,CLASS,PAT,PRV,COM,USER,TYP
  1.  S RXIEN=$P(DATA,U,1),AIEN=$P(DATA,U,3)
  1.  S HRN=$P(DATA,U,4),DRUG=$P(DATA,U,5),DEA=$P(DATA,U,6),CLASS=$P(DATA,U,7)
  1.  S PDAT=$P(DATA,U,8),PAT=$P(DATA,U,9),PRV=$P(DATA,U,10)
  1.  S PDAT=$$FMTE^XLFDT(PDAT)
  1.  S USER=$P(DATA,U,11),USER=$$GET1^DIQ(200,USER,.01,"E")
  1.  S COM=$P(DATA,U,12)
  1.  S QTY=$$GET1^DIQ(52,RXIEN,7,"E")
  1.  S DAYS=$$GET1^DIQ(52,RXIEN,8,"E")
  1.  S SCH=""
  1.  S X=0 F  S X=$O(^PSRX(RXIEN,6,X)) Q:'X  D
  1.  .S Y=$P($G(^PSRX(RXIEN,6,X,0)),U,8)
  1.  .I SCH="" S SCH=Y
  1.  .E  S SCH=SCH_","_Y
  1.  S RXNO=$P(DATA,U,2)
  1.  S DIV=$$GET1^DIQ(59,DIV,.01)
  1.  S PRV=$$GET1^DIQ(200,PRV,.01)
  1.  S CLINIC=$$GET1^DIQ(44,$P(DATA,U,14),.01,"E")
  1.  S TYPE=$P(DATA,U,13)
  1.  S TYP=$S(TYPE="T":"Transmitted",TYPE="P":"Printed",TYPE="F":"Failed",TYPE="X":"Retransmitted",TYPE="R":"Reprinted",1:"")
  1.  I APSPOUT=1 D
  1.  .W !,?12,"RX Number: "_RXNO,?30,"Type: "_TYP,?50,"Division: "_DIV
  1.  .D PRINT5
  1.  .W !,?12,"Patient: "_$E(PAT,1,25),?40,"HRN: "_HRN,?55,"Location: :"_CLINIC
  1.  .D PRINT5
  1.  .W !,?12,"Action Date: "_PDAT
  1.  .D PRINT5
  1.  .W !,?12,"Drug: "_$E(DRUG,1,25),?40,"CLASS: "_CLASS,?60,"DEA Class: "_DEA
  1.  .D PRINT5
  1.  .W !,?12,"Quantity: "_QTY,?40,"Days Supply: "_DAYS,?60,"Schedule: "_SCH
  1.  .D PRINT5
  1.  .W !,?12,"Provider: "_$E(PRV,1,25),?40,"Action Person: "_$E(USER,1,25)
  1.  .D PRINT5
  1.  .W !,?12,"Comment: "_$E(COM,1,65),!
  1.  I APSPOUT=2 D
  1.  .W !,?12,RXNO,?18,HRN,?28,$E(TYP,1,1),?32,$E(DRUG,1,15),?48,DEA,?54,$E(USER,1,15),?68,$P(PDAT,"@",1)
  1.  .D PRINT5 ;check page length
  1.  I APSPOUT=3 D
  1.  .W !
  1.  .W RXNO_U_DIV_U_HRN_U_PAT_U_DRUG_U_CLASS_U_DEA_U_PRV_U_TYP_U_USER_U_PDAT_U_QTY_U_DAYS_U_SCH_U_COM_U_CLINIC
  1.  Q
  1.  ; Check page length
  1. PRINT5 ;EP
  1.  N DIR
  1.  Q:$E(IOST)'="C"
  1.  I $Y+4>IOSL D
  1.  .K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  .S DIR(0)="E" D ^DIR
  1.  .D HDR
  1.  Q
  1.  ; Set data into ^TMP global for output
  1. SET(RX,IEN,TYPE) ;EP
  1.  N LSTDSPDT,NODE0,NODE2,NODE3,ANODE,X,Y,IENS,PDAT,USER,COM
  1.  N PDAT,DEACLASS,DRUG,PRV,DIV,RXNO,PRINT,DRCLASS,DRGNM
  1.  S NODE0=$G(^PSRX(RX,0))
  1.  S NODE2=$G(^PSRX(RX,2))
  1.  S NODE3=$G(^PSRX(RX,3))
  1.  S ANODE=$G(^PSRX(RX,"A",IEN,0))
  1.  S DIV=$P(NODE2,U,9)
  1.  S PRV=$P(NODE0,U,4),CLINIC=$P(NODE0,U,5)
  1.  S DRUG=$P(NODE0,U,6),DRGNM=$P(^PSDRUG(DRUG,0),U)
  1.  S DEACLASS=+$P(NODE0,U,3)
  1.  S PDAT=$P(ANODE,U,1)
  1.  S DRCLASS=$$GET1^DIQ(50,DRUG,2,"E")
  1.  S USER=$P(ANODE,U,3)
  1.  S HRN=$$HRN^AUPNPAT($P(NODE0,U,2),$$GET1^DIQ(59,DIV,100,"I"))
  1.  S PAT=$$GET1^DIQ(2,$P(NODE0,U,2),.01,"E")
  1.  S RXNO=$P(NODE0,U,1)
  1.  S IENS=IEN_","_RXIEN
  1.  S USER=$$GET1^DIQ(52.3,IENS,.03,"I")
  1.  S COM=$$GET1^DIQ(52.3,IENS,.05,"E")
  1.  N A,B,C
  1.  S A=DIV
  1.  I APSPSRT=1 D
  1.  .I APSPSRT2=1 S B=PDAT,C=DEACLASS
  1.  .I APSPSRT2=2 S B=PDAT,C=PRV
  1.  .I APSPSRT2=3 S B=PDAT,C=USER
  1.  I APSPSRT=2 D
  1.  .I APSPSRT2=1 S B=DEACLASS,C=DRUG
  1.  I APSPSRT=3 D
  1.  .I APSPSRT2=1 S B=PRV,C=DEACLASS
  1.  .I APSPSRT2=2 S B=PRV,C=PDAT
  1.  I APSPSRT=4 D
  1.  .I APSPSRT2=1 S B=USER,C=DEACLASS
  1.  .I APSPSRT2=2 S B=USER,C=PDAT
  1.  S CNT=CNT+1
  1.  I APSPDIV="*"&(APSPGRP=1) D
  1.  .S ^TMP("APSPESR",$J,A,B,C,CNT)=RX_U_RXNO_U_IEN_U_HRN_U_DRGNM_U_DEACLASS_U_DRCLASS_U_PDAT_U_PAT_U_PRV_U_USER_U_COM_U_TYPE_U_CLINIC
  1.  E  D
  1.  .S ^TMP("APSPESR",$J,B,C,A,CNT)=RX_U_RXNO_U_IEN_U_HRN_U_DRGNM_U_DEACLASS_U_DRCLASS_U_PDAT_U_PAT_U_PRV_U_USER_U_COM_U_TYPE_U_CLINIC
  1.  Q
  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.  ; 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 !,"External Pharmacy Prescriptions Report",?40,$P($TR($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG
  1.  W !,"Report Criteria: (Prescriptions which are marked as auto-finshed)"
  1.  W !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF
  1.  W !,?5,"Filtered by: "_$S(APSPFIL=1:"Electronic",APSPFIL=2:"Printed",APSPFIL=3:"Reprinted",1:"All")
  1.  W !,?5,"Pharmacy Division: "_$S(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All")
  1.  W !,?5,"Primary Sort: "_$S(APSPSRT=1:"Print Date",APSPSRT=2:"DEA schedule",APSPSRT=3:"Prescriber",APSPSRT=4:"User",1:"")
  1.  W !,$TR($J("",80)," ","-")
  1.  I APSPOUT=2 D HDR3
  1.  Q
  1.  ;
  1. HDR1(SRT1) ;EP
  1.  N LINE
  1.  I APSPSRT=1 S LINE="Print Date: "_$$FMTE^XLFDT(SRT1)
  1.  I APSPSRT=2 S LINE="DEA Class: "_$$GET1^DIQ(50,SRT1,.01,"E")
  1.  I APSPSRT=3 S LINE="Prescriber: "_$$GET1^DIQ(200,SRT1,.01,"E")
  1.  I APSPSRT=4 S LINE="User: "_$$GET1^DIQ(200,SRT1,.02,"E")
  1.  W !,?5,LINE
  1.  Q
  1. HDR2(SRT2) ;EP
  1.  I APSPSRT=1 D
  1.  .I APSPSRT2=1 D
  1.  ..S LINE=$$CVTDCLS(SRT2)
  1.  ..W !,10,"DEA Schedule: "_LINE
  1.  .I APSPSRT2=2 D
  1.  ..S LINE=$$GET1^DIQ(200,SRT2,.01,"E")
  1.  ..W !,?10,"Prescriber: "_LINE
  1.  .I APSPSRT2=3 D
  1.  ..S LINE=$$GET1^DIQ(200,SRT2,.01,"E")
  1.  ..W !,?10,"User: "_LINE
  1.  I APSPSRT=2 D
  1.  .S LINE=$$GET1^DIQ(50,SRT2,.01,"E")
  1.  .W !,?10,"Drug Name: "_LINE
  1.  I APSPSRT=3 D
  1.  .I APSPSRT2=1 D
  1.  ..S LINE=$$CVTDCLS(SRT2)
  1.  ..W !,?10,"DEA Schedule: "_LINE
  1.  .I APSPSRT2=2 D
  1.  ..S LINE=$$FMTE^XLFDT(SRT2)
  1.  ..W !,?10,"Print Date: "_LINE
  1.  I APSPSRT=4 D
  1.  .I APSPSRT2=1 D
  1.  ..S LINE=$$CVTDCLS(SRT2)
  1.  ..W !,?10,"DEA Schedule: "_LINE
  1.  .I APSPSRT2=2 D
  1.  ..S LINE=$$FMTE^XLFDT(SRT2)
  1.  ..W 1,?10,"Print Date: "_LINE
  1.  Q
  1. HDR3 ;PRINT OUT COLUMNS
  1.  I APSPOUT=1 Q
  1.  I APSPOUT=2 D
  1.  .W !,?12,"RX",?18,"HRN",?27,"Type",?32,"Drug Name",?48,"DEA",?54,"Action by",?70,"Print Dt"
  1.  .D DASH
  1.  E  D
  1.  .W !,"RX"_U_"Division"_U_"HRN"_U_"Patient"_U_"Drug Name"_U_"Classification"_U_"DEA Class"_U_"Provider"_U_"Type"_U_"User"_U_"Print Date"_U_"Quantity"_U_"Days"_U_"Schedule"_U_"Comments"_U_"Location"
  1.  Q
  1.  ;
  1. DASH ;EP
  1.  N DASH
  1.  W ! F DASH=1:1:IOM W "-"
  1.  W !
  1.  Q
  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.  ;