Routine: APSPESR1

APSPESR1 ; IHS/MSC/MGH - AUTO-FINISH REPORT ;04-Jun-2013 08:24;DU

 ;;7.0;IHS PHARMACY MODIFICATIONS;**1011,1016**;Sep 23, 2004;Build 74

EN ;EP

 N APSPBD,APSPED,APSPDIV,APSPRTYP,APSPQ,APSPDSUB,APSPDCLS,APSPSRT,APSPSRT2

 N APSPDCT,APSPDCTN,APSPDRG,APSPBDF,APSPEDF,APSPOUT,APSPGRP

 S APSPDIV="",APSPDRG="",APSPQ=0,APSPDSUB=0

 W @IOF

 W !!,"Auto-finish failure report by Division"

 D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)

 Q:APSPQ

 S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)

 S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)

 S APSPBD=APSPBD-.01,APSPED=APSPED+.99

 S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all divisions","Yes",,.APSPQ)

 Q:APSPQ

 I APSPDIV D

 .S APSPDIV="*"

 E  D  Q:APSPQ

 .S APSPDIV=$$GETIEN^APSPUTIL(4,"Select Division: ",.APSPQ)

 ;Get primary sort criteria

 S APSPSRT=+$$DIR^APSPUTIL("S^1:Date;2:Drug;3:Prescriber","Primary sort",,,.APSPQ)

 Q:APSPQ

 I APSPSRT=1 D

 .S APSPSRT2=+$$DIR^APSPUTIL("S^1:Drug;2:Prescriber","Within Date,sort by",,,.APSPQ)

 Q:APSPQ

 I APSPSRT=2 D

 .S APSPSRT2=+$$DIR^APSPUTIL("S^1:Date;2:Prescriber","Within Drug,sort by",,,.APSPQ)

 Q:APSPQ

 I APSPSRT=3 D

 .S APSPSRT2=+$$DIR^APSPUTIL("S^1:Date;2:Drug","Within Prescriber,sort by",,,.APSPQ)

 Q:APSPQ

 ;Ask about divisions

 S APSPGRP=0

 I APSPDIV="*" S APSPGRP=+$$DIR^APSPUTIL("S^1:Yes;0:No","Display by divison?",,,.APSPQ)

 Q:APSPQ

 ;Ask about output

 S APSPOUT=0

 S APSPOUT=+$$DIR^APSPUTIL("S^1:Detailed;2:Columnar;3:Delimited","Output format:",,,.APSPQ)

 Q:APSPQ

 D DEV

DEV ;

 N XBRP,XBNS

 S XBRP="OUT^APSPESR1"

 S XBNS="APS*"

 D ^XBDBQUE

OUT ;EP

 K ^TMP("APSPESR",$J)

 D FIND($G(APSPBD),$G(APSPED))

 D PRINT

FIND(APSPBD,APSPED) ;EP

 N RXIEN,ACTIEN,RTSDT,FILLDT,A0,DIV,PRV,CNT,LOC,AUTO,DRUG,DRGNM,HRN,PDATE,PAT,PNAME

 S RXIEN=0,RTSDT=APSPBD,CNT=0

 F  S RTSDT=$O(^APSPAF("B",RTSDT)) Q:'+RTSDT!(RTSDT>APSPED)  D

 .F  S RXIEN=$O(^APSPAF("B",RTSDT,RXIEN)) Q:'+RXIEN  D

 ..Q:'$D(^APSPAF(RXIEN,0))       ; Prescription must have a zero node

 ..;Only want non-autofinished meds

 ..S AUTO=$P($G(^APSPAF(RXIEN,0)),U,3)

 ..Q:+AUTO

 ..;Get the order

 ..S ORDER=$P($G(^APSPAF(RXIEN,0)),U,2)

 ..Q:'+ORDER

 ..;Now we have prescriptions that were not auto-finished but have a pharmacy defined

 ..;This is what we want so we can find the other variables.

 ..S LOC=$P($G(^OR(100,ORDER,0)),U,10)

 ..S LOC=$P(LOC,";",1)

 ..Q:'+LOC

 ..S DIV=$P($G(^SC(LOC,0)),U,4)

 ..D SET(DIV,ORDER)

