ABSPOSMF ; IHS/SD/RLT - Medicare Part D Insurer Report ; [ 01/30/06 09:20 AM ]
;;1.0;PHARMACY POINT OF SALE;**16,19,29,37,44**;JAN 30, 2006;Build 38
Q
;
;----------------------------------------------------------
;IHS/SD/RLT - 10/13/06 - Patch 19
; Report not printing to network devices. Fixed by adding
; U IO in tag EN.
;----------------------------------------------------------
;----------------------------------------------------------
;IHS/OIT/SCR - 01/16/09- Patch 29
; ADDED EN2 and GETDATA2 for sort by site report
;----------------------------------------------------------
EN ;EP
;
W @IOF
W "Totals by Medicare Part D Insurers",!
N RANGE S RANGE=$$DTR^ABSPOSU1 Q:RANGE<1
W !
N POP D ^%ZIS Q:$G(POP)
D SETTMP
D GETDATA($P(RANGE,U),$P(RANGE,U,2))
U IO ;IHS/SD/RLT - 10/13/06
D DISDATA
D ^%ZISC
K ^TMP("ABSPOSMF",$J)
Q
;
EN2 ;EP
;IHS/OIT/SCR 01/02/09 add to filter by site
W @IOF
N ABSPHARM
W "Totals by Medicare Part D Insurers For site",!
N RANGE S RANGE=$$DTR^ABSPOSU1 Q:RANGE<1
S DIC="^ABSP(9002313.56,"
S DIC(0)="AE"
S DIC("A")="PHARMACY: "
S DIC("B")=$P($G(^ABSP(9002313.56,1,0)),"^",1)
D ^DIC
Q:Y<0
S ABSPHARM=$P(Y,"^",1)
W !
N POP D ^%ZIS Q:$G(POP)
D SETTMP
D GETDATA2($P(RANGE,U),$P(RANGE,U,2),ABSPHARM)
U IO ;IHS/SD/RLT - 10/13/06
D DISDATA
D ^%ZISC
K ^TMP("ABSPOSMF",$J)
Q
;
GETDATA(BEGDT,ENDDT) ;
N RMRELDT,RMIEN,RMNODE0,IEN57,INSIEN,INSNAME
N PAY,ADJ,PAP,REJ,UNI
N ABSPCLSD ;;IHS/OIT/SCR 022010 patch 37
S RMRELDT=BEGDT-1
F S RMRELDT=$O(^ABSPECX("RPT","B",RMRELDT)) Q:'RMRELDT!(RMRELDT>ENDDT) D
. S RMIEN=0
. F S RMIEN=$O(^ABSPECX("RPT","B",RMRELDT,RMIEN)) Q:'RMIEN D
. . S RMNODE0=^ABSPECX("RPT",RMIEN,0)
. . S IEN57=$P(RMNODE0,U,3) ;9002313.57
. . Q:IEN57=""
. . S INSIEN=$$GET1^DIQ(9002313.57,IEN57_",",1.06,"I") ;9999999.18
. . Q:INSIEN="" ;and 9002313.4
. . S INSNAME=$$GET1^DIQ(9002313.57,IEN57_",",1.06)
. . Q:INSNAME=""
. . S ABSPCLSD=$$GET1^DIQ(9002313.57,IEN57_",",901,"I") ;IHS/OIT/SCR 022010 patch 37
. . Q:ABSPCLSD
. . Q:'$D(^TMP("ABSPOSMF",$J,INSNAME)) ;quit if not already in ^TMP
. . S PAY=$$GET1^DIQ(9002313.61,RMIEN_",",10006)
. . S:PAY="" PAY=0
. . S ADJ=$$GET1^DIQ(9002313.61,RMIEN_",",10007)
. . S:ADJ="" ADJ=0
. . S PAP=$$GET1^DIQ(9002313.61,RMIEN_",",10010)
. . S:PAP="" PAP=0
. . S REJ=$$GET1^DIQ(9002313.61,RMIEN_",",10013)
. . S:REJ="" REJ=0
. . ;
. . ;Subtotals
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U)+PAY
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,2)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,2)+ADJ
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,3)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,3)+PAP
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,4)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,4)+REJ
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,5)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,5)+1
. . ;
. . ;Total
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U)+PAY
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,2)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,2)+ADJ
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,3)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,3)+PAP
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,4)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,4)+REJ
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,5)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,5)+1
Q
GETDATA2(BEGDT,ENDDT,ABSPHARM) ;
;IHS/OIT/SCR 01/02/08 ADDED TO FILTER RESULTS TO DISPLAY ONLY ONE PHARMACY
N RMRELDT,RMIEN,RMNODE0,IEN57,INSIEN,INSNAME
N PAY,ADJ,PAP,REJ,UNI,APSPHRM,ABSPCLSD
S RMRELDT=BEGDT-1
F S RMRELDT=$O(^ABSPECX("RPT","B",RMRELDT)) Q:'RMRELDT!(RMRELDT>ENDDT) D
. S RMIEN=0
. F S RMIEN=$O(^ABSPECX("RPT","B",RMRELDT,RMIEN)) Q:'RMIEN D
. . S RMNODE0=^ABSPECX("RPT",RMIEN,0)
. . S IEN57=$P(RMNODE0,U,3) ;9002313.57
. . Q:IEN57=""
. . S INSIEN=$$GET1^DIQ(9002313.57,IEN57_",",1.06,"I") ;9999999.18
. . Q:INSIEN="" ;and 9002313.4
. . S INSNAME=$$GET1^DIQ(9002313.57,IEN57_",",1.06)
. . Q:INSNAME=""
. . S ABSPPHRM=$$GET1^DIQ(9002313.57,IEN57_",",1.07,"I")
. . Q:ABSPPHRM'=ABSPHARM
. . S ABSPCLSD=$$GET1^DIQ(9002313.57,IEN57_",",901,"I") ;IHS/OIT/SCR 022010 patch 37
. . Q:ABSPCLSD
. . ;QUIT IF THIS RECORD IS NOT FOR THE SELECTED PHARMACY?
. . Q:'$D(^TMP("ABSPOSMF",$J,INSNAME)) ;quit if not already in ^TMP
. . S PAY=$$GET1^DIQ(9002313.61,RMIEN_",",10006)
. . S:PAY="" PAY=0
. . S ADJ=$$GET1^DIQ(9002313.61,RMIEN_",",10007)
. . S:ADJ="" ADJ=0
. . S PAP=$$GET1^DIQ(9002313.61,RMIEN_",",10010)
. . S:PAP="" PAP=0
. . S REJ=$$GET1^DIQ(9002313.61,RMIEN_",",10013)
. . S:REJ="" REJ=0
. . ;
. . ;Subtotals
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U)+PAY
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,2)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,2)+ADJ
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,3)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,3)+PAP
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,4)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,4)+REJ
. . S $P(^TMP("ABSPOSMF",$J,INSNAME),U,5)=$P($G(^TMP("ABSPOSMF",$J,INSNAME)),U,5)+1
. . ;
. . ;Total
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U)+PAY
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,2)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,2)+ADJ
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,3)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,3)+PAP
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,4)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,4)+REJ
. . S $P(^TMP("ABSPOSMF",$J,"ZZZZTOTAL"),U,5)=$P($G(^TMP("ABSPOSMF",$J,"ZZZZTOTAL")),U,5)+1
Q
DISDATA ;
N DASHES
S $P(DASHES,"-",80)=""
N INSNAME,INSREC,PAY,ADJ,PAP,REJ,UNI,CNT
D HEADING
I '$D(^TMP("ABSPOSMF",$J)) D Q
. W !,"No Medicare D prescriptions found!"
. D ENDRPT^ABSPOSU5()
S INSNAME=""
F S INSNAME=$O(^TMP("ABSPOSMF",$J,INSNAME)) Q:INSNAME="" D
. S INSREC=$G(^TMP("ABSPOSMF",$J,INSNAME))
. S PAY=$P(INSREC,U)
. S ADJ=$P(INSREC,U,2)
. S PAP=$P(INSREC,U,3)
. S REJ=$P(INSREC,U,4)
. S CNT=$P(INSREC,U,5)
. I INSNAME="ZZZZTOTAL" W !,"TOTAL",!
. E W !,INSNAME,!
. W ?20,$J(PAY,10,2)
. W ?33,$J(ADJ,10,2)
. W ?46,$J(PAP,10,2)
. W ?59,$J(REJ,10,2)
. W ?72,$J(CNT,7)
. W !,DASHES
. I $$EOPQ^ABSPOSU8(3,,"D HEADING^"_$T(+0)) S INSNAME="ZZZZZ"
D ENDRPT^ABSPOSU5()
W @IOF
Q
HEADING ;
W @IOF
N RPTDATE S RPTDATE=$$NOWEXT^ABSPOSU1
W "TOTALS BY MEDICARE PART D INSURERS (",$T(+0),")",?60,RPTDATE
W !,"For "
N Y S Y=$P(RANGE,U) X ^DD("DD") W Y
W " through "
S Y=$P(RANGE,U,2) X ^DD("DD") W Y
W !!,?21,"PAYABLE",?34,"ADJUSTED",?48,"PAPER",?60,"REJECTED",?72,"RX CNT"
W !,DASHES
Q
SETTMP ;Build ^TMP global with all Medicare D insurers in the
;ABSP Insurer file.
;Set all amounts to zero. Want to report insurers not
;being used.
K ^TMP("ABSPOSMF",$J)
N INSIEN,INSNAME,FRMIEN,FRMNAME,MPDFLG
S INSIEN=0
F S INSIEN=$O(^ABSPEI(INSIEN)) Q:'INSIEN D
. S INSNAME=$$GET1^DIQ(9002313.4,INSIEN_",",.01)
. Q:INSNAME=""
. ;OIT/CAS/RCS Patch 44 07022012 - Comment next 3 lines, no longer looking for format, HEAT # 71654
. ;S FRMIEN=$$GET1^DIQ(9002313.4,INSIEN_",",100.01,"I")
. ;Q:FRMIEN="" ;quit if insurer not tied to a format
. ;S FRMNAME=$$GET1^DIQ(9002313.4,INSIEN_",",100.01)
. ;OIT/CAS/RCS Patch 44 07022012 - Comment next line and look at new location in Insurer file for Medicare Part D flag
. ;S MPDFLG=$$GET1^DIQ(9002313.92,FRMIEN_",",1.2)
. S MPDFLG=$$GET1^DIQ(9002313.4,INSIEN_",",100.18)
. Q:MPDFLG'="Y" ;quit if not a Medicare D format
. S ^TMP("ABSPOSMF",$J,INSNAME)="0^0^0^0^0"
Q
ABSPOSMF ; IHS/SD/RLT - Medicare Part D Insurer Report ; [ 01/30/06 09:20 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**16,19,29,37,44**;JAN 30, 2006;Build 38
+2 QUIT
+3 ;
+4 ;----------------------------------------------------------
+5 ;IHS/SD/RLT - 10/13/06 - Patch 19
+6 ; Report not printing to network devices. Fixed by adding
+7 ; U IO in tag EN.
+8 ;----------------------------------------------------------
+9 ;----------------------------------------------------------
+10 ;IHS/OIT/SCR - 01/16/09- Patch 29
+11 ; ADDED EN2 and GETDATA2 for sort by site report
+12 ;----------------------------------------------------------
EN ;EP
+1 ;
+2 WRITE @IOF
+3 WRITE "Totals by Medicare Part D Insurers",!
+4 NEW RANGE
SET RANGE=$$DTR^ABSPOSU1
IF RANGE<1
QUIT
+5 WRITE !
+6 NEW POP
DO ^%ZIS
IF $GET(POP)
QUIT
+7 DO SETTMP
+8 DO GETDATA($PIECE(RANGE,U),$PIECE(RANGE,U,2))
+9 ;IHS/SD/RLT - 10/13/06
USE IO
+10 DO DISDATA
+11 DO ^%ZISC
+12 KILL ^TMP("ABSPOSMF",$JOB)
+13 QUIT
+14 ;
EN2 ;EP
+1 ;IHS/OIT/SCR 01/02/09 add to filter by site
+2 WRITE @IOF
+3 NEW ABSPHARM
+4 WRITE "Totals by Medicare Part D Insurers For site",!
+5 NEW RANGE
SET RANGE=$$DTR^ABSPOSU1
IF RANGE<1
QUIT
+6 SET DIC="^ABSP(9002313.56,"
+7 SET DIC(0)="AE"
+8 SET DIC("A")="PHARMACY: "
+9 SET DIC("B")=$PIECE($GET(^ABSP(9002313.56,1,0)),"^",1)
+10 DO ^DIC
+11 IF Y<0
QUIT
+12 SET ABSPHARM=$PIECE(Y,"^",1)
+13 WRITE !
+14 NEW POP
DO ^%ZIS
IF $GET(POP)
QUIT
+15 DO SETTMP
+16 DO GETDATA2($PIECE(RANGE,U),$PIECE(RANGE,U,2),ABSPHARM)
+17 ;IHS/SD/RLT - 10/13/06
USE IO
+18 DO DISDATA
+19 DO ^%ZISC
+20 KILL ^TMP("ABSPOSMF",$JOB)
+21 QUIT
+22 ;
GETDATA(BEGDT,ENDDT) ;
+1 NEW RMRELDT,RMIEN,RMNODE0,IEN57,INSIEN,INSNAME
+2 NEW PAY,ADJ,PAP,REJ,UNI
+3 ;;IHS/OIT/SCR 022010 patch 37
NEW ABSPCLSD
+4 SET RMRELDT=BEGDT-1
+5 FOR
SET RMRELDT=$ORDER(^ABSPECX("RPT","B",RMRELDT))
IF 'RMRELDT!(RMRELDT>ENDDT)
QUIT
Begin DoDot:1
+6 SET RMIEN=0
+7 FOR
SET RMIEN=$ORDER(^ABSPECX("RPT","B",RMRELDT,RMIEN))
IF 'RMIEN
QUIT
Begin DoDot:2
+8 SET RMNODE0=^ABSPECX("RPT",RMIEN,0)
+9 ;9002313.57
SET IEN57=$PIECE(RMNODE0,U,3)
+10 IF IEN57=""
QUIT
+11 ;9999999.18
SET INSIEN=$$GET1^DIQ(9002313.57,IEN57_",",1.06,"I")
+12 ;and 9002313.4
IF INSIEN=""
QUIT
+13 SET INSNAME=$$GET1^DIQ(9002313.57,IEN57_",",1.06)
+14 IF INSNAME=""
QUIT
+15 ;IHS/OIT/SCR 022010 patch 37
SET ABSPCLSD=$$GET1^DIQ(9002313.57,IEN57_",",901,"I")
+16 IF ABSPCLSD
QUIT
+17 ;quit if not already in ^TMP
IF '$DATA(^TMP("ABSPOSMF",$JOB,INSNAME))
QUIT
+18 SET PAY=$$GET1^DIQ(9002313.61,RMIEN_",",10006)
+19 IF PAY=""
SET PAY=0
+20 SET ADJ=$$GET1^DIQ(9002313.61,RMIEN_",",10007)
+21 IF ADJ=""
SET ADJ=0
+22 SET PAP=$$GET1^DIQ(9002313.61,RMIEN_",",10010)
+23 IF PAP=""
SET PAP=0
+24 SET REJ=$$GET1^DIQ(9002313.61,RMIEN_",",10013)
+25 IF REJ=""
SET REJ=0
+26 ;
+27 ;Subtotals
+28 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U)+PAY
+29 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,2)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,2)+ADJ
+30 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,3)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,3)+PAP
+31 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,4)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,4)+REJ
+32 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,5)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,5)+1
+33 ;
+34 ;Total
+35 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U)+PAY
+36 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,2)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,2)+ADJ
+37 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,3)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,3)+PAP
+38 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,4)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,4)+REJ
+39 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,5)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,5)+1
End DoDot:2
End DoDot:1
+40 QUIT
GETDATA2(BEGDT,ENDDT,ABSPHARM) ;
+1 ;IHS/OIT/SCR 01/02/08 ADDED TO FILTER RESULTS TO DISPLAY ONLY ONE PHARMACY
+2 NEW RMRELDT,RMIEN,RMNODE0,IEN57,INSIEN,INSNAME
+3 NEW PAY,ADJ,PAP,REJ,UNI,APSPHRM,ABSPCLSD
+4 SET RMRELDT=BEGDT-1
+5 FOR
SET RMRELDT=$ORDER(^ABSPECX("RPT","B",RMRELDT))
IF 'RMRELDT!(RMRELDT>ENDDT)
QUIT
Begin DoDot:1
+6 SET RMIEN=0
+7 FOR
SET RMIEN=$ORDER(^ABSPECX("RPT","B",RMRELDT,RMIEN))
IF 'RMIEN
QUIT
Begin DoDot:2
+8 SET RMNODE0=^ABSPECX("RPT",RMIEN,0)
+9 ;9002313.57
SET IEN57=$PIECE(RMNODE0,U,3)
+10 IF IEN57=""
QUIT
+11 ;9999999.18
SET INSIEN=$$GET1^DIQ(9002313.57,IEN57_",",1.06,"I")
+12 ;and 9002313.4
IF INSIEN=""
QUIT
+13 SET INSNAME=$$GET1^DIQ(9002313.57,IEN57_",",1.06)
+14 IF INSNAME=""
QUIT
+15 SET ABSPPHRM=$$GET1^DIQ(9002313.57,IEN57_",",1.07,"I")
+16 IF ABSPPHRM'=ABSPHARM
QUIT
+17 ;IHS/OIT/SCR 022010 patch 37
SET ABSPCLSD=$$GET1^DIQ(9002313.57,IEN57_",",901,"I")
+18 IF ABSPCLSD
QUIT
+19 ;QUIT IF THIS RECORD IS NOT FOR THE SELECTED PHARMACY?
+20 ;quit if not already in ^TMP
IF '$DATA(^TMP("ABSPOSMF",$JOB,INSNAME))
QUIT
+21 SET PAY=$$GET1^DIQ(9002313.61,RMIEN_",",10006)
+22 IF PAY=""
SET PAY=0
+23 SET ADJ=$$GET1^DIQ(9002313.61,RMIEN_",",10007)
+24 IF ADJ=""
SET ADJ=0
+25 SET PAP=$$GET1^DIQ(9002313.61,RMIEN_",",10010)
+26 IF PAP=""
SET PAP=0
+27 SET REJ=$$GET1^DIQ(9002313.61,RMIEN_",",10013)
+28 IF REJ=""
SET REJ=0
+29 ;
+30 ;Subtotals
+31 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U)+PAY
+32 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,2)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,2)+ADJ
+33 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,3)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,3)+PAP
+34 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,4)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,4)+REJ
+35 SET $PIECE(^TMP("ABSPOSMF",$JOB,INSNAME),U,5)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,INSNAME)),U,5)+1
+36 ;
+37 ;Total
+38 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U)+PAY
+39 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,2)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,2)+ADJ
+40 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,3)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,3)+PAP
+41 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,4)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,4)+REJ
+42 SET $PIECE(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL"),U,5)=$PIECE($GET(^TMP("ABSPOSMF",$JOB,"ZZZZTOTAL")),U,5)+1
End DoDot:2
End DoDot:1
+43 QUIT
DISDATA ;
+1 NEW DASHES
+2 SET $PIECE(DASHES,"-",80)=""
+3 NEW INSNAME,INSREC,PAY,ADJ,PAP,REJ,UNI,CNT
+4 DO HEADING
+5 IF '$DATA(^TMP("ABSPOSMF",$JOB))
Begin DoDot:1
+6 WRITE !,"No Medicare D prescriptions found!"
+7 DO ENDRPT^ABSPOSU5()
End DoDot:1
QUIT
+8 SET INSNAME=""
+9 FOR
SET INSNAME=$ORDER(^TMP("ABSPOSMF",$JOB,INSNAME))
IF INSNAME=""
QUIT
Begin DoDot:1
+10 SET INSREC=$GET(^TMP("ABSPOSMF",$JOB,INSNAME))
+11 SET PAY=$PIECE(INSREC,U)
+12 SET ADJ=$PIECE(INSREC,U,2)
+13 SET PAP=$PIECE(INSREC,U,3)
+14 SET REJ=$PIECE(INSREC,U,4)
+15 SET CNT=$PIECE(INSREC,U,5)
+16 IF INSNAME="ZZZZTOTAL"
WRITE !,"TOTAL",!
+17 IF '$TEST
WRITE !,INSNAME,!
+18 WRITE ?20,$JUSTIFY(PAY,10,2)
+19 WRITE ?33,$JUSTIFY(ADJ,10,2)
+20 WRITE ?46,$JUSTIFY(PAP,10,2)
+21 WRITE ?59,$JUSTIFY(REJ,10,2)
+22 WRITE ?72,$JUSTIFY(CNT,7)
+23 WRITE !,DASHES
+24 IF $$EOPQ^ABSPOSU8(3,,"D HEADING^"_$TEXT(+0))
SET INSNAME="ZZZZZ"
End DoDot:1
+25 DO ENDRPT^ABSPOSU5()
+26 WRITE @IOF
+27 QUIT
HEADING ;
+1 WRITE @IOF
+2 NEW RPTDATE
SET RPTDATE=$$NOWEXT^ABSPOSU1
+3 WRITE "TOTALS BY MEDICARE PART D INSURERS (",$TEXT(+0),")",?60,RPTDATE
+4 WRITE !,"For "
+5 NEW Y
SET Y=$PIECE(RANGE,U)
XECUTE ^DD("DD")
WRITE Y
+6 WRITE " through "
+7 SET Y=$PIECE(RANGE,U,2)
XECUTE ^DD("DD")
WRITE Y
+8 WRITE !!,?21,"PAYABLE",?34,"ADJUSTED",?48,"PAPER",?60,"REJECTED",?72,"RX CNT"
+9 WRITE !,DASHES
+10 QUIT
SETTMP ;Build ^TMP global with all Medicare D insurers in the
+1 ;ABSP Insurer file.
+2 ;Set all amounts to zero. Want to report insurers not
+3 ;being used.
+4 KILL ^TMP("ABSPOSMF",$JOB)
+5 NEW INSIEN,INSNAME,FRMIEN,FRMNAME,MPDFLG
+6 SET INSIEN=0
+7 FOR
SET INSIEN=$ORDER(^ABSPEI(INSIEN))
IF 'INSIEN
QUIT
Begin DoDot:1
+8 SET INSNAME=$$GET1^DIQ(9002313.4,INSIEN_",",.01)
+9 IF INSNAME=""
QUIT
+10 ;OIT/CAS/RCS Patch 44 07022012 - Comment next 3 lines, no longer looking for format, HEAT # 71654
+11 ;S FRMIEN=$$GET1^DIQ(9002313.4,INSIEN_",",100.01,"I")
+12 ;Q:FRMIEN="" ;quit if insurer not tied to a format
+13 ;S FRMNAME=$$GET1^DIQ(9002313.4,INSIEN_",",100.01)
+14 ;OIT/CAS/RCS Patch 44 07022012 - Comment next line and look at new location in Insurer file for Medicare Part D flag
+15 ;S MPDFLG=$$GET1^DIQ(9002313.92,FRMIEN_",",1.2)
+16 SET MPDFLG=$$GET1^DIQ(9002313.4,INSIEN_",",100.18)
+17 ;quit if not a Medicare D format
IF MPDFLG'="Y"
QUIT
+18 SET ^TMP("ABSPOSMF",$JOB,INSNAME)="0^0^0^0^0"
End DoDot:1
+19 QUIT
