GMRGCLAS ;HIRMFO/RM-TERM CLASSIFICATION FILE EDIT ;1/23/96
;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY TO ADD DATA TO AGGREGATE TERM FILE IF PACKAGE IS KNOWN
; PACKAGE IN VARIABLE GMRGPK.
Q:'$D(GMRGPK)
S DIC("S")="I $P(^(0),U,2)=GMRGPK",DIC("A")="Select Classification to be modified: ",DIC="^GMRD(124.25,",DIC(0)="AEQML",DLAYGO=124.25
S DIC("DR")="1///^S X=GMRGPK"
W ! D ^DIC K DIC Q:+Y'>0 S DA=+Y,DIE="^GMRD(124.25,",DR=".01;2;S:DUZ(0)'=""@"" Y=""@1"";7;8;9;10;@1" D ^DIE
G EN1
EN2 ; SELECT PACKAGE FOR WHICH ADDING TERMS
W !!,"PACKAGE REFERENCE: " R X:DTIME G Q3:"^^"[X!'$T
I $L(X)<2!($L(X)>5)!(X?1P.E) W !?5,$C(7),"This is a reference for which to identify which package an aggregate",!?5,"term entry belongs. Answer must be 2-5 characters in length.",!!?5,"References already used include: " D LP G EN2
S GMRGPK=X D EN1
Q3 K GMRGLP,GMRGPK
Q
LP ;
S X="" F GMRGLP=0:0 S X=$O(^GMRD(124.2,"AA",X)) Q:X="" W !?18,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGCLAS 954 printed Dec 13, 2024@01:55:12 Page 2
GMRGCLAS ;HIRMFO/RM-TERM CLASSIFICATION FILE EDIT ;1/23/96
+1 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY TO ADD DATA TO AGGREGATE TERM FILE IF PACKAGE IS KNOWN
+1 ; PACKAGE IN VARIABLE GMRGPK.
+2 if '$DATA(GMRGPK)
QUIT
+3 SET DIC("S")="I $P(^(0),U,2)=GMRGPK"
SET DIC("A")="Select Classification to be modified: "
SET DIC="^GMRD(124.25,"
SET DIC(0)="AEQML"
SET DLAYGO=124.25
+4 SET DIC("DR")="1///^S X=GMRGPK"
+5 WRITE !
DO ^DIC
KILL DIC
if +Y'>0
QUIT
SET DA=+Y
SET DIE="^GMRD(124.25,"
SET DR=".01;2;S:DUZ(0)'=""@"" Y=""@1"";7;8;9;10;@1"
DO ^DIE
+6 GOTO EN1
EN2 ; SELECT PACKAGE FOR WHICH ADDING TERMS
+1 WRITE !!,"PACKAGE REFERENCE: "
READ X:DTIME
if "^^"[X!'$TEST
GOTO Q3
+2 IF $LENGTH(X)<2!($LENGTH(X)>5)!(X?1P.E)
WRITE !?5,$CHAR(7),"This is a reference for which to identify which package an aggregate",!?5,"term entry belongs. Answer must be 2-5 characters in length.",!!?5,"References already used include: "
DO LP
GOTO EN2
+3 SET GMRGPK=X
DO EN1
Q3 KILL GMRGLP,GMRGPK
+1 QUIT
LP ;
+1 SET X=""
FOR GMRGLP=0:0
SET X=$ORDER(^GMRD(124.2,"AA",X))
if X=""
QUIT
WRITE !?18,X
+2 QUIT