PRINT ;EP

 N APSPPG,DFLG

 S (APSPPG,DFLG)=0

 D HDR

 D PRINT1

 W:'DFLG !,"No data found..."

PRINT1 ;EP

 N DIV,SUB1,SUB2,SUB3,SUB4,VAL

 I APSPDIV="*"&(APSPGRP=1) D PRINT2

 E  D PRINT3

PRINT2 ;Print out by division

 N DIV,SUB1,SUB2,VAL,DIVCT,TOT,NUM

 S TOT=0

 S DIV=0 F  S DIV=$O(^TMP("APSPESR",$J,DIV)) Q:'DIV  D

 .S DIVCT=0

 .I APSPDIV="*" W !,$$GET1^DIQ(4,DIV,.01) D PRINT5

 .S SUB1=0 F  S SUB1=$O(^TMP("APSPESR",$J,DIV,SUB1)) Q:'SUB1  D

 ..D HDR1(SUB1)

 ..S SUB2=0 F  S SUB2=$O(^TMP("APSPESR",$J,DIV,SUB1,SUB2)) Q:'SUB2  D

 ...D HDR2(SUB2)

 ...S NUM=0 F  S NUM=$O(^TMP("APSPESR",$J,DIV,SUB1,SUB2,NUM)) Q:'NUM  D

 ....S VAL=$G(^TMP("APSPESR",$J,DIV,SUB1,SUB2,NUM))

 ....D PRINT4(VAL)

 ....S DFLG=1

 ....S TOT=TOT+1,DIVCT=DIVCT+1

 .W !,"Division Count: "_DIVCT D PRINT5

 W !,"TOTAL Count: "_TOT

PRINT3 ;No divisional counts

 N SUB1,SUB2,VAL,TOT,DIV

 S TOT=0

 S SUB1=0 F  S SUB1=$O(^TMP("APSPESR",$J,SUB1)) Q:'SUB1  D

 .D HDR1(SUB1)

 .S SUB2=0 F  S SUB2=$O(^TMP("APSPESR",$J,SUB1,SUB2)) Q:'SUB2  D

 ..D HDR2(SUB2)

 ..S DIV=0 F  S DIV=$O(^TMP("APSPESR",$J,SUB1,SUB2,DIV)) Q:'DIV  D

 ...S NUM=0 F  S NUM=$O(^TMP("APSPESR",$J,SUB1,SUB2,DIV,NUM)) Q:'NUM  D

 ....S DFLG=1

 ....S VAL=$G(^TMP("APSPESR",$J,SUB1,SUB2,DIV,NUM))

 ....D PRINT4(VAL)

 ....S TOT=TOT+1

 W !,"TOTAL CT: "_TOT

 ; Check page length

PRINT5 ;EP

 N DIR

 Q:$E(IOST)'="C"

 I $Y+4>IOSL D

 .K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 .S DIR(0)="E" D ^DIR

 .D HDR

 ; Set data into ^TMP global for output

