Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPIYY

RMPRPIYY.m

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