Routine: ABSPOSMB

ABSPOSMB ; IHS/FCS/DRS - General Inquiry/Report .57; [ 09/12/2002  10:14 AM ]

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

JOIN ;EP - various options from ABSPOSMA join here

 N X,DEFDATES

A ;S X=$$MODE^ABSPOSMZ

 S X="I" ; always Inquiry mode?

 I X="I" S ABSPOSMA("MODE")="INQUIRY"

 E  I X="R" S ABSPOSMA("MODE")="REPORT"

 E  Q

B I '$D(ABSPOSMA("SORT")) G D     ;if doing a Fileman sort, skip date range

 D DEFDATES ; set default sort dates

 S X=$$SORTDATE^ABSPOSMZ I X="" G A

 I X="T" D

 . S ABSPOSMA("BY WHICH DATE")="TRANSACTION"

 . K ABSPOSMA("SORT",9999.95)

 E  I X="R" D

 . S ABSPOSMA("BY WHICH DATE")="RELEASED"

 E  Q

C S X=$$DATES^ABSPOSMZ(DEFDATES) G:'X B

 I ABSPOSMA("BY WHICH DATE")="TRANSACTION" D

 . S ABSPOSMA("SORT",7,"FR")=$P(X,U)

 . S ABSPOSMA("SORT",7,"TO")=$P(X,U,2)

 . K ABSPOSMA("SORT",9999.95)

 . D AUTO^ABSPOSM1() ; have to do this because of "AE" screen

 E  D  ; released dates:  compute equivalent transaction dates

 . S ABSPOSMA("SORT",9999.95,"FR")=$P(X,U)

 . S ABSPOSMA("SORT",9999.95,"TO")=$P(X,U,2)

 . S X=$$FILE61(X)

 . I 'X D

 . . W !,"No transactions in this range of released dates?!",!

 . S ABSPOSMA("SORT",7,"FR")=$P(X,U)

 . S ABSPOSMA("SORT",7,"TO")=$P(X,U,2)

 I 'ABSPOSMA("SORT",7,"FR") G B

D ; If in report mode, then get the type of output right now

 I ABSPOSMA("MODE")="REPORT" D  G:X="" C

 . S X=$$OUTPUT^ABSPOSMZ Q:X=""

 . S ABSPOSMA("OUTPUT TYPE")=X

 W ! G CONTINUE^ABSPOSMC

FILE61(X) ; given X = low^high date range of released dates

 ; figure out range of transaction dates needed to include all of them

 ; This will make the sort efficient.

 ; return low^high range of transaction dates

 D AUTO^ABSPOSM1() ; update last couple days of 9002313.61

 N TLO,THI S TLO=9999999,THI=-1

 N RLO,RHI S RLO=$P(X,U)\1,RHI=$P(X,U,2)\1 ; stored w/o time in .61

 N RDT S RDT=RLO

 N IEN61 S IEN61=0

 F  D  S RDT=$O(^ABSPECX("RPT","B",RDT)) Q:'RDT  Q:RDT>RHI  D

 . ; loop through all released on this date

 . S IEN61=0 F  S IEN61=$O(^ABSPECX("RPT","B",RDT,IEN61)) Q:'IEN61  D

 . . N IEN57 S IEN57=$P(^ABSPECX("RPT",IEN61,0),U,3)

 . . N X S X=$P($G(^ABSPTL(IEN57,0)),U,8) ; transaction date

 . . S:X<TLO TLO=X S:X>THI THI=X

 I TLO>THI Q "" ; none?!

 Q TLO_U_THI

DEFDATES ; set DEFDATES=start^end default sort dates

 N X S X=$O(ABSPOSMA("SORT"," ")) ; what are we sorting on?

 ; by Patient or by Claim ID, we go back a year

 I X="PATIENT"!(X="CLAIM:Claim ID") S DEFDATES=DT-10000

 E  S DEFDATES=DT ; for others, it's today only

 I $P(DEFDATES,U,2)="" S $P(DEFDATES,U,2)=DT

 ; If start date default is today and there are no transactions,

 ; set the default start date to yesterday

 I $P(DEFDATES,U)=DT,'$O(^ABSPTL("AH",DT)) S $P(DEFDATES,U)=$$YESTER

YESTER() Q $$TADD^ABSPOSUD(DT,-1) ; yesterday

ABSPOSMB  ; IHS/FCS/DRS - General Inquiry/Report .57; [ 09/12/2002  10:14 AM ]

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

 +2        QUIT

JOIN      ;EP - various options from ABSPOSMA join here

 +1        NEW X,DEFDATES

A         ;S X=$$MODE^ABSPOSMZ

 +1       ; always Inquiry mode?

           SET X="I"

 +2        IF X="I"

               SET ABSPOSMA("MODE")="INQUIRY"

 +3       IF '$TEST

               IF X="R"

                   SET ABSPOSMA("MODE")="REPORT"

 +4       IF '$TEST

               QUIT