SET(DIV,ORDER) ;EP

 N LSTDSPDT,NODE0,X,Y,ITEM,PRV,PDAT,HRN,PAT,DRUGNM,DRUG,DRUG2,DPT,PNAME

 S NODE0=^OR(100,ORDER,0)

 S DRUGNM=""

 S DPT=$P($P(NODE0,U,2),";",1)

 F X=0:0 S X=$O(^OR(100,ORDER,8,X)) Q:'+X  D

 .I X=1 D

 ..S PRV=$P($G(^OR(100,ORDER,8,1,0)),U,5)

 ..S PNAME=$$GET1^DIQ(200,PRV,.01,"E")

 ..S PDAT=$P($G(^OR(100,ORDER,8,1,0)),U,6)

 S ITEM=0,DRGNM=""

 F  S ITEM=$O(^OR(100,ORDER,.1,ITEM)) Q:'+ITEM  D

 .S DRUG=$P($G(^OR(100,ORDER,.1,ITEM,0)),U,1)

 .S DRUG2=$$GET1^DIQ(101.43,DRUG,.01,"E")

 .S DRGNM=$S(DRGNM'="":DRGNM_","_DRUG2,1:DRUG2)

 S HRN=$$HRN^AUPNPAT(DPT,DIV)

 S PAT=$$GET1^DIQ(2,DPT,.01,"E")

 ;Sort these items

 N A,B,C,D

 S A=DIV

 I APSPSRT=1 D

 .I APSPSRT2=1 S B=RTSDT,C=DRUG

 .I APSPSRT2=2 S B=RTSDT,C=PRV

 I APSPSRT=2 D

 .I APSPSRT2=1 S B=DRUG,C=RTSDT

 .I APSPSRT2=2 S B=DRUG,C=PRV

 I APSPSRT=3 D

 .I APSPSRT2=1 S B=PRV,C=RTSDT

 .I APSPSRT2=2 S B=PRV,C=DRUG

 S CNT=CNT+1

 I APSPDIV="*"&(APSPGRP=1) D

 .S ^TMP("APSPESR",$J,A,B,C,ORDER)=ORDER_U_HRN_U_DRGNM_U_PDAT_U_PNAME_U_PAT

 E  D

 .S ^TMP("APSPESR",$J,B,C,A,ORDER)=ORDER_U_HRN_U_DRGNM_U_PDAT_U_PNAME_U_PAT

HDR ;EP

 W @IOF

 S APSPPG=APSPPG+1

 W !,"Auto-Finish Failure Report",?35,$P($TR($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG

 W !,"Report Criteria: Orders which did not auto-finshed"

 W !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF

 W !,?5,"Division: "_$S(APSPDIV:$$GET1^DIQ(4,APSPDIV,.01),1:"All")

 W !,?5,"Primary Sort: "_$S(APSPSRT=1:"Date",APSPSRT=2:"Drug",APSPSRT=3:"Prescriber",1:"")

 W !,$TR($J("",80)," ","-")

 D HDR3

HDR1(SRT1) ;EP

 N LINE

 Q:APSPOUT=3

 I APSPSRT=1 S LINE=$$FMTE^XLFDT(SRT1)

 I APSPSRT=2 S LINE=$$GET1^DIQ(101.43,SRT1,.01,"E")

 I APSPSRT=3 S LINE=$$GET1^DIQ(200,SRT1,.01,"E")

 W !,?5,LINE

 D PRINT5

HDR2(SRT2) ;EP

 Q:APSPOUT=3

 I APSPSRT=1 D

 .I APSPSRT2=1 D

 ..S LINE=$$GET1^DIQ(101.43,SRT2,.01,"E")

 ..W !,?10,LINE

 ..D DASH

 .I APSPSRT2=2 D

 ..S LINE=$$GET1^DIQ(200,SRT2,.01,"E")

 ..W !,?10,LINE

 ..D DASH

 I APSPSRT=2 D

 .I APSPSRT2=1 D

 ..S LINE=$$FMTE^XLFDT(SRT2)

 ..W !,?10,LINE

 ..D DASH

 .I APSPSRT2=2 D

 ..S LINE=$$GET1^DIQ(200,SRT2,.01,"E")

 ..W !,?10,LINE

 ..D DASH

 I APSPSRT=3 D

 .I APSPSRT2=1 D

 ..S LINE=$$FMTE^XLFDT(SRT2)

 ..W !,?10,LINE

 ..D DASH

 .I APSPSRT2=2 D

 ..S LINE=$$GET1^DIQ(50,SRT2,.01,"E")

 ..W !,?10,LINE

 ..D DASH

HDR3 ;Print out header

 I APSPOUT=2 D

 .W !,?12,"Order",?20,"HRN",?30,"Date",?45,"Provider",?65,"Item"

 I APSPOUT=3 D

 .W !,"Order"_U_"Patient"_U_"HRN"_U_"Date"_U_"Provider"_U_"Orderable Item"

 ;Print the line

PRINT4(DATA) ;EP

 N WP,FILE,IENS,FIELD,X,Y

 I APSPOUT=1 D

 .W !,?12,"Order: "_$P(DATA,U,1),?30,"Patient: "_$P(DATA,U,6),?60,"HRN: "_$P(DATA,U,2)

 .D PRINT5

 .W !,?12,"Date: "_$$FMTE^XLFDT($P(DATA,U,4)),?40,"Provider: "_$P(DATA,U,5)

 .D PRINT5

 .W !,?12,"Text:"

 .D PRINT5

 .S FILE=100.008,FIELD=.1

 .S IENS="1,"_ORDER_","

 .S X=$$GET1^DIQ(FILE,IENS,FIELD,"","WP")

 .S Y="" F  S Y=$O(WP(Y)) Q:Y=""  D

 ..W !,?12,$E($G(WP(Y)),1,60)

 ..D PRINT5

 ..I $L(WP(Y))>60 D

 ...W !,?12,$E($G(WP(Y)),61,$L($G(WP(Y))))

 ...D PRINT5

 .W !

 I APSPOUT=2 D

 .W !,?12,$P(DATA,U,1),?20,$P(DATA,U,2),?30,$E($$FMTE^XLFDT($P(DATA,U,4)),1,12),?45,$E($P(DATA,U,5),1,18),?65,$E($P(DATA,U,3),1,15)

 I APSPOUT=3 D

 .W !,$P(DATA,U,1)_U_$P(DATA,U,6)_U_$P(DATA,U,2)_U_$$FMTE^XLFDT($P(DATA,U,4))_U_$P(DATA,U,5)_U_$P(DATA,U,3)

DASH ;EP

 N DASH

 W ! F DASH=1:1:IOM W "-"

W !

APSPESR1  ; IHS/MSC/MGH - AUTO-FINISH REPORT ;04-Jun-2013 08:24;DU

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;**1011,1016**;Sep 23, 2004;Build 74

 +2       ;

EN        ;EP

 +1        NEW APSPBD,APSPED,APSPDIV,APSPRTYP,APSPQ,APSPDSUB,APSPDCLS,APSPSRT,APSPSRT2

 +2        NEW APSPDCT,APSPDCTN,APSPDRG,APSPBDF,APSPEDF,APSPOUT,APSPGRP

 +3        SET APSPDIV=""

           SET APSPDRG=""

           SET APSPQ=0

           SET APSPDSUB=0

 +4        WRITE @IOF

 +5        WRITE !!,"Auto-finish failure report by Division"

 +6        DO ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)

 +7        IF APSPQ

               QUIT

 +8        SET APSPBDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)

 +9        SET APSPEDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)

 +10       SET APSPBD=APSPBD-.01

           SET APSPED=APSPED+.99

 +11       SET APSPDIV=$$DIR^APSPUTIL("Y","Would you like all divisions","Yes",,.APSPQ)

 +12       IF APSPQ

               QUIT

 +13       IF APSPDIV

               Begin DoDot:1

 +14               SET APSPDIV="*"

               End DoDot:1

 +15      IF '$TEST

               Begin DoDot:1

 +16               SET APSPDIV=$$GETIEN^APSPUTIL(4,"Select Division: ",.APSPQ)

               End DoDot:1

               IF APSPQ

                   QUIT

 +17      ;Get primary sort criteria

 +18       SET APSPSRT=+$$DIR^APSPUTIL("S^1:Date;2:Drug;3:Prescriber","Primary sort",,,.APSPQ)

 +19       IF APSPQ

               QUIT

 +20       IF APSPSRT=1

               Begin DoDot:1

 +21               SET APSPSRT2=+$$DIR^APSPUTIL("S^1:Drug;2:Prescriber","Within Date,sort by",,,.APSPQ)

               End DoDot:1

 +22       IF APSPQ

               QUIT

 +23       IF APSPSRT=2

               Begin DoDot:1

 +24               SET APSPSRT2=+$$DIR^APSPUTIL("S^1:Date;2:Prescriber","Within Drug,sort by",,,.APSPQ)

               End DoDot:1

 +25       IF APSPQ

               QUIT

 +26       IF APSPSRT=3

               Begin DoDot:1

 +27               SET APSPSRT2=+$$DIR^APSPUTIL("S^1:Date;2:Drug","Within Prescriber,sort by",,,.APSPQ)

               End DoDot:1

 +28       IF APSPQ

               QUIT

 +29      ;Ask about divisions

 +30       SET APSPGRP=0

 +31       IF APSPDIV="*"

               SET APSPGRP=+$$DIR^APSPUTIL("S^1:Yes;0:No","Display by divison?",,,.APSPQ)

 +32       IF APSPQ

               QUIT

 +33      ;Ask about output

 +34       SET APSPOUT=0

 +35       SET APSPOUT=+$$DIR^APSPUTIL("S^1:Detailed;2:Columnar;3:Delimited","Output format:",,,.APSPQ)

 +36       IF APSPQ

               QUIT

 +37       DO DEV

 +38       QUIT

