GMRCPOS.m

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

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