APSPCSM1 ; IHS/MSC/PLS - CONTROLLED SUBSTANCE MANAGEMENT REPORT ;13-Aug-2013 09:25;PLS
;;7.0;IHS PHARMACY MODIFICATIONS;**1007,1011,1013,1015,1016**;Sep 23, 2004;Build 74
;=====================================================================
;IHS/MSC/MGH Added column for fills in CMOP
;
Q
PRINT ;EP
N APSPPG,DFLG,NEWPG
S (APSPPG,DFLG,NEWPG)=0
I APSPXML D
.D HDRXML
.D PRINT1
.W !,$$TAG("Dispenses",1)
.W !,$$TAG("Report",1)
E D
.D HDR
.D PRINT1
.W:'DFLG !,"No data found..."
Q
;
PRINT1 ;EP
N DIV,SUB1,SUB2,SUB3,SUB4,SUB5,VAL,LP,LSTFDT
S LSTFDT=0
I APSPXML W !,$$TAG("PharmacyDivisions",0)
S DIV=0 F S DIV=$O(^TMP($J,"XREF",DIV)) Q:'DIV D
.I APSPDIV="*",'APSPXML W !!!,"Pharmacy Division: "_$$GET1^DIQ(59,DIV,.01),! ;W !,"|"_$$GET1^DIQ(59,DIV,.01)_"|" D PRINT3
.I APSPRTYP=1 D ; Summary report
..W:APSPXML !,$$TAG("PharmacyDivision",0)
..W:APSPXML !,$$TAG("DivisionName",2,$$GET1^DIQ(59,DIV,.01))
..I APSPSORT=2 D ; Fill Date/Drug Name
...S SUB1=0 F S SUB1=$O(^TMP($J,"XREF",DIV,"S-FDT",SUB1)) Q:'SUB1 D
....S SUB2="" F S SUB2=$O(^TMP($J,"XREF",DIV,"S-FDT",SUB1,SUB2)) Q:'$L(SUB2) D
.....S SUB3="" F S SUB3=$O(^TMP($J,"XREF",DIV,"S-FDT",SUB1,SUB2,SUB3)) Q:'SUB3 D
......D STATS^APSPCSM(^TMP($J,"DATA",SUB3))
.....D PRINTSUM(APSPSORT,SUB2,.STATS,SUB1)
.....K STATS
.....S DFLG=1
....W !
..E D ; Drug Name
...S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"S-DRUG",SUB1)) Q:'$L(SUB1) D
....S SUB2=0 F S SUB2=$O(^TMP($J,"XREF",DIV,"S-DRUG",SUB1,SUB2)) Q:'SUB2 D
.....D STATS^APSPCSM(^TMP($J,"DATA",SUB2))
....D PRINTSUM(APSPSORT,SUB1,.STATS)
....K STATS
....S DFLG=1
..W:APSPXML !,$$TAG("PharmacyDivision",1)
.E D ; Detailed report
..I APSPXML D
...W !,$$TAG("PharmacyDivision",0)
...W !,$$TAG("DivisionName",2,$$GET1^DIQ(59,DIV,.01))
..I APSPSORT=1 D ; Drug Name
...S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1)) Q:SUB1="" D ; Drug Name
....S SUB2=0 F S SUB2=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1,SUB2)) Q:'SUB2 D ; Fill Date
.....S SUB3=0 F S SUB3=$O(^TMP($J,"XREF",DIV,"DRUG",SUB1,SUB2,SUB3)) Q:'SUB3 D ; Data node
......D PRINT2(^TMP($J,"DATA",SUB3))
......S DFLG=1
..I APSPSORT=2 D ; Fill Date
...S SUB1=0 F S SUB1=$O(^TMP($J,"XREF",DIV,"FDT",SUB1)) Q:'SUB1 D ; Fill Date
....S SUB2="" F S SUB2=$O(^TMP($J,"XREF",DIV,"FDT",SUB1,SUB2)) Q:SUB2="" D ; Drug Name
.....S SUB3=0 F S SUB3=$O(^TMP($J,"XREF",DIV,"FDT",SUB1,SUB2,SUB3)) Q:'SUB3 D ; Data node
......D PRINT2(^TMP($J,"DATA",SUB3))
......S DFLG=1
..I APSPSORT=3 D ; Drug Class
...S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1)) Q:'$L(SUB1) D ; Drug Class
....S SUB2="" F S SUB2=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1,SUB2)) Q:'$L(SUB2) D ; Drug Name
.....S SUB3=0 F S SUB3=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1,SUB2,SUB3)) Q:'SUB3 D ; Fill Date
......S SUB4=0 F S SUB4=$O(^TMP($J,"XREF",DIV,"DCLS",SUB1,SUB2,SUB3,SUB4)) Q:'SUB4 D ; Data node
.......D PRINT2(^TMP($J,"DATA",SUB4))
.......S DFLG=1
..I APSPSORT=4 D ; Patient Name
...S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"PAT",SUB1)) Q:'$L(SUB1) D ; Patient Name
....S SUB2=0 F S SUB2=$O(^TMP($J,"XREF",DIV,"PAT",SUB1,SUB2)) Q:'SUB2 D ; Fill Date
.....S SUB3="" F S SUB3=$O(^TMP($J,"XREF",DIV,"PAT",SUB1,SUB2,SUB3)) Q:'$L(SUB3) D ; Drug Name
......S SUB4=0 F S SUB4=$O(^TMP($J,"XREF",DIV,"PAT",SUB1,SUB2,SUB3,SUB4)) Q:'SUB4 D ; Data node
.......D PRINT2(^TMP($J,"DATA",SUB4))
.......S DFLG=1
..I APSPSORT=5 D ; Provider
...S SUB1="" F S SUB1=$O(^TMP($J,"XREF",DIV,"PRV",SUB1)) Q:'$L(SUB1) D ; Provider
....S SUB2="" F S SUB2=$O(^TMP($J,"XREF",DIV,"PRV",SUB1,SUB2)) Q:'$L(SUB2) D ; Drug Name
.....S SUB3=0 F S SUB3=$O(^TMP($J,"XREF",DIV,"PRV",SUB1,SUB2,SUB3)) Q:'SUB3 D ; Fill Date
......S SUB4=0 F S SUB4=$O(^TMP($J,"XREF",DIV,"PRV",SUB1,SUB2,SUB3,SUB4)) Q:'SUB4 D ; Data node
.......D PRINT2(^TMP($J,"DATA",SUB4))
.......S DFLG=1
...I APSPDET,APSPPRV'="*" D PRTDSUM
..W:APSPXML !,$$TAG("PharmacyDivision",1)
.D:APSPDET PRTDSUM
.K STATS
D:APSPDET PRTRTOT
I APSPXML W !,$$TAG("PharmacyDivisions",1)
Q
; Print Summary report line
PRINTSUM(RPTTYP,DRGNM,STATS,FDT) ;EP -
N DAT
S DAT=$G(STATS("DRUGN",DRGNM))
I APSPXML D
.W !,$$TAG("DispenseSummary")
.W:$G(FDT) !,$$TAG("FillDate",2,$P($TR($$FMTE^XLFDT(FDT,"5Z"),"@"," "),":",1,2))
.;W !,$$TAG("DrugName",2,DRGNM)
.W !,$$TAG("DrugName",2,$P(DAT,U,3)) ;P1013
.;W !,$$TAG("RXCnt",2,$J(STATS("RXCNT"),6))
.W !,$$TAG("FillCnt",2,$J(STATS("FILLS"),6))
.W !,$$TAG("UnitType",2,$P(DAT,U,2))
.W !,$$TAG("TotalUnits",2,$J(+$G(STATS("DRUG",+DAT)),8))
.;W !,$$TAG("AvgUnitsDispPerRX",2,$J(+$G(STATS("DRUG",+DAT))\STATS("RXCNT"),6,1))
.W !,$$TAG("AvgUnitsDispPerFill",2,$J(+$G(STATS("DRUG",+DAT))\STATS("FILLS"),6,1))
.W !,$$TAG("DispenseSummary",1)
E D
.I $G(FDT),((FDT'=LSTFDT)!NEWPG) D
..W "Fill Date ",$$FMTE^XLFDT(FDT,"5Z"),!
..S LSTFDT=FDT
.;W DRGNM,?44,$J(STATS("RXCNT"),6),?51,$P(DAT,U,2),?63,$J(+$G(STATS("DRUG",+DAT)),8),?73,$J(+$G(STATS("DRUG",+DAT))\STATS("RXCNT"),6,1),!
.;W DRGNM,?44,$J(STATS("FILLS"),6),?51,$P(DAT,U,2),?63,$J(+$G(STATS("DRUG",+DAT)),8),?73,$J(+$G(STATS("DRUG",+DAT))\STATS("FILLS"),6,1),!
.;W DRGNM,?44,$E($P(DAT,U,2),1,10),?55,$J(STATS("FILLS"),6),?62,$J(+$G(STATS("DRUG",+DAT)),8),?74,$J(+$G(STATS("DRUG",+DAT))\STATS("FILLS"),6,1),?90,!
.W $P(DAT,U,3),?44,$E($P(DAT,U,2),1,10),?55,$J(STATS("FILLS"),6),?62,$J(+$G(STATS("DRUG",+DAT)),8),?74,$J(+$G(STATS("DRUG",+DAT))\STATS("FILLS"),6,1),!
.S NEWPG=0
.D PRINT3 ; check page length
Q
; Output summary for detail report
PRTDSUM ; EP -
N DRUGN,RX,RXCNT
Q:'APSPETOT ; User didn't ask for totals
I APSPXML D
.W !,$$TAG("ReportSubTotals")
.S DRUGN="" F S DRUGN=$O(STATS("RXDRUG",DRUGN)) Q:DRUGN="" D
..;W !,$$TAG("DrugName",2,DRUGN)
..W !,$$TAG("DrugName",2,$P(STATS("DRUGN",DRUGN),U,3))
..W !,$$TAG("RXCount",2,$J(STATS("RXDRUG",DRUGN),6,0))
..S RX=0 F S RX=$O(STATS("RXS",RX)) Q:'RX D
...S RXCNT=$G(RXCNT)+1
..W:$G(RXCNT) !,$$TAG("TotalPrescriptionCount",2,RXCNT)
..W !,$$TAG("TotalFills",2,STATS("FILLS"))
.W !,$$TAG("ReportSubTotals",1)
E D
.D PRINT3
.W !,"Report sub-totals",!
.W !,?5,"Drug Name",?47,"# of fills",!
.S DRUGN="" F S DRUGN=$O(STATS("RXDRUG",DRUGN)) Q:DRUGN="" D
..;W ?5,DRUGN,?47,$J(STATS("RXDRUG",DRUGN),6,0),!
..W ?5,$P(STATS("DRUGN",DRUGN),U,3),?47,$J(STATS("RXDRUG",DRUGN),6,0),!
..D PRINT3
.S RX=0 F S RX=$O(STATS("RXS",RX)) Q:'RX D
..S RXCNT=$G(RXCNT)+1
.;W !!,"Total prescription count: ",+$G(RXCNT)
.W !,"Total fills (new, refill, and partial): ",+$G(STATS("FILLS"))
Q
; Output totals for report
PRTRTOT ; EP -
N DRUGN,RX,RXCNT
Q:'APSPETOT ; User didn't ask for totals
I APSPXML D
.W !,$$TAG("ReportTotals")
.S DRUGN="" F S DRUGN=$O(APSPRTOT("RXDRUG",DRUGN)) Q:DRUGN="" D
..W !,$$TAG("DrugName",2,DRUGN)
..W !,$$TAG("RXCount",2,$J(APSPRTOT("RXDRUG",DRUGN),6,0))
..S RX=0 F S RX=$O(APSPRTOT("RXS",RX)) Q:'RX D
...S RXCNT=$G(RXCNT)+1
..W:$G(RXCNT) !,$$TAG("TotalPrescriptionCount",2,RXCNT)
.W !,$$TAG("TotalFills",2,$G(APSPRTOT("FILLS")))
.W !,$$TAG("ReportTotals",1)
E D
.D PRINT3
.W !!,"Report Totals",!
.W !,?5,"Drug Name",?47,"# of fills",!
.S DRUGN="" F S DRUGN=$O(APSPRTOT("RXDRUG",DRUGN)) Q:DRUGN="" D
..;W ?5,DRUGN,?47,$J(APSPRTOT("RXDRUG",DRUGN),6,0),!
..W ?5,$P(APSPRTOT("DRUGN",DRUGN),U,3),?47,$J(APSPRTOT("RXDRUG",DRUGN),6,0),!
..D PRINT3
.S RX=0 F S RX=$O(APSPRTOT("RXS",RX)) Q:'RX D
..S RXCNT=$G(RXCNT)+1
.;W !!,"Total prescription count: ",+$G(RXCNT)
.W !,"Total fills (new, refill, and partial): ",+$G(APSPRTOT("FILLS"))
Q
; Print the line
PRINT2(DATA) ; EP -
N RX,DFN,HRN
S RX=+DATA
S DFN=$$GET1^DIQ(52,RX,2,"I")
S HRN=$$HRN^AUPNPAT(DFN,DUZ(2))
D STATS^APSPCSM(DATA)
I APSPXML D
.W !,$$TAG("Dispense")
.W !,$$TAG("FillDate",2,$P($TR($$FMTE^XLFDT($P(DATA,U,2),"5Z"),"@"," "),":",1,2))
.W !,$$TAG("Type",2,$P(DATA,U,9))
.W !,$$TAG("PatientName",2,$$GET1^DIQ(2,DFN,.01))
.W !,$$TAG("PatientHRN",2,HRN)
.W !,$$TAG("PrescriptionNumber",2,$$GET1^DIQ(52,RX,.01))
.W !,$$TAG("DrugName",2,$P(DATA,U,8))
.W !,$$TAG("QTY",2,$P(DATA,U,6))
.W !,$$TAG("DaysSupply",2,$P(DATA,U,13))
.W !,$$TAG("DrugSchedule",2,$P(DATA,U,7))
.W !,$$TAG("Provider",2,$$GET1^DIQ(200,$P(DATA,U,14),.01))
.W !,$$TAG("ProviderDEA",2,$$GET1^DIQ(200,$P(DATA,U,14),53.2))
.W !,$$TAG("Pharmacist",2,$$GET1^DIQ(200,$P(DATA,U,15),.01))
.W !,$$TAG("RefillsRemaining",2,$P(DATA,U,16))
.;IHS/MSC/MGH Patch 1015
.W !,$$TAG("CMOP",2,$P(DATA,U,17))
.W !,$$TAG("Dosing",2,$$GETSIG(RX))
.W !,$$TAG("Dispense",1)
E D
.;IHS/MSC/MGH Patch 1015 added CMOP field
.W !,$P($TR($$FMTE^XLFDT($P(DATA,U,2),"5Z"),"@"," "),":",1,2),?14,$P(DATA,U,9),?20,$E($$GET1^DIQ(2,DFN,.01),1,16),?38,HRN,?48,$$GET1^DIQ(52,RX,.01),?60,$P(DATA,U,8),?107,$P(DATA,U,6),?117,$P(DATA,U,13),?127,$P(DATA,U,7)
.W !,?5,$$GET1^DIQ(200,$P(DATA,U,14),.01),?35,$$GET1^DIQ(200,$P(DATA,U,14),53.2),?50,$E($$GET1^DIQ(200,$P(DATA,U,15),.01),1,22),?74,$P(DATA,U,16),?90,$P(DATA,U,17)
.I APSPDOSE D
..W !,?5,"Dosing:" D OUTSIG($$GETSIG(RX),IOM,12)
.D PRINT3 ;check page length
Q
; Check page length and optionally print blank line
;
PRINT3 ;EP
D:$Y+8>IOSL HDR
Q
;
HDR ;EP
W:APSPPG @IOF
S APSPPG=APSPPG+1,NEWPG=1
W !,"Controlled Substance Management Report ("_$S(APSPRTYP=1:"Summary",1:"Detail")_")",?(IOM-28),$P($TR($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG
W !,"Report Criteria:"
W !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF
W !,?5,"Pharmacy Division: "_$S(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All")
W !,?5,"Drug Class: "_APSPDCTN(APSPDCLS)
I APSPRTYP=2 D
.W !,?5,"Sorted by: "_$S(APSPSORT=1:"Drug Name, Fill Date",APSPSORT=3:"Drug Schedule, Drug Name then Fill Date",APSPSORT=2:"Fill Date then Drug Name",APSPSORT=4:"Patient then Fill Date",5:"Prescriber then Drug Name, Fill Date",1:"Unknown")
E D
.W !,?5,"Sorted by: "_$S(APSPSORT=1:"Drug Name",1:"Fill Date then Drug Name")
W !,?5,"CMOP meds: "_$S(APSPCMOP:"Included",1:"Not Included")
I APSPDET,APSPSORT=4,APSPPAT W !,?7,"Patient sort restricted to ",$$GET1^DIQ(2,APSPPAT,.01)
I APSPDET,APSPSORT=5,APSPPRV W !,?7,"Prescriber sort restricted to ",$$GET1^DIQ(200,APSPPRV,.01)
D HDR1:APSPRTYP=2,HDR2:APSPRTYP=1
Q
;
HDR1 ;EP
D DASH
;IHS/MSC/MGH added CMOP field
W "Date Disp.",?14,"Type",?20,"Patient",?40,"HRN",?48,"Rx Number",?60,"Drug Name",?107,"Qty",?113,"Days Supply",?127,"Drug Schedule"
W !,?5,"Prescriber",?35,"DEA Number",?50,"Pharmacist",?74,"Refills left",?90,"CMOP/Mail"
W !,?5,"Dosage Ordered"
D DASH
Q
HDR2 ;EP - Summary Report Header
; Note: Header states RX but the value printed is fills
D DASH
D PRINT3
;W ?45,"# of",?75,"Units",!
;W "Drug Name",?45,"Fills",?51,"Unit Type",?66,"Total",?72,"/Fill"
W ?44,"Unit",?56,"# RXs",?64,"#Units",?74,"Avg",!
W "Drug Name",?44,"Type",?56,"Filled",?64,"Filled",?73,"Unit/RX"
D DASH
Q
;
HDRXML ;EP - XML Header
W $$XMLHDR^MXMLUTL() ;"<?xml version='1.0'?>"
W !,$$TAG("Report")
W !,$$TAG("ReportName",2,"Controlled Substance Management Report ("_$S(APSPRTYP=1:"Summary",1:"Detail")_")")
W !,$$TAG("ReportDate",2,$P($TR($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2))
W !,$$TAG("ReportCriteria")
W !,$$TAG("InclusiveDates",2,APSPBDF_" to "_APSPEDF)
W !,$$TAG("PharmacyDivision",2,$S(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All"))
W !,$$TAG("DrugClass",2,APSPDCTN(APSPDCLS))
W:APSPDET !,$$TAG("SortBy",2,$S(APSPSORT=1:"Drug Name, Fill Date",APSPSORT=3:"Drug Schedule, Drug Name then Fill Date",APSPSORT=2:"Fill Date, Drug Name",APSPSORT=4:"Patient, Fill Date",5:"Prescriber, Drug Name then Fill Date",1:"Unknown"))
I APSPDET,APSPSORT=4,APSPPAT W !,$$TAG("Patient sort restricted to "_$$GET1^DIQ(2,APSPPAT,.01),2)
I APSPDET,APSPSORT=5,APSPPRV W !,$$TAG("Prescriber sort restricted to "_$$GET1^DIQ(200,APSPPRV,.01),2)
W !,$$TAG("CMOP",2,$S(APSPCMOP=1:"CMOP Included",1:"CMOP Not Included"))
W !,$$TAG("ReportCriteria",1)
W !,$$TAG("Dispenses")
Q
;
DASH ;EP
N DASH
W ! F DASH=1:1:IOM W "-"
W !
Q
;
; Returns formatted tag
; Input: TAG - Name of Tag
; TYPE - (-1) = empty 0 =start <tag> 1 =end </tag> 2 = start -VAL - end
; VAL - data value
TAG(TAG,TYPE,VAL) ;EP
S TYPE=$G(TYPE,0)
S:$L($G(VAL)) VAL=$$SYMENC^MXMLUTL(VAL)
I TYPE<0 Q "<"_TAG_"/>" ;empty
E I TYPE=1 Q "</"_TAG_">"
E I TYPE=2 Q "<"_TAG_">"_$G(VAL)_"</"_TAG_">"
Q "<"_TAG_">"
; Return SIG as a single string
GETSIG(RX) ;EP
N LP,RET,SG
S RET=""
S SG=$G(^PSRX(RX,"SIG"))
I $P(SG,U,2) D
.S LP=0 F S LP=$O(^PSRX(RX,"SIG1",LP)) Q:'LP D
..S RET=RET_^PSRX(RX,"SIG1",LP,0)
E S RET=$P(SG,U)
Q RET
; Output SIG
; Input: X - Data to output
; RM - Right Margin
; LI - Left Indent
OUTSIG(X,RM,LI) ;EP - Output SIG
Q:'$L(X)
K ^UTILITY($J,"W")
N DIWL,DIWR,DIWF,LP
S DIWL=0,DIWR=RM-LI,DIWF=""
D ^DIWP
;S LP=0 F S LP=$O(^PSRX(RX,"PRC",LP)) Q:'LP D
;.I $D(^(LP,0)) S X=^(0) D ^DIWP
I $D(^UTILITY($J,"W")) D
.S LP=0 F S LP=$O(^UTILITY($J,"W",DIWL,LP)) Q:'LP W ?LI,^(LP,0),!
K ^UTILITY($J,"W")
Q
APSPCSM1 ; IHS/MSC/PLS - CONTROLLED SUBSTANCE MANAGEMENT REPORT ;13-Aug-2013 09:25;PLS
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1007,1011,1013,1015,1016**;Sep 23, 2004;Build 74
+2 ;=====================================================================
+3 ;IHS/MSC/MGH Added column for fills in CMOP
+4 ;
+5 QUIT
PRINT ;EP
+1 NEW APSPPG,DFLG,NEWPG
+2 SET (APSPPG,DFLG,NEWPG)=0
+3 IF APSPXML
Begin DoDot:1
+4 DO HDRXML
+5 DO PRINT1
+6 WRITE !,$$TAG("Dispenses",1)
+7 WRITE !,$$TAG("Report",1)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 DO HDR
+10 DO PRINT1
+11 IF 'DFLG
WRITE !,"No data found..."
End DoDot:1
+12 QUIT
+13 ;
PRINT1 ;EP
+1 NEW DIV,SUB1,SUB2,SUB3,SUB4,SUB5,VAL,LP,LSTFDT
+2 SET LSTFDT=0
+3 IF APSPXML
WRITE !,$$TAG("PharmacyDivisions",0)
+4 SET DIV=0
FOR
SET DIV=$ORDER(^TMP($JOB,"XREF",DIV))
IF 'DIV
QUIT
Begin DoDot:1
+5 ;W !,"|"_$$GET1^DIQ(59,DIV,.01)_"|" D PRINT3
IF APSPDIV="*"
IF 'APSPXML
WRITE !!!,"Pharmacy Division: "_$$GET1^DIQ(59,DIV,.01),!
+6 ; Summary report
IF APSPRTYP=1
Begin DoDot:2
+7 IF APSPXML
WRITE !,$$TAG("PharmacyDivision",0)
+8 IF APSPXML
WRITE !,$$TAG("DivisionName",2,$$GET1^DIQ(59,DIV,.01))
+9 ; Fill Date/Drug Name
IF APSPSORT=2
Begin DoDot:3
+10 SET SUB1=0
FOR
SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"S-FDT",SUB1))
IF 'SUB1
QUIT
Begin DoDot:4
+11 SET SUB2=""
FOR
SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"S-FDT",SUB1,SUB2))
IF '$LENGTH(SUB2)
QUIT
Begin DoDot:5
+12 SET SUB3=""
FOR
SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"S-FDT",SUB1,SUB2,SUB3))
IF 'SUB3
QUIT
Begin DoDot:6
+13 DO STATS^APSPCSM(^TMP($JOB,"DATA",SUB3))
End DoDot:6
+14 DO PRINTSUM(APSPSORT,SUB2,.STATS,SUB1)
+15 KILL STATS
+16 SET DFLG=1
End DoDot:5
+17 WRITE !
End DoDot:4
End DoDot:3
+18 ; Drug Name
IF '$TEST
Begin DoDot:3
+19 SET SUB1=""
FOR
SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"S-DRUG",SUB1))
IF '$LENGTH(SUB1)
QUIT
Begin DoDot:4
+20 SET SUB2=0
FOR
SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"S-DRUG",SUB1,SUB2))
IF 'SUB2
QUIT
Begin DoDot:5
+21 DO STATS^APSPCSM(^TMP($JOB,"DATA",SUB2))
End DoDot:5
+22 DO PRINTSUM(APSPSORT,SUB1,.STATS)
+23 KILL STATS
+24 SET DFLG=1
End DoDot:4
End DoDot:3
+25 IF APSPXML
WRITE !,$$TAG("PharmacyDivision",1)
End DoDot:2
+26 ; Detailed report
IF '$TEST
Begin DoDot:2
+27 IF APSPXML
Begin DoDot:3
+28 WRITE !,$$TAG("PharmacyDivision",0)
+29 WRITE !,$$TAG("DivisionName",2,$$GET1^DIQ(59,DIV,.01))
End DoDot:3
+30 ; Drug Name
IF APSPSORT=1
Begin DoDot:3
+31 ; Drug Name
SET SUB1=""
FOR
SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"DRUG",SUB1))
IF SUB1=""
QUIT
Begin DoDot:4
+32 ; Fill Date
SET SUB2=0
FOR
SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"DRUG",SUB1,SUB2))
IF 'SUB2
QUIT
Begin DoDot:5
+33 ; Data node
SET SUB3=0
FOR
SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"DRUG",SUB1,SUB2,SUB3))
IF 'SUB3
QUIT
Begin DoDot:6
+34 DO PRINT2(^TMP($JOB,"DATA",SUB3))
+35 SET DFLG=1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+36 ; Fill Date
IF APSPSORT=2
Begin DoDot:3
+37 ; Fill Date
SET SUB1=0
FOR
SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"FDT",SUB1))
IF 'SUB1
QUIT
Begin DoDot:4
+38 ; Drug Name
SET SUB2=""
FOR
SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"FDT",SUB1,SUB2))
IF SUB2=""
QUIT
Begin DoDot:5
+39 ; Data node
SET SUB3=0
FOR
SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"FDT",SUB1,SUB2,SUB3))
IF 'SUB3
QUIT
Begin DoDot:6
+40 DO PRINT2(^TMP($JOB,"DATA",SUB3))
+41 SET DFLG=1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+42 ; Drug Class
IF APSPSORT=3
Begin DoDot:3
+43 ; Drug Class
SET SUB1=""
FOR
SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"DCLS",SUB1))
IF '$LENGTH(SUB1)
QUIT
Begin DoDot:4
+44 ; Drug Name
SET SUB2=""
FOR
SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"DCLS",SUB1,SUB2))
IF '$LENGTH(SUB2)
QUIT
Begin DoDot:5
+45 ; Fill Date
SET SUB3=0
FOR
SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"DCLS",SUB1,SUB2,SUB3))
IF 'SUB3
QUIT
Begin DoDot:6
+46 ; Data node
SET SUB4=0
FOR
SET SUB4=$ORDER(^TMP($JOB,"XREF",DIV,"DCLS",SUB1,SUB2,SUB3,SUB4))
IF 'SUB4
QUIT
Begin DoDot:7
+47 DO PRINT2(^TMP($JOB,"DATA",SUB4))
+48 SET DFLG=1
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+49 ; Patient Name
IF APSPSORT=4
Begin DoDot:3
+50 ; Patient Name
SET SUB1=""
FOR
SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1))
IF '$LENGTH(SUB1)
QUIT
Begin DoDot:4
+51 ; Fill Date
SET SUB2=0
FOR
SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1,SUB2))
IF 'SUB2
QUIT
Begin DoDot:5
+52 ; Drug Name
SET SUB3=""
FOR
SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1,SUB2,SUB3))
IF '$LENGTH(SUB3)
QUIT
Begin DoDot:6
+53 ; Data node
SET SUB4=0
FOR
SET SUB4=$ORDER(^TMP($JOB,"XREF",DIV,"PAT",SUB1,SUB2,SUB3,SUB4))
IF 'SUB4
QUIT
Begin DoDot:7
+54 DO PRINT2(^TMP($JOB,"DATA",SUB4))
+55 SET DFLG=1
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+56 ; Provider
IF APSPSORT=5
Begin DoDot:3
+57 ; Provider
SET SUB1=""
FOR
SET SUB1=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1))
IF '$LENGTH(SUB1)
QUIT
Begin DoDot:4
+58 ; Drug Name
SET SUB2=""
FOR
SET SUB2=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1,SUB2))
IF '$LENGTH(SUB2)
QUIT
Begin DoDot:5
+59 ; Fill Date
SET SUB3=0
FOR
SET SUB3=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1,SUB2,SUB3))
IF 'SUB3
QUIT
Begin DoDot:6
+60 ; Data node
SET SUB4=0
FOR
SET SUB4=$ORDER(^TMP($JOB,"XREF",DIV,"PRV",SUB1,SUB2,SUB3,SUB4))
IF 'SUB4
QUIT
Begin DoDot:7
+61 DO PRINT2(^TMP($JOB,"DATA",SUB4))
+62 SET DFLG=1
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
+63 IF APSPDET
IF APSPPRV'="*"
DO PRTDSUM
End DoDot:3
+64 IF APSPXML
WRITE !,$$TAG("PharmacyDivision",1)
End DoDot:2
+65 IF APSPDET
DO PRTDSUM
+66 KILL STATS
End DoDot:1
+67 IF APSPDET
DO PRTRTOT
+68 IF APSPXML
WRITE !,$$TAG("PharmacyDivisions",1)
+69 QUIT
+70 ; Print Summary report line
PRINTSUM(RPTTYP,DRGNM,STATS,FDT) ;EP -
+1 NEW DAT
+2 SET DAT=$GET(STATS("DRUGN",DRGNM))
+3 IF APSPXML
Begin DoDot:1
+4 WRITE !,$$TAG("DispenseSummary")
+5 IF $GET(FDT)
WRITE !,$$TAG("FillDate",2,$PIECE($TRANSLATE($$FMTE^XLFDT(FDT,"5Z"),"@"," "),":",1,2))
+6 ;W !,$$TAG("DrugName",2,DRGNM)
+7 ;P1013
WRITE !,$$TAG("DrugName",2,$PIECE(DAT,U,3))
+8 ;W !,$$TAG("RXCnt",2,$J(STATS("RXCNT"),6))
+9 WRITE !,$$TAG("FillCnt",2,$JUSTIFY(STATS("FILLS"),6))
+10 WRITE !,$$TAG("UnitType",2,$PIECE(DAT,U,2))
+11 WRITE !,$$TAG("TotalUnits",2,$JUSTIFY(+$GET(STATS("DRUG",+DAT)),8))
+12 ;W !,$$TAG("AvgUnitsDispPerRX",2,$J(+$G(STATS("DRUG",+DAT))\STATS("RXCNT"),6,1))
+13 WRITE !,$$TAG("AvgUnitsDispPerFill",2,$JUSTIFY(+$GET(STATS("DRUG",+DAT))\STATS("FILLS"),6,1))
+14 WRITE !,$$TAG("DispenseSummary",1)
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 IF $GET(FDT)
IF ((FDT'=LSTFDT)!NEWPG)
Begin DoDot:2
+17 WRITE "Fill Date ",$$FMTE^XLFDT(FDT,"5Z"),!
+18 SET LSTFDT=FDT
End DoDot:2
+19 ;W DRGNM,?44,$J(STATS("RXCNT"),6),?51,$P(DAT,U,2),?63,$J(+$G(STATS("DRUG",+DAT)),8),?73,$J(+$G(STATS("DRUG",+DAT))\STATS("RXCNT"),6,1),!
+20 ;W DRGNM,?44,$J(STATS("FILLS"),6),?51,$P(DAT,U,2),?63,$J(+$G(STATS("DRUG",+DAT)),8),?73,$J(+$G(STATS("DRUG",+DAT))\STATS("FILLS"),6,1),!
+21 ;W DRGNM,?44,$E($P(DAT,U,2),1,10),?55,$J(STATS("FILLS"),6),?62,$J(+$G(STATS("DRUG",+DAT)),8),?74,$J(+$G(STATS("DRUG",+DAT))\STATS("FILLS"),6,1),?90,!
+22 WRITE $PIECE(DAT,U,3),?44,$EXTRACT($PIECE(DAT,U,2),1,10),?55,$JUSTIFY(STATS("FILLS"),6),?62,$JUSTIFY(+$GET(STATS("DRUG",+DAT)),8),?74,$JUSTIFY(+$GET(STATS("DRUG",+DAT))\STATS("FILLS"),6,1),!
+23 SET NEWPG=0
+24 ; check page length
DO PRINT3
End DoDot:1
+25 QUIT
+26 ; Output summary for detail report
PRTDSUM ; EP -
+1 NEW DRUGN,RX,RXCNT
+2 ; User didn't ask for totals
IF 'APSPETOT
QUIT
+3 IF APSPXML
Begin DoDot:1
+4 WRITE !,$$TAG("ReportSubTotals")
+5 SET DRUGN=""
FOR
SET DRUGN=$ORDER(STATS("RXDRUG",DRUGN))
IF DRUGN=""
QUIT
Begin DoDot:2
+6 ;W !,$$TAG("DrugName",2,DRUGN)
+7 WRITE !,$$TAG("DrugName",2,$PIECE(STATS("DRUGN",DRUGN),U,3))
+8 WRITE !,$$TAG("RXCount",2,$JUSTIFY(STATS("RXDRUG",DRUGN),6,0))
+9 SET RX=0
FOR
SET RX=$ORDER(STATS("RXS",RX))
IF 'RX
QUIT
Begin DoDot:3
+10 SET RXCNT=$GET(RXCNT)+1
End DoDot:3
+11 IF $GET(RXCNT)
WRITE !,$$TAG("TotalPrescriptionCount",2,RXCNT)
+12 WRITE !,$$TAG("TotalFills",2,STATS("FILLS"))
End DoDot:2
+13 WRITE !,$$TAG("ReportSubTotals",1)
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 DO PRINT3
+16 WRITE !,"Report sub-totals",!
+17 WRITE !,?5,"Drug Name",?47,"# of fills",!
+18 SET DRUGN=""
FOR
SET DRUGN=$ORDER(STATS("RXDRUG",DRUGN))
IF DRUGN=""
QUIT
Begin DoDot:2
+19 ;W ?5,DRUGN,?47,$J(STATS("RXDRUG",DRUGN),6,0),!
+20 WRITE ?5,$PIECE(STATS("DRUGN",DRUGN),U,3),?47,$JUSTIFY(STATS("RXDRUG",DRUGN),6,0),!
+21 DO PRINT3
End DoDot:2
+22 SET RX=0
FOR
SET RX=$ORDER(STATS("RXS",RX))
IF 'RX
QUIT
Begin DoDot:2
+23 SET RXCNT=$GET(RXCNT)+1
End DoDot:2
+24 ;W !!,"Total prescription count: ",+$G(RXCNT)
+25 WRITE !,"Total fills (new, refill, and partial): ",+$GET(STATS("FILLS"))
End DoDot:1
+26 QUIT
+27 ; Output totals for report
PRTRTOT ; EP -
+1 NEW DRUGN,RX,RXCNT
+2 ; User didn't ask for totals
IF 'APSPETOT
QUIT
+3 IF APSPXML
Begin DoDot:1
+4 WRITE !,$$TAG("ReportTotals")
+5 SET DRUGN=""
FOR
SET DRUGN=$ORDER(APSPRTOT("RXDRUG",DRUGN))
IF DRUGN=""
QUIT
Begin DoDot:2
+6 WRITE !,$$TAG("DrugName",2,DRUGN)
+7 WRITE !,$$TAG("RXCount",2,$JUSTIFY(APSPRTOT("RXDRUG",DRUGN),6,0))
+8 SET RX=0
FOR
SET RX=$ORDER(APSPRTOT("RXS",RX))
IF 'RX
QUIT
Begin DoDot:3
+9 SET RXCNT=$GET(RXCNT)+1
End DoDot:3
+10 IF $GET(RXCNT)
WRITE !,$$TAG("TotalPrescriptionCount",2,RXCNT)
End DoDot:2
+11 WRITE !,$$TAG("TotalFills",2,$GET(APSPRTOT("FILLS")))
+12 WRITE !,$$TAG("ReportTotals",1)
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 DO PRINT3
+15 WRITE !!,"Report Totals",!
+16 WRITE !,?5,"Drug Name",?47,"# of fills",!
+17 SET DRUGN=""
FOR
SET DRUGN=$ORDER(APSPRTOT("RXDRUG",DRUGN))
IF DRUGN=""
QUIT
Begin DoDot:2
+18 ;W ?5,DRUGN,?47,$J(APSPRTOT("RXDRUG",DRUGN),6,0),!
+19 WRITE ?5,$PIECE(APSPRTOT("DRUGN",DRUGN),U,3),?47,$JUSTIFY(APSPRTOT("RXDRUG",DRUGN),6,0),!
+20 DO PRINT3
End DoDot:2
+21 SET RX=0
FOR
SET RX=$ORDER(APSPRTOT("RXS",RX))
IF 'RX
QUIT
Begin DoDot:2
+22 SET RXCNT=$GET(RXCNT)+1
End DoDot:2
+23 ;W !!,"Total prescription count: ",+$G(RXCNT)
+24 WRITE !,"Total fills (new, refill, and partial): ",+$GET(APSPRTOT("FILLS"))
End DoDot:1
+25 QUIT
+26 ; Print the line
PRINT2(DATA) ; EP -
+1 NEW RX,DFN,HRN
+2 SET RX=+DATA
+3 SET DFN=$$GET1^DIQ(52,RX,2,"I")
+4 SET HRN=$$HRN^AUPNPAT(DFN,DUZ(2))
+5 DO STATS^APSPCSM(DATA)
+6 IF APSPXML
Begin DoDot:1
+7 WRITE !,$$TAG("Dispense")
+8 WRITE !,$$TAG("FillDate",2,$PIECE($TRANSLATE($$FMTE^XLFDT($PIECE(DATA,U,2),"5Z"),"@"," "),":",1,2))
+9 WRITE !,$$TAG("Type",2,$PIECE(DATA,U,9))
+10 WRITE !,$$TAG("PatientName",2,$$GET1^DIQ(2,DFN,.01))
+11 WRITE !,$$TAG("PatientHRN",2,HRN)
+12 WRITE !,$$TAG("PrescriptionNumber",2,$$GET1^DIQ(52,RX,.01))
+13 WRITE !,$$TAG("DrugName",2,$PIECE(DATA,U,8))
+14 WRITE !,$$TAG("QTY",2,$PIECE(DATA,U,6))
+15 WRITE !,$$TAG("DaysSupply",2,$PIECE(DATA,U,13))
+16 WRITE !,$$TAG("DrugSchedule",2,$PIECE(DATA,U,7))
+17 WRITE !,$$TAG("Provider",2,$$GET1^DIQ(200,$PIECE(DATA,U,14),.01))
+18 WRITE !,$$TAG("ProviderDEA",2,$$GET1^DIQ(200,$PIECE(DATA,U,14),53.2))
+19 WRITE !,$$TAG("Pharmacist",2,$$GET1^DIQ(200,$PIECE(DATA,U,15),.01))
+20 WRITE !,$$TAG("RefillsRemaining",2,$PIECE(DATA,U,16))
+21 ;IHS/MSC/MGH Patch 1015
+22 WRITE !,$$TAG("CMOP",2,$PIECE(DATA,U,17))
+23 WRITE !,$$TAG("Dosing",2,$$GETSIG(RX))
+24 WRITE !,$$TAG("Dispense",1)
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 ;IHS/MSC/MGH Patch 1015 added CMOP field
+27 WRITE !,$PIECE($TRANSLATE($$FMTE^XLFDT($PIECE(DATA,U,2),"5Z"),"@"," "),":",1,2),?14,$PIECE(DATA,U,9),?20,$EXTRACT($$GET1^DIQ(2,DFN,.01),1,16),?38,HRN,?48,$$GET1^DIQ(52,RX,.01),?60,$PIECE(DATA,U,8),?107,$PIECE(DATA,U,6),?117,...
... $PIECE(DATA,U,13),?127,$PIECE(DATA,U,7)
+28 WRITE !,?5,$$GET1^DIQ(200,$PIECE(DATA,U,14),.01),?35,$$GET1^DIQ(200,$PIECE(DATA,U,14),53.2),?50,$EXTRACT($$GET1^DIQ(200,$PIECE(DATA,U,15),.01),1,22),?74,$PIECE(DATA,U,16),?90,$PIECE(DATA,U,17)
+29 IF APSPDOSE
Begin DoDot:2
+30 WRITE !,?5,"Dosing:"
DO OUTSIG($$GETSIG(RX),IOM,12)
End DoDot:2
+31 ;check page length
DO PRINT3
End DoDot:1
+32 QUIT
+33 ; Check page length and optionally print blank line
+34 ;
PRINT3 ;EP
+1 IF $Y+8>IOSL
DO HDR
+2 QUIT
+3 ;
HDR ;EP
+1 IF APSPPG
WRITE @IOF
+2 SET APSPPG=APSPPG+1
SET NEWPG=1
+3 WRITE !,"Controlled Substance Management Report ("_$SELECT(APSPRTYP=1:"Summary",1:"Detail")_")",?(IOM-28),$PIECE($TRANSLATE($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG
+4 WRITE !,"Report Criteria:"
+5 WRITE !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF
+6 WRITE !,?5,"Pharmacy Division: "_$SELECT(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All")
+7 WRITE !,?5,"Drug Class: "_APSPDCTN(APSPDCLS)
+8 IF APSPRTYP=2
Begin DoDot:1
+9 WRITE !,?5,"Sorted by: "_$SELECT(APSPSORT=1:"Drug Name, Fill Date",APSPSORT=3:"Drug Schedule, Drug Name then Fill Date",APSPSORT=2:"Fill Date then Drug Name",APSPSORT=4:"Patient then Fill Date",5:"Prescriber then Drug Name, Fill Date",1
:"Unknown")
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 WRITE !,?5,"Sorted by: "_$SELECT(APSPSORT=1:"Drug Name",1:"Fill Date then Drug Name")
End DoDot:1
+12 WRITE !,?5,"CMOP meds: "_$SELECT(APSPCMOP:"Included",1:"Not Included")
+13 IF APSPDET
IF APSPSORT=4
IF APSPPAT
WRITE !,?7,"Patient sort restricted to ",$$GET1^DIQ(2,APSPPAT,.01)
+14 IF APSPDET
IF APSPSORT=5
IF APSPPRV
WRITE !,?7,"Prescriber sort restricted to ",$$GET1^DIQ(200,APSPPRV,.01)
+15 IF APSPRTYP=2
DO HDR1
IF APSPRTYP=1
DO HDR2
+16 QUIT
+17 ;
HDR1 ;EP
+1 DO DASH
+2 ;IHS/MSC/MGH added CMOP field
+3 WRITE "Date Disp.",?14,"Type",?20,"Patient",?40,"HRN",?48,"Rx Number",?60,"Drug Name",?107,"Qty",?113,"Days Supply",?127,"Drug Schedule"
+4 WRITE !,?5,"Prescriber",?35,"DEA Number",?50,"Pharmacist",?74,"Refills left",?90,"CMOP/Mail"
+5 WRITE !,?5,"Dosage Ordered"
+6 DO DASH
+7 QUIT
HDR2 ;EP - Summary Report Header
+1 ; Note: Header states RX but the value printed is fills
+2 DO DASH
+3 DO PRINT3
+4 ;W ?45,"# of",?75,"Units",!
+5 ;W "Drug Name",?45,"Fills",?51,"Unit Type",?66,"Total",?72,"/Fill"
+6 WRITE ?44,"Unit",?56,"# RXs",?64,"#Units",?74,"Avg",!
+7 WRITE "Drug Name",?44,"Type",?56,"Filled",?64,"Filled",?73,"Unit/RX"
+8 DO DASH
+9 QUIT
+10 ;
HDRXML ;EP - XML Header
+1 ;"<?xml version='1.0'?>"
WRITE $$XMLHDR^MXMLUTL()
+2 WRITE !,$$TAG("Report")
+3 WRITE !,$$TAG("ReportName",2,"Controlled Substance Management Report ("_$SELECT(APSPRTYP=1:"Summary",1:"Detail")_")")
+4 WRITE !,$$TAG("ReportDate",2,$PIECE($TRANSLATE($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2))
+5 WRITE !,$$TAG("ReportCriteria")
+6 WRITE !,$$TAG("InclusiveDates",2,APSPBDF_" to "_APSPEDF)
+7 WRITE !,$$TAG("PharmacyDivision",2,$SELECT(APSPDIV:$$GET1^DIQ(59,APSPDIV,.01),1:"All"))
+8 WRITE !,$$TAG("DrugClass",2,APSPDCTN(APSPDCLS))
+9 IF APSPDET
WRITE !,$$TAG("SortBy",2,$SELECT(APSPSORT=1:"Drug Name, Fill Date",APSPSORT=3:"Drug Schedule, Drug Name then Fill Date",APSPSORT=2:"Fill Date, Drug Name",APSPSORT=4:"Patient, Fill Date",5:"Prescriber, Drug Name then Fill Date",1:"Unknown"))
+10 IF APSPDET
IF APSPSORT=4
IF APSPPAT
WRITE !,$$TAG("Patient sort restricted to "_$$GET1^DIQ(2,APSPPAT,.01),2)
+11 IF APSPDET
IF APSPSORT=5
IF APSPPRV
WRITE !,$$TAG("Prescriber sort restricted to "_$$GET1^DIQ(200,APSPPRV,.01),2)
+12 WRITE !,$$TAG("CMOP",2,$SELECT(APSPCMOP=1:"CMOP Included",1:"CMOP Not Included"))
+13 WRITE !,$$TAG("ReportCriteria",1)
+14 WRITE !,$$TAG("Dispenses")
+15 QUIT
+16 ;
DASH ;EP
+1 NEW DASH
+2 WRITE !
FOR DASH=1:1:IOM
WRITE "-"
+3 WRITE !
+4 QUIT
+5 ;
+6 ; Returns formatted tag
+7 ; Input: TAG - Name of Tag
+8 ; TYPE - (-1) = empty 0 =start <tag> 1 =end </tag> 2 = start -VAL - end
+9 ; VAL - data value
TAG(TAG,TYPE,VAL) ;EP
+1 SET TYPE=$GET(TYPE,0)
+2 IF $LENGTH($GET(VAL))
SET VAL=$$SYMENC^MXMLUTL(VAL)
+3 ;empty
IF TYPE<0
QUIT "<"_TAG_"/>"
+4 IF '$TEST
IF TYPE=1
QUIT "</"_TAG_">"
+5 IF '$TEST
IF TYPE=2
QUIT "<"_TAG_">"_$GET(VAL)_"</"_TAG_">"
+6 QUIT "<"_TAG_">"
+7 ; Return SIG as a single string
GETSIG(RX) ;EP
+1 NEW LP,RET,SG
+2 SET RET=""
+3 SET SG=$GET(^PSRX(RX,"SIG"))
+4 IF $PIECE(SG,U,2)
Begin DoDot:1
+5 SET LP=0
FOR
SET LP=$ORDER(^PSRX(RX,"SIG1",LP))
IF 'LP
QUIT
Begin DoDot:2
+6 SET RET=RET_^PSRX(RX,"SIG1",LP,0)
End DoDot:2
End DoDot:1
+7 IF '$TEST
SET RET=$PIECE(SG,U)
+8 QUIT RET
+9 ; Output SIG
+10 ; Input: X - Data to output
+11 ; RM - Right Margin
+12 ; LI - Left Indent
OUTSIG(X,RM,LI) ;EP - Output SIG
+1 IF '$LENGTH(X)
QUIT
+2 KILL ^UTILITY($JOB,"W")
+3 NEW DIWL,DIWR,DIWF,LP
+4 SET DIWL=0
SET DIWR=RM-LI
SET DIWF=""
+5 DO ^DIWP
+6 ;S LP=0 F S LP=$O(^PSRX(RX,"PRC",LP)) Q:'LP D
+7 ;.I $D(^(LP,0)) S X=^(0) D ^DIWP
+8 IF $DATA(^UTILITY($JOB,"W"))
Begin DoDot:1
+9 SET LP=0
FOR
SET LP=$ORDER(^UTILITY($JOB,"W",DIWL,LP))
IF 'LP
QUIT
WRITE ?LI,^(LP,0),!
End DoDot:1
+10 KILL ^UTILITY($JOB,"W")
+11 QUIT