DEV       ;

 +1        NEW XBRP,XBNS

 +2        SET XBRP="OUT^APSPESR1"

 +3        SET XBNS="APS*"

 +4        DO ^XBDBQUE

 +5        QUIT

OUT       ;EP

 +1        KILL ^TMP("APSPESR",$JOB)

 +2        DO FIND($GET(APSPBD),$GET(APSPED))

 +3        DO PRINT

 +4        QUIT

 +5       ;

FIND(APSPBD,APSPED) ;EP

 +1        NEW RXIEN,ACTIEN,RTSDT,FILLDT,A0,DIV,PRV,CNT,LOC,AUTO,DRUG,DRGNM,HRN,PDATE,PAT,PNAME

 +2        SET RXIEN=0

           SET RTSDT=APSPBD

           SET CNT=0

 +3        FOR

               SET RTSDT=$ORDER(^APSPAF("B",RTSDT))

               IF '+RTSDT!(RTSDT>APSPED)

                   QUIT

               Begin DoDot:1

 +4                FOR

                       SET RXIEN=$ORDER(^APSPAF("B",RTSDT,RXIEN))

                       IF '+RXIEN

                           QUIT

                       Begin DoDot:2

 +5       ; Prescription must have a zero node

                           IF '$DATA(^APSPAF(RXIEN,0))

                               QUIT

 +6       ;Only want non-autofinished meds

 +7                        SET AUTO=$PIECE($GET(^APSPAF(RXIEN,0)),U,3)

 +8                        IF +AUTO

                               QUIT

 +9       ;Get the order

 +10                       SET ORDER=$PIECE($GET(^APSPAF(RXIEN,0)),U,2)

 +11                       IF '+ORDER

                               QUIT

 +12      ;Now we have prescriptions that were not auto-finished but have a pharmacy defined

 +13      ;This is what we want so we can find the other variables.

 +14                       SET LOC=$PIECE($GET(^OR(100,ORDER,0)),U,10)

 +15                       SET LOC=$PIECE(LOC,";",1)

 +16                       IF '+LOC

                               QUIT

 +17                       SET DIV=$PIECE($GET(^SC(LOC,0)),U,4)

 +18                       DO SET(DIV,ORDER)

                       End DoDot:2

               End DoDot:1

 +19       QUIT

 +20      ;

