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

ABSPOSM.m

Go to the documentation of this file.
  1. ABSPOSM ; IHS/FCS/DRS - Report Master (.61) ; [ 09/12/2002 10:12 AM ]
  1. ;;1.0;PHARMACY POINT OF SALE;**3,44**;JUN 21, 2001;Build 38
  1. ;
  1. ; ABSPOSM1 - takes care of updating of file .61
  1. ; ABSPOSM2 - some report headers called from Print options
  1. ; ABSPOSMA-ABSPOSM* for lowercase * - general inquiry/report on .57
  1. ;
  1. Q
  1. MESSAGE(IEN57,N) ;EP - message sent in e-claim response
  1. I 'IEN57 Q ""
  1. N RESP,POS D RESPPOS(IEN57) Q:'RESP!'POS ""
  1. I '$D(N) S N=0
  1. I N=1 Q $$MESSAGE^ABSPOS03(RESP,POS,1)
  1. I N=2 Q $$MESSAGE^ABSPOS03(RESP,POS,2)
  1. Q $$MESSAGE^ABSPOS03(RESP,POS)
  1. RESPPOS(IEN57) ;EP - caller should N RESP,POS
  1. I $G(^ABSPTL(IEN57,4)) D ; reversal
  1. . S RESP=$P(^ABSPTL(IEN57,4),U,2)
  1. . S POS=1
  1. E D
  1. . S RESP=$P(^ABSPTL(IEN57,0),U,5)
  1. . S POS=$P(^ABSPTL(IEN57,0),U,9)
  1. Q
  1. ; Computed fields:
  1. INSHELP(D0) ;EP - (#10002) INSURER HELP #
  1. N X S X=$P($G(^ABSPECX("RPT",D0,0)),U,3) I 'X Q "" ; IEN57
  1. S X=$P($G(^ABSPTL(X,1)),U,6) I 'X Q "" ; INSURER
  1. S X=$G(^ABSPEI(X,100)) I X="" Q "" ; insurer pharm e-claims info
  1. N Y S Y=$P(X,U,5) I Y]"" Q Y ; specific phone # for insurer
  1. ;OIT/CAS/RCS 062912 - Patch 44 Formats no longer used so quit if no phone #
  1. Q ""
  1. ;S X=$P(X,U) I 'X Q "" ; format
  1. ;Q $P($G(^ABSPF(9002313.92,X,1)),U,5) ; phone # as stored with format
  1. RELTIME(D0) ;EP - (#10003) RX RELEASED DATE/TIME
  1. N RXI,RXR D D0RXIRXR
  1. I RXI=""!(RXR="") Q "" ; should never happen
  1. I RXR Q $P($G(^PSRX(RXI,1,RXR,0)),U,17)
  1. E Q $P($G(^PSRX(RXI,2)),U,13)
  1. RETSTOCK(D0) ;EP - (#10004) RX RETURNED TO STOCK
  1. N RXI,RXR D D0RXIRXR
  1. I RXI=""!(RXR="") Q "" ; should never happen
  1. I RXR Q +$P($G(^PSRX(RXI,1,RXR,0)),U,16)
  1. E Q +$P($G(^PSRX(RXI,2)),U,15)
  1. DELETED(D0) ; EP - (#10001) RX DELETED
  1. N RXI,RXR D D0RXIRXR
  1. I RXI=""!(RXR="") Q "" ; should never happen
  1. Q $$RXDEL^ABSPOS(RXI,RXR)
  1. QTY(D0) ;EP -
  1. N RXI,RXR D D0RXIRXR Q:RXI=""!(RXR="")
  1. I RXR Q $P($G(^PSRX(RXI,1,RXR,0)),U,4)
  1. E Q $P($G(^PSRX(RXI,0)),U,7)
  1. D0RXIRXR ; set up RXI,RXR,R for computed fields for ien D0
  1. N X S X=$G(^ABSPECX("RPT",D0,0)),RXI=$P(X,U,4),RXR=$P(X,U,5)
  1. Q
  1. TEST ; TEMPORARY
  1. D UPDATE61^ABSPOSM1(3010110,3010110)
  1. Q