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

RMPG6.m

Go to the documentation of this file.
  1. RMPG6 ;DDC/KAW-ROES PATCH RMPF*2.0*9-AHS [ 01/28/98 9:30 AM ]
  1. ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**9**;1/21/98
  1. W @IOF,!,"ROES PATCH: RMPF*2.0*9"
  1. W !!,"This patch will inactivate old Custom Hearing Aid models and components"
  1. W !,"and add new models, makes and components for the Custom Hearing Aid"
  1. W !,"contracts that take affect on February 1, 1998. Only ROES users must be"
  1. W !,"off of the system while running the patch. These contract changes will"
  1. W !,"take affect on February 1, 1998, at the DDC, so this patch should"
  1. W !,"be installed between COB 1/30/98 and the morning of 2/2/98 at your station."
  1. W !!,"The only files affected are:"
  1. W !!?10,"791811 - REMOTE INVENTORY PRODUCT"
  1. W !?10,"791811.2 - HEARING AID COMPONENTS"
  1. W !?10,"791811.3 - BATTERY FILE",!
  1. W !!,"Inactivating old models and components"
  1. S RMPFX=0
  1. F S RMPFX=$O(^RMPF(791811,RMPFX)) Q:'RMPFX D
  1. .S X=$P($G(^RMPF(791811,RMPFX,0)),U,3) Q:'X S NM=$P(^(0),U,1)
  1. .Q:'$D(^RMPF(791811.1,X,0)) Q:$P(^(0),U,1)'="CUSTOM HEARING AIDS"
  1. .S DIE="^RMPF(791811,",DA=RMPFX,DR="999////1" D ^DIE W "."
  1. .K ^RMPF(791811,RMPFX,101),^(102)
  1. D ^RMPG6A
  1. W !!,"Update Complete"
  1. END K BP,BT,BX,CA,%,CD,CP,CS,CX,DLAYGO,DQ,D0,DI,DA,DR,DIC,DIE,IX,IY,IZ,MD,MP,NM,ST,SX,X,Y,RMPFX Q
  1. SET1 I '$D(^RMPF(791811,MP,101,0)) S ^RMPF(791811,MP,101,0)="^791811.0101PA"
  1. Q:$D(^RMPF(791811,MP,101,"B",CX))
  1. S DIC="^RMPF(791811,"_MP_",101,",X=CX,DIC(0)="L",DLAYGO=791811
  1. S DIC("DR")=".02////"_CS,DA(1)=MP K DD,DO D FILE^DICN K DIC
  1. I Y=-1 W !!,CP," not added."
  1. Q
  1. SET2 I '$D(^RMPF(791811,MP,102,0)) S ^RMPF(791811,MP,102,0)="^791811.0102PA"
  1. Q:$D(^RMPF(791811,MP,102,"B",BP))
  1. S DIC="^RMPF(791811,"_MP_",102,",X=BP,DIC(0)="L",DLAYGO=791811
  1. S DA(1)=MP K DD,DO D FILE^DICN K DIC
  1. I Y=-1 W !!,BP," not added."
  1. Q