PRINT     ;EP

 +1        NEW APSPPG,DFLG

 +2        SET (APSPPG,DFLG)=0

 +3        DO HDR

 +4        DO PRINT1

 +5        IF 'DFLG

               WRITE !,"No data found..."

 +6        QUIT

 +7       ;

PRINT1    ;EP

 +1        NEW DIV,SUB1,SUB2,SUB3,SUB4,VAL

 +2        IF APSPDIV="*"&(APSPGRP=1)

               DO PRINT2

 +3       IF '$TEST

               DO PRINT3

 +4        QUIT

PRINT2    ;Print out by division

 +1        NEW DIV,SUB1,SUB2,VAL,DIVCT,TOT,NUM

 +2        SET TOT=0

 +3        SET DIV=0

FOR

               SET DIV=$ORDER(^TMP("APSPESR",$JOB,DIV))

               IF 'DIV

                   QUIT

               Begin DoDot:1

 +4                SET DIVCT=0

 +5                IF APSPDIV="*"

                       WRITE !,$$GET1^DIQ(4,DIV,.01)

                       DO PRINT5

 +6                SET SUB1=0

FOR

                       SET SUB1=$ORDER(^TMP("APSPESR",$JOB,DIV,SUB1))

                       IF 'SUB1

                           QUIT

                       Begin DoDot:2

 +7                        DO HDR1(SUB1)

 +8                        SET SUB2=0

FOR

                               SET SUB2=$ORDER(^TMP("APSPESR",$JOB,DIV,SUB1,SUB2))

                               IF 'SUB2

                                   QUIT

                               Begin DoDot:3

 +9                                DO HDR2(SUB2)

 +10                               SET NUM=0

