ABSPOSM.m

ABSPOSM ; IHS/FCS/DRS - Report Master (.61) ;     [ 09/12/2002  10:12 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**3,44**;JUN 21, 2001;Build 38

 ;

 ; ABSPOSM1 - takes care of updating of file .61

 ; ABSPOSM2 - some report headers called from Print options

 ; ABSPOSMA-ABSPOSM* for lowercase * - general inquiry/report on .57

 ;

 Q

MESSAGE(IEN57,N) ;EP - message sent in e-claim response

 I 'IEN57 Q ""

 N RESP,POS D RESPPOS(IEN57) Q:'RESP!'POS ""

 I '$D(N) S N=0

 I N=1 Q $$MESSAGE^ABSPOS03(RESP,POS,1)

 I N=2 Q $$MESSAGE^ABSPOS03(RESP,POS,2)

 Q $$MESSAGE^ABSPOS03(RESP,POS)

RESPPOS(IEN57) ;EP - caller should N RESP,POS

 I $G(^ABSPTL(IEN57,4)) D  ; reversal

 . S RESP=$P(^ABSPTL(IEN57,4),U,2)

 . S POS=1

 E  D

 . S RESP=$P(^ABSPTL(IEN57,0),U,5)

 . S POS=$P(^ABSPTL(IEN57,0),U,9)

 Q

 ; Computed fields:

INSHELP(D0) ;EP - (#10002) INSURER HELP #

 N X S X=$P($G(^ABSPECX("RPT",D0,0)),U,3) I 'X Q "" ; IEN57

 S X=$P($G(^ABSPTL(X,1)),U,6) I 'X Q "" ; INSURER

 S X=$G(^ABSPEI(X,100)) I X="" Q "" ; insurer pharm e-claims info

 N Y S Y=$P(X,U,5) I Y]"" Q Y ; specific phone # for insurer

 ;OIT/CAS/RCS 062912 - Patch 44 Formats no longer used so quit if no phone #

 Q ""

 ;S X=$P(X,U) I 'X Q "" ; format

 ;Q $P($G(^ABSPF(9002313.92,X,1)),U,5) ; phone # as stored with format

RELTIME(D0) ;EP - (#10003) RX RELEASED DATE/TIME

 N RXI,RXR D D0RXIRXR

 I RXI=""!(RXR="") Q "" ; should never happen

 I RXR Q $P($G(^PSRX(RXI,1,RXR,0)),U,17)

 E  Q $P($G(^PSRX(RXI,2)),U,13)

RETSTOCK(D0) ;EP - (#10004) RX RETURNED TO STOCK

 N RXI,RXR D D0RXIRXR

 I RXI=""!(RXR="") Q "" ; should never happen

 I RXR Q +$P($G(^PSRX(RXI,1,RXR,0)),U,16)

 E  Q +$P($G(^PSRX(RXI,2)),U,15)

DELETED(D0) ; EP - (#10001) RX DELETED

 N RXI,RXR D D0RXIRXR

 I RXI=""!(RXR="") Q "" ; should never happen

 Q $$RXDEL^ABSPOS(RXI,RXR)

QTY(D0) ;EP -

 N RXI,RXR D D0RXIRXR Q:RXI=""!(RXR="")

 I RXR Q $P($G(^PSRX(RXI,1,RXR,0)),U,4)

 E  Q $P($G(^PSRX(RXI,0)),U,7)

D0RXIRXR ; set up RXI,RXR,R for computed fields for ien D0

 N X S X=$G(^ABSPECX("RPT",D0,0)),RXI=$P(X,U,4),RXR=$P(X,U,5)

 Q

TEST ; TEMPORARY

 D UPDATE61^ABSPOSM1(3010110,3010110)

 Q

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

 +2       ;

 +3       ; ABSPOSM1 - takes care of updating of file .61

 +4       ; ABSPOSM2 - some report headers called from Print options

 +5       ; ABSPOSMA-ABSPOSM* for lowercase * - general inquiry/report on .57

 +6       ;

 +7        QUIT 

MESSAGE(IEN57,N) ;EP - message sent in e-claim response

 +1        IF 'IEN57

               QUIT ""

 +2        NEW RESP,POS

           DO RESPPOS(IEN57)

           IF 'RESP!'POS

               QUIT ""

 +3        IF '$DATA(N)

               SET N=0

 +4        IF N=1

               QUIT $$MESSAGE^ABSPOS03(RESP,POS,1)

 +5        IF N=2

               QUIT $$MESSAGE^ABSPOS03(RESP,POS,2)

 +6        QUIT $$MESSAGE^ABSPOS03(RESP,POS)

RESPPOS(IEN57) ;EP - caller should N RESP,POS

 +1       ; reversal

           IF $GET(^ABSPTL(IEN57,4))

               Begin DoDot:1

 +2                SET RESP=$PIECE(^ABSPTL(IEN57,4),U,2)

 +3                SET POS=1

               End DoDot:1

 +4       IF '$TEST

               Begin DoDot:1

 +5                SET RESP=$PIECE(^ABSPTL(IEN57,0),U,5)

 +6                SET POS=$PIECE(^ABSPTL(IEN57,0),U,9)

               End DoDot:1

 +7        QUIT 

 +8       ; Computed fields:

INSHELP(D0) ;EP - (#10002) INSURER HELP #

 +1       ; IEN57

           NEW X

           SET X=$PIECE($GET(^ABSPECX("RPT",D0,0)),U,3)

           IF 'X

               QUIT ""

 +2       ; INSURER

           SET X=$PIECE($GET(^ABSPTL(X,1)),U,6)

           IF 'X

               QUIT ""

 +3       ; insurer pharm e-claims info

           SET X=$GET(^ABSPEI(X,100))

           IF X=""

               QUIT ""

 +4       ; specific phone # for insurer

           NEW Y

           SET Y=$PIECE(X,U,5)

           IF Y]""

               QUIT Y

 +5       ;OIT/CAS/RCS 062912 - Patch 44 Formats no longer used so quit if no phone #

 +6        QUIT ""

 +7       ;S X=$P(X,U) I 'X Q "" ; format

 +8       ;Q $P($G(^ABSPF(9002313.92,X,1)),U,5) ; phone # as stored with format

RELTIME(D0) ;EP - (#10003) RX RELEASED DATE/TIME

 +1        NEW RXI,RXR

           DO D0RXIRXR

 +2       ; should never happen

           IF RXI=""!(RXR="")

               QUIT ""

 +3        IF RXR

               QUIT $PIECE($GET(^PSRX(RXI,1,RXR,0)),U,17)

 +4       IF '$TEST

               QUIT $PIECE($GET(^PSRX(RXI,2)),U,13)

RETSTOCK(D0) ;EP - (#10004) RX RETURNED TO STOCK

 +1        NEW RXI,RXR

           DO D0RXIRXR

 +2       ; should never happen

           IF RXI=""!(RXR="")

               QUIT ""

 +3        IF RXR

               QUIT +$PIECE($GET(^PSRX(RXI,1,RXR,0)),U,16)

 +4       IF '$TEST

               QUIT +$PIECE($GET(^PSRX(RXI,2)),U,15)

DELETED(D0) ; EP - (#10001) RX DELETED

 +1        NEW RXI,RXR

           DO D0RXIRXR

 +2       ; should never happen

           IF RXI=""!(RXR="")

               QUIT ""

 +3        QUIT $$RXDEL^ABSPOS(RXI,RXR)

QTY(D0)   ;EP -

 +1        NEW RXI,RXR

           DO D0RXIRXR

           IF RXI=""!(RXR="")

               QUIT 

 +2        IF RXR

               QUIT $PIECE($GET(^PSRX(RXI,1,RXR,0)),U,4)

 +3       IF '$TEST

               QUIT $PIECE($GET(^PSRX(RXI,0)),U,7)

D0RXIRXR  ; set up RXI,RXR,R for computed fields for ien D0

 +1        NEW X

           SET X=$GET(^ABSPECX("RPT",D0,0))

           SET RXI=$PIECE(X,U,4)

           SET RXR=$PIECE(X,U,5)

 +2        QUIT 

TEST      ; TEMPORARY

 +1        DO UPDATE61^ABSPOSM1(3010110,3010110)

 +2        QUIT