ABSPOSMZ.m

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)

OUTMENU ;

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

DATEMENU ;

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

MODEMENU ;

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

OUTMENU   ;

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

DATEMENU  ;

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

MODEMENU  ;

 +1       ;I:Inquiry mode (choose from list)

 +2       ;R:Report mode (just print, no choosing)

 +3       ;*