FOR

                                       SET NUM=$ORDER(^TMP("APSPESR",$JOB,DIV,SUB1,SUB2,NUM))

                                       IF 'NUM

                                           QUIT

                                       Begin DoDot:4

 +11                                       SET VAL=$GET(^TMP("APSPESR",$JOB,DIV,SUB1,SUB2,NUM))

 +12                                       DO PRINT4(VAL)

 +13                                       SET DFLG=1

 +14                                       SET TOT=TOT+1

                                           SET DIVCT=DIVCT+1

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +15               WRITE !,"Division Count: "_DIVCT

                   DO PRINT5

               End DoDot:1

 +16       WRITE !,"TOTAL Count: "_TOT

 +17       QUIT

PRINT3    ;No divisional counts

 +1        NEW SUB1,SUB2,VAL,TOT,DIV

 +2        SET TOT=0

 +3        SET SUB1=0

FOR

               SET SUB1=$ORDER(^TMP("APSPESR",$JOB,SUB1))

               IF 'SUB1

                   QUIT

               Begin DoDot:1

 +4                DO HDR1(SUB1)

 +5                SET SUB2=0

FOR

                       SET SUB2=$ORDER(^TMP("APSPESR",$JOB,SUB1,SUB2))

                       IF 'SUB2

                           QUIT

                       Begin DoDot:2

 +6                        DO HDR2(SUB2)

 +7                        SET DIV=0

FOR

                               SET DIV=$ORDER(^TMP("APSPESR",$JOB,SUB1,SUB2,DIV))

                               IF 'DIV

                                   QUIT

                               Begin DoDot:3

 +8                                SET NUM=0

FOR

                                       SET NUM=$ORDER(^TMP("APSPESR",$JOB,SUB1,SUB2,DIV,NUM))

                                       IF 'NUM

                                           QUIT

                                       Begin DoDot:4

 +9                                        SET DFLG=1

 +10                                       SET VAL=$GET(^TMP("APSPESR",$JOB,SUB1,SUB2,DIV,NUM))

 +11                                       DO PRINT4(VAL)

 +12                                       SET TOT=TOT+1

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +13       WRITE !,"TOTAL CT: "_TOT

 +14      ; Check page length

PRINT5    ;EP

 +1        NEW DIR

 +2        IF $EXTRACT(IOST)'="C"

               QUIT

 +3        IF $Y+4>IOSL

               Begin DoDot:1

 +4                KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5                SET DIR(0)="E"

                   DO ^DIR

 +6                DO HDR

               End DoDot:1

 +7        QUIT

 +8       ; Set data into ^TMP global for output

