ABSPOSRT ;IHS/OIT/CNI/RAN - Transaction History Report
;;1.0;PHARMACY POINT OF SALE;**40,47**;JUN 21, 2001;Build 38
; ABSP TRANSACTION HISTORY REPORT
; DISPLAYS ALL TRANSACTIONS FOR A GIVEN PRESCRIPTION
EN ;
N ABSPQUIT,ABSPDONE,ABSPSTRT,ABSPEND,ABSPLCNT,ABSPREJ,ABSPRJ,U,ABSPTMP,ABSPTMPC,ABSPCLM,ABSPUSER,ABSPPPHM,X
S U="^"
I $D(ZTQPARAM) D START
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: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 ABSPQUIT=$$CLNC^ABSPOSUU()
Q:ABSPQUIT=-1
S ABSPQUIT=$$USER^ABSPOSUU()
D DEVSEL
Q:ABSPQUIT=-1
D ^XBCLS
D FIND
D NEXT
Q
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 ; FIND TRANSACTIONS BY TRANSACTION DATE USING "AH" CROSS REFERENCE
N ABSPRDT,ABSPDONE,ABSPDONE,ABSPTRN,ABSPTPTL,ABSPRESC,ABSPRESP
S ABSPRDT=ABSPSTRT
S ABSPEND=ABSPEND_".99999999"
S ABSPDONE=0
;GO THROUGH INDEX BY TRANSACTION DATE
F S ABSPRDT=$O(^ABSPTL("AH",ABSPRDT)) Q:(ABSPRDT="")!(ABSPDONE)!(+ABSPRDT=0) D
.I ABSPRDT>ABSPEND S ABSPDONE=1 Q
.S ABSPTRN=""
.F S ABSPTRN=$O(^ABSPTL("AH",ABSPRDT,ABSPTRN)) Q:(ABSPTRN="")!(ABSPDONE) D
..S ABSPRESC=$P(^ABSPTL(ABSPTRN,0),U)
..D GETINFO($P(ABSPRDT,"."),ABSPTRN,ABSPRESC)
Q
GETINFO(ABSPRDT,ABSPTRN,ABSPRESC) ;GET ALL INFO FOR THIS PARTICULAR TRANSACTION
N ABSPTPTL,ABSPPRI,DO,ABSPTYPI,ABSPTTYP,ABSPRNUM,ABSPREA,ABSPBAMT,ABSPPHM1,ABSPPAID,ABSPUSR1,ABSPCLMI,ABSPORIG,ABSP9PTL,ABSP1PTL,ABSPTDT,ABSPTL
M ABSPTL(ABSPTRN)=^ABSPTL(ABSPTRN)
S ABSPTPTL=ABSPTL(ABSPTRN,0)
S ABSP1PTL=ABSPTL(ABSPTRN,1)
S ABSP9PTL=$G(ABSPTL(ABSPTRN,9))
S ABSPPRI=$P(ABSPTPTL,U,5)
S ABSPCLMI=$P(ABSPTPTL,U,4)
I ABSPPRI="" D ;NON ELECTRONIC...THIS IS A PAPER CLAIM
. S ABSPTTYP="PAPER"
. S (ABSPRNUM,ABSPREA)=""
. S ABSPPAID=0
. I '$D(ABSPTL(ABSPTRN,5)) S ABSPTTYP="REVERSED",ABSPBAMT=0
S ABSPPHM1=$P(ABSP1PTL,U,7) ; SET PHARMACY
I (ABSPPPHM'="ALL")&&(ABSPPHM1'=ABSPPPHM) Q ; NOT SELECTED PHARMACY
I ABSPPHM1="" S ABSPPHM1=ABSPPPHM
S ABSPUSR1=$P(ABSPTPTL,U,17)
I (ABSPUSER'="ALL"),(ABSPUSR1'=ABSPUSER) Q ; NOT SELECTED USER
I ABSPUSR1="" S ABSPUSR1=ABSPUSER
I $D(ABSPTL(ABSPTRN,5)) S ABSPBAMT=$P(ABSPTL(ABSPTRN,5),U,5) ;Billed amount
ELSE S ABSPBAMT=0
I ABSPPRI'="" D ;SKIP ALL THIS IF WE HAVE PAPER CLAIM
.S DO=$P(ABSPTPTL,U,9)
.I '$D(^ABSPR(ABSPPRI,1000,DO)) S DO=$$GETDO^ABSPOSUU(ABSPPRI,$P(ABSPRESC,"."))
.Q:DO=""
.S ABSPTYPI=$P(^ABSPR(ABSPPRI,1000,DO,500),U)
.S ABSPTTYP=$S(ABSPTYPI="P":"PAYABLE",ABSPTYPI="R":"REJECTED",ABSPTYPI="D":"DUPLICATE",1:"PAPER")
.S (ABSPRNUM,ABSPREA)=""
.I ABSPTYPI="R" D
.. I '$D(^ABSPR(ABSPPRI,1000,DO,511)) S (ABSPRNUM,ABSPREA)="UKN" ;Added to skip junk data in PMAA test area
.. E D
... S ABSPRNUM=$P(^ABSPR(ABSPPRI,1000,DO,511,1,0),U)
... I '$D(^ABSPF(9002313.93,"B",ABSPRNUM)) S ABSPREA="Reject Code description not entered,See NCPDP Rejects" Q ;IHS/OIT/RCS PATCH 47
... S ABSPREA=$P(^ABSPF(9002313.93,$O(^ABSPF(9002313.93,"B",ABSPRNUM,"")),0),U,2)
.. S ABSPPAID=0
.I ABSPTYPI="P" D
..S ABSPPAID=$$DFF2EXT^ABSPECFM($P(^ABSPR(ABSPPRI,1000,DO,500),U,9)),ABSPRESP(ABSPPRI)=""
..S (ABSPRNUM,ABSPREA)=""
.I ABSPTYPI="D" S ABSPPAID=0
I ABSP9PTL'="" D
. S ABSPTDT=$P(ABSPTPTL,U,8)
. I $P(ABSP9PTL,U)=1 S ABSPTTYP="CLOSED",ABSPRNUM="",ABSPREA="",ABSPBAMT=0,ABSPPAID=0
. I ($P(ABSP9PTL,U)=0)&($P(ABSP9PTL,U,4)=ABSPTDT) S ABSPTTYP="REOPENED"
Q:$G(ABSPTTYP)=""
I '$D(ABSPTMPC(ABSPRESC)) S ABSPTMPC(ABSPRESC)=1
E S ABSPTMPC(ABSPRESC)=ABSPTMPC(ABSPRESC)+1
S ^TMP("ABSPOSRT",$J,ABSPRDT,ABSPPHM1,ABSPUSR1,ABSPRESC,ABSPTRN)=ABSPTMPC(ABSPRESC)_U_ABSPTTYP_U_ABSPRNUM_U_ABSPREA_U_ABSPBAMT_U_ABSPPAID_U_ABSPPRI
S ABSPCLM(ABSPRESC)=ABSPCLMI
Q
NEXT ; WHAT TO DO NEXT
N ABSPSTOP,ABSPOUT
S (ABSPSTOP,ABSPOUT)=0
D PRHDR
I $O(^TMP("ABSPOSRT",$J,""))="" D
.W !!," NO TRANSACTIONS FOUND FOR THE SELECTED DATE(S)"
.D ZEND
.S ABSPSTOP=1
.Q
Q:ABSPSTOP
I ABSPOUT D ZEND Q
D PRNTDTL
D ZEND
Q
PRHDR ; PRINT HEADER
N ABSPFEDT,ABSPFBDT,Y
U IO W:$D(ABSPSUM) @IOF
S Y=ABSPSTRT
D DD^%DT
S ABSPFBDT=Y
S Y=$P(ABSPEND,".")
D DD^%DT
S ABSPFEDT=Y
W @IOF
W !,?16,"Pharmacy Point of Sale Transaction History Report"
W !?22,"From: "_ABSPFBDT_" TO: "_ABSPFEDT
W !?18,"Pharmacy: "_ABSPPPHM
W !?22,"User: "_ABSPUSER
Q
PRNTDHD ; PRINT HEADER
;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
S ABSPOUT=$$WRITE^ABSPOSUU("!,""SUBMISSION"",?14,""STATUS"",?25,""REJ"",?30,""REJ REASON"",?58,""BILLED AMT"",?70,""PAID AMT""")
Q:ABSPOUT
Q
PRNTDTL ; PRINT DETAIL
N ABSPTRDT,ABSPOUT,Y,ABSPFRDT,ABSPPPHM,ABSPPHMN,ABSPRESC,ABSPTRN,STRING,ABSPSUB,ABSPTYP,ABSPRJCD,ABSPREA,ABSPBAMT,ABSPPAID,ABSPUSRN
N ABSPRXGT,ABSPSBGT,ABSPAYGT,ABSPDATE,ABSPUSR,ABSPHARM,ABSPRESP,ABSPREST,ABSPAID1,ABSPUSER,ABSPCLMI,ABSPPRI,ABSPPRX,ABSPPRXR,ABSPOTH
S (ABSPRXGT,ABSPSBGT,ABSPAYGT)=0
S (ABSPTRDT,ABSPOUT)=""
F S ABSPTRDT=$O(^TMP("ABSPOSRT",$J,ABSPTRDT)) Q:(ABSPTRDT="")!(ABSPOUT) D
.M ABSPTMP(ABSPTRDT)=^TMP("ABSPOSRT",$J,ABSPTRDT)
.S ABSPPPHM=""
.S Y=ABSPTRDT
.D DD^%DT
.S ABSPFRDT=Y ; FORMATTED DATE
.S ABSPPPHM=""
.F S ABSPPPHM=$O(ABSPTMP(ABSPTRDT,ABSPPPHM)) Q:(ABSPPPHM="")!(ABSPOUT) D
..S ABSPPHMN=$P($G(^ABSP(9002313.56,ABSPPPHM,0)),U,1)
..I ABSPPHMN="" S ABSPPHMN="UKN"
..Q:ABSPOUT
..;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
..S ABSPOUT=$$WRITE^ABSPOSUU("!!,?5,""PHARMACY: "",ABSPPHMN,"" TRANSACTION DATE: "",ABSPFRDT")
..Q:ABSPOUT
..S ABSPUSER=""
..F S ABSPUSER=$O(ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER)) Q:(ABSPUSER="")!(ABSPOUT) D
...S ABSPUSRN="UKN"
...S:ABSPUSER>0 ABSPUSRN=$P($G(^VA(200,ABSPUSER,0)),"^",1)
...S ABSPOUT=$$WRITE^ABSPOSUU("!!,?5,""POS USER: "",ABSPUSRN")
...Q:ABSPOUT
...S ABSPRESC=""
...F S ABSPRESC=$O(ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER,ABSPRESC)) Q:(ABSPRESC="")!(ABSPOUT) D
....I '$D(ABSPREST(ABSPRESC)) D
.....S ABSPRXGT=ABSPRXGT+1
.....S ABSPREST(ABSPRESC)=""
....S ABSPDATE(ABSPTRDT,"RX")=$G(ABSPDATE(ABSPTRDT,"RX"))+1
....S ABSPHARM(ABSPTRDT,ABSPPPHM,"RX")=$G(ABSPHARM(ABSPTRDT,ABSPPPHM,"RX"))+1
....S ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"RX")=$G(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"RX"))+1
....S ABSPPRX=$P(ABSPRESC,".")
....S ABSPCLMI=ABSPCLM(ABSPRESC)
....I ABSPCLMI="" S ABSPPRXR=0
....E S ABSPPRXR=$P($P(^ABSPC(ABSPCLMI,400,$P(^ABSPC(ABSPCLMI,400,0),U,3),400),U,3),"D3",2)
....S ABSPOTH=$$OTHERS(ABSPRESC,ABSPSTRT,ABSPEND)
....I ABSPOTH S ABSPPRXR=ABSPPRXR_" **"
....S ABSPOUT=$$WRITE^ABSPOSUU("!!,?25,""RX/REFILL: "",ABSPPRX,""/"",ABSPPRXR")
....Q:ABSPOUT
....D PRNTDHD
....S ABSPTRN=""
....F S ABSPTRN=$O(ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER,ABSPRESC,ABSPTRN)) Q:(ABSPTRN="")!(ABSPOUT) D
.....S ABSPSBGT=ABSPSBGT+1
.....S ABSPDATE(ABSPTRDT,"SUB")=$G(ABSPDATE(ABSPTRDT,"SUB"))+1
.....S ABSPHARM(ABSPTRDT,ABSPPPHM,"SUB")=$G(ABSPHARM(ABSPTRDT,ABSPPPHM,"SUB"))+1
.....S ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"SUB")=$G(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"SUB"))+1
.....S STRING=ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER,ABSPRESC,ABSPTRN)
.....S ABSPSUB=$P(STRING,U)
.....S ABSPTYP=$P(STRING,U,2)
.....S ABSPRJCD=$P(STRING,U,3)
.....S ABSPREA=$P(STRING,U,4)
.....S ABSPBAMT=$P(STRING,U,5)
.....S ABSPPAID=$P(STRING,U,6)
.....S ABSPPRI=$P(STRING,U,7)
.....I (ABSPPRI'="")&&('$D(ABSPRESP(ABSPPRI))) D
......S ABSPAID1=ABSPPAID
......S ABSPRESP(ABSPPRI)=""
.....E S ABSPAID1=0
.....S ABSPAYGT=ABSPAYGT+ABSPPAID
.....S ABSPDATE(ABSPTRDT,"PAY")=$G(ABSPDATE("DT",ABSPTRDT,"PAY"))+ABSPAID1
.....S ABSPHARM(ABSPTRDT,ABSPPPHM,"PAY")=$G(ABSPHARM(ABSPTRDT,ABSPPPHM,"PAY"))+ABSPAID1
.....S ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"PAY")=$G(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"PAY"))+ABSPAID1
.....S ABSPOUT=$$WRITE^ABSPOSUU("!,ABSPSUB,?14,ABSPTYP,?25,ABSPRJCD,?30,ABSPREA,?58,$J($FN(ABSPBAMT,"","",2),10),?70,$J($FN(ABSPPAID,"","",2),8)")
....Q:ABSPOUT
....I ABSPOTH S ABSPOUT=$$WRITE^ABSPOSUU("!!,""`**` Denotes this prescription has additional transactions "",!,?5,""outside the date range of this report.""")
...Q:ABSPOUT
...S ABSPOUT=$$WRITE^ABSPOSUU("!!,""FOR USER "",ABSPUSRN,"":""")
...Q:ABSPOUT
...S ABSPOUT=$$WRITE^ABSPOSUU("!,""Prescriptions: "",ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,""RX"")")
...Q:ABSPOUT
...S ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,""SUB"")")
...Q:ABSPOUT
...S ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,""PAY""),"","",2),6)")
...Q:ABSPOUT
..Q:ABSPOUT
..S ABSPOUT=$$WRITE^ABSPOSUU("!!,""FOR PHARMACY "",ABSPPHMN,"":""")
..Q:ABSPOUT
..S ABSPOUT=$$WRITE^ABSPOSUU("!,""Prescriptions: "",ABSPHARM(ABSPTRDT,ABSPPPHM,""RX"")")
..Q:ABSPOUT
..S ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPHARM(ABSPTRDT,ABSPPPHM,""SUB"")")
..Q:ABSPOUT
..S ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPHARM(ABSPTRDT,ABSPPPHM,""PAY""),"","",2),6)")
..Q:ABSPOUT
.K ABSPTMP(ABSPTRDT)
.Q:ABSPOUT
.S ABSPOUT=$$WRITE^ABSPOSUU("!!,""FOR TRANSACTION DATE "",ABSPFRDT,"":""")
.Q:ABSPOUT
.S ABSPOUT=$$WRITE^ABSPOSUU("!,""Prescriptions: "",ABSPDATE(ABSPTRDT,""RX"")")
.Q:ABSPOUT
.S ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPDATE(ABSPTRDT,""SUB"")")
.Q:ABSPOUT
.S ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPDATE(ABSPTRDT,""PAY""),"","",2),6)")
.Q:ABSPOUT
S ABSPOUT=$$WRITE^ABSPOSUU("!!!,""Report Totals:""")
Q:ABSPOUT
S ABSPOUT=$$WRITE^ABSPOSUU("!!!,""Prescriptions: "",ABSPRXGT")
Q:ABSPOUT
S ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPSBGT")
Q:ABSPOUT
S ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPAYGT,"","",2),6)")
Q:ABSPOUT
Q
ZEND ; END AND KILL VARIABLES
K ^TMP("ABSPOSRT",$J)
D ^%ZISC
Q
START ;
N X,Y,ABSPJ,ABSPRJC,ABSPPAT,ABSPPIEN
I $D(ZTQPARAM) D
.I $P(ZTQPARAM,";",1)["T-1" S ABSPSTRT=DT-1
.I $P(ZTQPARAM,";",2)["T-1" S ABSPEND=DT-1
.S ABSPINS="ALL"
.S ABSPPPHM="ALL"
.S ABSPRTYP="D"
.D FIND
.D ZEND
.Q
Q
BDT() ; ENTER BEGINING DATE
N ABSPBDT,DIR,X1,X,Y
W !
K DIR
S DIR(0)="DEX"
S DIR("A")="Enter Beginning POS Transaction 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,Y
W !
K DIR
S DIR(0)="DEX"
S DIR("A")="Enter Ending POS Transaction Date"
D ^DIR
I $D(DIRUT) Q -1
S ABSPEDT=+Y
S X1=ABSPEDT D C^%DTC
Q X
OTHERS(ABSPRESC,ABSPSTRT,ABSPEND) ;CHECK FOR OTHER TRANSACTIONS OUTSIDE DATE RANGE
;See if there are any transactions outside the date range
N X,ABSPTRN,ABSPDT,DONE
S ABSPTRN=""
S (X,DONE)=0
F S ABSPTRN=$O(^ABSPTL("B",ABSPRESC,ABSPTRN)) Q:(ABSPTRN="")!(DONE) D
. S ABSPDT=$P(^ABSPTL(ABSPTRN,0),U,8)
. I (ABSPDT<ABSPSTRT)!(ABSPDT>ABSPEND) S (X,DONE)=1
Q X
ABSPOSRT ;IHS/OIT/CNI/RAN - Transaction History Report
+1 ;;1.0;PHARMACY POINT OF SALE;**40,47**;JUN 21, 2001;Build 38
+2 ; ABSP TRANSACTION HISTORY REPORT
+3 ; DISPLAYS ALL TRANSACTIONS FOR A GIVEN PRESCRIPTION
EN ;
+1 NEW ABSPQUIT,ABSPDONE,ABSPSTRT,ABSPEND,ABSPLCNT,ABSPREJ,ABSPRJ,U,ABSPTMP,ABSPTMPC,ABSPCLM,ABSPUSER,ABSPPPHM,X
+2 SET U="^"
+3 IF $DATA(ZTQPARAM)
DO START
+4 SET ABSPDONE=0
+5 SET ABSPQUIT=0
+6 FOR
IF ABSPDONE=1
QUIT
Begin DoDot:1
+7 SET ABSPSTRT=$$BDT()
+8 IF ABSPSTRT=-1
Begin DoDot:2
+9 SET ABSPQUIT=1
+10 SET ABSPDONE=1
End DoDot:2
+11 IF ABSPQUIT
QUIT
+12 SET ABSPEND=$$EDT()
+13 IF ABSPEND=-1
Begin DoDot:2
+14 SET ABSPQUIT=1
+15 SET ABSPDONE=1
+16 QUIT
End DoDot:2
+17 IF ABSPQUIT
QUIT
+18 IF ABSPSTRT<0
SET ABSPDONE=1
QUIT
+19 IF ABSPEND<0
SET ABSPDONE=1
QUIT
+20 SET X2=ABSPSTRT
SET X1=ABSPEND
DO ^%DTC
+21 IF X<0
DO EN^DDIOL("Ending Date is BEFORE Beginning Date Please enter new dates","","!!,*7")
+22 IF X>=0
SET ABSPDONE=1
+23 QUIT
End DoDot:1
+24 IF ABSPQUIT
QUIT
+25 SET ABSPQUIT=$$CLNC^ABSPOSUU()
+26 IF ABSPQUIT=-1
QUIT
+27 SET ABSPQUIT=$$USER^ABSPOSUU()
+28 DO DEVSEL
+29 IF ABSPQUIT=-1
QUIT
+30 DO ^XBCLS
+31 DO FIND
+32 DO NEXT
+33 QUIT
DEVSEL ; SELECT DEVICE
+1 NEW ABSPSTOP
+2 SET ABSPSTOP=0
+3 DO ^%ZIS
+4 IF POP
Begin DoDot:1
+5 DO ^%ZIS
+6 QUIT
End DoDot:1
+7 IF $DATA(DUOUT)
Begin DoDot:1
+8 DO ZEND
+9 SET ABSPSTOP=1
+10 QUIT
End DoDot:1
+11 IF ABSPSTOP
QUIT
+12 IF POP
Begin DoDot:1
+13 WRITE "DEVICE UNAVAILABLE"
GOTO DEVSEL
End DoDot:1
+14 QUIT
FIND ; FIND TRANSACTIONS BY TRANSACTION DATE USING "AH" CROSS REFERENCE
+1 NEW ABSPRDT,ABSPDONE,ABSPDONE,ABSPTRN,ABSPTPTL,ABSPRESC,ABSPRESP
+2 SET ABSPRDT=ABSPSTRT
+3 SET ABSPEND=ABSPEND_".99999999"
+4 SET ABSPDONE=0
+5 ;GO THROUGH INDEX BY TRANSACTION DATE
+6 FOR
SET ABSPRDT=$ORDER(^ABSPTL("AH",ABSPRDT))
IF (ABSPRDT="")!(ABSPDONE)!(+ABSPRDT=0)
QUIT
Begin DoDot:1
+7 IF ABSPRDT>ABSPEND
SET ABSPDONE=1
QUIT
+8 SET ABSPTRN=""
+9 FOR
SET ABSPTRN=$ORDER(^ABSPTL("AH",ABSPRDT,ABSPTRN))
IF (ABSPTRN="")!(ABSPDONE)
QUIT
Begin DoDot:2
+10 SET ABSPRESC=$PIECE(^ABSPTL(ABSPTRN,0),U)
+11 DO GETINFO($PIECE(ABSPRDT,"."),ABSPTRN,ABSPRESC)
End DoDot:2
End DoDot:1
+12 QUIT
GETINFO(ABSPRDT,ABSPTRN,ABSPRESC) ;GET ALL INFO FOR THIS PARTICULAR TRANSACTION
+1 NEW ABSPTPTL,ABSPPRI,DO,ABSPTYPI,ABSPTTYP,ABSPRNUM,ABSPREA,ABSPBAMT,ABSPPHM1,ABSPPAID,ABSPUSR1,ABSPCLMI,ABSPORIG,ABSP9PTL,ABSP1PTL,ABSPTDT,ABSPTL
+2 MERGE ABSPTL(ABSPTRN)=^ABSPTL(ABSPTRN)
+3 SET ABSPTPTL=ABSPTL(ABSPTRN,0)
+4 SET ABSP1PTL=ABSPTL(ABSPTRN,1)
+5 SET ABSP9PTL=$GET(ABSPTL(ABSPTRN,9))
+6 SET ABSPPRI=$PIECE(ABSPTPTL,U,5)
+7 SET ABSPCLMI=$PIECE(ABSPTPTL,U,4)
+8 ;NON ELECTRONIC...THIS IS A PAPER CLAIM
IF ABSPPRI=""
Begin DoDot:1
+9 SET ABSPTTYP="PAPER"
+10 SET (ABSPRNUM,ABSPREA)=""
+11 SET ABSPPAID=0
+12 IF '$DATA(ABSPTL(ABSPTRN,5))
SET ABSPTTYP="REVERSED"
SET ABSPBAMT=0
End DoDot:1
+13 ; SET PHARMACY
SET ABSPPHM1=$PIECE(ABSP1PTL,U,7)
+14 ; NOT SELECTED PHARMACY
IF (ABSPPPHM'="ALL")&&(ABSPPHM1'=ABSPPPHM)
QUIT
+15 IF ABSPPHM1=""
SET ABSPPHM1=ABSPPPHM
+16 SET ABSPUSR1=$PIECE(ABSPTPTL,U,17)
+17 ; NOT SELECTED USER
IF (ABSPUSER'="ALL")
IF (ABSPUSR1'=ABSPUSER)
QUIT
+18 IF ABSPUSR1=""
SET ABSPUSR1=ABSPUSER
+19 ;Billed amount
IF $DATA(ABSPTL(ABSPTRN,5))
SET ABSPBAMT=$PIECE(ABSPTL(ABSPTRN,5),U,5)
+20 IF '$TEST
SET ABSPBAMT=0
+21 ;SKIP ALL THIS IF WE HAVE PAPER CLAIM
IF ABSPPRI'=""
Begin DoDot:1
+22 SET DO=$PIECE(ABSPTPTL,U,9)
+23 IF '$DATA(^ABSPR(ABSPPRI,1000,DO))
SET DO=$$GETDO^ABSPOSUU(ABSPPRI,$PIECE(ABSPRESC,"."))
+24 IF DO=""
QUIT
+25 SET ABSPTYPI=$PIECE(^ABSPR(ABSPPRI,1000,DO,500),U)
+26 SET ABSPTTYP=$SELECT(ABSPTYPI="P":"PAYABLE",ABSPTYPI="R":"REJECTED",ABSPTYPI="D":"DUPLICATE",1:"PAPER")
+27 SET (ABSPRNUM,ABSPREA)=""
+28 IF ABSPTYPI="R"
Begin DoDot:2
+29 ;Added to skip junk data in PMAA test area
IF '$DATA(^ABSPR(ABSPPRI,1000,DO,511))
SET (ABSPRNUM,ABSPREA)="UKN"
+30 IF '$TEST
Begin DoDot:3
+31 SET ABSPRNUM=$PIECE(^ABSPR(ABSPPRI,1000,DO,511,1,0),U)
+32 ;IHS/OIT/RCS PATCH 47
IF '$DATA(^ABSPF(9002313.93,"B",ABSPRNUM))
SET ABSPREA="Reject Code description not entered,See NCPDP Rejects"
QUIT
+33 SET ABSPREA=$PIECE(^ABSPF(9002313.93,$ORDER(^ABSPF(9002313.93,"B",ABSPRNUM,"")),0),U,2)
End DoDot:3
+34 SET ABSPPAID=0
End DoDot:2
+35 IF ABSPTYPI="P"
Begin DoDot:2
+36 SET ABSPPAID=$$DFF2EXT^ABSPECFM($PIECE(^ABSPR(ABSPPRI,1000,DO,500),U,9))
SET ABSPRESP(ABSPPRI)=""
+37 SET (ABSPRNUM,ABSPREA)=""
End DoDot:2
+38 IF ABSPTYPI="D"
SET ABSPPAID=0
End DoDot:1
+39 IF ABSP9PTL'=""
Begin DoDot:1
+40 SET ABSPTDT=$PIECE(ABSPTPTL,U,8)
+41 IF $PIECE(ABSP9PTL,U)=1
SET ABSPTTYP="CLOSED"
SET ABSPRNUM=""
SET ABSPREA=""
SET ABSPBAMT=0
SET ABSPPAID=0
+42 IF ($PIECE(ABSP9PTL,U)=0)&($PIECE(ABSP9PTL,U,4)=ABSPTDT)
SET ABSPTTYP="REOPENED"
End DoDot:1
+43 IF $GET(ABSPTTYP)=""
QUIT
+44 IF '$DATA(ABSPTMPC(ABSPRESC))
SET ABSPTMPC(ABSPRESC)=1
+45 IF '$TEST
SET ABSPTMPC(ABSPRESC)=ABSPTMPC(ABSPRESC)+1
+46 SET ^TMP("ABSPOSRT",$JOB,ABSPRDT,ABSPPHM1,ABSPUSR1,ABSPRESC,ABSPTRN)=ABSPTMPC(ABSPRESC)_U_ABSPTTYP_U_ABSPRNUM_U_ABSPREA_U_ABSPBAMT_U_ABSPPAID_U_ABSPPRI
+47 SET ABSPCLM(ABSPRESC)=ABSPCLMI
+48 QUIT
NEXT ; WHAT TO DO NEXT
+1 NEW ABSPSTOP,ABSPOUT
+2 SET (ABSPSTOP,ABSPOUT)=0
+3 DO PRHDR
+4 IF $ORDER(^TMP("ABSPOSRT",$JOB,""))=""
Begin DoDot:1
+5 WRITE !!," NO TRANSACTIONS FOUND FOR THE SELECTED DATE(S)"
+6 DO ZEND
+7 SET ABSPSTOP=1
+8 QUIT
End DoDot:1
+9 IF ABSPSTOP
QUIT
+10 IF ABSPOUT
DO ZEND
QUIT
+11 DO PRNTDTL
+12 DO ZEND
+13 QUIT
PRHDR ; PRINT HEADER
+1 NEW ABSPFEDT,ABSPFBDT,Y
+2 USE IO
IF $DATA(ABSPSUM)
WRITE @IOF
+3 SET Y=ABSPSTRT
+4 DO DD^%DT
+5 SET ABSPFBDT=Y
+6 SET Y=$PIECE(ABSPEND,".")
+7 DO DD^%DT
+8 SET ABSPFEDT=Y
+9 WRITE @IOF
+10 WRITE !,?16,"Pharmacy Point of Sale Transaction History Report"
+11 WRITE !?22,"From: "_ABSPFBDT_" TO: "_ABSPFEDT
+12 WRITE !?18,"Pharmacy: "_ABSPPPHM
+13 WRITE !?22,"User: "_ABSPUSER
+14 QUIT
PRNTDHD ; PRINT HEADER
+1 ;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
+2 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""SUBMISSION"",?14,""STATUS"",?25,""REJ"",?30,""REJ REASON"",?58,""BILLED AMT"",?70,""PAID AMT""")
+3 IF ABSPOUT
QUIT
+4 QUIT
PRNTDTL ; PRINT DETAIL
+1 NEW ABSPTRDT,ABSPOUT,Y,ABSPFRDT,ABSPPPHM,ABSPPHMN,ABSPRESC,ABSPTRN,STRING,ABSPSUB,ABSPTYP,ABSPRJCD,ABSPREA,ABSPBAMT,ABSPPAID,ABSPUSRN
+2 NEW ABSPRXGT,ABSPSBGT,ABSPAYGT,ABSPDATE,ABSPUSR,ABSPHARM,ABSPRESP,ABSPREST,ABSPAID1,ABSPUSER,ABSPCLMI,ABSPPRI,ABSPPRX,ABSPPRXR,ABSPOTH
+3 SET (ABSPRXGT,ABSPSBGT,ABSPAYGT)=0
+4 SET (ABSPTRDT,ABSPOUT)=""
+5 FOR
SET ABSPTRDT=$ORDER(^TMP("ABSPOSRT",$JOB,ABSPTRDT))
IF (ABSPTRDT="")!(ABSPOUT)
QUIT
Begin DoDot:1
+6 MERGE ABSPTMP(ABSPTRDT)=^TMP("ABSPOSRT",$JOB,ABSPTRDT)
+7 SET ABSPPPHM=""
+8 SET Y=ABSPTRDT
+9 DO DD^%DT
+10 ; FORMATTED DATE
SET ABSPFRDT=Y
+11 SET ABSPPPHM=""
+12 FOR
SET ABSPPPHM=$ORDER(ABSPTMP(ABSPTRDT,ABSPPPHM))
IF (ABSPPPHM="")!(ABSPOUT)
QUIT
Begin DoDot:2
+13 SET ABSPPHMN=$PIECE($GET(^ABSP(9002313.56,ABSPPPHM,0)),U,1)
+14 IF ABSPPHMN=""
SET ABSPPHMN="UKN"
+15 IF ABSPOUT
QUIT
+16 ;IHS/OIT/CNI/RAN 04272010 patch 39 - When printing to screen, use paging
+17 SET ABSPOUT=$$WRITE^ABSPOSUU("!!,?5,""PHARMACY: "",ABSPPHMN,"" TRANSACTION DATE: "",ABSPFRDT")
+18 IF ABSPOUT
QUIT
+19 SET ABSPUSER=""
+20 FOR
SET ABSPUSER=$ORDER(ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER))
IF (ABSPUSER="")!(ABSPOUT)
QUIT
Begin DoDot:3
+21 SET ABSPUSRN="UKN"
+22 IF ABSPUSER>0
SET ABSPUSRN=$PIECE($GET(^VA(200,ABSPUSER,0)),"^",1)
+23 SET ABSPOUT=$$WRITE^ABSPOSUU("!!,?5,""POS USER: "",ABSPUSRN")
+24 IF ABSPOUT
QUIT
+25 SET ABSPRESC=""
+26 FOR
SET ABSPRESC=$ORDER(ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER,ABSPRESC))
IF (ABSPRESC="")!(ABSPOUT)
QUIT
Begin DoDot:4
+27 IF '$DATA(ABSPREST(ABSPRESC))
Begin DoDot:5
+28 SET ABSPRXGT=ABSPRXGT+1
+29 SET ABSPREST(ABSPRESC)=""
End DoDot:5
+30 SET ABSPDATE(ABSPTRDT,"RX")=$GET(ABSPDATE(ABSPTRDT,"RX"))+1
+31 SET ABSPHARM(ABSPTRDT,ABSPPPHM,"RX")=$GET(ABSPHARM(ABSPTRDT,ABSPPPHM,"RX"))+1
+32 SET ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"RX")=$GET(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"RX"))+1
+33 SET ABSPPRX=$PIECE(ABSPRESC,".")
+34 SET ABSPCLMI=ABSPCLM(ABSPRESC)
+35 IF ABSPCLMI=""
SET ABSPPRXR=0
+36 IF '$TEST
SET ABSPPRXR=$PIECE($PIECE(^ABSPC(ABSPCLMI,400,$PIECE(^ABSPC(ABSPCLMI,400,0),U,3),400),U,3),"D3",2)
+37 SET ABSPOTH=$$OTHERS(ABSPRESC,ABSPSTRT,ABSPEND)
+38 IF ABSPOTH
SET ABSPPRXR=ABSPPRXR_" **"
+39 SET ABSPOUT=$$WRITE^ABSPOSUU("!!,?25,""RX/REFILL: "",ABSPPRX,""/"",ABSPPRXR")
+40 IF ABSPOUT
QUIT
+41 DO PRNTDHD
+42 SET ABSPTRN=""
+43 FOR
SET ABSPTRN=$ORDER(ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER,ABSPRESC,ABSPTRN))
IF (ABSPTRN="")!(ABSPOUT)
QUIT
Begin DoDot:5
+44 SET ABSPSBGT=ABSPSBGT+1
+45 SET ABSPDATE(ABSPTRDT,"SUB")=$GET(ABSPDATE(ABSPTRDT,"SUB"))+1
+46 SET ABSPHARM(ABSPTRDT,ABSPPPHM,"SUB")=$GET(ABSPHARM(ABSPTRDT,ABSPPPHM,"SUB"))+1
+47 SET ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"SUB")=$GET(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"SUB"))+1
+48 SET STRING=ABSPTMP(ABSPTRDT,ABSPPPHM,ABSPUSER,ABSPRESC,ABSPTRN)
+49 SET ABSPSUB=$PIECE(STRING,U)
+50 SET ABSPTYP=$PIECE(STRING,U,2)
+51 SET ABSPRJCD=$PIECE(STRING,U,3)
+52 SET ABSPREA=$PIECE(STRING,U,4)
+53 SET ABSPBAMT=$PIECE(STRING,U,5)
+54 SET ABSPPAID=$PIECE(STRING,U,6)
+55 SET ABSPPRI=$PIECE(STRING,U,7)
+56 IF (ABSPPRI'="")&&('$DATA(ABSPRESP(ABSPPRI)))
Begin DoDot:6
+57 SET ABSPAID1=ABSPPAID
+58 SET ABSPRESP(ABSPPRI)=""
End DoDot:6
+59 IF '$TEST
SET ABSPAID1=0
+60 SET ABSPAYGT=ABSPAYGT+ABSPPAID
+61 SET ABSPDATE(ABSPTRDT,"PAY")=$GET(ABSPDATE("DT",ABSPTRDT,"PAY"))+ABSPAID1
+62 SET ABSPHARM(ABSPTRDT,ABSPPPHM,"PAY")=$GET(ABSPHARM(ABSPTRDT,ABSPPPHM,"PAY"))+ABSPAID1
+63 SET ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"PAY")=$GET(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,"PAY"))+ABSPAID1
+64 SET ABSPOUT=$$WRITE^ABSPOSUU("!,ABSPSUB,?14,ABSPTYP,?25,ABSPRJCD,?30,ABSPREA,?58,$J($FN(ABSPBAMT,"","",2),10),?70,$J($FN(ABSPPAID,"","",2),8)")
End DoDot:5
+65 IF ABSPOUT
QUIT
+66 IF ABSPOTH
SET ABSPOUT=$$WRITE^ABSPOSUU("!!,""`**` Denotes this prescription has additional transactions "",!,?5,""outside the date range of this report.""")
End DoDot:4
+67 IF ABSPOUT
QUIT
+68 SET ABSPOUT=$$WRITE^ABSPOSUU("!!,""FOR USER "",ABSPUSRN,"":""")
+69 IF ABSPOUT
QUIT
+70 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""Prescriptions: "",ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,""RX"")")
+71 IF ABSPOUT
QUIT
+72 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,""SUB"")")
+73 IF ABSPOUT
QUIT
+74 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPUSR(ABSPTRDT,ABSPPPHM,ABSPUSER,""PAY""),"","",2),6)")
+75 IF ABSPOUT
QUIT
End DoDot:3
+76 IF ABSPOUT
QUIT
+77 SET ABSPOUT=$$WRITE^ABSPOSUU("!!,""FOR PHARMACY "",ABSPPHMN,"":""")
+78 IF ABSPOUT
QUIT
+79 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""Prescriptions: "",ABSPHARM(ABSPTRDT,ABSPPPHM,""RX"")")
+80 IF ABSPOUT
QUIT
+81 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPHARM(ABSPTRDT,ABSPPPHM,""SUB"")")
+82 IF ABSPOUT
QUIT
+83 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPHARM(ABSPTRDT,ABSPPPHM,""PAY""),"","",2),6)")
+84 IF ABSPOUT
QUIT
End DoDot:2
+85 KILL ABSPTMP(ABSPTRDT)
+86 IF ABSPOUT
QUIT
+87 SET ABSPOUT=$$WRITE^ABSPOSUU("!!,""FOR TRANSACTION DATE "",ABSPFRDT,"":""")
+88 IF ABSPOUT
QUIT
+89 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""Prescriptions: "",ABSPDATE(ABSPTRDT,""RX"")")
+90 IF ABSPOUT
QUIT
+91 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPDATE(ABSPTRDT,""SUB"")")
+92 IF ABSPOUT
QUIT
+93 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPDATE(ABSPTRDT,""PAY""),"","",2),6)")
+94 IF ABSPOUT
QUIT
End DoDot:1
+95 SET ABSPOUT=$$WRITE^ABSPOSUU("!!!,""Report Totals:""")
+96 IF ABSPOUT
QUIT
+97 SET ABSPOUT=$$WRITE^ABSPOSUU("!!!,""Prescriptions: "",ABSPRXGT")
+98 IF ABSPOUT
QUIT
+99 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""POS Submissions: "",ABSPSBGT")
+100 IF ABSPOUT
QUIT
+101 SET ABSPOUT=$$WRITE^ABSPOSUU("!,""Total Paid: $"",$J($FN(ABSPAYGT,"","",2),6)")
+102 IF ABSPOUT
QUIT
+103 QUIT
ZEND ; END AND KILL VARIABLES
+1 KILL ^TMP("ABSPOSRT",$JOB)
+2 DO ^%ZISC
+3 QUIT
START ;
+1 NEW X,Y,ABSPJ,ABSPRJC,ABSPPAT,ABSPPIEN
+2 IF $DATA(ZTQPARAM)
Begin DoDot:1
+3 IF $PIECE(ZTQPARAM,";",1)["T-1"
SET ABSPSTRT=DT-1
+4 IF $PIECE(ZTQPARAM,";",2)["T-1"
SET ABSPEND=DT-1
+5 SET ABSPINS="ALL"
+6 SET ABSPPPHM="ALL"
+7 SET ABSPRTYP="D"
+8 DO FIND
+9 DO ZEND
+10 QUIT
End DoDot:1
+11 QUIT
BDT() ; ENTER BEGINING DATE
+1 NEW ABSPBDT,DIR,X1,X,Y
+2 WRITE !
+3 KILL DIR
+4 SET DIR(0)="DEX"
+5 SET DIR("A")="Enter Beginning POS Transaction Date"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT -1
+8 SET ABSPBDT=+Y
+9 SET X1=ABSPBDT
DO C^%DTC
+10 QUIT X
EDT() ; ENTER END DATE
+1 NEW ABSPEDT,DIR,X1,X,Y
+2 WRITE !
+3 KILL DIR
+4 SET DIR(0)="DEX"
+5 SET DIR("A")="Enter Ending POS Transaction Date"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT -1
+8 SET ABSPEDT=+Y
+9 SET X1=ABSPEDT
DO C^%DTC
+10 QUIT X
OTHERS(ABSPRESC,ABSPSTRT,ABSPEND) ;CHECK FOR OTHER TRANSACTIONS OUTSIDE DATE RANGE
+1 ;See if there are any transactions outside the date range
+2 NEW X,ABSPTRN,ABSPDT,DONE
+3 SET ABSPTRN=""
+4 SET (X,DONE)=0
+5 FOR
SET ABSPTRN=$ORDER(^ABSPTL("B",ABSPRESC,ABSPTRN))
IF (ABSPTRN="")!(DONE)
QUIT
Begin DoDot:1
+6 SET ABSPDT=$PIECE(^ABSPTL(ABSPTRN,0),U,8)
+7 IF (ABSPDT<ABSPSTRT)!(ABSPDT>ABSPEND)
SET (X,DONE)=1
End DoDot:1
+8 QUIT X
