133 lines
4.2 KiB
Mathematica
133 lines
4.2 KiB
Mathematica
RMPRPIYY ;HINCIO/ODJ - PIP EDIT - PROMPTS AND BARCODE ;3/8/01
|
|
;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
|
|
Q
|
|
; The following subroutines are for selecting Orders (661.41)
|
|
;
|
|
;***** OK - Prompt for an OK
|
|
OK(RMPRYN,RMPREXC) ;
|
|
N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
|
|
S RMPREXC=""
|
|
S RMPRYN="N"
|
|
S DIR("A")=" ...OK"
|
|
S DIR("B")="Yes"
|
|
S DIR(0)="Y"
|
|
D ^DIR
|
|
I $D(DTOUT) S RMPREXC="T" G OKX
|
|
I $D(DIROUT) S RMPREXC="P" G OKX
|
|
I X=""!(X["^") S RMPREXC="^" G OKX
|
|
S RMPRYN="N" S:Y RMPRYN="Y"
|
|
OKX Q
|
|
;
|
|
;***** PVEN - Prompt for an Open order
|
|
PORD(RMPRSTN,RMPRHCPC,RMPRITM,RMPR41,RMPREXC) ;
|
|
N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR,RMPRIEN1
|
|
N RMPRMAX,RMPRLIN,RMPRGBL,RMPR41I,RMPRS,STS,RMPROCNT,RMPRIEN,RMPRD
|
|
S (RMPRERR,RMPROCNT)=0
|
|
S RMPREXC=""
|
|
S RMPRMAX=15
|
|
S RMPRLIN=0
|
|
K RMPR41
|
|
;
|
|
; See if just 1 record - no need to list if there is
|
|
; Loop on open orders
|
|
K RMPRORD,RMPRIEN1
|
|
F STS="O","R" S RMPRD="" F S RMPRD=$O(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRHCPC,RMPRITM,RMPRD)) Q:RMPRD="" D Q:RMPRERR
|
|
. S RMPRIEN=""
|
|
. F S RMPRIEN=$O(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRHCPC,RMPRITM,RMPRD,RMPRIEN)) Q:RMPRIEN="" D Q:RMPRERR
|
|
.. K RMPR41 S RMPR41("IEN")=RMPRIEN
|
|
.. S RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
|
|
.. I RMPRERR S RMPRERR=99 Q
|
|
.. I RMPR41("BALANCE QTY")<1 Q
|
|
.. S RMPRORD(RMPRD,RMPRIEN)=STS,RMPRIEN1=RMPRIEN,RMPROCNT=RMPROCNT+1
|
|
.. Q
|
|
. Q
|
|
I RMPROCNT=0 K RMPR41 G PORDX
|
|
I RMPROCNT=1 S RMPR41("IEN")=RMPRIEN1 G PORDG
|
|
;
|
|
; Selection list of current stock records
|
|
PORDL1 S RMPRD=0
|
|
PORDL1A S RMPRD=$O(RMPRORD(RMPRD)) I RMPRD="" G:'RMPRLIN PORDX G PORDP
|
|
PORDL1B S RMPRIEN=$O(RMPRORD(RMPRD,RMPRIEN)) G:RMPRIEN="" PORDL1A
|
|
K RMPR41,RMPR41I
|
|
S RMPR41("IEN")=RMPRIEN
|
|
S RMPR41I("IEN")=RMPR41("IEN")
|
|
S RMPRERR=$$GETI^RMPRPIXN(.RMPR41I,)
|
|
S RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
|
|
I RMPRLIN,'(RMPRLIN#RMPRMAX) D G PORDP
|
|
. S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
|
|
. Q
|
|
PORDL2 S RMPRLIN=RMPRLIN+1
|
|
I RMPRLIN=1 D PORDH
|
|
S RMPRS=$P(RMPR41I("DATE ORDER"),".",1)
|
|
W !,$J(RMPRLIN,2)," ",$E(RMPRS,4,5)_"/"_$E(RMPRS,6,7)_"/"_$E(RMPRS,2,3)
|
|
W ?11,$J(RMPR41("ORDER QTY"),5,0)
|
|
W ?18,$E(RMPR41("VENDOR"),1,30)
|
|
I +RMPR41("RECEIVE QTY") D
|
|
. W ?49,$J(RMPR41("RECEIVE QTY"),5,0)
|
|
. S RMPRS=$P(RMPR41I("DATE RECEIVE"),".",1)
|
|
. W " ",$E(RMPRS,4,5)_"/"_$E(RMPRS,6,7)_"/"_$E(RMPRS,2,3)
|
|
. Q
|
|
S RMPRA(RMPRLIN)=RMPR41("IEN")
|
|
K RMPR41,RMPR41I
|
|
G PORDL1B
|
|
;
|
|
; Prompt for selection
|
|
PORDP S DIR(0)="FAO"
|
|
S DIR("A")="Choose 1 - "_RMPRLIN_" : "
|
|
D ^DIR
|
|
I $D(DTOUT) S RMPREXC="T" G PORDX
|
|
I $D(DIROUT) S RMPREXC="P" G PORDX
|
|
I X="",$D(DIR("A",1)) K DIR("A",1) D PORDH G PORDL2
|
|
I X="" S RMPREXC="^" G PORDX
|
|
I X["^"!($D(DUOUT)) S RMPREXC="^" G PORDX
|
|
I '$D(RMPRA(X)) D G PORDP
|
|
. W !,"Please select a stock order record"
|
|
. W !,"by entering a line number in range 1 - "
|
|
. W RMPRLIN
|
|
. Q
|
|
S RMPR41("IEN")=RMPRA(X)
|
|
PORDG K RMPR41I
|
|
S RMPR41I("IEN")=RMPR41("IEN")
|
|
S RMPRERR=$$GETI^RMPRPIXN(.RMPR41I,)
|
|
S RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
|
|
S RMPR41("VENDOR IEN")=RMPR41I("VENDOR")
|
|
PORDX Q
|
|
PORDE() ;
|
|
Q:$QS(RMPRGBL,1)'=661.41 1
|
|
Q:$QS(RMPRGBL,2)'="ASSHID" 1
|
|
Q:$QS(RMPRGBL,3)'=RMPRSTN 1
|
|
Q:$QS(RMPRGBL,4)'="O" 1
|
|
Q:$QS(RMPRGBL,5)'=RMPRHCPC 1
|
|
Q:$QS(RMPRGBL,6)'=RMPRITM 1
|
|
Q 0
|
|
PORDH W !
|
|
W !,"Select a current stock order record, or ^ if not receiving against an order.",!
|
|
W ?3,"Date",?13,"Qty",?18,"Vendor",?49,"Received"
|
|
Q
|
|
;
|
|
;***** NLAB - call prompt for number of labels to print
|
|
NLAB S RMPRNLAB=RMPR6("QUANTITY")
|
|
W ! D NLABP^RMPRPIYS(.RMPRNLAB,RMPR6("QUANTITY"),.RMPREXC)
|
|
I RMPREXC="T" G RCX
|
|
I RMPREXC="P" G RCNX
|
|
I RMPREXC="^" G RCNX
|
|
I RMPRNLAB=0 G RCNX
|
|
;
|
|
;***** SELP - call prompt for barcode print device
|
|
SELP ;
|
|
I RMPREXC'="" G NLAB
|
|
;K RMPR7I
|
|
;S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
|
|
S RMPRBARC=RMPR11("HCPCS")_"-"_$P(RMPR6("DATE&TIME"),".",1)_$P(RMPR6("DATE&TIME"),".",2)
|
|
S RMPRITXT("DATE")=$E(RMPR6("DATE&TIME"),4,5)_"/"_$E(RMPR6("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR6("DATE&TIME"),1,3))
|
|
S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM")
|
|
S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION")
|
|
S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER")
|
|
S RMPRITXT("UNIT PRICE")=RMPRUCST
|
|
S RMPRITXT("VENDOR")=RMPRVEND("NAME")
|
|
S RMPRITXT("LOCATION")=RMPR5("NAME")
|
|
D PRINT^RMPRPIYS
|
|
RCNX ;K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST,RMPRBCP,RMPRQ,RMPRIOP,RMPRNLAB
|
|
;K RMPRBARC,RMPRITXT,RMPR41N,RMPR41,RMPRVEND
|
|
RCX Q
|