ABSPOSM2 ; IHS/FCS/DRS - Report Master (.61) ; [ 09/12/2002 10:12 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,11,20,29,37,40**;JUN 21, 2001;Build 38
;
; ABSPOSM2 - headers called from some Fileman reports
; D0 points to 9002313.61
;-----------------------------------------------------
;IHS/SD/lwj 06/04/04 patch 11
; Subroutine was named "DUPLICAT" but the option was
; calling "DUPLICATE" for the possible duplicates report.
; This was not an issue until Cache, since MSM only
; recognized the first 8 characters of the subroutine.
; Subroutine was renamed to DUPLICATE to match the option.
;------------------------------------------------------
;IHS/SD/RLT - 3/26/07 - Patch 20
; Added NPI
;
;------------------------------------------------------
;IHS/OIT/SCR - 12/12/08 - Patch 29 added SITE reports
;------------------------------------------------------
Q
PAYABLE ;W @IOF
W $$HDR1("PAYABLE"),!
W $$PHARMACY,!
W $$PHARMNO,!
W $$INSURER,!
W !
W ?0,"Trans. Date"
W ?35,"Presc/Fill"
W ?46,"$billed"
W ?54,"Ins.Pd."
W !
W !
Q
REJECTED ;
;W @IOF
W $$HDR1("REJECTED"),!
W $$PHARMACY,!
W $$PHARMNO,!
W $$INSURER,!
W !
W ?0,"Trans. Date/Time"
W ?20,"Claim ID"
W ?42,"Presc/Fill"
W ?64,"NDC Number"
W !
W ?0,"Cardholder ID"
W ?20,"Group Number"
W ?41,"Qty"
W ?46,"$billed"
W !
W !
Q
CAPTURED ;
; W @IOF
W $$HDR1("CAPTURED"),!
W $$PHARMACY,!
W $$PHARMNO,!
W $$INSURER,!
W !
W ?0,"Trans. Date"
W ?35,"Presc/Fill"
W ?46,"$billed"
W !
W !
Q
DUPLICATE ;IHS/SD/lwj 6/4/04 patch 11 tag added to match option
DUPLICAT ;
;W !IOF
W $$HDR1("DUPLICATE"),!
W $$PHARMACY,!
W $$PHARMNO,!
W $$INSURER,!
W !
W ?0,"Trans. Date"
W ?35,"Presc/Fill"
W ?46,"$billed"
W !
W !
Q
PAPER ;
;W @IOF
W $$HDR1("PAPER"),!
W $$PHARMACY,!
W $$PHARMNO,!
W $$INSURER,!
W !
W ?0,"Trans. Date"
W ?35,"Presc/Fill"
W ?46,"$amount"
W !
W !
Q
UNINS ;W @IOF
W $$HDR1("UNINSURED"),!
W $$PHARMACY,!
W $$PHARMNO,!
W $$ELIG,!
W !
W ?0,"Trans. Date"
W ?35,"Presc/Fill"
W ?46,"$amount"
W !
W !
Q
; - subroutines -
ELIG() ;
N IEN57 S IEN57=$$IEN57 Q:'IEN57 ""
N PAT S PAT=$P($G(^ABSPTL(IEN57,0)),U,6)
Q "ELIGIBILITY STATUS: "_$$GET1^DIQ(9000001,PAT_",",1112)
INSURER() N IEN4 S IEN4=$$IEN4 Q:'IEN4 ""
N X,Y
S X=$P($G(^AUTNINS(IEN4,0)),U) Q:X="" ""
S Y=$$INSHELP^ABSPOSM(D0)
I Y]"" S X=X_" Help Desk:"_Y
Q X
PHARMACY() ;
N IEN56 S IEN56=$$IEN56 Q:'IEN56 ""
N X
S X=$G(^ABSP(9002313.56,IEN56,0))
Q $P(X,U)
PHARMNO() ;
N IEN56 S IEN56=$$IEN56 Q:'IEN56 ""
N X,Y
S Y=$G(^ABSP(9002313.56,IEN56,0))
S X="NPI #"_$$NPI
S X=X_" NCPDP (NABP) #"_$P(Y,U,2)
S X=X_" Medicaid #"_$P($G(^ABSP(9002313.56,IEN56,"CAID")),U)
Q X
NPI() ;
N IEN57 S IEN57=$$IEN57 Q:'IEN57 ""
N OPS,INST,NPI
S OPS=$P($G(^ABSPTL(IEN57,1)),U,4) ;outpatient site
S INST=""
I OPS'="" D
. S INST=$P($G(^PS(59,OPS,"INI")),U,2) ;institution
;
S NPI="" ;pharmacy NPI
I INST'="" D
. S NPI=$P($$NPI^XUSNPI("Organization_ID",INST),U)
. S:NPI'>0 NPI=""
Q NPI
IEN4() N X S X=$$IEN57 Q:'X ""
Q $P($G(^ABSPTL(X,1)),U,6)
IEN56() N X S X=$$IEN57 Q:'X ""
Q $P($G(^ABSPTL(X,1)),U,7)
IEN57() Q:'D0 "" Q $P($G(^ABSPECX("RPT",D0,0)),U,3) ; TRANSACTION
RELDATE() Q:'D0 "" N Y S Y=$P($G(^ABSPECX("RPT",D0,0)),U) X ^DD("DD") Q Y
HDR1(X) N R S R=$$RELDATE
N A S A="POS "_X_" claims for prescriptions RELEASED"
I R]"" S A=A_" on "_R
N B S B=$$NOW^ABSPOS
S B=$E(B,4,5)_"/"_$E(B,6,7)_"@"_$E(B,9,10)_":"_$E(B,11,12)
Q A_$J(B,80-1-$L(A))
;IHS/OIT/SCR 12/12/08 - START CHANGES FOR SITE REPORTS patch 29
PAYPHARM ;
W $$HDR1("PHARMACY PAYABLE"),!
W $$PHARMACY,!
W $$PHARMNO,!
W $$INSURER,!
W !
W ?0,"Trans. Date"
W ?35,"Presc/Fill"
W ?46,"$billed"
W ?54,"Ins.Pd."
W !
W !
Q
ASKPHARM() ;
N Y,DIR
S DIR(0)="P^ABSP(9002313.56,:QEM"
D ^DIR
Q Y
HDR2(ABSPTYP,ABSPSITE) ;
N ABSPDATE,ABSPSTRN,ABSPNOW
S ABSPSTRN="POS "_ABSPNAME_" :"_ABSPTYP_" claims for prescriptions RELEASED"
S ABSPDATE=$$RELDATE
I ABSPDATE]"" S ABSPSTRN=ABSPSTRN_" on "_ABSPDATE
N ABSPNOW S ABSPNOW=$$NOW^ABSPOS
S ABSPNOW=$E(ABSPNOW,4,5)_"/"_$E(ABSPNOW,6,7)_"@"_$E(ABSPNOW,9,10)_":"_$E(ABSPNOW,11,12)
Q ABSPSTRN_$J(ABSPNOW,80-1-$L(ABSPSTRN))
;
CLOSED ;IHS/OIT/SCR 021810 patch 37
W $$HDR1("CLOSED"),!
W $$PHARMACY,!
W $$PHARMNO,!
;W $$INSURER,!
W !
W ?0,"Internal RX#"
W ?20,"Cardholder ID"
W ?40,"Group Number"
W !
W ?3,"Closed Date"
W ?23,"Closed By"
W ?43,"Closed Reason"
;/IHS/OIT/CNI/RAN 09/13/2010 patch 40 Added header for Rejects, and $Billed
W !,?6,"Rejects",?26,"$Billed"
W !,!
Q
ABSPOSM2 ; IHS/FCS/DRS - Report Master (.61) ; [ 09/12/2002 10:12 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,11,20,29,37,40**;JUN 21, 2001;Build 38
+2 ;
+3 ; ABSPOSM2 - headers called from some Fileman reports
+4 ; D0 points to 9002313.61
+5 ;-----------------------------------------------------
+6 ;IHS/SD/lwj 06/04/04 patch 11
+7 ; Subroutine was named "DUPLICAT" but the option was
+8 ; calling "DUPLICATE" for the possible duplicates report.
+9 ; This was not an issue until Cache, since MSM only
+10 ; recognized the first 8 characters of the subroutine.
+11 ; Subroutine was renamed to DUPLICATE to match the option.
+12 ;------------------------------------------------------
+13 ;IHS/SD/RLT - 3/26/07 - Patch 20
+14 ; Added NPI
+15 ;
+16 ;------------------------------------------------------
+17 ;IHS/OIT/SCR - 12/12/08 - Patch 29 added SITE reports
+18 ;------------------------------------------------------
+19 QUIT
PAYABLE ;W @IOF
+1 WRITE $$HDR1("PAYABLE"),!
+2 WRITE $$PHARMACY,!
+3 WRITE $$PHARMNO,!
+4 WRITE $$INSURER,!
+5 WRITE !
+6 WRITE ?0,"Trans. Date"
+7 WRITE ?35,"Presc/Fill"
+8 WRITE ?46,"$billed"
+9 WRITE ?54,"Ins.Pd."
+10 WRITE !
+11 WRITE !
+12 QUIT
REJECTED ;
+1 ;W @IOF
+2 WRITE $$HDR1("REJECTED"),!
+3 WRITE $$PHARMACY,!
+4 WRITE $$PHARMNO,!
+5 WRITE $$INSURER,!
+6 WRITE !
+7 WRITE ?0,"Trans. Date/Time"
+8 WRITE ?20,"Claim ID"
+9 WRITE ?42,"Presc/Fill"
+10 WRITE ?64,"NDC Number"
+11 WRITE !
+12 WRITE ?0,"Cardholder ID"
+13 WRITE ?20,"Group Number"
+14 WRITE ?41,"Qty"
+15 WRITE ?46,"$billed"
+16 WRITE !
+17 WRITE !
+18 QUIT
CAPTURED ;
+1 ; W @IOF
+2 WRITE $$HDR1("CAPTURED"),!
+3 WRITE $$PHARMACY,!
+4 WRITE $$PHARMNO,!
+5 WRITE $$INSURER,!
+6 WRITE !
+7 WRITE ?0,"Trans. Date"
+8 WRITE ?35,"Presc/Fill"
+9 WRITE ?46,"$billed"
+10 WRITE !
+11 WRITE !
+12 QUIT
DUPLICATE ;IHS/SD/lwj 6/4/04 patch 11 tag added to match option
DUPLICAT ;
+1 ;W !IOF
+2 WRITE $$HDR1("DUPLICATE"),!
+3 WRITE $$PHARMACY,!
+4 WRITE $$PHARMNO,!
+5 WRITE $$INSURER,!
+6 WRITE !
+7 WRITE ?0,"Trans. Date"
+8 WRITE ?35,"Presc/Fill"
+9 WRITE ?46,"$billed"
+10 WRITE !
+11 WRITE !
+12 QUIT
PAPER ;
+1 ;W @IOF
+2 WRITE $$HDR1("PAPER"),!
+3 WRITE $$PHARMACY,!
+4 WRITE $$PHARMNO,!
+5 WRITE $$INSURER,!
+6 WRITE !
+7 WRITE ?0,"Trans. Date"
+8 WRITE ?35,"Presc/Fill"
+9 WRITE ?46,"$amount"
+10 WRITE !
+11 WRITE !
+12 QUIT
UNINS ;W @IOF
+1 WRITE $$HDR1("UNINSURED"),!
+2 WRITE $$PHARMACY,!
+3 WRITE $$PHARMNO,!
+4 WRITE $$ELIG,!
+5 WRITE !
+6 WRITE ?0,"Trans. Date"
+7 WRITE ?35,"Presc/Fill"
+8 WRITE ?46,"$amount"
+9 WRITE !
+10 WRITE !
+11 QUIT
+12 ; - subroutines -
ELIG() ;
+1 NEW IEN57
SET IEN57=$$IEN57
IF 'IEN57
QUIT ""
+2 NEW PAT
SET PAT=$PIECE($GET(^ABSPTL(IEN57,0)),U,6)
+3 QUIT "ELIGIBILITY STATUS: "_$$GET1^DIQ(9000001,PAT_",",1112)
INSURER() NEW IEN4
SET IEN4=$$IEN4
IF 'IEN4
QUIT ""
+1 NEW X,Y
+2 SET X=$PIECE($GET(^AUTNINS(IEN4,0)),U)
IF X=""
QUIT ""
+3 SET Y=$$INSHELP^ABSPOSM(D0)
+4 IF Y]""
SET X=X_" Help Desk:"_Y
+5 QUIT X
PHARMACY() ;
+1 NEW IEN56
SET IEN56=$$IEN56
IF 'IEN56
QUIT ""
+2 NEW X
+3 SET X=$GET(^ABSP(9002313.56,IEN56,0))
+4 QUIT $PIECE(X,U)
PHARMNO() ;
+1 NEW IEN56
SET IEN56=$$IEN56
IF 'IEN56
QUIT ""
+2 NEW X,Y
+3 SET Y=$GET(^ABSP(9002313.56,IEN56,0))
+4 SET X="NPI #"_$$NPI
+5 SET X=X_" NCPDP (NABP) #"_$PIECE(Y,U,2)
+6 SET X=X_" Medicaid #"_$PIECE($GET(^ABSP(9002313.56,IEN56,"CAID")),U)
+7 QUIT X
NPI() ;
+1 NEW IEN57
SET IEN57=$$IEN57
IF 'IEN57
QUIT ""
+2 NEW OPS,INST,NPI
+3 ;outpatient site
SET OPS=$PIECE($GET(^ABSPTL(IEN57,1)),U,4)
+4 SET INST=""
+5 IF OPS'=""
Begin DoDot:1
+6 ;institution
SET INST=$PIECE($GET(^PS(59,OPS,"INI")),U,2)
End DoDot:1
+7 ;
+8 ;pharmacy NPI
SET NPI=""
+9 IF INST'=""
Begin DoDot:1
+10 SET NPI=$PIECE($$NPI^XUSNPI("Organization_ID",INST),U)
+11 IF NPI'>0
SET NPI=""
End DoDot:1
+12 QUIT NPI
IEN4() NEW X
SET X=$$IEN57
IF 'X
QUIT ""
+1 QUIT $PIECE($GET(^ABSPTL(X,1)),U,6)
IEN56() NEW X
SET X=$$IEN57
IF 'X
QUIT ""
+1 QUIT $PIECE($GET(^ABSPTL(X,1)),U,7)
IEN57() ; TRANSACTION
IF 'D0
QUIT ""
QUIT $PIECE($GET(^ABSPECX("RPT",D0,0)),U,3)
RELDATE() IF 'D0
QUIT ""
NEW Y
SET Y=$PIECE($GET(^ABSPECX("RPT",D0,0)),U)
XECUTE ^DD("DD")
QUIT Y
HDR1(X) NEW R
SET R=$$RELDATE
+1 NEW A
SET A="POS "_X_" claims for prescriptions RELEASED"
+2 IF R]""
SET A=A_" on "_R
+3 NEW B
SET B=$$NOW^ABSPOS
+4 SET B=$EXTRACT(B,4,5)_"/"_$EXTRACT(B,6,7)_"@"_$EXTRACT(B,9,10)_":"_$EXTRACT(B,11,12)
+5 QUIT A_$JUSTIFY(B,80-1-$LENGTH(A))
+6 ;IHS/OIT/SCR 12/12/08 - START CHANGES FOR SITE REPORTS patch 29
PAYPHARM ;
+1 WRITE $$HDR1("PHARMACY PAYABLE"),!
+2 WRITE $$PHARMACY,!
+3 WRITE $$PHARMNO,!
+4 WRITE $$INSURER,!
+5 WRITE !
+6 WRITE ?0,"Trans. Date"
+7 WRITE ?35,"Presc/Fill"
+8 WRITE ?46,"$billed"
+9 WRITE ?54,"Ins.Pd."
+10 WRITE !
+11 WRITE !
+12 QUIT
ASKPHARM() ;
+1 NEW Y,DIR
+2 SET DIR(0)="P^ABSP(9002313.56,:QEM"
+3 DO ^DIR
+4 QUIT Y
HDR2(ABSPTYP,ABSPSITE) ;
+1 NEW ABSPDATE,ABSPSTRN,ABSPNOW
+2 SET ABSPSTRN="POS "_ABSPNAME_" :"_ABSPTYP_" claims for prescriptions RELEASED"
+3 SET ABSPDATE=$$RELDATE
+4 IF ABSPDATE]""
SET ABSPSTRN=ABSPSTRN_" on "_ABSPDATE
+5 NEW ABSPNOW
SET ABSPNOW=$$NOW^ABSPOS
+6 SET ABSPNOW=$EXTRACT(ABSPNOW,4,5)_"/"_$EXTRACT(ABSPNOW,6,7)_"@"_$EXTRACT(ABSPNOW,9,10)_":"_$EXTRACT(ABSPNOW,11,12)
+7 QUIT ABSPSTRN_$JUSTIFY(ABSPNOW,80-1-$LENGTH(ABSPSTRN))
+8 ;
CLOSED ;IHS/OIT/SCR 021810 patch 37
+1 WRITE $$HDR1("CLOSED"),!
+2 WRITE $$PHARMACY,!
+3 WRITE $$PHARMNO,!
+4 ;W $$INSURER,!
+5 WRITE !
+6 WRITE ?0,"Internal RX#"
+7 WRITE ?20,"Cardholder ID"
+8 WRITE ?40,"Group Number"
+9 WRITE !
+10 WRITE ?3,"Closed Date"
+11 WRITE ?23,"Closed By"
+12 WRITE ?43,"Closed Reason"
+13 ;/IHS/OIT/CNI/RAN 09/13/2010 patch 40 Added header for Rejects, and $Billed
+14 WRITE !,?6,"Rejects",?26,"$Billed"
+15 WRITE !,!
+16 QUIT
