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

RMPRPIYM.m

Go to the documentation of this file.
  1. RMPRPIYM ;HINCIO/ODJ - PIP RECONCILE OPTION PROMPTS ;3/8/01
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. Q
  1. ; The following subroutines are a series of prompts called
  1. ; by RECONCILE option (UP^RMPRPIYA)
  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. ;***** ITEM - Prompt for Item - restrict choice to Location and HCPC
  1. ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ;
  1. N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN
  1. S RMPRERR=0
  1. S RMPREXC=""
  1. I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX
  1. I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX
  1. I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX
  1. K RMPR11,RMPR4
  1. S DIR(0)="FOA^1:50"
  1. S DIR("A")="Enter ITEM to Reconcile: "
  1. S DIR("?")="^D QM^RMPRPIY8"
  1. S DIR("??")="^D QQM^RMPRPIY8"
  1. ITEMA1 D ^DIR
  1. I $D(DTOUT) S RMPREXC="T" G ITEMX
  1. I $D(DIROUT) S RMPREXC="P" G ITEMX
  1. I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX
  1. D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4)
  1. I RMPREXC="T" G ITEMX
  1. I RMPREXC="P" G ITEMX
  1. I RMPREXC="^" G ITEMA1
  1. I RMPR4("IEN")="" D G ITEMA1
  1. . W !,"Cannot locate ITEM with this sequence NUMBER"
  1. . Q
  1. W " ",RMPR11("HCPCS-ITEM")," ",RMPR11("DESCRIPTION")
  1. D OK(.RMPRYN,.RMPREXC)
  1. I RMPRYN'="Y" G ITEMA1
  1. G ITEMX
  1. ITEMX Q RMPRERR