GMRCYP41 ;SLC/JFR - PRE/POST INSTALL FOR GMRC*3*41; 2/4/05 13:29
;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
;
; This routine invokes one-time IA #4605
;
Q
PRE ; pre-install
; This pre-install will delete the "AE", "AE1" and "AE2" MUMPS
; cross-references on the REQUEST/CONSULTATION (#123) file
; and replace them with a new-style index "AE" during the install
; that will have the same format as the prior "AE" cross-reference.
; This will insure greater reliability in the setting and
; killing of the "AE" cross-reference.
;
N GMRCAE,GMRCAE1,GMRCAE2,IDX
S (GMRCAE,GMRCAE1,GMRCAE2)=0
K ^GMR(123,"AE") ; kill off all existing data
S IDX=0
F S IDX=$O(^DD(123,1,1,IDX)) Q:'IDX D
. Q:$P($G(^DD(123,1,1,IDX,0)),U,2)'="AE"
. S GMRCAE=IDX
. D DELIX^DDMOD(123,1,GMRCAE)
. S IDX=" " ;quit the loop
. Q
S IDX=0
F S IDX=$O(^DD(123,3,1,IDX)) Q:'IDX D
. Q:$P($G(^DD(123,3,1,IDX,0)),U,2)'="AE1"
. S GMRCAE1=IDX
. D DELIX^DDMOD(123,3,GMRCAE1)
. S IDX=" " ; quit the loop
. Q
S IDX=0
F S IDX=$O(^DD(123,8,1,IDX)) Q:'IDX D
. Q:$P($G(^DD(123,8,1,IDX,0)),U,2)'="AE2"
. S GMRCAE2=IDX
. D DELIX^DDMOD(123,8,GMRCAE2)
. S IDX=" " ; quit the loop
. Q
Q
;
POST ; post-install to create and build new "AE" index
N GMRCXR,GMRCRES,GMRCOUT
S GMRCXR("FILE")=123
S GMRCXR("NAME")="AE"
S GMRCXR("TYPE")="R"
S GMRCXR("USE")="S"
S GMRCXR("EXECUTION")="R"
S GMRCXR("ACTIVITY")="IR"
S GMRCXR("SHORT DESCR")="Index by SERVICE, STATUS, DATE OF REQUEST"
S GMRCXR("DESCR",1)="This cross reference is used for services to see all consults by service,"
S GMRCXR("DESCR",2)="OE/RR status and Date of Request."
S GMRCXR("VAL",1)=1
S GMRCXR("VAL",1,"SUBSCRIPT")=1
S GMRCXR("VAL",1,"LENGTH")=5
S GMRCXR("VAL",1,"COLLATION")="F"
S GMRCXR("VAL",2)=8
S GMRCXR("VAL",2,"SUBSCRIPT")=2
S GMRCXR("VAL",2,"LENGTH")=5
S GMRCXR("VAL",2,"COLLATION")="F"
S GMRCXR("VAL",3)=3
S GMRCXR("VAL",3,"SUBSCRIPT")=3
S GMRCXR("VAL",3,"LENGTH")=20
S GMRCXR("VAL",3,"COLLATION")="F"
S GMRCXR("VAL",3,"XFORM FOR STORAGE")="S X=9999999-X"
D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP41 2161 printed Nov 22, 2024@16:58:06 Page 2
GMRCYP41 ;SLC/JFR - PRE/POST INSTALL FOR GMRC*3*41; 2/4/05 13:29
+1 ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
+2 ;
+3 ; This routine invokes one-time IA #4605
+4 ;
+5 QUIT
PRE ; pre-install
+1 ; This pre-install will delete the "AE", "AE1" and "AE2" MUMPS
+2 ; cross-references on the REQUEST/CONSULTATION (#123) file
+3 ; and replace them with a new-style index "AE" during the install
+4 ; that will have the same format as the prior "AE" cross-reference.
+5 ; This will insure greater reliability in the setting and
+6 ; killing of the "AE" cross-reference.
+7 ;
+8 NEW GMRCAE,GMRCAE1,GMRCAE2,IDX
+9 SET (GMRCAE,GMRCAE1,GMRCAE2)=0
+10 ; kill off all existing data
KILL ^GMR(123,"AE")
+11 SET IDX=0
+12 FOR
SET IDX=$ORDER(^DD(123,1,1,IDX))
if 'IDX
QUIT
Begin DoDot:1
+13 if $PIECE($GET(^DD(123,1,1,IDX,0)),U,2)'="AE"
QUIT
+14 SET GMRCAE=IDX
+15 DO DELIX^DDMOD(123,1,GMRCAE)
+16 ;quit the loop
SET IDX=" "
+17 QUIT
End DoDot:1
+18 SET IDX=0
+19 FOR
SET IDX=$ORDER(^DD(123,3,1,IDX))
if 'IDX
QUIT
Begin DoDot:1
+20 if $PIECE($GET(^DD(123,3,1,IDX,0)),U,2)'="AE1"
QUIT
+21 SET GMRCAE1=IDX
+22 DO DELIX^DDMOD(123,3,GMRCAE1)
+23 ; quit the loop
SET IDX=" "
+24 QUIT
End DoDot:1
+25 SET IDX=0
+26 FOR
SET IDX=$ORDER(^DD(123,8,1,IDX))
if 'IDX
QUIT
Begin DoDot:1
+27 if $PIECE($GET(^DD(123,8,1,IDX,0)),U,2)'="AE2"
QUIT
+28 SET GMRCAE2=IDX
+29 DO DELIX^DDMOD(123,8,GMRCAE2)
+30 ; quit the loop
SET IDX=" "
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;
POST ; post-install to create and build new "AE" index
+1 NEW GMRCXR,GMRCRES,GMRCOUT
+2 SET GMRCXR("FILE")=123
+3 SET GMRCXR("NAME")="AE"
+4 SET GMRCXR("TYPE")="R"
+5 SET GMRCXR("USE")="S"
+6 SET GMRCXR("EXECUTION")="R"
+7 SET GMRCXR("ACTIVITY")="IR"
+8 SET GMRCXR("SHORT DESCR")="Index by SERVICE, STATUS, DATE OF REQUEST"
+9 SET GMRCXR("DESCR",1)="This cross reference is used for services to see all consults by service,"
+10 SET GMRCXR("DESCR",2)="OE/RR status and Date of Request."
+11 SET GMRCXR("VAL",1)=1
+12 SET GMRCXR("VAL",1,"SUBSCRIPT")=1
+13 SET GMRCXR("VAL",1,"LENGTH")=5
+14 SET GMRCXR("VAL",1,"COLLATION")="F"
+15 SET GMRCXR("VAL",2)=8
+16 SET GMRCXR("VAL",2,"SUBSCRIPT")=2
+17 SET GMRCXR("VAL",2,"LENGTH")=5
+18 SET GMRCXR("VAL",2,"COLLATION")="F"
+19 SET GMRCXR("VAL",3)=3
+20 SET GMRCXR("VAL",3,"SUBSCRIPT")=3
+21 SET GMRCXR("VAL",3,"LENGTH")=20
+22 SET GMRCXR("VAL",3,"COLLATION")="F"
+23 SET GMRCXR("VAL",3,"XFORM FOR STORAGE")="S X=9999999-X"
+24 DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")
+25 QUIT