SET(DIV,ORDER) ;EP

 +1        NEW LSTDSPDT,NODE0,X,Y,ITEM,PRV,PDAT,HRN,PAT,DRUGNM,DRUG,DRUG2,DPT,PNAME

 +2        SET NODE0=^OR(100,ORDER,0)

 +3        SET DRUGNM=""

 +4        SET DPT=$PIECE($PIECE(NODE0,U,2),";",1)

 +5        FOR X=0:0

               SET X=$ORDER(^OR(100,ORDER,8,X))

               IF '+X

                   QUIT

               Begin DoDot:1

 +6                IF X=1

                       Begin DoDot:2

 +7                        SET PRV=$PIECE($GET(^OR(100,ORDER,8,1,0)),U,5)

 +8                        SET PNAME=$$GET1^DIQ(200,PRV,.01,"E")

 +9                        SET PDAT=$PIECE($GET(^OR(100,ORDER,8,1,0)),U,6)

                       End DoDot:2

               End DoDot:1

 +10       SET ITEM=0

           SET DRGNM=""

 +11       FOR

               SET ITEM=$ORDER(^OR(100,ORDER,.1,ITEM))

               IF '+ITEM

                   QUIT

               Begin DoDot:1

 +12               SET DRUG=$PIECE($GET(^OR(100,ORDER,.1,ITEM,0)),U,1)

 +13               SET DRUG2=$$GET1^DIQ(101.43,DRUG,.01,"E")

 +14               SET DRGNM=$SELECT(DRGNM'="":DRGNM_","_DRUG2,1:DRUG2)

               End DoDot:1

 +15       SET HRN=$$HRN^AUPNPAT(DPT,DIV)

 +16       SET PAT=$$GET1^DIQ(2,DPT,.01,"E")

 +17      ;Sort these items

 +18       NEW A,B,C,D

 +19       SET A=DIV

 +20       IF APSPSRT=1

               Begin DoDot:1

 +21               IF APSPSRT2=1

                       SET B=RTSDT

                       SET C=DRUG

 +22               IF APSPSRT2=2

                       SET B=RTSDT

                       SET C=PRV

               End DoDot:1

 +23       IF APSPSRT=2

               Begin DoDot:1

 +24               IF APSPSRT2=1

                       SET B=DRUG

                       SET C=RTSDT

 +25               IF APSPSRT2=2

                       SET B=DRUG

                       SET C=PRV

               End DoDot:1

 +26       IF APSPSRT=3

               Begin DoDot:1

 +27               IF APSPSRT2=1

                       SET B=PRV

                       SET C=RTSDT

 +28               IF APSPSRT2=2

                       SET B=PRV

                       SET C=DRUG

               End DoDot:1

 +29       SET CNT=CNT+1

 +30       IF APSPDIV="*"&(APSPGRP=1)

               Begin DoDot:1

 +31               SET ^TMP("APSPESR",$JOB,A,B,C,ORDER)=ORDER_U_HRN_U_DRGNM_U_PDAT_U_PNAME_U_PAT

               End DoDot:1

 +32      IF '$TEST

               Begin DoDot:1

 +33               SET ^TMP("APSPESR",$JOB,B,C,A,ORDER)=ORDER_U_HRN_U_DRGNM_U_PDAT_U_PNAME_U_PAT

               End DoDot:1

 +34       QUIT

HDR       ;EP

 +1        WRITE @IOF

 +2        SET APSPPG=APSPPG+1

 +3        WRITE !,"Auto-Finish Failure Report",?35,$PIECE($TRANSLATE($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@"," "),":",1,2),?(IOM-10),"Page: "_APSPPG

 +4        WRITE !,"Report Criteria: Orders which did not auto-finshed"

 +5        WRITE !,?5,"Inclusive Dates: "_APSPBDF_" to "_APSPEDF

 +6        WRITE !,?5,"Division: "_$SELECT(APSPDIV:$$GET1^DIQ(4,APSPDIV,.01),1:"All")

 +7        WRITE !,?5,"Primary Sort: "_$SELECT(APSPSRT=1:"Date",APSPSRT=2:"Drug",APSPSRT=3:"Prescriber",1:"")

 +8        WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")

 +9        DO HDR3

 +10       QUIT

 +11      ;

HDR1(SRT1) ;EP

 +1        NEW LINE

 +2        IF APSPOUT=3

               QUIT

 +3        IF APSPSRT=1

               SET LINE=$$FMTE^XLFDT(SRT1)

 +4        IF APSPSRT=2

               SET LINE=$$GET1^DIQ(101.43,SRT1,.01,"E")

 +5        IF APSPSRT=3

               SET LINE=$$GET1^DIQ(200,SRT1,.01,"E")

 +6        WRITE !,?5,LINE

 +7        DO PRINT5

 +8        QUIT

HDR2(SRT2) ;EP

 +1        IF APSPOUT=3

               QUIT

 +2        IF APSPSRT=1

               Begin DoDot:1

 +3                IF APSPSRT2=1

                       Begin DoDot:2

 +4                        SET LINE=$$GET1^DIQ(101.43,SRT2,.01,"E")

 +5                        WRITE !,?10,LINE

 +6                        DO DASH

                       End DoDot:2

 +7                IF APSPSRT2=2

                       Begin DoDot:2

 +8                        SET LINE=$$GET1^DIQ(200,SRT2,.01,"E")

 +9                        WRITE !,?10,LINE

 +10                       DO DASH

                       End DoDot:2

               End DoDot:1

 +11       IF APSPSRT=2

               Begin DoDot:1

 +12               IF APSPSRT2=1

                       Begin DoDot:2

 +13                       SET LINE=$$FMTE^XLFDT(SRT2)

 +14                       WRITE !,?10,LINE

 +15                       DO DASH

                       End DoDot:2

 +16               IF APSPSRT2=2

                       Begin DoDot:2

 +17                       SET LINE=$$GET1^DIQ(200,SRT2,.01,"E")

 +18                       WRITE !,?10,LINE

 +19                       DO DASH

                       End DoDot:2

               End DoDot:1

 +20       IF APSPSRT=3

               Begin DoDot:1

 +21               IF APSPSRT2=1

                       Begin DoDot:2

 +22                       SET LINE=$$FMTE^XLFDT(SRT2)

 +23                       WRITE !,?10,LINE

 +24                       DO DASH

                       End DoDot:2

 +25               IF APSPSRT2=2

                       Begin DoDot:2

 +26                       SET LINE=$$GET1^DIQ(50,SRT2,.01,"E")

 +27                       WRITE !,?10,LINE

 +28                       DO DASH

                       End DoDot:2

               End DoDot:1

 +29       QUIT

HDR3      ;Print out header

 +1        IF APSPOUT=2

               Begin DoDot:1

 +2                WRITE !,?12,"Order",?20,"HRN",?30,"Date",?45,"Provider",?65,"Item"

               End DoDot:1

 +3        IF APSPOUT=3

               Begin DoDot:1

 +4                WRITE !,"Order"_U_"Patient"_U_"HRN"_U_"Date"_U_"Provider"_U_"Orderable Item"

               End DoDot:1

 +5        QUIT

 +6       ;Print the line

PRINT4(DATA) ;EP

 +1        NEW WP,FILE,IENS,FIELD,X,Y

 +2        IF APSPOUT=1

               Begin DoDot:1

 +3                WRITE !,?12,"Order: "_$PIECE(DATA,U,1),?30,"Patient: "_$PIECE(DATA,U,6),?60,"HRN: "_$PIECE(DATA,U,2)

 +4                DO PRINT5

 +5                WRITE !,?12,"Date: "_$$FMTE^XLFDT($PIECE(DATA,U,4)),?40,"Provider: "_$PIECE(DATA,U,5)

 +6                DO PRINT5

 +7                WRITE !,?12,"Text:"

 +8                DO PRINT5

 +9                SET FILE=100.008

                   SET FIELD=.1

 +10               SET IENS="1,"_ORDER_","

 +11               SET X=$$GET1^DIQ(FILE,IENS,FIELD,"","WP")

 +12               SET Y=""

FOR

                       SET Y=$ORDER(WP(Y))

                       IF Y=""

                           QUIT

                       Begin DoDot:2

 +13                       WRITE !,?12,$EXTRACT($GET(WP(Y)),1,60)

 +14                       DO PRINT5

 +15                       IF $LENGTH(WP(Y))>60

                               Begin DoDot:3

 +16                               WRITE !,?12,$EXTRACT($GET(WP(Y)),61,$LENGTH($GET(WP(Y))))

 +17                               DO PRINT5

                               End DoDot:3

                       End DoDot:2

 +18               WRITE !

               End DoDot:1

 +19       IF APSPOUT=2

               Begin DoDot:1

 +20               WRITE !,?12,$PIECE(DATA,U,1),?20,$PIECE(DATA,U,2),?30,$EXTRACT($$FMTE^XLFDT($PIECE(DATA,U,4)),1,12),?45,$EXTRACT($PIECE(DATA,U,5),1,18),?65,$EXTRACT($PIECE(DATA,U,3),1,15)

               End DoDot:1

 +21       IF APSPOUT=3

               Begin DoDot:1

 +22               WRITE !,$PIECE(DATA,U,1)_U_$PIECE(DATA,U,6)_U_$PIECE(DATA,U,2)_U_$$FMTE^XLFDT($PIECE(DATA,U,4))_U_$PIECE(DATA,U,5)_U_$PIECE(DATA,U,3)

               End DoDot:1

 +23       QUIT

 +24      ;

DASH      ;EP

 +1        NEW DASH

 +2        WRITE !

           FOR DASH=1:1:IOM

               WRITE "-"

 +3        WRITE !

 +4        QUIT

APSPESR1.m