B         ;if doing a Fileman sort, skip date range

           IF '$DATA(ABSPOSMA("SORT"))

               GOTO D

 +1       ; set default sort dates

           DO DEFDATES

 +2        SET X=$$SORTDATE^ABSPOSMZ

           IF X=""

               GOTO A

 +3        IF X="T"

               Begin DoDot:1

 +4                SET ABSPOSMA("BY WHICH DATE")="TRANSACTION"

 +5                KILL ABSPOSMA("SORT",9999.95)

               End DoDot:1

 +6       IF '$TEST

               IF X="R"

                   Begin DoDot:1

 +7                    SET ABSPOSMA("BY WHICH DATE")="RELEASED"

                   End DoDot:1

 +8       IF '$TEST

               QUIT

C          SET X=$$DATES^ABSPOSMZ(DEFDATES)

           IF 'X

               GOTO B

 +1        IF ABSPOSMA("BY WHICH DATE")="TRANSACTION"

               Begin DoDot:1

 +2                SET ABSPOSMA("SORT",7,"FR")=$PIECE(X,U)

 +3                SET ABSPOSMA("SORT",7,"TO")=$PIECE(X,U,2)

 +4                KILL ABSPOSMA("SORT",9999.95)

 +5       ; have to do this because of "AE" screen

                   DO AUTO^ABSPOSM1()

               End DoDot:1

 +6       ; released dates:  compute equivalent transaction dates

          IF '$TEST

               Begin DoDot:1

 +7                SET ABSPOSMA("SORT",9999.95,"FR")=$PIECE(X,U)

 +8                SET ABSPOSMA("SORT",9999.95,"TO")=$PIECE(X,U,2)

 +9                SET X=$$FILE61(X)

 +10               IF 'X

                       Begin DoDot:2

 +11                       WRITE !,"No transactions in this range of released dates?!",!

                       End DoDot:2

 +12               SET ABSPOSMA("SORT",7,"FR")=$PIECE(X,U)

 +13               SET ABSPOSMA("SORT",7,"TO")=$PIECE(X,U,2)

               End DoDot:1

 +14       IF 'ABSPOSMA("SORT",7,"FR")

               GOTO B

D         ; If in report mode, then get the type of output right now

 +1        IF ABSPOSMA("MODE")="REPORT"

               Begin DoDot:1

 +2                SET X=$$OUTPUT^ABSPOSMZ

                   IF X=""

                       QUIT

 +3                SET ABSPOSMA("OUTPUT TYPE")=X

               End DoDot:1

               IF X=""

                   GOTO C

 +4        WRITE !

           GOTO CONTINUE^ABSPOSMC

FILE61(X) ; given X = low^high date range of released dates

 +1       ; figure out range of transaction dates needed to include all of them

 +2       ; This will make the sort efficient.

 +3       ; return low^high range of transaction dates

 +4       ; update last couple days of 9002313.61

           DO AUTO^ABSPOSM1()

 +5        NEW TLO,THI

           SET TLO=9999999

           SET THI=-1

 +6       ; stored w/o time in .61

           NEW RLO,RHI

           SET RLO=$PIECE(X,U)\1

           SET RHI=$PIECE(X,U,2)\1

 +7        NEW RDT

           SET RDT=RLO

 +8        NEW IEN61

           SET IEN61=0

 +9        FOR

               Begin DoDot:1

 +10      ; loop through all released on this date

 +11               SET IEN61=0

FOR

                       SET IEN61=$ORDER(^ABSPECX("RPT","B",RDT,IEN61))

                       IF 'IEN61

                           QUIT

                       Begin DoDot:2

 +12                       NEW IEN57

                           SET IEN57=$PIECE(^ABSPECX("RPT",IEN61,0),U,3)

 +13      ; transaction date

                           NEW X

                           SET X=$PIECE($GET(^ABSPTL(IEN57,0)),U,8)

 +14                       IF X<TLO

                               SET TLO=X

                           IF X>THI

                               SET THI=X

                       End DoDot:2

               End DoDot:1

               SET RDT=$ORDER(^ABSPECX("RPT","B",RDT))

               IF 'RDT

                   QUIT

               IF RDT>RHI

                   QUIT

               Begin DoDot:1

               End DoDot:1

 +15      ; none?!

           IF TLO>THI

               QUIT ""

 +16       QUIT TLO_U_THI

DEFDATES  ; set DEFDATES=start^end default sort dates

 +1       ; what are we sorting on?

           NEW X

           SET X=$ORDER(ABSPOSMA("SORT"," "))

 +2       ; by Patient or by Claim ID, we go back a year

 +3        IF X="PATIENT"!(X="CLAIM:Claim ID")

               SET DEFDATES=DT-10000

 +4       ; for others, it's today only

          IF '$TEST

               SET DEFDATES=DT

 +5        IF $PIECE(DEFDATES,U,2)=""

               SET $PIECE(DEFDATES,U,2)=DT

 +6       ; If start date default is today and there are no transactions,

 +7       ; set the default start date to yesterday

 +8        IF $PIECE(DEFDATES,U)=DT

               IF '$ORDER(^ABSPTL("AH",DT))

                   SET $PIECE(DEFDATES,U)=$$YESTER

 +9        QUIT

YESTER()  ; yesterday

           QUIT $$TADD^ABSPOSUD(DT,-1)

ABSPOSMB.m