GMRCPOS ;SLC/DLT - Consult postinit file maintenance ;10/28/98 14:31
;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ; -- postinit
N DA,DIK,ACTION,SITE
; Move the PREINIT actions from temporary storage in XTMP("GMRC"
; to the CONSULTS PARAMETERS FILE 123.9 for future clean-up
S DA(1)=$O(^GMR(123.9,0)) I 'DA(1) S SITE=+$$SITE^VASITE,^GMR(123.9,1,0)=SITE,^GMR(123.9,"B",SITE,1)="",DA(1)=1
;
S:'$D(^GMR(123.9,DA(1),"OLD",0)) ^GMR(123.9,DA(1),"OLD",0)="^123.9999^"
S ACTION=0 F S ACTION=$O(^XTMP("GMRC","PREINIT",ACTION)) Q:'ACTION D
.S ^GMR(123.9,DA(1),"OLD",+ACTION,0)=$P($G(^XTMP("GMRC","PREINIT",ACTION)),U,1,3)
.S $P(^GMR(123.9,DA(1),"OLD",0),U,3)=$P(^GMR(123.9,DA(1),"OLD",0),U,3)+1
.S $P(^GMR(123.9,DA(1),"OLD",0),U,4)=+ACTION
;
; -- Re-index Request Action Types in 123.1
S DIK="^GMR(123.1," D IXALL^DIK
; -- Re-index old Request Action Types in 123.9
S DA(1)=$O(^GMR(123.9,0)) Q:'DA(1)
S DIK="^GMR(123.9,"_DA(1)_",""OLD"",",DIK(1)=.01
D ENALL^DIK ;only executes the SET logic
; -- RJS -- RECREATE 63 CHARACTER 'B' CROSS REFERENCE
S DIK="^GMR(123.5,",DIK(1)=".01^B"
D ENALL^DIK ;only executes the SET logic
; -- CREATE NEW CROSS REFERENCE FOR APC and AC on sub-file (10th node)
K DA S DIK(1)="10^APC^AC",DA(1)=0
F S DA(1)=$O(^GMR(123.5,DA(1))) Q:'DA(1) D
. S DIK="^GMR(123.5,"_DA(1)_",10,"
. S DIK(1)=".01^APC^AC" D ENALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPOS 1400 printed Nov 22, 2024@16:56:53 Page 2
GMRCPOS ;SLC/DLT - Consult postinit file maintenance ;10/28/98 14:31
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ; -- postinit
+1 NEW DA,DIK,ACTION,SITE
+2 ; Move the PREINIT actions from temporary storage in XTMP("GMRC"
+3 ; to the CONSULTS PARAMETERS FILE 123.9 for future clean-up
+4 SET DA(1)=$ORDER(^GMR(123.9,0))
IF 'DA(1)
SET SITE=+$$SITE^VASITE
SET ^GMR(123.9,1,0)=SITE
SET ^GMR(123.9,"B",SITE,1)=""
SET DA(1)=1
+5 ;
+6 if '$DATA(^GMR(123.9,DA(1),"OLD",0))
SET ^GMR(123.9,DA(1),"OLD",0)="^123.9999^"
+7 SET ACTION=0
FOR
SET ACTION=$ORDER(^XTMP("GMRC","PREINIT",ACTION))
if 'ACTION
QUIT
Begin DoDot:1
+8 SET ^GMR(123.9,DA(1),"OLD",+ACTION,0)=$PIECE($GET(^XTMP("GMRC","PREINIT",ACTION)),U,1,3)
+9 SET $PIECE(^GMR(123.9,DA(1),"OLD",0),U,3)=$PIECE(^GMR(123.9,DA(1),"OLD",0),U,3)+1
+10 SET $PIECE(^GMR(123.9,DA(1),"OLD",0),U,4)=+ACTION
End DoDot:1
+11 ;
+12 ; -- Re-index Request Action Types in 123.1
+13 SET DIK="^GMR(123.1,"
DO IXALL^DIK
+14 ; -- Re-index old Request Action Types in 123.9
+15 SET DA(1)=$ORDER(^GMR(123.9,0))
if 'DA(1)
QUIT
+16 SET DIK="^GMR(123.9,"_DA(1)_",""OLD"","
SET DIK(1)=.01
+17 ;only executes the SET logic
DO ENALL^DIK
+18 ; -- RJS -- RECREATE 63 CHARACTER 'B' CROSS REFERENCE
+19 SET DIK="^GMR(123.5,"
SET DIK(1)=".01^B"
+20 ;only executes the SET logic
DO ENALL^DIK
+21 ; -- CREATE NEW CROSS REFERENCE FOR APC and AC on sub-file (10th node)
+22 KILL DA
SET DIK(1)="10^APC^AC"
SET DA(1)=0
+23 FOR
SET DA(1)=$ORDER(^GMR(123.5,DA(1)))
if 'DA(1)
QUIT
Begin DoDot:1
+24 SET DIK="^GMR(123.5,"_DA(1)_",10,"
+25 SET DIK(1)=".01^APC^AC"
DO ENALL^DIK
End DoDot:1
+26 QUIT
