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

ABSPOSQ.m

Go to the documentation of this file. 
  1. ABSPOSQ ; IHS/FCS/DRS - POS background, Part 1 ;   
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q
  1.  ; ABSPOSQ1 - Assemble claim information
  1.  ; ABSPOSQ2 - Put claims into packets for transmission
  1.  ; ABSPOSQ3 - Send and Receive
  1.  ; ABSPOSQ4 - Process Responses
  1.  ;
  1.  ; Numerous little $$'s called by ABSPOSQB, etc. are here
  1.  ; .57 versions of these are in ABSPOS57, using IEN57
  1.  ;
  1. DRGDFN() ;EP -
  1.  Q $P(^PSRX($$RXI,0),U,6) ; Given IEN59, return DRGDFN
  1. DRGNAME()          Q $P(^PSDRUG($$DRGDFN,0),U) ; Given IEN59, return DRGNAME
  1. RXI() ;EP -
  1.  Q $P(^ABSPT(IEN59,1),U,11) ; Given IEN59, return RXI
  1. RXR() ;EP -
  1.  Q $P(^ABSPT(IEN59,1),U,1) ; Given IEN59, return RXR
  1. N57LAST() ;EP -
  1.  Q $O(^ABSPTL("NON-FILEMAN","RXIRXR",$$RXI,$$RXR,""),-1)
  1. NDC() ;EP -
  1.  I $$TYPE=1 Q $P(^ABSPT(IEN59,1),U,2)
  1.  D IMPOSS^ABSPOSUE("P","TI","postage and supplies not implemented",,"NDC",$T(+0))
  1.  Q
  1. QTY() Q $P(^ABSPT(IEN59,5),U) ; Given IEN59, return quantity
  1. AMT() ;EP -
  1.  Q $P(^ABSPT(IEN59,5),U,5) ; return total $amount
  1. CHG() Q $P(^ABSPT(IEN59,5),U,5) ; Given IEN59, ret total charge
  1. CPTIEN() I $$TYPE=1 Q $O(^ABSCPT(9002300,"AVMED",$$DRGDFN,0))
  1.  ; CPT code for postage could vary by insurer and amount?
  1.  ; A complication not yet programmed
  1.  I $$TYPE=2 Q $P($G(^ABSP(9002313.99,1,"POSTAGE")),U)
  1.  I $$TYPE=3 Q $$EXTRCPT3 ; extract CPT from  visitien.cptien3
  1.  Q "" ; not reach; $$TYPE already checked for 1, 2, 3
  1. EXTRCPT3()          N X S X=IEN59,X=$P(X,".",2),X=$E(X,1,$L(X)-1) Q +X
  1. PATIENT()          Q $P(^ABSPT(IEN59,0),U,6)
  1. VISITIEN() Q $P(^ABSPT(IEN59,0),U,7)
  1. USER() N X S X=$P(^ABSPT(IEN59,0),U,10) S:'X X=$G(DUZ) Q X
  1. TYPE() ;EP -
  1.  N X S X=$E(IEN59,$L(IEN59)) ; 1=prescription, 2=postage, 3=other
  1.  I X'=1,X'=2,X'=3 D  S X=""
  1.  . D IMPOSS^ABSPOSUE("DB","TI","Bad type for IEN59="_IEN59,,"TYPE",$T(+0))
  1.  Q X
  1. NOW() N %,%H,%I,X D NOW^%DTC Q %
  1. FILLDATE()         N RXI,RXR S RXI=$$RXI,RXR=$$RXR
  1.  Q:RXR $P(^PSRX(RXI,1,RXR,0),U)  Q:RXI $P(^PSRX(RXI,2),U,2)
  1.  Q $$VISDATE
  1. VISDATE() Q $P($P(^AUPNVSIT($$VISITIEN,0),U),".")
  1. VMED() N RXI,RXR S RXI=$$RXI,RXR=$$RXR
  1.  Q:RXR $P(^PSRX(RXI,1,RXR,999999911),U) Q $P(^PSRX(RXI,999999911),U)
  1. PROVIDER()         Q $P(^PSRX($$RXI,0),U,4)
  1. VCN() Q $P(^AUPNVSIT($$VISITIEN,"VCN"),U)
  1.  ;
  1. ARSYSTEM()         Q $P(^ABSP(9002313.99,1,"A/R INTERFACE"),U)
  1. MAKEVCN() ;EP - true/false  should we assign a VCN # to the visit?
  1.  N AR S AR=$$ARSYSTEM
  1.  I AR=0 Q 1 ; yes, for ILC A/R
  1.  I AR=2 Q 1 ; yes, for ANMC A/R
  1.  Q 0 ; no, for everybody else
  1. LOG2LIST(MSG) ;EP -
  1.  D LOG2LIST^ABSPOSL(MSG) Q
  1. LOG2CLM(MSG,IEN02) ;EP 
  1.  D LOG2CLM^ABSPOSL(MSG,IEN02) Q
  1. LOG59(MSG,IEN59) ;EP -
  1.  D LOG59^ABSPOSL(MSG,IEN59) Q