ABSPOS6G.m

ABSPOS6G ; IHS/FCS/DRS - DUR stuff ;

 ;;1.0;PHARMACY POINT OF SALE;**1,31**;JUN 21, 2001;Build 38

 Q

DURBRIEF(RXI)      ;EP - from ABSPOS6B ;

 ; $$ brief version - for the list manager line

 S RXI=$P(RXI,".",1)  ;IHS/OIT/SCR 05/07/09 patch 31 for some reason some RXIs come in with stuff after the "."

 N RESP S RESP=$P($G(^ABSPT(RXI,0)),"^",5)

 I 'RESP Q ""  ; no response message

 N POS S POS=$P($G(^ABSPT(RXI,0)),"^",9)

 I $G(POS)="" Q ""  ;IHS/OIT/SCR 05/07/07 avoid undefined error patch 1

 N DUR S DUR=$P($G(^ABSPR(RESP,1000,POS,525)),"^")

 I DUR="" Q ""

 N I,RET S RET="" F I=1,54,107 D

 . N Y S Y=$E(DUR,I,I+53-1)

 . N X S X=$E(Y,1,2)

 . I "  0  00"[X Q

 . S:RET]"" RET=RET_" " S RET=RET_$$DUR^ABSPECP2(X)

 . N MSG S MSG=$E(Y,20,49) F  Q:$E(MSG,$L(MSG))'=" "  D

 . . S MSG=$E(MSG,1,$L(MSG)-1)

 . I MSG]"" S RET=RET_"("_MSG_")"

 Q RET

ABSPOS6G  ; IHS/FCS/DRS - DUR stuff ;

 +1       ;;1.0;PHARMACY POINT OF SALE;**1,31**;JUN 21, 2001;Build 38

 +2        QUIT 

DURBRIEF(RXI) ;EP - from ABSPOS6B ;

 +1       ; $$ brief version - for the list manager line

 +2       ;IHS/OIT/SCR 05/07/09 patch 31 for some reason some RXIs come in with stuff after the "."

           SET RXI=$PIECE(RXI,".",1)

 +3        NEW RESP

           SET RESP=$PIECE($GET(^ABSPT(RXI,0)),"^",5)

 +4       ; no response message

           IF 'RESP

               QUIT ""

 +5        NEW POS

           SET POS=$PIECE($GET(^ABSPT(RXI,0)),"^",9)

 +6       ;IHS/OIT/SCR 05/07/07 avoid undefined error patch 1

           IF $GET(POS)=""

               QUIT ""

 +7        NEW DUR

           SET DUR=$PIECE($GET(^ABSPR(RESP,1000,POS,525)),"^")

 +8        IF DUR=""

               QUIT ""

 +9        NEW I,RET

           SET RET=""

           FOR I=1,54,107

               Begin DoDot:1

 +10               NEW Y

                   SET Y=$EXTRACT(DUR,I,I+53-1)

 +11               NEW X

                   SET X=$EXTRACT(Y,1,2)

 +12               IF "  0  00"[X

                       QUIT 

 +13               IF RET]""

                       SET RET=RET_" "

                   SET RET=RET_$$DUR^ABSPECP2(X)

 +14               NEW MSG

                   SET MSG=$EXTRACT(Y,20,49)

                   FOR 

                       IF $EXTRACT(MSG,$LENGTH(MSG))'=" "

                           QUIT 

                       Begin DoDot:2

 +15                       SET MSG=$EXTRACT(MSG,1,$LENGTH(MSG)-1)

                       End DoDot:2

 +16               IF MSG]""

                       SET RET=RET_"("_MSG_")"

               End DoDot:1

 +17       QUIT RET