APSPCSM1.m

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")