- 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 Apr 23, 2025@18:01:09 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
