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

ABSPOSM2.m

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