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
Q
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
Q
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)
