ABSPOSMZ ; IHS/FCS/DRS - General Inquiry/Report .57; [ 09/12/2002 10:15 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
Q
ASKPHARM() ; EP - Lookup pharmacy (the POS pharmacy, that is)
; Return pointer to 9002313.56
N DIC,X,Y,DINUM,DTIME,DLAYGO
S DIC=9002313.56,DIC(0)="AEMQ"
D ^DIC
Q $S(Y>0:+Y,1:"")
ASKPAT() ; EP - Lookup patient - patient must have a Point of Sale transaction
; Return patient IEN, return false if none selected
N DIC,X,Y,DINUM,DTIME,DLAYGO
S DIC=2,DIC(0)="AEMQ"
S DIC("S")="I $D(^ABSPTL(""AC"",Y))"
D ^DIC
Q $S(Y>0:+Y,1:"")
ASKRTYPE() ; EP - Lookup result type
; Return the name of the result type, null if none selected
N DIC,X,Y,DINUM,DTIME,DLAYGO
S DIC=9002313.83,DIC(0)="AEMQ"
D ^DIC
Q $S(Y>0:$P(^ABSPF(9002313.83,+Y,0),U),1:"")
OUTPUT() ; EP - ask for output type
; Returns one of the codes in OUTMENU, below. Or "" if no selection.
N DIR,X,Y
S DIR(0)="SAO^"
S DIR("A")="Select style of output: "
N I,X W !! F I=1:1 S X=$P($T(OUTMENU+I),";",2) Q:X="*" D
. S DIR(0)=DIR(0)_X_";"
. W ?5,$P(X,":"),?10,$P(X,":",2),!
S DIR("B")=$G(ABSPOSMA("OUTPUT TYPE")) S:DIR("B")="" DIR("B")="S"
D ^DIR
Q $S("^^"[Y:"",1:Y)
;D:DUR info only
;F:Financial Detail
;C:Claim - Basic info
;S:Transaction Summary only
;R:Response info
;J:Rejection Codes Detail
;*
;T:Total Detail
;REC:Summary Receipt
;PT:Print Template selection
;FM:Fileman to customize output
DEFOUT() ; EP - return code of first item in OUTMENU
N X S X=$T(OUTMENU+1)
Q $P($P(X,";",2),":")
SORTDATE() ; EP - ask which date to sort by
; Returns "T" for transaction date, "R" for released date, or ""
N DIR,X,Y S DIR(0)="SAO^"
S DIR("A")="Select by which date? "
S DIR("B")="T"
N I,X W !! F I=1:1 S X=$P($T(DATEMENU+I),";",2) Q:X="*" D
. S DIR(0)=DIR(0)_X_";"
. W ?5,$P(X,":"),?10,$P(X,":",2),!
D ^DIR
Q $S("^^"[Y:"",1:Y)
;T:Transaction date
;R:Released date
;*
DATES(DEF) ; EP -
N PR1,PR2,DEF1,DEF2
S PR1="Starting with "_ABSPOSMA("BY WHICH DATE")_" date: "
S PR2=" Going thru "_ABSPOSMA("BY WHICH DATE")_" date: "
S DEF1=$P(DEF,U),DEF2=$P(DEF,U,2)
;I ABSPOSMA("BY WHICH DATE")="TRANSACTION" D
;. S DEF1=$G(ABSPOSMA("SORT",7,"FR"))
;. S DEF2=$G(ABSPOSMA("SORT",7,"TO"))
;E D
;. S DEF1=$G(ABSPOSMA("SORT",9999.95,"FR"))
;. S DEF2=$G(ABSPOSMA("SORT",9999.95,"TO"))
I 'DEF2 S DEF2=$E($$NOW^ABSPOS,1,7+1+2+2) ; today (down to the minute)
I 'DEF1 S DEF1=$$TADD^ABSPOSUD(DEF2\1,-7) ; a week ago
W !
Q $$DTR^ABSPOSU1(PR1,PR2,DEF1,DEF2,"T")
MODE() ; EP - ask which mode to run in - Inquiry or Report
; Returns "I" for inquiry mode, "R" for report mode, or ""
N DIR,X,Y S DIR(0)="SAO^"
S DIR("A")="Inquiry or Report mode? "
S DIB("B")="I"
N I,X W !! F I=1:1 S X=$P($T(MODEMENU+I),";",2) Q:X="*" D
. S DIR(0)=DIR(0)_X_";"
. W ?5,$P(X,":"),?10,$P(X,":",2),!
S DIR("B")=$E($G(ABSPOSMA("MODE"))) S:DIR("B")="" DIR("B")="I"
D ^DIR
Q $S("^^"[Y:"",1:Y)
;I:Inquiry mode (choose from list)
;R:Report mode (just print, no choosing)
;*
ABSPOSMZ ; IHS/FCS/DRS - General Inquiry/Report .57; [ 09/12/2002 10:15 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 QUIT
ASKPHARM() ; EP - Lookup pharmacy (the POS pharmacy, that is)
+1 ; Return pointer to 9002313.56
+2 NEW DIC,X,Y,DINUM,DTIME,DLAYGO
+3 SET DIC=9002313.56
SET DIC(0)="AEMQ"
+4 DO ^DIC
+5 QUIT $SELECT(Y>0:+Y,1:"")
ASKPAT() ; EP - Lookup patient - patient must have a Point of Sale transaction
+1 ; Return patient IEN, return false if none selected
+2 NEW DIC,X,Y,DINUM,DTIME,DLAYGO
+3 SET DIC=2
SET DIC(0)="AEMQ"
+4 SET DIC("S")="I $D(^ABSPTL(""AC"",Y))"
+5 DO ^DIC
+6 QUIT $SELECT(Y>0:+Y,1:"")
ASKRTYPE() ; EP - Lookup result type
+1 ; Return the name of the result type, null if none selected
+2 NEW DIC,X,Y,DINUM,DTIME,DLAYGO
+3 SET DIC=9002313.83
SET DIC(0)="AEMQ"
+4 DO ^DIC
+5 QUIT $SELECT(Y>0:$PIECE(^ABSPF(9002313.83,+Y,0),U),1:"")
OUTPUT() ; EP - ask for output type
+1 ; Returns one of the codes in OUTMENU, below. Or "" if no selection.
+2 NEW DIR,X,Y
+3 SET DIR(0)="SAO^"
+4 SET DIR("A")="Select style of output: "
+5 NEW I,X
WRITE !!
FOR I=1:1
SET X=$PIECE($TEXT(OUTMENU+I),";",2)
IF X="*"
QUIT
Begin DoDot:1
+6 SET DIR(0)=DIR(0)_X_";"
+7 WRITE ?5,$PIECE(X,":"),?10,$PIECE(X,":",2),!
End DoDot:1
+8 SET DIR("B")=$GET(ABSPOSMA("OUTPUT TYPE"))
IF DIR("B")=""
SET DIR("B")="S"
+9 DO ^DIR
+10 QUIT $SELECT("^^"[Y:"",1:Y)
+1 ;D:DUR info only
+2 ;F:Financial Detail
+3 ;C:Claim - Basic info
+4 ;S:Transaction Summary only
+5 ;R:Response info
+6 ;J:Rejection Codes Detail
+7 ;*
+8 ;T:Total Detail
+9 ;REC:Summary Receipt
+10 ;PT:Print Template selection
+11 ;FM:Fileman to customize output
DEFOUT() ; EP - return code of first item in OUTMENU
+1 NEW X
SET X=$TEXT(OUTMENU+1)
+2 QUIT $PIECE($PIECE(X,";",2),":")
SORTDATE() ; EP - ask which date to sort by
+1 ; Returns "T" for transaction date, "R" for released date, or ""
+2 NEW DIR,X,Y
SET DIR(0)="SAO^"
+3 SET DIR("A")="Select by which date? "
+4 SET DIR("B")="T"
+5 NEW I,X
WRITE !!
FOR I=1:1
SET X=$PIECE($TEXT(DATEMENU+I),";",2)
IF X="*"
QUIT
Begin DoDot:1
+6 SET DIR(0)=DIR(0)_X_";"
+7 WRITE ?5,$PIECE(X,":"),?10,$PIECE(X,":",2),!
End DoDot:1
+8 DO ^DIR
+9 QUIT $SELECT("^^"[Y:"",1:Y)
+1 ;T:Transaction date
+2 ;R:Released date
+3 ;*
DATES(DEF) ; EP -
+1 NEW PR1,PR2,DEF1,DEF2
+2 SET PR1="Starting with "_ABSPOSMA("BY WHICH DATE")_" date: "
+3 SET PR2=" Going thru "_ABSPOSMA("BY WHICH DATE")_" date: "
+4 SET DEF1=$PIECE(DEF,U)
SET DEF2=$PIECE(DEF,U,2)
+5 ;I ABSPOSMA("BY WHICH DATE")="TRANSACTION" D
+6 ;. S DEF1=$G(ABSPOSMA("SORT",7,"FR"))
+7 ;. S DEF2=$G(ABSPOSMA("SORT",7,"TO"))
+8 ;E D
+9 ;. S DEF1=$G(ABSPOSMA("SORT",9999.95,"FR"))
+10 ;. S DEF2=$G(ABSPOSMA("SORT",9999.95,"TO"))
+11 ; today (down to the minute)
IF 'DEF2
SET DEF2=$EXTRACT($$NOW^ABSPOS,1,7+1+2+2)
+12 ; a week ago
IF 'DEF1
SET DEF1=$$TADD^ABSPOSUD(DEF2\1,-7)
+13 WRITE !
+14 QUIT $$DTR^ABSPOSU1(PR1,PR2,DEF1,DEF2,"T")
MODE() ; EP - ask which mode to run in - Inquiry or Report
+1 ; Returns "I" for inquiry mode, "R" for report mode, or ""
+2 NEW DIR,X,Y
SET DIR(0)="SAO^"
+3 SET DIR("A")="Inquiry or Report mode? "
+4 SET DIB("B")="I"
+5 NEW I,X
WRITE !!
FOR I=1:1
SET X=$PIECE($TEXT(MODEMENU+I),";",2)
IF X="*"
QUIT
Begin DoDot:1
+6 SET DIR(0)=DIR(0)_X_";"
+7 WRITE ?5,$PIECE(X,":"),?10,$PIECE(X,":",2),!
End DoDot:1
+8 SET DIR("B")=$EXTRACT($GET(ABSPOSMA("MODE")))
IF DIR("B")=""
SET DIR("B")="I"
+9 DO ^DIR
+10 QUIT $SELECT("^^"[Y:"",1:Y)
+1 ;I:Inquiry mode (choose from list)
+2 ;R:Report mode (just print, no choosing)
+3 ;*
