Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSR6

ABSPOSR6.m

Go to the documentation of this file. 
  1. 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
  1.  ; ABSP RPT RECOVERED FROM RJN
  1.  ; DISPLAYS COST AMOUNT RECOVERED FOR TRANSACTIONS THAT WERE REJECTED AT ONE TIME AND HAVE
  1.  ; BECOME PAYABLE FOR A RANGE OF RELEASE DATES.
  1.  ; REMOVED IN PATCH 38
  1. UPD ; UPDATE THE REPORT MASTER FILE IN ABSP
  1.  Q
  1.  ;N ABSPQUIT,ABSPDONE,ABSPQUIT,ABSPPHRM,ABSPTMP,Y,X1,X2,ABSPEND,ABSPSTRT,ABSPDAT,ABSPPRXI
  1.  ;N ABSPPHMP,ABSPPHMI,ABSPDATP,ABSPDATI,ABSPGRNP,ABSPGRNI,ABSPUSR  ;IHS/OIT/SCR 082709 patch 34
  1.  ;D AUTO^ABSPOSM1()
  1.  ;S ABSPDONE=0
  1.  ;S ABSPQUIT=0
  1.  ;F  Q:ABSPDONE=1  D
  1.  ;.S ABSPSTRT=$$BDT()
  1.  ;.I ABSPSTRT=-1 D
  1.  ;..S ABSPQUIT=1
  1.  ;..S ABSPDONE=1
  1.  ;..Q
  1.  ;.Q:ABSPQUIT
  1.  ;.S ABSPEND=$$EDT()
  1.  ;.I ABSPEND=-1 D
  1.  ;..S ABSPQUIT=1
  1.  ;..S ABSPDONE=1
  1.  ;..Q
  1.  ;.Q:ABSPQUIT
  1.  ;.I ABSPSTRT<0 S ABSPDONE=1 Q
  1.  ;.I ABSPEND<0 S ABSPDONE=1 Q
  1.  ;.S X2=ABSPSTRT,X1=ABSPEND D ^%DTC
  1.  ;.I X<0 D EN^DDIOL("Ending Date is BEFORE Beginning Date Please enter new dates","","!!,*7")
  1.  ;.I X>=0 S ABSPDONE=1
  1.  ;.Q
  1.  ;Q:ABSPQUIT
  1.  ;S ABSPPHRM=$$CLNC()
  1.  ;Q:ABSPPHRM=-1
  1.  ;S ABSPUSR=$$USER() ;IHS/OIT/SCR 083109 patch 34
  1.  ;D ^XBCLS
  1.  ;S ABSPTMP=""
  1.  ;D FIND(ABSPSTRT,ABSPEND,ABSPPHRM,.ABSPTMP) IHS/OIT/SCR 083109 patch 34
  1.  ;D FIND(ABSPSTRT,ABSPEND,ABSPPHRM,ABSPUSR,.ABSPTMP)
  1.  ;S Y=ABSPSTRT D DD^%DT S ABSPFROM=Y
  1.  ;S Y=ABSPEND D DD^%DT S ABSPTO=Y
  1.  ;I $O(ABSPTMP(""))="" D
  1.  ;.W !,"      ****NO RECORDS FOUND FOR DATE RANGE***",!!
  1.  ;.N DIR
  1.  ;.S DIR(0)="Y"
  1.  ;.S DIR("A")="PRINT ANYWAY"
  1.  ;.D ^DIR
  1.  ;.I Y'=1 S ABSPQUIT=1
  1.  ;.Q
  1.  ;Q:ABSPQUIT
  1.  ;D DEVSEL
  1.  ;D PRHDR(ABSPSTRT,ABSPEND)
  1.  ;S ABSPSDAT=""
  1.  ;S ABSPGRNP=0,ABSPGRNI=0 ;IHS/OIT/SCR 082709 patch 34
  1.  ;F  S ABSPSDAT=$O(ABSPTMP(ABSPSDAT)) Q:ABSPSDAT=""  D
  1.  ;.S ABSPDATP=0,ABSPDATI=0 ;IHS/OIT/SCR 082709 patch 34
  1.  ;.S ABSPPHRM=""
  1.  ;.S Y=ABSPSDAT
  1.  ;.D DD^%DT
  1.  ;.W !!?10,"RELEASED DATE: "_Y
  1.  ;.F  S ABSPPHRM=$O(ABSPTMP(ABSPSDAT,ABSPPHRM)) Q:ABSPPHRM=""  D
  1.  ;..S ABSPPHMP=0,ABSPPHMI=0 ;IHS/OIT/SCR 082709 patch 34
  1.  ;..W !?15,"PHARMACY: "_$P($G(^ABSP(9002313.56,ABSPPHRM,0)),"^",1)
  1.  ;..I ABSPUSR="ALL" W !,?19,"USER: ALL"
  1.  ;..I ABSPUSR'="ALL" W !,?19,"USER: "_$P($G(^VA(200,ABSPUSR,0)),"^",1)
  1.  ;..S ABSPPRXI=""
  1.  ;..F  S ABSPPRXI=$O(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI)) Q:ABSPPRXI=""  D
  1.  ;...W !!,"RX #/REFILL: `"_ABSPPRXI_"/"_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),U,1)
  1.  ;...S Y=$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",2) D DD^%DT
  1.  ;...W !?5,"TRANSACTION DATE: "_Y,?40,"RECOVERED BY: "_$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",5)
  1.  ;...;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
  1.  ;...W !?5,"TOTAL PRICE: "_$FNUMBER($P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3),",",2),?40,"PAID BY INSURER: "_$FNUMBER($P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4),",",2)
  1.  ;...S ABSPPHMP=ABSPPHMP+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",3)
  1.  ;...S ABSPPHMI=ABSPPHMI+$P(ABSPTMP(ABSPSDAT,ABSPPHRM,ABSPPRXI),"^",4)
  1.  ;...Q
  1.  ;..;W !!,"TOTAL PRICE FOR PHARMACY: "_ABSPPHMP,?25,"TOTAL PAID BY INSURER FOR PHARMACY: "_ABSPPHMI
  1.  ;..W !!,"PHARMACY TOTAL "_$FNUMBER(ABSPPHMP,",",2),?40,"INSURER PAID: "_$FNUMBER(ABSPPHMI,",",2)
  1.  ;..S ABSPDATP=ABSPDATP+ABSPPHMP
  1.  ;..S ABSPDATI=ABSPDATI+ABSPPHMI
  1.  ;..Q
  1.  ;.;W !!,"TOTAL PRICE FOR DATE: "_ABSPPHMP,?25,"TOTAL PAID BY INSURER FOR DATE: "_ABSPPHMI
  1.  ;.W !!,"DATE TOTAL: "_$FNUMBER(ABSPPHMP,",",2),?40,"TOTAL PAID BY INSURER FOR DATE: "_$FNUMBER(ABSPPHMI,",",2)
  1.  ;.S ABSPGRNP=ABSPGRNP+ABSPDATP
  1.  ;.S ABSPGRNI=ABSPGRNI+ABSPDATI
  1.  ;.Q
  1.  ;W !!,"GRAND TOTAL PRICE: "_ABSPGRNP,?25,"GRAND TOTAL PAID BY INSURER :"_ABSPGRNI
  1.  ;W !!,"GRAND TOTAL: "_$FNUMBER(ABSPGRNP,",",2),?40,"GRAND TOTAL INSURER PAID: "_$FNUMBER(ABSPGRNI,",",2)
  1.  ;D ZEND   ;IHS/OIT/SCR 1/4/09 patch 36 close the printer device
  1.  ;Q
  1.  ;CLNC() ; PICK WHICH OR ALL CLINIC PHARMACIES
  1.  ;N DIC,X,Y,ABSPPHRM
  1.  ;S DIC="^ABSP(9002313.56,"
  1.  ;S DIC(0)="AEMQVZ"
  1.  ;S DIC("A")="Please Select a Pharmacy or leave blank for ALL:  "
  1.  ;D ^DIC K DIC
  1.  ;I X["^" Q -1
  1.  ;I Y=-1 S ABSPPHRM="ALL"
  1.  ;I Y>-1 S ABSPPHRM=$P(Y,"^",1)
  1.  ;Q ABSPPHRM
  1.  ;USER() ; PICK WHICH OR ALL NEW PESRSON
  1.  ;IHS/OIT/SCR 083109 patch 34
  1.  ;N DIC,X,Y,ABSPUSER
  1.  ;S DIC="^VA(200,"
  1.  ;S DIC(0)="AEMQVZ"
  1.  ;S DIC("A")="Please Select a User or leave blank for ALL:  "
  1.  ;D ^DIC K DIC
  1.  ;I X["^" Q -1
  1.  ;I Y=-1 S ABSPUSER="ALL"
  1.  ;I Y>-1 S ABSPUSER=$P(Y,"^",1)
  1.  ;Q ABSPUSER
  1.  ;DEVSEL ; SELECT DEVICE
  1.  ;N ABSPSTOP
  1.  ;S ABSPSTOP=0
  1.  ;D ^%ZIS
  1.  ;I POP D
  1.  ;.D ^%ZIS
  1.  ;.Q
  1.  ;I $D(DUOUT) D
  1.  ; .D ZEND
  1.   ;.S ABSPSTOP=1
  1.  ; .Q
  1.  ;Q:ABSPSTOP
  1.  ;I POP D
  1.  ;.W "DEVICE UNAVAILABLE" G DEVSEL
  1.  ;Q
  1.  ;FIND(ABSPSTRT,ABSPEND,ABSPPHRM,ABSPUSR,ABSPTMP) ;  FIND PAYABLE CLAIMS IN A DATE RANGE, AND THEN DETERMINE IF THEY WERE REJECTED AT ONE TIME...
  1.  ;N ABSPDONE,ABSPRDT,ABSPTDAT,ABSPTRXN,ABSPPHM1,APSPTRXI,ABSPRICE,ABSPFND,ABSPRXI,ABSPTRXR,ABSPRXN,ABSPTRXR
  1.  ;N ABSPUSR1,ABSPUSRN ;IHS/OIT/SCR 083109 patch 34
  1.  ;;S ABSPUSR1=0
  1.  ;S ABSPRDT=ABSPSTRT-1
  1.  ;S ABSPDONE=0
  1.  ;S ABSPRMI=""
  1.  ;F  S ABSPRDT=$O(^ABSPECX("RPT","B",ABSPRDT)) Q:ABSPRDT=""!ABSPDONE  D
  1.  ;.I ABSPRDT>ABSPEND S ABSPDONE=1 Q
  1.  ;.F ABSPJ=1:1 S ABSPRMI=$O(^ABSPECX("RPT","B",ABSPRDT,ABSPRMI)) Q:ABSPRMI'=+ABSPRMI  D
  1.  ;..I $P(^ABSPECX("RPT",ABSPRMI,0),U,6)'=4 Q   ; NOT A PAYABLE CLAIM
  1.  ;..S ABSPTRNS=$P(^ABSPECX("RPT",ABSPRMI,0),U,3)
  1.  ;..S ABSPPHM1=""
  1.  ;..I ABSPPHRM'="ALL" D
  1.  ;...I $P(^ABSPTL(ABSPTRNS,1),U,7)'=ABSPPHRM Q   ; NOT SELECTED PHARMACY
  1.  ;...S ABSPPHM1=ABSPPHRM
  1.  ;...Q
  1.  ;..I ABSPPHRM="ALL" S ABSPPHM1=$P(^ABSPTL(ABSPTRNS,1),U,7)    ; SET PHARMACY
  1.  ;..I ABSPPHM1="" Q
  1.  ;..;IHS/OIT/SCR 083109 patch 32 START
  1.  ;..S ABSPUSR1=-1
  1.  ;..I ABSPUSR'="ALL" D
  1.  ;...I $P(^ABSPTL(ABSPTRNS,0),U,17)'=ABSPUSR Q  ; NOT SELECTED USER
  1.  ;...S ABSPUSR1=ABSPUSR
  1.  ;...Q
  1.  ;..I ABSPUSR="ALL" S ABSPUSR1=$P(^ABSPTL(ABSPTRNS,1),U,17)    ; SET USER
  1.  ;..I ABSPUSR1=-1 Q
  1.  ;..;IHS/OIT/SCR 083109 patch 32 END
  1.  ;..S ABSPTRXI=$P(^ABSPTL(ABSPTRNS,1),U,11)
  1.  ;..S ABSPTRXR=$P(^ABSPTL(ABSPTRNS,1),U,1)
  1.  ;..I ABSPTRXI=""!(ABSPTRXR="") Q
  1.  ;..;NOW WE HAVE A PAYABLE CLAIM...BUT IT ONLY BELONGS ON THIS REPORT IF IT HAS BEEN REJECTED BEFORE
  1.  ;..;SO....WE HAVE TO  LOOK AT THE LOG OF TRANSACTIONS FOR THIS PRESCRIPTION BEFORE THE ONE
  1.  ;..;WE HAVE IN OUR HANDS...IF THAT ONE WAS REJECTED, PUT THIS INFO ON THE REPORT
  1.  ;..;Q $O(^ABSPTL("NON-FILEMAN","RXIRXR",RXI,RXR,""),-1)  ;FOUND IN ABSPOS57 AND ABSPOSBB
  1.  ;..S ABSPFND=0
  1.  ;..S ABSPTRN1=""
  1.  ;..F  S ABSPTRN1=$O(^ABSPTL("NON-FILEMAN","RXIRXR",ABSPTRXI,ABSPTRXR,ABSPTRN1),-1) Q:ABSPTRN1=""!(ABSPFND=1)  D
  1.  ;...S ABSPRWR=$$GET1^DIQ(9002313.57,ABSPTRN1_",","RESULT WITH REVERSAL")
  1.  ;...S ABSPRESP=$P(^ABSPTL(ABSPTRNS,0),U,5)  ;POINTER TO RESPONSE FILE
  1.  ;...S ABSPPSTN=$P(^ABSPTL(ABSPTRNS,0),U,9)  ;POSITION IN CLAIM
  1.  ;...;I ABSPRWR="E REVERSAL ACCEPTED" D    ;IHS/OIT/SCR 122909 patch 36 grab previously REJECTED claims
  1.  ;...I ABSPRWR="E REJECTED" D
  1.  ;....S ABSPPAID=0
  1.  ;....I (ABSPRESP'="")&(ABSPPSTN'="") S ABSPPAID=$$509^ABSPOS03(ABSPRESP,ABSPPSTN) ;(#509) Total Amount Paid
  1.  ;....S ABSPFND=1
  1.  ;....S ABSPRXI=$P(^ABSPECX("RPT",ABSPRMI,0),U,4) ;POINTER TO PRESCRIPTION FILE
  1.  ;....S ABSPRXN=$P($G(^PSRX(ABSPRXI,0)),U,1)  ;PRESCRIPTION NUMBER
  1.  ;....S ABSPTDAT=$P(^ABSPECX("RPT",ABSPRMI,0),U,2) ;TRANSACTION LAST UPDATE
  1.  ;....S ABSPTRXR=$P(^ABSPECX("RPT",ABSPRMI,0),U,5) ;REFIL NUMBER
  1.  ;....S ABSPRICE=$P(^ABSPTL(ABSPTRNS,5),U,5)  ;TOTAL PRICE
  1.  ;....S ABSPUSRI=$P(^ABSPTL(ABSPTRNS,0),U,17) ;USER LAST UPDATED - IHS/OIT/SCR 082709 patch 34
  1.  ;....;S ABSPUSRI=$P(^ABSPTL(ABSPTRNS,0),U,10)
  1.  ;....S ABSPUSRN=""
  1.  ;....;S ABSPUSRN=$P($G(^VA(200,ABSPUSRI,0)),"^",1)
  1.  ;....S:ABSPUSRI>0 ABSPUSRN=$P($G(^VA(200,ABSPUSRI,0)),"^",1)
  1.  ;....S ABSPTMP(ABSPRDT,ABSPPHM1,ABSPRXI)=ABSPTRXR_"^"_ABSPTDAT_"^"_ABSPRICE_"^"_ABSPPAID_"^"_ABSPUSRN
  1.  ;....Q
  1.  ;...Q
  1.  ;..Q
  1.  ;.Q
  1.  ;Q
  1.  ;PRHDR(ABSPSTRT,ABSPEND) ; PRINT HEADER
  1.  ;N ABSPFEDT,ABSPFBDT
  1.  ;U IO W @IOF
  1.  ;S Y=ABSPSTRT
  1.  ;D DD^%DT
  1.  ;S ABSPFBDT=Y
  1.  ;S Y=ABSPEND
  1.  ;D DD^%DT
  1.  ;S ABSPFEDT=Y
  1.  ;W !,?19,"Pharmacy Point of Recovered from Rejection Report"
  1.  ;W !?22,"From "_ABSPFBDT_" TO "_ABSPFEDT
  1.  ;Q
  1.  ;BDT()  ; ENTER BEGINING DATE
  1.  ;N ABSPBDT,DIR,X1,X
  1.  ;W !
  1.  ;K DIR
  1.  ;S DIR(0)="DEX"
  1.  ;S DIR("A")="Enter Beginning Prescription Release Date"
  1.  ;D ^DIR
  1.  ;I $D(DIRUT) Q -1
  1.  ;S ABSPBDT=+Y
  1.  ;S X1=ABSPBDT D C^%DTC
  1.  ;Q X
  1.  ;EDT()  ; ENTER END DATE
  1.  ;N ABSPEDT,DIR,X1,X
  1.  ;W !
  1.  ;K DIR
  1.  ;S DIR(0)="DEX"
  1.  ;S DIR("A")="Enter Ending Prescription Release Date"
  1.  ;D ^DIR
  1.  ;I $D(DIRUT) Q -1
  1.  ;S ABSPEDT=+Y
  1.  ;S X1=ABSPEDT D C^%DTC
  1.  ;Q X
  1.  ;ZEND   ;Close the device that was opened
  1.  ;IHS/OIT/SCR 1/4/09 patch 36
  1.  ;D ^%ZISC
  1.  Q