RMPRPIY1 ;HINCIO/ODJ - PIP Data Entry - Prompts;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** STN - Prompt for Station
STN(RMPRSTN,RMPRESC) ;
N X,Y,DIC,DA,DUOUT,DTOUT,DIROUT,DIRUT,RMPR,RMPRSITE
S RMPRERR=0
S RMPRSTN("IEN")=$G(RMPRSTN("IEN"))
I $G(DUZ)="" S RMPRERR=1 G STNX ;User must exist (ptr. to ^VA(200))
S RMPRESC=""
D DIV4^RMPRSIT ; call standard Prosthetic site look-up
I $G(X)="^^" S RMPREXC="P" G STNX
I $D(X) S RMPRESC="^" G STNX
S RMPRSTN("IEN")=$G(RMPR("STA"))
I RMPRSTN("IEN")="" S RMPRERR=99 G STNX
S RMPRSTN("SITE NAME")=$G(RMPR("NAME"))
STNX Q RMPRERR
;
;***** ITED - Edit an Inventory Item description and update 661.11
ITED(RMPR11,RMPREXC) ;
N DIR,X,Y,DA,DUOUT,DTOUT,DIRUT,DIROUT,RMPRYN,RMPR11N,RMPRERR
S DIR(0)="FOA^3:60"
S DIR("A")="PIP Item Description: "
S DIR("??")="^D ITEDH2^RMPRPIY1"
S DIR("B")=$G(RMPR11("DESCRIPTION"))
ITED1 D ^DIR
I $D(DTOUT) S RMPREXC="T" G ITEDX
I $D(DIROUT) S RMPREXC="P" G ITEDX
I X["^"!($D(DUOUT)) S RMPREXC="^" G ITEDX
I X="" G ITEDX
S RMPREXC=""
I X=$G(RMPR11("DESCRIPTION")) G ITEDX
L +^RMPR(661.11,RMPR11("IEN")):0 E D G ITEDX
. W !,"Item being edited by another user, cannot continue."
. H 2
. S RMPREXC="^"
. Q
S RMPR11N("DESCRIPTION")=X
D ITEDO(.RMPRYN,.RMPREXC)
I RMPREXC="T" G ITEDU
I RMPREXC'=""!(RMPRYN="N") D G ITED1
. S RMPREXC=""
. L -^RMPR(661.11,RMPR11("IEN"))
. Q
S RMPR11N("IEN")=RMPR11("IEN")
S RMPRERR=$$UPD^RMPRPIX1(.RMPR11N)
W !
S RMPR11("DESCRIPTION")=$G(RMPR11N("DESCRIPTION"))
ITEDU L -^RMPR(661.11,RMPR11("IEN"))
ITEDX Q
;
; (??) Help text for item desc.
ITEDH2 W "Enter a description for this item which will be used locally by",!
W "your Prosthetics Service.",!
W "You may want to use the Item Master description with additional",!
W "text specifying things like size, volume, etc."
Q
;
; Y/N Prompt to confirm change of Item Description
ITEDO(RMPRYN,RMPREXC) ;
N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
S RMPRYN="N"
S RMPREXC=""
S DIR(0)="Y"
S DIR("B")="N"
S DIR("A")="Are you sure you want to change this Item's Description"
D ^DIR
I $D(DTOUT) S RMPREXC="T" G ITEDOX
I $D(DIROUT) S RMPREXC="P" G ITEDOX
I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G ITEDOX
S:Y RMPRYN="Y"
ITEDOX Q
;
;***** MASIT - prompt for Item Master
MASIT(RMPR1,RMPREXC) ;
N DIC,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
S DIC(0)="AEQM"
S DIC=661
S DIC("A")="IFCAP ITEM: "
I $G(RMPR1("ITEM MASTER IEN"))'="" S DIC("B")=RMPR1("ITEM MASTER IEN")
W !
D ^DIC
I $D(DTOUT) S RMPREXC="T" G MASITX
I $D(DUOUT) S RMPREXC=$S(X="^^":"P",1:"^") G MASITX
I +Y=-1 S RMPREXC="^" G MASITX
S RMPREXC=""
S RMPR1("IEN")=$P(Y,"^",1)
MASITX Q
;
;***** HCPCS - select HCPCS and inventory item
HCPCS(RMPRSTN,RMPRHCPC,RMPR1,RMPR11,RMPREXC) ;
HCPCS1 D HCPCS^RMPRPIY7(RMPRSTN,$G(RMPRHCPC),.RMPR1,.RMPR11,.RMPREXC)
I RMPREXC="T" G HCPCSX
I RMPREXC="P"!(RMPREXC="^") G HCPCSX
I $G(RMPR11("IEN"))'="" G HCPCSX
HCPCS2 D ITEM^RMPRPIYP(RMPRSTN,RMPR1("HCPCS"),.RMPR11,.RMPREXC)
I RMPREXC="T" G HCPCSX
I RMPREXC="P" G HCPCS1
I RMPREXC="^" G HCPCSX
S RMPR11("STATION")=RMPRSTN
S RMPR11("STATION IEN")=RMPRSTN
;
; display selected HCPCS and item and continue
HCPCS3 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC"))
W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER"))
W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION"))
HCPCSX Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIY1 3444 printed Dec 13, 2024@02:36:50 Page 2
RMPRPIY1 ;HINCIO/ODJ - PIP Data Entry - Prompts;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** STN - Prompt for Station
STN(RMPRSTN,RMPRESC) ;
+1 NEW X,Y,DIC,DA,DUOUT,DTOUT,DIROUT,DIRUT,RMPR,RMPRSITE
+2 SET RMPRERR=0
+3 SET RMPRSTN("IEN")=$GET(RMPRSTN("IEN"))
+4 ;User must exist (ptr. to ^VA(200))
IF $GET(DUZ)=""
SET RMPRERR=1
GOTO STNX
+5 SET RMPRESC=""
+6 ; call standard Prosthetic site look-up
DO DIV4^RMPRSIT
+7 IF $GET(X)="^^"
SET RMPREXC="P"
GOTO STNX
+8 IF $DATA(X)
SET RMPRESC="^"
GOTO STNX
+9 SET RMPRSTN("IEN")=$GET(RMPR("STA"))
+10 IF RMPRSTN("IEN")=""
SET RMPRERR=99
GOTO STNX
+11 SET RMPRSTN("SITE NAME")=$GET(RMPR("NAME"))
STNX QUIT RMPRERR
+1 ;
+2 ;***** ITED - Edit an Inventory Item description and update 661.11
ITED(RMPR11,RMPREXC) ;
+1 NEW DIR,X,Y,DA,DUOUT,DTOUT,DIRUT,DIROUT,RMPRYN,RMPR11N,RMPRERR
+2 SET DIR(0)="FOA^3:60"
+3 SET DIR("A")="PIP Item Description: "
+4 SET DIR("??")="^D ITEDH2^RMPRPIY1"
+5 SET DIR("B")=$GET(RMPR11("DESCRIPTION"))
ITED1 DO ^DIR
+1 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO ITEDX
+2 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO ITEDX
+3 IF X["^"!($DATA(DUOUT))
SET RMPREXC="^"
GOTO ITEDX
+4 IF X=""
GOTO ITEDX
+5 SET RMPREXC=""
+6 IF X=$GET(RMPR11("DESCRIPTION"))
GOTO ITEDX
+7 LOCK +^RMPR(661.11,RMPR11("IEN")):0
IF '$TEST
Begin DoDot:1
+8 WRITE !,"Item being edited by another user, cannot continue."
+9 HANG 2
+10 SET RMPREXC="^"
+11 QUIT
End DoDot:1
GOTO ITEDX
+12 SET RMPR11N("DESCRIPTION")=X
+13 DO ITEDO(.RMPRYN,.RMPREXC)
+14 IF RMPREXC="T"
GOTO ITEDU
+15 IF RMPREXC'=""!(RMPRYN="N")
Begin DoDot:1
+16 SET RMPREXC=""
+17 LOCK -^RMPR(661.11,RMPR11("IEN"))
+18 QUIT
End DoDot:1
GOTO ITED1
+19 SET RMPR11N("IEN")=RMPR11("IEN")
+20 SET RMPRERR=$$UPD^RMPRPIX1(.RMPR11N)
+21 WRITE !
+22 SET RMPR11("DESCRIPTION")=$GET(RMPR11N("DESCRIPTION"))
ITEDU LOCK -^RMPR(661.11,RMPR11("IEN"))
ITEDX QUIT
+1 ;
+2 ; (??) Help text for item desc.
ITEDH2 WRITE "Enter a description for this item which will be used locally by",!
+1 WRITE "your Prosthetics Service.",!
+2 WRITE "You may want to use the Item Master description with additional",!
+3 WRITE "text specifying things like size, volume, etc."
+4 QUIT
+5 ;
+6 ; Y/N Prompt to confirm change of Item Description
ITEDO(RMPRYN,RMPREXC) ;
+1 NEW DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
+2 SET RMPRYN="N"
+3 SET RMPREXC=""
+4 SET DIR(0)="Y"
+5 SET DIR("B")="N"
+6 SET DIR("A")="Are you sure you want to change this Item's Description"
+7 DO ^DIR
+8 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO ITEDOX
+9 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO ITEDOX
+10 IF X=""!(X["^")!($DATA(DUOUT))
SET RMPREXC="^"
GOTO ITEDOX
+11 if Y
SET RMPRYN="Y"
ITEDOX QUIT
+1 ;
+2 ;***** MASIT - prompt for Item Master
MASIT(RMPR1,RMPREXC) ;
+1 NEW DIC,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
+2 SET DIC(0)="AEQM"
+3 SET DIC=661
+4 SET DIC("A")="IFCAP ITEM: "
+5 IF $GET(RMPR1("ITEM MASTER IEN"))'=""
SET DIC("B")=RMPR1("ITEM MASTER IEN")
+6 WRITE !
+7 DO ^DIC
+8 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO MASITX
+9 IF $DATA(DUOUT)
SET RMPREXC=$SELECT(X="^^":"P",1:"^")
GOTO MASITX
+10 IF +Y=-1
SET RMPREXC="^"
GOTO MASITX
+11 SET RMPREXC=""
+12 SET RMPR1("IEN")=$PIECE(Y,"^",1)
MASITX QUIT
+1 ;
+2 ;***** HCPCS - select HCPCS and inventory item
HCPCS(RMPRSTN,RMPRHCPC,RMPR1,RMPR11,RMPREXC) ;
HCPCS1 DO HCPCS^RMPRPIY7(RMPRSTN,$GET(RMPRHCPC),.RMPR1,.RMPR11,.RMPREXC)
+1 IF RMPREXC="T"
GOTO HCPCSX
+2 IF RMPREXC="P"!(RMPREXC="^")
GOTO HCPCSX
+3 IF $GET(RMPR11("IEN"))'=""
GOTO HCPCSX
HCPCS2 DO ITEM^RMPRPIYP(RMPRSTN,RMPR1("HCPCS"),.RMPR11,.RMPREXC)
+1 IF RMPREXC="T"
GOTO HCPCSX
+2 IF RMPREXC="P"
GOTO HCPCS1
+3 IF RMPREXC="^"
GOTO HCPCSX
+4 SET RMPR11("STATION")=RMPRSTN
+5 SET RMPR11("STATION IEN")=RMPRSTN
+6 ;
+7 ; display selected HCPCS and item and continue
HCPCS3 WRITE !!,"HCPCS: "_$GET(RMPR1("HCPCS"))_" "_$GET(RMPR1("SHORT DESC"))
+1 WRITE !!,"IFCAP Item: ",$GET(RMPR11("ITEM MASTER"))
+2 WRITE !!,"PIP Item desc.: ",$GET(RMPR11("DESCRIPTION"))
HCPCSX QUIT
