- RMPG6 ;DDC/KAW-ROES PATCH RMPF*2.0*9-AHS [ 01/28/98 9:30 AM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**9**;1/21/98
- W @IOF,!,"ROES PATCH: RMPF*2.0*9"
- W !!,"This patch will inactivate old Custom Hearing Aid models and components"
- W !,"and add new models, makes and components for the Custom Hearing Aid"
- W !,"contracts that take affect on February 1, 1998. Only ROES users must be"
- W !,"off of the system while running the patch. These contract changes will"
- W !,"take affect on February 1, 1998, at the DDC, so this patch should"
- W !,"be installed between COB 1/30/98 and the morning of 2/2/98 at your station."
- W !!,"The only files affected are:"
- W !!?10,"791811 - REMOTE INVENTORY PRODUCT"
- W !?10,"791811.2 - HEARING AID COMPONENTS"
- W !?10,"791811.3 - BATTERY FILE",!
- W !!,"Inactivating old models and components"
- S RMPFX=0
- F S RMPFX=$O(^RMPF(791811,RMPFX)) Q:'RMPFX D
- .S X=$P($G(^RMPF(791811,RMPFX,0)),U,3) Q:'X S NM=$P(^(0),U,1)
- .Q:'$D(^RMPF(791811.1,X,0)) Q:$P(^(0),U,1)'="CUSTOM HEARING AIDS"
- .S DIE="^RMPF(791811,",DA=RMPFX,DR="999////1" D ^DIE W "."
- .K ^RMPF(791811,RMPFX,101),^(102)
- D ^RMPG6A
- W !!,"Update Complete"
- 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
- SET1 I '$D(^RMPF(791811,MP,101,0)) S ^RMPF(791811,MP,101,0)="^791811.0101PA"
- Q:$D(^RMPF(791811,MP,101,"B",CX))
- S DIC="^RMPF(791811,"_MP_",101,",X=CX,DIC(0)="L",DLAYGO=791811
- S DIC("DR")=".02////"_CS,DA(1)=MP K DD,DO D FILE^DICN K DIC
- I Y=-1 W !!,CP," not added."
- Q
- SET2 I '$D(^RMPF(791811,MP,102,0)) S ^RMPF(791811,MP,102,0)="^791811.0102PA"
- Q:$D(^RMPF(791811,MP,102,"B",BP))
- S DIC="^RMPF(791811,"_MP_",102,",X=BP,DIC(0)="L",DLAYGO=791811
- S DA(1)=MP K DD,DO D FILE^DICN K DIC
- I Y=-1 W !!,BP," not added."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPG6 1799 printed Feb 19, 2025@00:03:33 Page 2
- 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
- +2 WRITE @IOF,!,"ROES PATCH: RMPF*2.0*9"
- +3 WRITE !!,"This patch will inactivate old Custom Hearing Aid models and components"
- +4 WRITE !,"and add new models, makes and components for the Custom Hearing Aid"
- +5 WRITE !,"contracts that take affect on February 1, 1998. Only ROES users must be"
- +6 WRITE !,"off of the system while running the patch. These contract changes will"
- +7 WRITE !,"take affect on February 1, 1998, at the DDC, so this patch should"
- +8 WRITE !,"be installed between COB 1/30/98 and the morning of 2/2/98 at your station."
- +9 WRITE !!,"The only files affected are:"
- +10 WRITE !!?10,"791811 - REMOTE INVENTORY PRODUCT"
- +11 WRITE !?10,"791811.2 - HEARING AID COMPONENTS"
- +12 WRITE !?10,"791811.3 - BATTERY FILE",!
- +13 WRITE !!,"Inactivating old models and components"
- +14 SET RMPFX=0
- +15 FOR
- SET RMPFX=$ORDER(^RMPF(791811,RMPFX))
- if 'RMPFX
- QUIT
- Begin DoDot:1
- +16 SET X=$PIECE($GET(^RMPF(791811,RMPFX,0)),U,3)
- if 'X
- QUIT
- SET NM=$PIECE(^(0),U,1)
- +17 if '$DATA(^RMPF(791811.1,X,0))
- QUIT
- if $PIECE(^(0),U,1)'="CUSTOM HEARING AIDS"
- QUIT
- +18 SET DIE="^RMPF(791811,"
- SET DA=RMPFX
- SET DR="999////1"
- DO ^DIE
- WRITE "."
- +19 KILL ^RMPF(791811,RMPFX,101),^(102)
- End DoDot:1
- +20 DO ^RMPG6A
- +21 WRITE !!,"Update Complete"
- END KILL 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
- QUIT
- SET1 IF '$DATA(^RMPF(791811,MP,101,0))
- SET ^RMPF(791811,MP,101,0)="^791811.0101PA"
- +1 if $DATA(^RMPF(791811,MP,101,"B",CX))
- QUIT
- +2 SET DIC="^RMPF(791811,"_MP_",101,"
- SET X=CX
- SET DIC(0)="L"
- SET DLAYGO=791811
- +3 SET DIC("DR")=".02////"_CS
- SET DA(1)=MP
- KILL DD,DO
- DO FILE^DICN
- KILL DIC
- +4 IF Y=-1
- WRITE !!,CP," not added."
- +5 QUIT
- SET2 IF '$DATA(^RMPF(791811,MP,102,0))
- SET ^RMPF(791811,MP,102,0)="^791811.0102PA"
- +1 if $DATA(^RMPF(791811,MP,102,"B",BP))
- QUIT
- +2 SET DIC="^RMPF(791811,"_MP_",102,"
- SET X=BP
- SET DIC(0)="L"
- SET DLAYGO=791811
- +3 SET DA(1)=MP
- KILL DD,DO
- DO FILE^DICN
- KILL DIC
- +4 IF Y=-1
- WRITE !!,BP," not added."
- +5 QUIT
