- 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 Jan 18, 2025@03:37:59 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