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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYY 4470 printed Nov 22, 2024@17:47:21 Page 2
RMPRPIYY ;HINCIO/ODJ - PIP EDIT - PROMPTS AND BARCODE ;3/8/01
+1 ;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
+2 QUIT
+3 ; The following subroutines are for selecting Orders (661.41)
+4 ;
+5 ;***** OK - Prompt for an OK
OK(RMPRYN,RMPREXC) ;
+1 NEW DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
+2 SET RMPREXC=""
+3 SET RMPRYN="N"
+4 SET DIR("A")=" ...OK"
+5 SET DIR("B")="Yes"
+6 SET DIR(0)="Y"
+7 DO ^DIR
+8 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO OKX
+9 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO OKX
+10 IF X=""!(X["^")
SET RMPREXC="^"
GOTO OKX
+11 SET RMPRYN="N"
if Y
SET RMPRYN="Y"
OKX QUIT
+1 ;
+2 ;***** PVEN - Prompt for an Open order
PORD(RMPRSTN,RMPRHCPC,RMPRITM,RMPR41,RMPREXC) ;
+1 NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR,RMPRIEN1
+2 NEW RMPRMAX,RMPRLIN,RMPRGBL,RMPR41I,RMPRS,STS,RMPROCNT,RMPRIEN,RMPRD
+3 SET (RMPRERR,RMPROCNT)=0
+4 SET RMPREXC=""
+5 SET RMPRMAX=15
+6 SET RMPRLIN=0
+7 KILL RMPR41
+8 ;
+9 ; See if just 1 record - no need to list if there is
+10 ; Loop on open orders
+11 KILL RMPRORD,RMPRIEN1
+12 FOR STS="O","R"
SET RMPRD=""
FOR
SET RMPRD=$ORDER(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRHCPC,RMPRITM,RMPRD))
if RMPRD=""
QUIT
Begin DoDot:1
+13 SET RMPRIEN=""
+14 FOR
SET RMPRIEN=$ORDER(^RMPR(661.41,"ASSHID",RMPRSTN,STS,RMPRHCPC,RMPRITM,RMPRD,RMPRIEN))
if RMPRIEN=""
QUIT
Begin DoDot:2
+15 KILL RMPR41
SET RMPR41("IEN")=RMPRIEN
+16 SET RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
+17 IF RMPRERR
SET RMPRERR=99
QUIT
+18 IF RMPR41("BALANCE QTY")<1
QUIT
+19 SET RMPRORD(RMPRD,RMPRIEN)=STS
SET RMPRIEN1=RMPRIEN
SET RMPROCNT=RMPROCNT+1
+20 QUIT
End DoDot:2
if RMPRERR
QUIT
+21 QUIT
End DoDot:1
if RMPRERR
QUIT
+22 IF RMPROCNT=0
KILL RMPR41
GOTO PORDX
+23 IF RMPROCNT=1
SET RMPR41("IEN")=RMPRIEN1
GOTO PORDG
+24 ;
+25 ; Selection list of current stock records
PORDL1 SET RMPRD=0
PORDL1A SET RMPRD=$ORDER(RMPRORD(RMPRD))
IF RMPRD=""
if 'RMPRLIN
GOTO PORDX
GOTO PORDP
PORDL1B SET RMPRIEN=$ORDER(RMPRORD(RMPRD,RMPRIEN))
if RMPRIEN=""
GOTO PORDL1A
+1 KILL RMPR41,RMPR41I
+2 SET RMPR41("IEN")=RMPRIEN
+3 SET RMPR41I("IEN")=RMPR41("IEN")
+4 SET RMPRERR=$$GETI^RMPRPIXN(.RMPR41I,)
+5 SET RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
+6 IF RMPRLIN
IF '(RMPRLIN#RMPRMAX)
Begin DoDot:1
+7 SET DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
+8 QUIT
End DoDot:1
GOTO PORDP
PORDL2 SET RMPRLIN=RMPRLIN+1
+1 IF RMPRLIN=1
DO PORDH
+2 SET RMPRS=$PIECE(RMPR41I("DATE ORDER"),".",1)
+3 WRITE !,$JUSTIFY(RMPRLIN,2)," ",$EXTRACT(RMPRS,4,5)_"/"_$EXTRACT(RMPRS,6,7)_"/"_$EXTRACT(RMPRS,2,3)
+4 WRITE ?11,$JUSTIFY(RMPR41("ORDER QTY"),5,0)
+5 WRITE ?18,$EXTRACT(RMPR41("VENDOR"),1,30)
+6 IF +RMPR41("RECEIVE QTY")
Begin DoDot:1
+7 WRITE ?49,$JUSTIFY(RMPR41("RECEIVE QTY"),5,0)
+8 SET RMPRS=$PIECE(RMPR41I("DATE RECEIVE"),".",1)
+9 WRITE " ",$EXTRACT(RMPRS,4,5)_"/"_$EXTRACT(RMPRS,6,7)_"/"_$EXTRACT(RMPRS,2,3)
+10 QUIT
End DoDot:1
+11 SET RMPRA(RMPRLIN)=RMPR41("IEN")
+12 KILL RMPR41,RMPR41I
+13 GOTO PORDL1B
+14 ;
+15 ; Prompt for selection
PORDP SET DIR(0)="FAO"
+1 SET DIR("A")="Choose 1 - "_RMPRLIN_" : "
+2 DO ^DIR
+3 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO PORDX
+4 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO PORDX
+5 IF X=""
IF $DATA(DIR("A",1))
KILL DIR("A",1)
DO PORDH
GOTO PORDL2
+6 IF X=""
SET RMPREXC="^"
GOTO PORDX
+7 IF X["^"!($DATA(DUOUT))
SET RMPREXC="^"
GOTO PORDX
+8 IF '$DATA(RMPRA(X))
Begin DoDot:1
+9 WRITE !,"Please select a stock order record"
+10 WRITE !,"by entering a line number in range 1 - "
+11 WRITE RMPRLIN
+12 QUIT
End DoDot:1
GOTO PORDP
+13 SET RMPR41("IEN")=RMPRA(X)
PORDG KILL RMPR41I
+1 SET RMPR41I("IEN")=RMPR41("IEN")
+2 SET RMPRERR=$$GETI^RMPRPIXN(.RMPR41I,)
+3 SET RMPRERR=$$GET^RMPRPIXN(.RMPR41,)
+4 SET RMPR41("VENDOR IEN")=RMPR41I("VENDOR")
PORDX QUIT
PORDE() ;
+1 if $QSUBSCRIPT(RMPRGBL,1)'=661.41
QUIT 1
+2 if $QSUBSCRIPT(RMPRGBL,2)'="ASSHID"
QUIT 1
+3 if $QSUBSCRIPT(RMPRGBL,3)'=RMPRSTN
QUIT 1
+4 if $QSUBSCRIPT(RMPRGBL,4)'="O"
QUIT 1
+5 if $QSUBSCRIPT(RMPRGBL,5)'=RMPRHCPC
QUIT 1
+6 if $QSUBSCRIPT(RMPRGBL,6)'=RMPRITM
QUIT 1
+7 QUIT 0
PORDH WRITE !
+1 WRITE !,"Select a current stock order record, or ^ if not receiving against an order.",!
+2 WRITE ?3,"Date",?13,"Qty",?18,"Vendor",?49,"Received"
+3 QUIT
+4 ;
+5 ;***** NLAB - call prompt for number of labels to print
NLAB SET RMPRNLAB=RMPR6("QUANTITY")
+1 WRITE !
DO NLABP^RMPRPIYS(.RMPRNLAB,RMPR6("QUANTITY"),.RMPREXC)
+2 IF RMPREXC="T"
GOTO RCX
+3 IF RMPREXC="P"
GOTO RCNX
+4 IF RMPREXC="^"
GOTO RCNX
+5 IF RMPRNLAB=0
GOTO RCNX
+6 ;
+7 ;***** SELP - call prompt for barcode print device
SELP ;
+1 IF RMPREXC'=""
GOTO NLAB
+2 ;K RMPR7I
+3 ;S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
+4 SET RMPRBARC=RMPR11("HCPCS")_"-"_$PIECE(RMPR6("DATE&TIME"),".",1)_$PIECE(RMPR6("DATE&TIME"),".",2)
+5 SET RMPRITXT("DATE")=$EXTRACT(RMPR6("DATE&TIME"),4,5)_"/"_$EXTRACT(RMPR6("DATE&TIME"),6,7)_"/"_(1700+$EXTRACT(RMPR6("DATE&TIME"),1,3))
+6 SET RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM")
+7 SET RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION")
+8 SET RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER")
+9 SET RMPRITXT("UNIT PRICE")=RMPRUCST
+10 SET RMPRITXT("VENDOR")=RMPRVEND("NAME")
+11 SET RMPRITXT("LOCATION")=RMPR5("NAME")
+12 DO PRINT^RMPRPIYS
RCNX ;K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST,RMPRBCP,RMPRQ,RMPRIOP,RMPRNLAB
+1 ;K RMPRBARC,RMPRITXT,RMPR41N,RMPR41,RMPRVEND
RCX QUIT
