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

RMPRPIY1.m

Go to the documentation of this file.
  1. RMPRPIY1 ;HINCIO/ODJ - PIP Data Entry - Prompts;3/8/01
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. Q
  1. ;
  1. ;***** STN - Prompt for Station
  1. STN(RMPRSTN,RMPRESC) ;
  1. N X,Y,DIC,DA,DUOUT,DTOUT,DIROUT,DIRUT,RMPR,RMPRSITE
  1. S RMPRERR=0
  1. S RMPRSTN("IEN")=$G(RMPRSTN("IEN"))
  1. I $G(DUZ)="" S RMPRERR=1 G STNX ;User must exist (ptr. to ^VA(200))
  1. S RMPRESC=""
  1. D DIV4^RMPRSIT ; call standard Prosthetic site look-up
  1. I $G(X)="^^" S RMPREXC="P" G STNX
  1. I $D(X) S RMPRESC="^" G STNX
  1. S RMPRSTN("IEN")=$G(RMPR("STA"))
  1. I RMPRSTN("IEN")="" S RMPRERR=99 G STNX
  1. S RMPRSTN("SITE NAME")=$G(RMPR("NAME"))
  1. STNX Q RMPRERR
  1. ;
  1. ;***** ITED - Edit an Inventory Item description and update 661.11
  1. ITED(RMPR11,RMPREXC) ;
  1. N DIR,X,Y,DA,DUOUT,DTOUT,DIRUT,DIROUT,RMPRYN,RMPR11N,RMPRERR
  1. S DIR(0)="FOA^3:60"
  1. S DIR("A")="PIP Item Description: "
  1. S DIR("??")="^D ITEDH2^RMPRPIY1"
  1. S DIR("B")=$G(RMPR11("DESCRIPTION"))
  1. ITED1 D ^DIR
  1. I $D(DTOUT) S RMPREXC="T" G ITEDX
  1. I $D(DIROUT) S RMPREXC="P" G ITEDX
  1. I X["^"!($D(DUOUT)) S RMPREXC="^" G ITEDX
  1. I X="" G ITEDX
  1. S RMPREXC=""
  1. I X=$G(RMPR11("DESCRIPTION")) G ITEDX
  1. L +^RMPR(661.11,RMPR11("IEN")):0 E D G ITEDX
  1. . W !,"Item being edited by another user, cannot continue."
  1. . H 2
  1. . S RMPREXC="^"
  1. . Q
  1. S RMPR11N("DESCRIPTION")=X
  1. D ITEDO(.RMPRYN,.RMPREXC)
  1. I RMPREXC="T" G ITEDU
  1. I RMPREXC'=""!(RMPRYN="N") D G ITED1
  1. . S RMPREXC=""
  1. . L -^RMPR(661.11,RMPR11("IEN"))
  1. . Q
  1. S RMPR11N("IEN")=RMPR11("IEN")
  1. S RMPRERR=$$UPD^RMPRPIX1(.RMPR11N)
  1. W !
  1. S RMPR11("DESCRIPTION")=$G(RMPR11N("DESCRIPTION"))
  1. ITEDU L -^RMPR(661.11,RMPR11("IEN"))
  1. ITEDX Q
  1. ;
  1. ; (??) Help text for item desc.
  1. ITEDH2 W "Enter a description for this item which will be used locally by",!
  1. W "your Prosthetics Service.",!
  1. W "You may want to use the Item Master description with additional",!
  1. W "text specifying things like size, volume, etc."
  1. Q
  1. ;
  1. ; Y/N Prompt to confirm change of Item Description
  1. ITEDO(RMPRYN,RMPREXC) ;
  1. N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
  1. S RMPRYN="N"
  1. S RMPREXC=""
  1. S DIR(0)="Y"
  1. S DIR("B")="N"
  1. S DIR("A")="Are you sure you want to change this Item's Description"
  1. D ^DIR
  1. I $D(DTOUT) S RMPREXC="T" G ITEDOX
  1. I $D(DIROUT) S RMPREXC="P" G ITEDOX
  1. I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G ITEDOX
  1. S:Y RMPRYN="Y"
  1. ITEDOX Q
  1. ;
  1. ;***** MASIT - prompt for Item Master
  1. MASIT(RMPR1,RMPREXC) ;
  1. N DIC,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
  1. S DIC(0)="AEQM"
  1. S DIC=661
  1. S DIC("A")="IFCAP ITEM: "
  1. I $G(RMPR1("ITEM MASTER IEN"))'="" S DIC("B")=RMPR1("ITEM MASTER IEN")
  1. W !
  1. D ^DIC
  1. I $D(DTOUT) S RMPREXC="T" G MASITX
  1. I $D(DUOUT) S RMPREXC=$S(X="^^":"P",1:"^") G MASITX
  1. I +Y=-1 S RMPREXC="^" G MASITX
  1. S RMPREXC=""
  1. S RMPR1("IEN")=$P(Y,"^",1)
  1. MASITX Q
  1. ;
  1. ;***** HCPCS - select HCPCS and inventory item
  1. HCPCS(RMPRSTN,RMPRHCPC,RMPR1,RMPR11,RMPREXC) ;
  1. HCPCS1 D HCPCS^RMPRPIY7(RMPRSTN,$G(RMPRHCPC),.RMPR1,.RMPR11,.RMPREXC)
  1. I RMPREXC="T" G HCPCSX
  1. I RMPREXC="P"!(RMPREXC="^") G HCPCSX
  1. I $G(RMPR11("IEN"))'="" G HCPCSX
  1. HCPCS2 D ITEM^RMPRPIYP(RMPRSTN,RMPR1("HCPCS"),.RMPR11,.RMPREXC)
  1. I RMPREXC="T" G HCPCSX
  1. I RMPREXC="P" G HCPCS1
  1. I RMPREXC="^" G HCPCSX
  1. S RMPR11("STATION")=RMPRSTN
  1. S RMPR11("STATION IEN")=RMPRSTN
  1. ;
  1. ; display selected HCPCS and item and continue
  1. HCPCS3 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC"))
  1. W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER"))
  1. W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION"))
  1. HCPCSX Q