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
Q
DEV ;
N XBRP,XBNS
S XBRP="OUT^APSPESR1"
S XBNS="APS*"
D ^XBDBQUE
Q
OUT ;EP
K ^TMP("APSPESR",$J)
D FIND($G(APSPBD),$G(APSPED))
D PRINT
Q
;
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)
Q
;
PRINT ;EP
N APSPPG,DFLG
S (APSPPG,DFLG)=0
D HDR
D PRINT1
W:'DFLG !,"No data found..."
Q
;
PRINT1 ;EP
N DIV,SUB1,SUB2,SUB3,SUB4,VAL
I APSPDIV="*"&(APSPGRP=1) D PRINT2
E D PRINT3
Q
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
Q
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
Q
; 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
Q
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
Q
;
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
Q
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
Q
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"
Q
;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)
Q
;
DASH ;EP
N DASH
W ! F DASH=1:1:IOM W "-"
W !
Q
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
