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

RMPRPIYR.m

Go to the documentation of this file.
  1. RMPRPIYR ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. Q
  1. ; The following subroutines are for selecting HCPCS
  1. ; and Inventory Item
  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 current Stock Record
  1. PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ;
  1. N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR
  1. N RMPRMAX,RMPRLIN,RMPRGBL,RMPR7I,RMPRS
  1. S RMPRERR=0
  1. S RMPREXC=""
  1. S RMPRMAX=15
  1. S RMPRLIN=0
  1. K RMPR7,RMPR6
  1. S RMPRLCN=$G(RMPRLCN)
  1. ;
  1. ; See if just 1 record - no need to list if there is
  1. S RMPRGBLR="^RMPR(661.7,""XSHIDS"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITM_""")"
  1. S RMPRGBL=$Q(@RMPRGBLR)
  1. I $$PVENE() G PVENX
  1. S RMPR7("IEN")=$QS(RMPRGBL,8)
  1. S RMPRGBL=$Q(@RMPRGBL)
  1. I $$PVENE() G PVENG
  1. ;
  1. ; Selection list of current stock records
  1. S RMPRGBL=RMPRGBLR
  1. PVENL1 S RMPRGBL=$Q(@RMPRGBL)
  1. I $$PVENE G:'RMPRLIN PVENX G PVENP
  1. K RMPR7,RMPR7I
  1. S RMPR7("IEN")=$QS(RMPRGBL,8)
  1. S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
  1. S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
  1. I RMPRLCN'="",RMPRLCN'=RMPR7I("LOCATION") G PVENL1
  1. I RMPRLIN,'(RMPRLIN#RMPRMAX) D G PVENP
  1. . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
  1. . Q
  1. PVENL2 S RMPRLIN=RMPRLIN+1
  1. I RMPRLIN=1 D PVENH
  1. S RMPRS=$P(RMPR7I("DATE&TIME"),".",1)
  1. W !,$J(RMPRLIN,2)," ",$E(RMPRS,4,5)_"/"_$E(RMPRS,6,7)_"/"_$E(RMPRS,2,3)
  1. W ?11,$J(RMPR7("QUANTITY"),5,0)
  1. I +RMPR7("QUANTITY") D
  1. . W ?18,$J(RMPR7("VALUE")/RMPR7("QUANTITY"),8,2)
  1. . Q
  1. W ?26,$J(RMPR7("VALUE"),10,2)
  1. S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
  1. S RMPR6("HCPCS")=RMPRHCPC
  1. S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
  1. W ?38,$E(RMPR6("VENDOR"),1,30)
  1. W ?69,$E(RMPR7("LOCATION"),1,10)
  1. S RMPRA(RMPRLIN)=RMPR7("IEN")
  1. K RMPR7,RMPR7I,RMPR6
  1. G PVENL1
  1. ;
  1. ; Prompt for selection
  1. PVENP S DIR(0)="FAO"
  1. S DIR("A")="Choose 1 - "_RMPRLIN_" : "
  1. D ^DIR
  1. I $D(DTOUT) S RMPREXC="T" G PVENX
  1. I $D(DIROUT) S RMPREXC="P" G PVENX
  1. I X="",$D(DIR("A",1)) K DIR("A",1) D PVENH G PVENL2
  1. I X="" S RMPREXC="^" G PVENX
  1. I X["^"!($D(DUOUT)) S RMPREXC="^" G PVENX
  1. I '$D(RMPRA(X)) D G PVENP
  1. . W !,"Please select a current stock record"
  1. . W !,"by entering a line number in range 1 - "
  1. . W RMPRLIN
  1. . Q
  1. S RMPR7("IEN")=RMPRA(X)
  1. PVENG S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
  1. K RMPR7I
  1. S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
  1. S RMPRLCN=RMPR7I("LOCATION")
  1. S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
  1. S RMPR6("HCPCS")=RMPRHCPC
  1. S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
  1. PVENX Q
  1. PVENE() ;
  1. Q:$QS(RMPRGBL,1)'=661.7 1
  1. Q:$QS(RMPRGBL,2)'="XSHIDS" 1
  1. Q:$QS(RMPRGBL,3)'=RMPRSTN 1
  1. Q:$QS(RMPRGBL,4)'=RMPRHCPC 1
  1. Q:$QS(RMPRGBL,5)'=RMPRITM 1
  1. Q 0
  1. PVENH W !
  1. W !,"Select a current stock record...",!
  1. W ?3,"Date",?13,"Qty",?18,"Unit Cost",?31,"Value",?38,"Vendor"
  1. I RMPRLCN="" W ?69,"Location"
  1. Q