ABSPOSR6 ;IHS/OIT/SCR - RECOVERED FROM REJECTION REPORT - WRR
;;1.0;PHARMACY POINT OF SALE;**30,34,36,38,39**;JUN 21, 2001;Build 38
; ABSP RPT RECOVERED FROM RJN
; DISPLAYS COST AMOUNT RECOVERED FOR TRANSACTIONS THAT WERE REJECTED AT ONE TIME AND HAVE
; BECOME PAYABLE FOR A RANGE OF RELEASE DATES.
; REMOVED IN PATCH 38
UPD ; UPDATE THE REPORT MASTER FILE IN ABSP
Q
;N ABSPQUIT,ABSPDONE,ABSPQUIT,ABSPPHRM,ABSPTMP,Y,X1,X2,ABSPEND,ABSPSTRT,ABSPDAT,ABSPPRXI
;N ABSPPHMP,ABSPPHMI,ABSPDATP,ABSPDATI,ABSPGRNP,ABSPGRNI,ABSPUSR ;IHS/OIT/SCR 082709 patch 34
;D AUTO^ABSPOSM1()
;S ABSPDONE=0
;S ABSPQUIT=0
;F Q:ABSPDONE=1 D
;.S ABSPSTRT=$$BDT()
;.I ABSPSTRT=-1 D
;..S ABSPQUIT=1
;..S ABSPDONE=1
;..Q
;.Q:ABSPQUIT
;.S ABSPEND=$$EDT()
;.I ABSPEND=-1 D
;..S ABSPQUIT=1
;..S ABSPDONE=1
;..Q
;.Q:ABSPQUIT
;.I ABSPSTRT<0 S ABSPDONE=1 Q
;.I ABSPEND<0 S ABSPDONE=1 Q
;.S X2=ABSPSTRT,X1=ABSPEND D ^%DTC
;.I X<0 D EN^DDIOL("Ending Date is BEFORE Beginning Date Please enter new dates","","!!,*7")
;.I X>=0 S ABSPDONE=1
;.Q
;Q:ABSPQUIT
;S ABSPPHRM=$$CLNC()
;Q:ABSPPHRM=-1
;S ABSPUSR=$$USER() ;IHS/OIT/SCR 083109 patch 34
;D ^XBCLS
;S ABSPTMP=""
;D FIND(ABSPSTRT,ABSPEND,ABSPPHRM,.ABSPTMP) IHS/OIT/SCR 083109 patch 34
;D FIND(ABSPSTRT,ABSPEND,ABSPPHRM,ABSPUSR,.ABSPTMP)
;S Y=ABSPSTRT D DD^%DT S ABSPFROM=Y
;S Y=ABSPEND D DD^%DT S ABSPTO=Y
;I $O(ABSPTMP(""))="" D
;.W !," ****NO RECORDS FOUND FOR DATE RANGE***",!!
;.N DIR
;.S DIR(0)="Y"
;.S DIR("A")="PRINT ANYWAY"
;.D ^DIR
;.I Y'=1 S ABSPQUIT=1
;.Q
;Q:ABSPQUIT
;D DEVSEL
;D PRHDR(ABSPSTRT,ABSPEND)
;S ABSPSDAT=""
;S ABSPGRNP=0,ABSPGRNI=0 ;IHS/OIT/SCR 082709 patch 34
;F S ABSPSDAT=$O(ABSPTMP(ABSPSDAT)) Q:ABSPSDAT="" D
;.S ABSPDATP=0,ABSPDATI=0 ;IHS/OIT/SCR 082709 patch 34
;.S ABSPPHRM=""
;.S Y=ABSPSDAT
;.D DD^%DT
;.W !!?10,"RELEASED DATE: "_Y
;.F S ABSPPHRM=$O(ABSPTMP(ABSPSDAT,ABSPPHRM)) Q:ABSPPHRM="" D
;..S ABSPPHMP=0,ABSPPHMI=0 ;IHS/OIT/SCR 082709 patch 34
;..W !?15,"PHARMACY: "_$P($G(^ABSP(9002313.56,ABSPPHRM,0)),"^",1)
;..I ABSPUSR="ALL" W !,?19,"USER: ALL"
;..I ABSPUSR'="ALL" W !,?19,"USER: "_$P($G(^VA(200,ABSPUSR,0)),"^",1)
;..S ABSPPRXI=""
;..F S ABSPPRXI=$O(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI)) Q:ABSPPRXI="" D
;...W !!,"RX #/REFILL: `"_ABSPPRXI_"/"_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),U,1)
;...S Y=$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",2) D DD^%DT
;...W !?5,"TRANSACTION DATE: "_Y,?40,"RECOVERED BY: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",5)
;...;W !?0,"TOTAL PRICE: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3),?25,"PAID BY INSURER: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4) ;IHS/OIT/SCR 122909 patch 36
;...W !?5,"TOTAL PRICE: "_$FNUMBER($P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3),",",2),?40,"PAID BY INSURER: "_$FNUMBER($P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4),",",2)
;...S ABSPPHMP=ABSPPHMP+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3)
;...S ABSPPHMI=ABSPPHMI+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4)
;...Q
;..;W !!,"TOTAL PRICE FOR PHARMACY: "_ABSPPHMP,?25,"TOTAL PAID BY INSURER FOR PHARMACY: "_ABSPPHMI
;..W !!,"PHARMACY TOTAL "_$FNUMBER(ABSPPHMP,",",2),?40,"INSURER PAID: "_$FNUMBER(ABSPPHMI,",",2)
;..S ABSPDATP=ABSPDATP+ABSPPHMP
;..S ABSPDATI=ABSPDATI+ABSPPHMI
;..Q
;.;W !!,"TOTAL PRICE FOR DATE: "_ABSPPHMP,?25,"TOTAL PAID BY INSURER FOR DATE: "_ABSPPHMI
;.W !!,"DATE TOTAL: "_$FNUMBER(ABSPPHMP,",",2),?40,"TOTAL PAID BY INSURER FOR DATE: "_$FNUMBER(ABSPPHMI,",",2)
;.S ABSPGRNP=ABSPGRNP+ABSPDATP
;.S ABSPGRNI=ABSPGRNI+ABSPDATI
;.Q
;W !!,"GRAND TOTAL PRICE: "_ABSPGRNP,?25,"GRAND TOTAL PAID BY INSURER :"_ABSPGRNI
;W !!,"GRAND TOTAL: "_$FNUMBER(ABSPGRNP,",",2),?40,"GRAND TOTAL INSURER PAID: "_$FNUMBER(ABSPGRNI,",",2)
;D ZEND ;IHS/OIT/SCR 1/4/09 patch 36 close the printer device
;Q
;CLNC() ; PICK WHICH OR ALL CLINIC PHARMACIES
;N DIC,X,Y,ABSPPHRM
;S DIC="^ABSP(9002313.56,"
;S DIC(0)="AEMQVZ"
;S DIC("A")="Please Select a Pharmacy or leave blank for ALL: "
;D ^DIC K DIC
;I X["^" Q -1
;I Y=-1 S ABSPPHRM="ALL"
;I Y>-1 S ABSPPHRM=$P(Y,"^",1)
;Q ABSPPHRM
;USER() ; PICK WHICH OR ALL NEW PESRSON
;IHS/OIT/SCR 083109 patch 34
;N DIC,X,Y,ABSPUSER
;S DIC="^VA(200,"
;S DIC(0)="AEMQVZ"
;S DIC("A")="Please Select a User or leave blank for ALL: "
;D ^DIC K DIC
;I X["^" Q -1
;I Y=-1 S ABSPUSER="ALL"
;I Y>-1 S ABSPUSER=$P(Y,"^",1)
;Q ABSPUSER
;DEVSEL ; SELECT DEVICE
;N ABSPSTOP
;S ABSPSTOP=0
;D ^%ZIS
;I POP D
;.D ^%ZIS
;.Q
;I $D(DUOUT) D
; .D ZEND
;.S ABSPSTOP=1
; .Q
;Q:ABSPSTOP
;I POP D
;.W "DEVICE UNAVAILABLE" G DEVSEL
;Q
;FIND(ABSPSTRT,ABSPEND,ABSPPHRM,ABSPUSR,ABSPTMP) ; FIND PAYABLE CLAIMS IN A DATE RANGE, AND THEN DETERMINE IF THEY WERE REJECTED AT ONE TIME...
;N ABSPDONE,ABSPRDT,ABSPTDAT,ABSPTRXN,ABSPPHM1,APSPTRXI,ABSPRICE,ABSPFND,ABSPRXI,ABSPTRXR,ABSPRXN,ABSPTRXR
;N ABSPUSR1,ABSPUSRN ;IHS/OIT/SCR 083109 patch 34
;;S ABSPUSR1=0
;S ABSPRDT=ABSPSTRT-1
;S ABSPDONE=0
;S ABSPRMI=""
;F S ABSPRDT=$O(^ABSPECX("RPT","B",ABSPRDT)) Q:ABSPRDT=""!ABSPDONE D
;.I ABSPRDT>ABSPEND S ABSPDONE=1 Q
;.F ABSPJ=1:1 S ABSPRMI=$O(^ABSPECX("RPT","B",ABSPRDT,ABSPRMI)) Q:ABSPRMI'=+ABSPRMI D
;..I $P(^ABSPECX("RPT",ABSPRMI,0),U,6)'=4 Q ; NOT A PAYABLE CLAIM
;..S ABSPTRNS=$P(^ABSPECX("RPT",ABSPRMI,0),U,3)
;..S ABSPPHM1=""
;..I ABSPPHRM'="ALL" D
;...I $P(^ABSPTL(ABSPTRNS,1),U,7)'=ABSPPHRM Q ; NOT SELECTED PHARMACY
;...S ABSPPHM1=ABSPPHRM
;...Q
;..I ABSPPHRM="ALL" S ABSPPHM1=$P(^ABSPTL(ABSPTRNS,1),U,7) ; SET PHARMACY
;..I ABSPPHM1="" Q
;..;IHS/OIT/SCR 083109 patch 32 START
;..S ABSPUSR1=-1
;..I ABSPUSR'="ALL" D
;...I $P(^ABSPTL(ABSPTRNS,0),U,17)'=ABSPUSR Q ; NOT SELECTED USER
;...S ABSPUSR1=ABSPUSR
;...Q
;..I ABSPUSR="ALL" S ABSPUSR1=$P(^ABSPTL(ABSPTRNS,1),U,17) ; SET USER
;..I ABSPUSR1=-1 Q
;..;IHS/OIT/SCR 083109 patch 32 END
;..S ABSPTRXI=$P(^ABSPTL(ABSPTRNS,1),U,11)
;..S ABSPTRXR=$P(^ABSPTL(ABSPTRNS,1),U,1)
;..I ABSPTRXI=""!(ABSPTRXR="") Q
;..;NOW WE HAVE A PAYABLE CLAIM...BUT IT ONLY BELONGS ON THIS REPORT IF IT HAS BEEN REJECTED BEFORE
;..;SO....WE HAVE TO LOOK AT THE LOG OF TRANSACTIONS FOR THIS PRESCRIPTION BEFORE THE ONE
;..;WE HAVE IN OUR HANDS...IF THAT ONE WAS REJECTED, PUT THIS INFO ON THE REPORT
;..;Q $O(^ABSPTL("NON-FILEMAN","RXIRXR",RXI,RXR,""),-1) ;FOUND IN ABSPOS57 AND ABSPOSBB
;..S ABSPFND=0
;..S ABSPTRN1=""
;..F S ABSPTRN1=$O(^ABSPTL("NON-FILEMAN","RXIRXR",ABSPTRXI,ABSPTRXR,ABSPTRN1),-1) Q:ABSPTRN1=""!(ABSPFND=1) D
;...S ABSPRWR=$$GET1^DIQ(9002313.57,ABSPTRN1_",","RESULT WITH REVERSAL")
;...S ABSPRESP=$P(^ABSPTL(ABSPTRNS,0),U,5) ;POINTER TO RESPONSE FILE
;...S ABSPPSTN=$P(^ABSPTL(ABSPTRNS,0),U,9) ;POSITION IN CLAIM
;...;I ABSPRWR="E REVERSAL ACCEPTED" D ;IHS/OIT/SCR 122909 patch 36 grab previously REJECTED claims
;...I ABSPRWR="E REJECTED" D
;....S ABSPPAID=0
;....I (ABSPRESP'="")&(ABSPPSTN'="") S ABSPPAID=$$509^ABSPOS03(ABSPRESP,ABSPPSTN) ;(#509) Total Amount Paid
;....S ABSPFND=1
;....S ABSPRXI=$P(^ABSPECX("RPT",ABSPRMI,0),U,4) ;POINTER TO PRESCRIPTION FILE
;....S ABSPRXN=$P($G(^PSRX(ABSPRXI,0)),U,1) ;PRESCRIPTION NUMBER
;....S ABSPTDAT=$P(^ABSPECX("RPT",ABSPRMI,0),U,2) ;TRANSACTION LAST UPDATE
;....S ABSPTRXR=$P(^ABSPECX("RPT",ABSPRMI,0),U,5) ;REFIL NUMBER
;....S ABSPRICE=$P(^ABSPTL(ABSPTRNS,5),U,5) ;TOTAL PRICE
;....S ABSPUSRI=$P(^ABSPTL(ABSPTRNS,0),U,17) ;USER LAST UPDATED - IHS/OIT/SCR 082709 patch 34
;....;S ABSPUSRI=$P(^ABSPTL(ABSPTRNS,0),U,10)
;....S ABSPUSRN=""
;....;S ABSPUSRN=$P($G(^VA(200,ABSPUSRI,0)),"^",1)
;....S:ABSPUSRI>0 ABSPUSRN=$P($G(^VA(200,ABSPUSRI,0)),"^",1)
;....S ABSPTMP(ABSPRDT,ABSPPHM1,ABSPRXI)=ABSPTRXR_"^"_ABSPTDAT_"^"_ABSPRICE_"^"_ABSPPAID_"^"_ABSPUSRN
;....Q
;...Q
;..Q
;.Q
;Q
;PRHDR(ABSPSTRT,ABSPEND) ; PRINT HEADER
;N ABSPFEDT,ABSPFBDT
;U IO W @IOF
;S Y=ABSPSTRT
;D DD^%DT
;S ABSPFBDT=Y
;S Y=ABSPEND
;D DD^%DT
;S ABSPFEDT=Y
;W !,?19,"Pharmacy Point of Recovered from Rejection Report"
;W !?22,"From "_ABSPFBDT_" TO "_ABSPFEDT
;Q
;BDT() ; ENTER BEGINING DATE
;N ABSPBDT,DIR,X1,X
;W !
;K DIR
;S DIR(0)="DEX"
;S DIR("A")="Enter Beginning Prescription Release Date"
;D ^DIR
;I $D(DIRUT) Q -1
;S ABSPBDT=+Y
;S X1=ABSPBDT D C^%DTC
;Q X
;EDT() ; ENTER END DATE
;N ABSPEDT,DIR,X1,X
;W !
;K DIR
;S DIR(0)="DEX"
;S DIR("A")="Enter Ending Prescription Release Date"
;D ^DIR
;I $D(DIRUT) Q -1
;S ABSPEDT=+Y
;S X1=ABSPEDT D C^%DTC
;Q X
;ZEND ;Close the device that was opened
;IHS/OIT/SCR 1/4/09 patch 36
;D ^%ZISC
Q
ABSPOSR6 ;IHS/OIT/SCR - RECOVERED FROM REJECTION REPORT - WRR
+1 ;;1.0;PHARMACY POINT OF SALE;**30,34,36,38,39**;JUN 21, 2001;Build 38
+2 ; ABSP RPT RECOVERED FROM RJN
+3 ; DISPLAYS COST AMOUNT RECOVERED FOR TRANSACTIONS THAT WERE REJECTED AT ONE TIME AND HAVE
+4 ; BECOME PAYABLE FOR A RANGE OF RELEASE DATES.
+5 ; REMOVED IN PATCH 38
UPD ; UPDATE THE REPORT MASTER FILE IN ABSP
+1 QUIT
+2 ;N ABSPQUIT,ABSPDONE,ABSPQUIT,ABSPPHRM,ABSPTMP,Y,X1,X2,ABSPEND,ABSPSTRT,ABSPDAT,ABSPPRXI
+3 ;N ABSPPHMP,ABSPPHMI,ABSPDATP,ABSPDATI,ABSPGRNP,ABSPGRNI,ABSPUSR ;IHS/OIT/SCR 082709 patch 34
+4 ;D AUTO^ABSPOSM1()
+5 ;S ABSPDONE=0
+6 ;S ABSPQUIT=0
+7 ;F Q:ABSPDONE=1 D
+8 ;.S ABSPSTRT=$$BDT()
+9 ;.I ABSPSTRT=-1 D
+10 ;..S ABSPQUIT=1
+11 ;..S ABSPDONE=1
+12 ;..Q
+13 ;.Q:ABSPQUIT
+14 ;.S ABSPEND=$$EDT()
+15 ;.I ABSPEND=-1 D
+16 ;..S ABSPQUIT=1
+17 ;..S ABSPDONE=1
+18 ;..Q
+19 ;.Q:ABSPQUIT
+20 ;.I ABSPSTRT<0 S ABSPDONE=1 Q
+21 ;.I ABSPEND<0 S ABSPDONE=1 Q
+22 ;.S X2=ABSPSTRT,X1=ABSPEND D ^%DTC
+23 ;.I X<0 D EN^DDIOL("Ending Date is BEFORE Beginning Date Please enter new dates","","!!,*7")
+24 ;.I X>=0 S ABSPDONE=1
+25 ;.Q
+26 ;Q:ABSPQUIT
+27 ;S ABSPPHRM=$$CLNC()
+28 ;Q:ABSPPHRM=-1
+29 ;S ABSPUSR=$$USER() ;IHS/OIT/SCR 083109 patch 34
+30 ;D ^XBCLS
+31 ;S ABSPTMP=""
+32 ;D FIND(ABSPSTRT,ABSPEND,ABSPPHRM,.ABSPTMP) IHS/OIT/SCR 083109 patch 34
+33 ;D FIND(ABSPSTRT,ABSPEND,ABSPPHRM,ABSPUSR,.ABSPTMP)
+34 ;S Y=ABSPSTRT D DD^%DT S ABSPFROM=Y
+35 ;S Y=ABSPEND D DD^%DT S ABSPTO=Y
+36 ;I $O(ABSPTMP(""))="" D
+37 ;.W !," ****NO RECORDS FOUND FOR DATE RANGE***",!!
+38 ;.N DIR
+39 ;.S DIR(0)="Y"
+40 ;.S DIR("A")="PRINT ANYWAY"
+41 ;.D ^DIR
+42 ;.I Y'=1 S ABSPQUIT=1
+43 ;.Q
+44 ;Q:ABSPQUIT
+45 ;D DEVSEL
+46 ;D PRHDR(ABSPSTRT,ABSPEND)
+47 ;S ABSPSDAT=""
+48 ;S ABSPGRNP=0,ABSPGRNI=0 ;IHS/OIT/SCR 082709 patch 34
+49 ;F S ABSPSDAT=$O(ABSPTMP(ABSPSDAT)) Q:ABSPSDAT="" D
+50 ;.S ABSPDATP=0,ABSPDATI=0 ;IHS/OIT/SCR 082709 patch 34
+51 ;.S ABSPPHRM=""
+52 ;.S Y=ABSPSDAT
+53 ;.D DD^%DT
+54 ;.W !!?10,"RELEASED DATE: "_Y
+55 ;.F S ABSPPHRM=$O(ABSPTMP(ABSPSDAT,ABSPPHRM)) Q:ABSPPHRM="" D
+56 ;..S ABSPPHMP=0,ABSPPHMI=0 ;IHS/OIT/SCR 082709 patch 34
+57 ;..W !?15,"PHARMACY: "_$P($G(^ABSP(9002313.56,ABSPPHRM,0)),"^",1)
+58 ;..I ABSPUSR="ALL" W !,?19,"USER: ALL"
+59 ;..I ABSPUSR'="ALL" W !,?19,"USER: "_$P($G(^VA(200,ABSPUSR,0)),"^",1)
+60 ;..S ABSPPRXI=""
+61 ;..F S ABSPPRXI=$O(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI)) Q:ABSPPRXI="" D
+62 ;...W !!,"RX #/REFILL: `"_ABSPPRXI_"/"_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),U,1)
+63 ;...S Y=$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",2) D DD^%DT
+64 ;...W !?5,"TRANSACTION DATE: "_Y,?40,"RECOVERED BY: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",5)
+65 ;...;W !?0,"TOTAL PRICE: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3),?25,"PAID BY INSURER: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4) ;IHS/OIT/SCR 122909 patch 36
+66 ;...W !?5,"TOTAL PRICE: "_$FNUMBER($P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3),",",2),?40,"PAID BY INSURER: "_$FNUMBER($P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4),",",2)
+67 ;...S ABSPPHMP=ABSPPHMP+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3)
+68 ;...S ABSPPHMI=ABSPPHMI+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4)
+69 ;...Q
+70 ;..;W !!,"TOTAL PRICE FOR PHARMACY: "_ABSPPHMP,?25,"TOTAL PAID BY INSURER FOR PHARMACY: "_ABSPPHMI
+71 ;..W !!,"PHARMACY TOTAL "_$FNUMBER(ABSPPHMP,",",2),?40,"INSURER PAID: "_$FNUMBER(ABSPPHMI,",",2)
+72 ;..S ABSPDATP=ABSPDATP+ABSPPHMP
+73 ;..S ABSPDATI=ABSPDATI+ABSPPHMI
+74 ;..Q
+75 ;.;W !!,"TOTAL PRICE FOR DATE: "_ABSPPHMP,?25,"TOTAL PAID BY INSURER FOR DATE: "_ABSPPHMI
+76 ;.W !!,"DATE TOTAL: "_$FNUMBER(ABSPPHMP,",",2),?40,"TOTAL PAID BY INSURER FOR DATE: "_$FNUMBER(ABSPPHMI,",",2)
+77 ;.S ABSPGRNP=ABSPGRNP+ABSPDATP
+78 ;.S ABSPGRNI=ABSPGRNI+ABSPDATI
+79 ;.Q
+80 ;W !!,"GRAND TOTAL PRICE: "_ABSPGRNP,?25,"GRAND TOTAL PAID BY INSURER :"_ABSPGRNI
+81 ;W !!,"GRAND TOTAL: "_$FNUMBER(ABSPGRNP,",",2),?40,"GRAND TOTAL INSURER PAID: "_$FNUMBER(ABSPGRNI,",",2)
+82 ;D ZEND ;IHS/OIT/SCR 1/4/09 patch 36 close the printer device
+83 ;Q
+84 ;CLNC() ; PICK WHICH OR ALL CLINIC PHARMACIES
+85 ;N DIC,X,Y,ABSPPHRM
+86 ;S DIC="^ABSP(9002313.56,"
+87 ;S DIC(0)="AEMQVZ"
+88 ;S DIC("A")="Please Select a Pharmacy or leave blank for ALL: "
+89 ;D ^DIC K DIC
+90 ;I X["^" Q -1
+91 ;I Y=-1 S ABSPPHRM="ALL"
+92 ;I Y>-1 S ABSPPHRM=$P(Y,"^",1)
+93 ;Q ABSPPHRM
+94 ;USER() ; PICK WHICH OR ALL NEW PESRSON
+95 ;IHS/OIT/SCR 083109 patch 34
+96 ;N DIC,X,Y,ABSPUSER
+97 ;S DIC="^VA(200,"
+98 ;S DIC(0)="AEMQVZ"
+99 ;S DIC("A")="Please Select a User or leave blank for ALL: "
+100 ;D ^DIC K DIC
+101 ;I X["^" Q -1
+102 ;I Y=-1 S ABSPUSER="ALL"
+103 ;I Y>-1 S ABSPUSER=$P(Y,"^",1)
+104 ;Q ABSPUSER
+105 ;DEVSEL ; SELECT DEVICE
+106 ;N ABSPSTOP
+107 ;S ABSPSTOP=0
+108 ;D ^%ZIS
+109 ;I POP D
+110 ;.D ^%ZIS
+111 ;.Q
+112 ;I $D(DUOUT) D
+113 ; .D ZEND
+114 ;.S ABSPSTOP=1
+115 ; .Q
+116 ;Q:ABSPSTOP
+117 ;I POP D
+118 ;.W "DEVICE UNAVAILABLE" G DEVSEL
+119 ;Q
+120 ;FIND(ABSPSTRT,ABSPEND,ABSPPHRM,ABSPUSR,ABSPTMP) ; FIND PAYABLE CLAIMS IN A DATE RANGE, AND THEN DETERMINE IF THEY WERE REJECTED AT ONE TIME...
+121 ;N ABSPDONE,ABSPRDT,ABSPTDAT,ABSPTRXN,ABSPPHM1,APSPTRXI,ABSPRICE,ABSPFND,ABSPRXI,ABSPTRXR,ABSPRXN,ABSPTRXR
+122 ;N ABSPUSR1,ABSPUSRN ;IHS/OIT/SCR 083109 patch 34
+123 ;;S ABSPUSR1=0
+124 ;S ABSPRDT=ABSPSTRT-1
+125 ;S ABSPDONE=0
+126 ;S ABSPRMI=""
+127 ;F S ABSPRDT=$O(^ABSPECX("RPT","B",ABSPRDT)) Q:ABSPRDT=""!ABSPDONE D
+128 ;.I ABSPRDT>ABSPEND S ABSPDONE=1 Q
+129 ;.F ABSPJ=1:1 S ABSPRMI=$O(^ABSPECX("RPT","B",ABSPRDT,ABSPRMI)) Q:ABSPRMI'=+ABSPRMI D
+130 ;..I $P(^ABSPECX("RPT",ABSPRMI,0),U,6)'=4 Q ; NOT A PAYABLE CLAIM
+131 ;..S ABSPTRNS=$P(^ABSPECX("RPT",ABSPRMI,0),U,3)
+132 ;..S ABSPPHM1=""
+133 ;..I ABSPPHRM'="ALL" D
+134 ;...I $P(^ABSPTL(ABSPTRNS,1),U,7)'=ABSPPHRM Q ; NOT SELECTED PHARMACY
+135 ;...S ABSPPHM1=ABSPPHRM
+136 ;...Q
+137 ;..I ABSPPHRM="ALL" S ABSPPHM1=$P(^ABSPTL(ABSPTRNS,1),U,7) ; SET PHARMACY
+138 ;..I ABSPPHM1="" Q
+139 ;..;IHS/OIT/SCR 083109 patch 32 START
+140 ;..S ABSPUSR1=-1
+141 ;..I ABSPUSR'="ALL" D
+142 ;...I $P(^ABSPTL(ABSPTRNS,0),U,17)'=ABSPUSR Q ; NOT SELECTED USER
+143 ;...S ABSPUSR1=ABSPUSR
+144 ;...Q
+145 ;..I ABSPUSR="ALL" S ABSPUSR1=$P(^ABSPTL(ABSPTRNS,1),U,17) ; SET USER
+146 ;..I ABSPUSR1=-1 Q
+147 ;..;IHS/OIT/SCR 083109 patch 32 END
+148 ;..S ABSPTRXI=$P(^ABSPTL(ABSPTRNS,1),U,11)
+149 ;..S ABSPTRXR=$P(^ABSPTL(ABSPTRNS,1),U,1)
+150 ;..I ABSPTRXI=""!(ABSPTRXR="") Q
+151 ;..;NOW WE HAVE A PAYABLE CLAIM...BUT IT ONLY BELONGS ON THIS REPORT IF IT HAS BEEN REJECTED BEFORE
+152 ;..;SO....WE HAVE TO LOOK AT THE LOG OF TRANSACTIONS FOR THIS PRESCRIPTION BEFORE THE ONE
+153 ;..;WE HAVE IN OUR HANDS...IF THAT ONE WAS REJECTED, PUT THIS INFO ON THE REPORT
+154 ;..;Q $O(^ABSPTL("NON-FILEMAN","RXIRXR",RXI,RXR,""),-1) ;FOUND IN ABSPOS57 AND ABSPOSBB
+155 ;..S ABSPFND=0
+156 ;..S ABSPTRN1=""
+157 ;..F S ABSPTRN1=$O(^ABSPTL("NON-FILEMAN","RXIRXR",ABSPTRXI,ABSPTRXR,ABSPTRN1),-1) Q:ABSPTRN1=""!(ABSPFND=1) D
+158 ;...S ABSPRWR=$$GET1^DIQ(9002313.57,ABSPTRN1_",","RESULT WITH REVERSAL")
+159 ;...S ABSPRESP=$P(^ABSPTL(ABSPTRNS,0),U,5) ;POINTER TO RESPONSE FILE
+160 ;...S ABSPPSTN=$P(^ABSPTL(ABSPTRNS,0),U,9) ;POSITION IN CLAIM
+161 ;...;I ABSPRWR="E REVERSAL ACCEPTED" D ;IHS/OIT/SCR 122909 patch 36 grab previously REJECTED claims
+162 ;...I ABSPRWR="E REJECTED" D
+163 ;....S ABSPPAID=0
+164 ;....I (ABSPRESP'="")&(ABSPPSTN'="") S ABSPPAID=$$509^ABSPOS03(ABSPRESP,ABSPPSTN) ;(#509) Total Amount Paid
+165 ;....S ABSPFND=1
+166 ;....S ABSPRXI=$P(^ABSPECX("RPT",ABSPRMI,0),U,4) ;POINTER TO PRESCRIPTION FILE
+167 ;....S ABSPRXN=$P($G(^PSRX(ABSPRXI,0)),U,1) ;PRESCRIPTION NUMBER
+168 ;....S ABSPTDAT=$P(^ABSPECX("RPT",ABSPRMI,0),U,2) ;TRANSACTION LAST UPDATE
+169 ;....S ABSPTRXR=$P(^ABSPECX("RPT",ABSPRMI,0),U,5) ;REFIL NUMBER
+170 ;....S ABSPRICE=$P(^ABSPTL(ABSPTRNS,5),U,5) ;TOTAL PRICE
+171 ;....S ABSPUSRI=$P(^ABSPTL(ABSPTRNS,0),U,17) ;USER LAST UPDATED - IHS/OIT/SCR 082709 patch 34
+172 ;....;S ABSPUSRI=$P(^ABSPTL(ABSPTRNS,0),U,10)
+173 ;....S ABSPUSRN=""
+174 ;....;S ABSPUSRN=$P($G(^VA(200,ABSPUSRI,0)),"^",1)
+175 ;....S:ABSPUSRI>0 ABSPUSRN=$P($G(^VA(200,ABSPUSRI,0)),"^",1)
+176 ;....S ABSPTMP(ABSPRDT,ABSPPHM1,ABSPRXI)=ABSPTRXR_"^"_ABSPTDAT_"^"_ABSPRICE_"^"_ABSPPAID_"^"_ABSPUSRN
+177 ;....Q
+178 ;...Q
+179 ;..Q
+180 ;.Q
+181 ;Q
+182 ;PRHDR(ABSPSTRT,ABSPEND) ; PRINT HEADER
+183 ;N ABSPFEDT,ABSPFBDT
+184 ;U IO W @IOF
+185 ;S Y=ABSPSTRT
+186 ;D DD^%DT
+187 ;S ABSPFBDT=Y
+188 ;S Y=ABSPEND
+189 ;D DD^%DT
+190 ;S ABSPFEDT=Y
+191 ;W !,?19,"Pharmacy Point of Recovered from Rejection Report"
+192 ;W !?22,"From "_ABSPFBDT_" TO "_ABSPFEDT
+193 ;Q
+194 ;BDT() ; ENTER BEGINING DATE
+195 ;N ABSPBDT,DIR,X1,X
+196 ;W !
+197 ;K DIR
+198 ;S DIR(0)="DEX"
+199 ;S DIR("A")="Enter Beginning Prescription Release Date"
+200 ;D ^DIR
+201 ;I $D(DIRUT) Q -1
+202 ;S ABSPBDT=+Y
+203 ;S X1=ABSPBDT D C^%DTC
+204 ;Q X
+205 ;EDT() ; ENTER END DATE
+206 ;N ABSPEDT,DIR,X1,X
+207 ;W !
+208 ;K DIR
+209 ;S DIR(0)="DEX"
+210 ;S DIR("A")="Enter Ending Prescription Release Date"
+211 ;D ^DIR
+212 ;I $D(DIRUT) Q -1
+213 ;S ABSPEDT=+Y
+214 ;S X1=ABSPEDT D C^%DTC
+215 ;Q X
+216 ;ZEND ;Close the device that was opened
+217 ;IHS/OIT/SCR 1/4/09 patch 36
+218 ;D ^%ZISC
+219 QUIT
