Routine: SDECINI1

SDECINI1 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

RESAB  ;populate SDEC ACCESS BLOCK file from existing AVAILABILITY in file 44

SDWLCL  ;populate SD WL CLINIC LOCATION file with clinics from file 44

 N SDCL,SDCLID,SDCLN,SDCLRD,SDDATA,SDFDA,SDFIELDS,SDIEN,SDMSG,SDW

 W !!,"Updating SD WL CLINIC LOCATION file 409.32 with clinics from file 44..."

 S SDCL=0 F  S SDCL=$O(^SC(SDCL)) Q:SDCL'>0  D

 .K SDDATA,SDMSG

 .; .01 name; 2 type; 1912 len of appt; 2508 no show let; 2509 pre-appt let; 2510 clinic can let;

 .;S SDFIELDS=".01;2;3;1912;2502.3;2505;2506;2508;2509;2510"

 .S SDFIELDS=".01;2;3;1912;2505;2506;2508;2509;2510"

 .D GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG")

 .Q:SDDATA(44,SDCL_",",2,"I")'="C"

 .;Q:SDDATA(44,SDCL_",",2502.3,"I")=1

 .S SDCLN=SDDATA(44,SDCL_",",.01,"E")   ;clinic name

 .;look for existing to allow this post-init to be re-entrant

 .I $O(^SDWL(409.32,"B",SDCL,0)) D SDWLCL1(SDCL,.SDDATA) Q  ;W !,"SDWLCL: Clinic "_SDCLN_" is already defined in SD WL CLINIC LOCATION." Q

 .S SDCLID=SDDATA(44,SDCL_",",2505,"I")

 .S SDCLRD=SDDATA(44,SDCL_",",2506,"I")

 .Q:$$INACTIVE^SDECUTL2(SDCL,$P($$NOW^XLFDT,".",1),9991231,SDCLID,SDCLRD)

 .I SDDATA(44,SDCL_",",3,"I")="" D  Q

 ..W !,"SDWLCL: Clinic "_SDCLN_" does not have an INSTITUTION defined in file 44."

 ..W !,"        Unable to store "_SDCLN_" in the SD WL CLINIC LOCATION file."

 .S SDW="+1"

 .K SDFDA,SDIEN,SDMSG

 .S SDFDA=$NA(SDFDA(409.32,SDW_","))

 .S @SDFDA@(.01)=SDCL

 .S @SDFDA@(.02)=SDDATA(44,SDCL_",",3,"I")

 .I SDCLID="" S @SDFDA@(1)=$P($$NOW^XLFDT,".",1)

 .I SDCLID="" S @SDFDA@(2)=DUZ

 .I SDCLID'="" S @SDFDA@(3)=SDDATA(44,SDCL_",",2505,"I")

 .I SDCLID'="" S @SDFDA@(4)=DUZ  ;SDDATA(44,SDCL_",",2506,"I")

 .D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")

 .I $D(SDMSG) W !,"SDWLCL: Unable to store clinic "_SDCL_" in SD WL CLINIC LOCATION." Q

SDWLCL1(SDCL,SDDATA)  ;

 N SDAD,SDCLI,SDCLAD,SDCLID,SDCLRD,SDFDA,SDI,SDID

 S SDI="" F  S SDI=$O(^SDWL(409.32,"B",SDCL,SDI)) Q:SDI'>0  D

 .S SDAD=$$GET1^DIQ(409.32,SDI_",",1,"I")

 .S SDID=$$GET1^DIQ(409.32,SDI_",",3,"I")

 .S SDCLAD=$P($$NOW^XLFDT,".",1)

 .S SDCLID=SDDATA(44,SDCL_",",2505,"I")

 .S SDCLRD=SDDATA(44,SDCL_",",2506,"I")

 .S SDCLI=$$INACTIVE^SDECUTL2(SDCL,SDCLAD,9991231,SDCLID,SDCLRD)

 .Q:SDCLI=0  ;leave the settings in 409.32 as they are if clinic is active

 .;I SDCLI=0 D  ;clinic is active

 .;.I SDID="",((SDAD="")!(SDAD>SDCLAD)) D

 .;..K SDFDA

 .;..S SDFDA=$NA(SDFDA(409.32,SDI_","))

 .;..S @SDFDA@(1)=SDCLAD

 .;..S @SDFDA@(2)=DUZ

 .;..D UPDATE^DIE("","SDFDA")

 .I SDCLI=1 D  ;clinic is inactive

 ..I SDID'="",SDID<=SDCLAD Q   ;409.32 is already inactive

 ..K SDFDA

 ..S SDFDA=$NA(SDFDA(409.32,SDI_","))

 ..S @SDFDA@(3)=SDCLAD

 ..S @SDFDA@(4)=DUZ

 ..D UPDATE^DIE("","SDFDA")

INDEX ;initialize new xrefs

 N CNT,DA,DIK,GMR,SDCL,SDWL,Y

;44

 ;AVADPR in file 44

 S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 W !!,"Build new 'AVADPR' and 'AG' indexes for HOSPITAL LOCATION file 44"

 W !,Y

 S SDCL=0 F  S SDCL=$O(^SC(SDCL)) Q:SDCL'>0  D AVADPR44(SDCL)

 D AG44()  ;AG

 ;403.5

 S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 W !!,"Build new 'AC' index for RECALL REMINDERS file 403.5"

 W !,Y

 D AC4035()   ;AC

 ;403.56

 S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 W !!,"Build new 'AC' index for RECALL REMINDERS REMOVED file 403.56"

 W !,Y

 D AC40356()  ;AC

 ;409.3

 ;E in file 409.3

 S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 W !!,"Build new 'E','AC','AD', and 'AE' indexes for SD WAIT LIST file 409.3"

 W !,Y

 N DA,DIK,SDCL

 D E4093()      ;E

 D AE4093()     ;AE

 D AC4093()     ;AC

 D AD4093()     ;AD

 ;409.831

 D AC409831()

 S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 W !!,"Build new 'AD' index for SDEC RESOURCE USER file 409.833"

 W !,Y

 D AD833()

 ;409.85

 S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 W !!,"Build new 'E' and 'AC' index for SDEC APPT REQUEST file 409.85"

 W !,Y

 D E40985()

 ;123  this will be done in GMRC*3.0*83

 ;S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 ;W !!,"Build new 'AG' index for REQUEST/CONSULTATION file 123"

 ;W !,Y

 ;D I123()

AC409831() ;create and build NEW style AC for all SDEC RESOURCE entries in file 44

 N GMRCXR,GMRCRES,GMRCOUT

 S GMRCXR("FILE")=409.831

 S GMRCXR("NAME")="AC"

 S GMRCXR("TYPE")="MU"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index of RESOURCE TYPE"

 S GMRCXR("DESCR",1)="This cross-reference is built from both pieces of the"

 S GMRCXR("DESCR",2)="RESOURCE TYPE variable pointer field to speed up the"

 S GMRCXR("DESCR",3)="sorting of resources when given a specific source and ID."

 S GMRCXR("DESCR",4)="The sources could be HOSPITAL LOCATION, NEW PERSON, or SDEC"

 S GMRCXR("DESCR",5)="ADDITIONAL RESOURCE."

 S GMRCXR("SET")="D RTS^SDEC03(DA,X) Q"

 S GMRCXR("KILL")="D RTK^SDEC03(DA,X) Q"

 S GMRCXR("WHOLE KILL")="K ^SDEC(409.831,""AC"")"

 S GMRCXR("VAL",1)=.012

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",1,"TYPE")="F"

 S GMRCXR("VAL",2)=.012

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 S GMRCXR("VAL",2,"TYPE")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

AG44() ;create and build NEW style AG for all HOSPITAL LOCATION entries in file 44

 N GMRCXR,GMRCRES,GMRCOUT

 S GMRCXR("FILE")=44

 S GMRCXR("NAME")="AG"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by TYPE and NAME."

 S GMRCXR("DESCR",1)="This cross reference is used to sort by TYPE and NAME."

 S GMRCXR("VAL",1)=2

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=.01

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

AVADPR44(SDCL) ;rebuild AVADPR for given Hospital Location in file 44

 N DA,DIK,SDI

 S SDI=0 F  S SDI=$O(^SC(SDCL,"PR",SDI)) Q:SDI'>0  D

 .S DIK="^SC("_SDCL_",""PR"","

 .S DA(1)=SDCL

 .S DA=SDI

 .S DIK(1)=".01^AVADPR"

 .D EN1^DIK

AC4035() ;create and build NEW style AC for all RECALL REMINDERS entries in file 403.5

 N GMRCXR,GMRCRES,GMRCOUT

 K GMRCXR

 S GMRCXR("FILE")=403.5

 S GMRCXR("INDEX")="AC"

 S GMRCXR("FLAGS")="K"

 D DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 K GMRCXR

 S GMRCXR("FILE")=403.5

 S GMRCXR("NAME")="AC"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by DATE/TIME RECALL ADDED and USER WHO ENTERED RECALL"

 S GMRCXR("DESCR",1)="This cross reference is used to sort by DATE/TIME RECALL ADDED"

 S GMRCXR("DESCR",2)="and USER WHO ENTERED RECALL."

 S GMRCXR("VAL",1)=7.5

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=7

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

AC40356() ;create and build NEW style AC for all RECALL REMINDERS REMOVED entries in file 403.56

 N GMRCXR,GMRCRES,GMRCOUT

 K GMRCXR

 S GMRCXR("FILE")=403.56

 S GMRCXR("INDEX")="AC"

 S GMRCXR("FLAGS")="K"

 D DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 K GMRCXR

 S GMRCXR("FILE")=403.56

 S GMRCXR("NAME")="AC"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by DATE/TIME RECALL ADDED and USER WHO ENTERED RECALL"

 S GMRCXR("DESCR",1)="This cross reference is used to sort by DATE/TIME RECALL ADDED"

 S GMRCXR("DESCR",2)="and USER WHO ENTERED RECALL."

 S GMRCXR("VAL",1)=7.5

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=7

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

E4093(SDWL) ;rebuild E for given SD WAIT LIST in file 409.3

 N DA,DIK

 S DIK="^SDWL(409.3,"

 ;S DA(1)=SDWL

 S DIK(1)=23

 D ENALL^DIK

AF4093() ;create and build NEW style AF for all SD WAIT LIST entries in file 409.3

 N GMRCXR,GMRCRES,GMRCOUT

 S GMRCXR("FILE")=409.3

 S GMRCXR("NAME")="AF"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 ;S GMRCXR("ROOT TYPE")="W"

 ;S GMRCXR("ROOT FILE")=123.02

 S GMRCXR("SHORT DESCR")="Index by CURRENT STATUS and ORIGINATING DATE."

 S GMRCXR("DESCR",1)="This xref is used to speed up the lookup of open or closed"

 S GMRCXR("DESCR",2)="wait list entries for a given time range.."

 S GMRCXR("VAL",1)=23

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=1

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

AE4093(SDWL) ;rebuild AE for given SD WAIT LIST in file 409.3

 N DA,DIK

 S DIK="^SDWL(409.3,"

 ;S DA(1)=SDWL

 S DIK(1)=8.5

 D ENALL^DIK

AC4093() ;create and build NEW style AC for all SD WAIT LIST entries in file 409.3

 N GMRCXR

 K GMRCXR

 S GMRCXR("FILE")=409.3

 S GMRCXR("INDEX")="AC"

 S GMRCXR("FLAGS")="K"

 D DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 K GMRCXR

 N GMRCXR,GMRCRES,GMRCOUT

 S GMRCXR("FILE")=409.3

 S GMRCXR("NAME")="AC"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by ORIGINATING DATE and ORIGINATING USER"

 S GMRCXR("DESCR",1)="This cross reference is used to sort by ORIGINATING DATE and"

 S GMRCXR("DESCR",2)="ORIGINATING USER."

 S GMRCXR("VAL",1)=9.5

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=9

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

AD4093() ;create and build NEW style AD for all SD WAIT LIST entries in file 409.3

 N GMRCXR,GMRCRES,GMRCOUT

 N GMRCXR

 K GMRCXR

 S GMRCXR("FILE")=409.3

 S GMRCXR("INDEX")="AD"

 S GMRCXR("FLAGS")="K"

 D DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 K GMRCXR

 S GMRCXR("FILE")=409.3

 S GMRCXR("NAME")="AD"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by PATIENT and WL SPECIFIC HOSPITAL LOCATION"

 S GMRCXR("DESCR",1)="This cross reference is used to sort by PATIENT and"

 S GMRCXR("DESCR",2)="WL SPECIFIC HOSPITAL LOCATION."

 S GMRCXR("VAL",1)=.01

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=8.5

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

E40985() ;create NEW style E and AC for SDEC APPT REQUEST file 409.85

 N GMRCXR,GMRCRES,GMRCOUT

 S GMRCXR("FILE")=409.85

 S GMRCXR("NAME")="E"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by CURRENT STATUS and CREATE DATE."

 S GMRCXR("DESCR",1)="This cross reference is used to sort by CURRENT STATUS and CREATE DATE."

 S GMRCXR("VAL",1)=23

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=1

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

;AC

 K GMRCXR

 S GMRCXR("FILE")=409.85

 S GMRCXR("INDEX")="AC"

 S GMRCXR("FLAGS")="K"

 D DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 K GMRCXR

 S GMRCXR("FILE")=409.85

 S GMRCXR("NAME")="AC"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by CREATE DATE and ORIGINATING USER"

 S GMRCXR("DESCR",1)="This cross reference is used to sort by CREATE DATE and"

 S GMRCXR("DESCR",2)="ORIGINATING USER."

 S GMRCXR("VAL",1)=9.5

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=9

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

AD833() ;create and build NEW style AD for all SDEC RESOURCE USER entries in file 409.833

 N GMRCXR,GMRCRES,GMRCOUT

 K GMRCXR

 S GMRCXR("FILE")=409.833

 S GMRCXR("INDEX")="AD"

 S GMRCXR("FLAGS")="K"

 D DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 K GMRCXR

 S GMRCXR("FILE")=409.833

 S GMRCXR("NAME")="AD"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 ;S GMRCXR("ROOT TYPE")="W"

 ;S GMRCXR("ROOT FILE")=123.02

 S GMRCXR("SHORT DESCR")="Index by RESOURCENAME and USERNAME."

 S GMRCXR("DESCR",1)="This cross reference is used to sort by RESOURCENAME and USERNAME."

 S GMRCXR("VAL",1)=.01

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=.02

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

I123() ;create and build NEW style AG for all REQUEST/CONSULTATION entries in file 123

 N GMRCXR,GMRCRES,GMRCOUT

 S GMRCXR("FILE")=123

 S GMRCXR("NAME")="AG"

 S GMRCXR("TYPE")="R"

 S GMRCXR("USE")="S"

 S GMRCXR("EXECUTION")="R"

 S GMRCXR("ACTIVITY")="IR"

 S GMRCXR("SHORT DESCR")="Index by DATE/TIME OF ACTION ENTRY and WHO ENTERED ACTIVITY."

 S GMRCXR("ROOT TYPE")="W"

 S GMRCXR("ROOT FILE")=123.02

 S GMRCXR("DESCR",1)="This cross reference is used to sort by DATE/TIME OF ACTION ENTRY and"

 S GMRCXR("DESCR",2)="WHO ENTERED ACTIVITY."

 S GMRCXR("VAL",1)=.01

 S GMRCXR("VAL",1,"SUBSCRIPT")=1

 S GMRCXR("VAL",1,"LENGTH")=""

 S GMRCXR("VAL",1,"COLLATION")="F"

 S GMRCXR("VAL",2)=4

 S GMRCXR("VAL",2,"SUBSCRIPT")=2

 S GMRCXR("VAL",2,"LENGTH")=""

 S GMRCXR("VAL",2,"COLLATION")="F"

 D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECINI1   14600     printed  Oct 16, 2024@18:52:47                                                                                                                                                                                                   Page 2

SDECINI1  ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 +1       ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

 +2       ;

 +3        QUIT

 +4       ;

RESAB     ;populate SDEC ACCESS BLOCK file from existing AVAILABILITY in file 44

 +1        QUIT

 +2       ;

SDWLCL    ;populate SD WL CLINIC LOCATION file with clinics from file 44

 +1        NEW SDCL,SDCLID,SDCLN,SDCLRD,SDDATA,SDFDA,SDFIELDS,SDIEN,SDMSG,SDW

 +2        WRITE !!,"Updating SD WL CLINIC LOCATION file 409.32 with clinics from file 44..."

 +3        SET SDCL=0

FOR

               SET SDCL=$ORDER(^SC(SDCL))

               if SDCL'>0

                   QUIT

               Begin DoDot:1

 +4                KILL SDDATA,SDMSG

 +5       ; .01 name; 2 type; 1912 len of appt; 2508 no show let; 2509 pre-appt let; 2510 clinic can let;

 +6       ;S SDFIELDS=".01;2;3;1912;2502.3;2505;2506;2508;2509;2510"

 +7                SET SDFIELDS=".01;2;3;1912;2505;2506;2508;2509;2510"

 +8                DO GETS^DIQ(44,SDCL_",",SDFIELDS,"IE","SDDATA","SDMSG")

 +9                if SDDATA(44,SDCL_",",2,"I")'="C"

                       QUIT

 +10      ;Q:SDDATA(44,SDCL_",",2502.3,"I")=1

 +11      ;clinic name

                   SET SDCLN=SDDATA(44,SDCL_",",.01,"E")

 +12      ;look for existing to allow this post-init to be re-entrant

 +13      ;W !,"SDWLCL: Clinic "_SDCLN_" is already defined in SD WL CLINIC LOCATION." Q

                   IF $ORDER(^SDWL(409.32,"B",SDCL,0))

                       DO SDWLCL1(SDCL,.SDDATA)

                       QUIT

 +14               SET SDCLID=SDDATA(44,SDCL_",",2505,"I")

 +15               SET SDCLRD=SDDATA(44,SDCL_",",2506,"I")

 +16               if $$INACTIVE^SDECUTL2(SDCL,$PIECE($$NOW^XLFDT,".",1),9991231,SDCLID,SDCLRD)

                       QUIT

 +17               IF SDDATA(44,SDCL_",",3,"I")=""

                       Begin DoDot:2

 +18                       WRITE !,"SDWLCL: Clinic "_SDCLN_" does not have an INSTITUTION defined in file 44."

 +19                       WRITE !,"        Unable to store "_SDCLN_" in the SD WL CLINIC LOCATION file."

                       End DoDot:2

                       QUIT

 +20               SET SDW="+1"

 +21               KILL SDFDA,SDIEN,SDMSG

 +22               SET SDFDA=$NAME(SDFDA(409.32,SDW_","))

 +23               SET @SDFDA@(.01)=SDCL

 +24               SET @SDFDA@(.02)=SDDATA(44,SDCL_",",3,"I")

 +25               IF SDCLID=""

                       SET @SDFDA@(1)=$PIECE($$NOW^XLFDT,".",1)

 +26               IF SDCLID=""

                       SET @SDFDA@(2)=DUZ

 +27               IF SDCLID'=""

                       SET @SDFDA@(3)=SDDATA(44,SDCL_",",2505,"I")

 +28      ;SDDATA(44,SDCL_",",2506,"I")

                   IF SDCLID'=""

                       SET @SDFDA@(4)=DUZ

 +29               DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")

 +30               IF $DATA(SDMSG)

                       WRITE !,"SDWLCL: Unable to store clinic "_SDCL_" in SD WL CLINIC LOCATION."

                       QUIT

               End DoDot:1

 +31       QUIT

SDWLCL1(SDCL,SDDATA) ;

 +1        NEW SDAD,SDCLI,SDCLAD,SDCLID,SDCLRD,SDFDA,SDI,SDID

 +2        SET SDI=""

FOR

               SET SDI=$ORDER(^SDWL(409.32,"B",SDCL,SDI))

               if SDI'>0

                   QUIT

               Begin DoDot:1

 +3                SET SDAD=$$GET1^DIQ(409.32,SDI_",",1,"I")

 +4                SET SDID=$$GET1^DIQ(409.32,SDI_",",3,"I")

 +5                SET SDCLAD=$PIECE($$NOW^XLFDT,".",1)

 +6                SET SDCLID=SDDATA(44,SDCL_",",2505,"I")

 +7                SET SDCLRD=SDDATA(44,SDCL_",",2506,"I")

 +8                SET SDCLI=$$INACTIVE^SDECUTL2(SDCL,SDCLAD,9991231,SDCLID,SDCLRD)

 +9       ;leave the settings in 409.32 as they are if clinic is active

                   if SDCLI=0

                       QUIT

 +10      ;I SDCLI=0 D  ;clinic is active

 +11      ;.I SDID="",((SDAD="")!(SDAD>SDCLAD)) D

 +12      ;..K SDFDA

 +13      ;..S SDFDA=$NA(SDFDA(409.32,SDI_","))

 +14      ;..S @SDFDA@(1)=SDCLAD

 +15      ;..S @SDFDA@(2)=DUZ

 +16      ;..D UPDATE^DIE("","SDFDA")

 +17      ;clinic is inactive

                   IF SDCLI=1

                       Begin DoDot:2

 +18      ;409.32 is already inactive

                           IF SDID'=""

                               IF SDID<=SDCLAD

                                   QUIT

 +19                       KILL SDFDA

 +20                       SET SDFDA=$NAME(SDFDA(409.32,SDI_","))

 +21                       SET @SDFDA@(3)=SDCLAD

 +22                       SET @SDFDA@(4)=DUZ

 +23                       DO UPDATE^DIE("","SDFDA")

                       End DoDot:2

               End DoDot:1

 +24       QUIT

 +25      ;

INDEX     ;initialize new xrefs

 +1        NEW CNT,DA,DIK,GMR,SDCL,SDWL,Y

 +2       ;

 +3       ;44

 +4       ;AVADPR in file 44

 +5        SET Y=$$NOW^XLFDT

           SET Y=$$FMTE^XLFDT(Y)

 +6        WRITE !!,"Build new 'AVADPR' and 'AG' indexes for HOSPITAL LOCATION file 44"

 +7        WRITE !,Y

 +8        SET SDCL=0

FOR

               SET SDCL=$ORDER(^SC(SDCL))

               if SDCL'>0

                   QUIT

               DO AVADPR44(SDCL)

 +9       ;AG

           DO AG44()

 +10      ;

 +11      ;403.5

 +12       SET Y=$$NOW^XLFDT

           SET Y=$$FMTE^XLFDT(Y)

 +13       WRITE !!,"Build new 'AC' index for RECALL REMINDERS file 403.5"

 +14       WRITE !,Y

 +15      ;AC

           DO AC4035()

 +16      ;

 +17      ;403.56

 +18       SET Y=$$NOW^XLFDT

           SET Y=$$FMTE^XLFDT(Y)

 +19       WRITE !!,"Build new 'AC' index for RECALL REMINDERS REMOVED file 403.56"

 +20       WRITE !,Y

 +21      ;AC

           DO AC40356()

 +22      ;

 +23      ;409.3

 +24      ;E in file 409.3

 +25       SET Y=$$NOW^XLFDT

           SET Y=$$FMTE^XLFDT(Y)

 +26       WRITE !!,"Build new 'E','AC','AD', and 'AE' indexes for SD WAIT LIST file 409.3"

 +27       WRITE !,Y

 +28       NEW DA,DIK,SDCL

 +29      ;E

           DO E4093()

 +30      ;AE

           DO AE4093()

 +31      ;AC

           DO AC4093()

 +32      ;AD

           DO AD4093()

 +33      ;

 +34      ;409.831

 +35       DO AC409831()

 +36      ;

 +37       SET Y=$$NOW^XLFDT

           SET Y=$$FMTE^XLFDT(Y)

 +38       WRITE !!,"Build new 'AD' index for SDEC RESOURCE USER file 409.833"

 +39       WRITE !,Y

 +40       DO AD833()

 +41      ;

 +42      ;409.85

 +43       SET Y=$$NOW^XLFDT

           SET Y=$$FMTE^XLFDT(Y)

 +44       WRITE !!,"Build new 'E' and 'AC' index for SDEC APPT REQUEST file 409.85"

 +45       WRITE !,Y

 +46       DO E40985()

 +47      ;

 +48      ;123  this will be done in GMRC*3.0*83

 +49      ;S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)

 +50      ;W !!,"Build new 'AG' index for REQUEST/CONSULTATION file 123"

 +51      ;W !,Y

 +52      ;D I123()

 +53       QUIT

 +54      ;

AC409831() ;create and build NEW style AC for all SDEC RESOURCE entries in file 44

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        SET GMRCXR("FILE")=409.831

 +3        SET GMRCXR("NAME")="AC"

 +4        SET GMRCXR("TYPE")="MU"

 +5        SET GMRCXR("USE")="S"

 +6        SET GMRCXR("EXECUTION")="R"

 +7        SET GMRCXR("ACTIVITY")="IR"

 +8        SET GMRCXR("SHORT DESCR")="Index of RESOURCE TYPE"

 +9        SET GMRCXR("DESCR",1)="This cross-reference is built from both pieces of the"

 +10       SET GMRCXR("DESCR",2)="RESOURCE TYPE variable pointer field to speed up the"

 +11       SET GMRCXR("DESCR",3)="sorting of resources when given a specific source and ID."

 +12       SET GMRCXR("DESCR",4)="The sources could be HOSPITAL LOCATION, NEW PERSON, or SDEC"

 +13       SET GMRCXR("DESCR",5)="ADDITIONAL RESOURCE."

 +14       SET GMRCXR("SET")="D RTS^SDEC03(DA,X) Q"

 +15       SET GMRCXR("KILL")="D RTK^SDEC03(DA,X) Q"

 +16       SET GMRCXR("WHOLE KILL")="K ^SDEC(409.831,""AC"")"

 +17       SET GMRCXR("VAL",1)=.012

 +18       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +19       SET GMRCXR("VAL",1,"LENGTH")=""

 +20       SET GMRCXR("VAL",1,"COLLATION")="F"

 +21       SET GMRCXR("VAL",1,"TYPE")="F"

 +22       SET GMRCXR("VAL",2)=.012

 +23       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +24       SET GMRCXR("VAL",2,"LENGTH")=""

 +25       SET GMRCXR("VAL",2,"COLLATION")="F"

 +26       SET GMRCXR("VAL",2,"TYPE")="F"

 +27       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +28       QUIT

 +29      ;

AG44()    ;create and build NEW style AG for all HOSPITAL LOCATION entries in file 44

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        SET GMRCXR("FILE")=44

 +3        SET GMRCXR("NAME")="AG"

 +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 TYPE and NAME."

 +9        SET GMRCXR("DESCR",1)="This cross reference is used to sort by TYPE and NAME."

 +10       SET GMRCXR("VAL",1)=2

 +11       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +12       SET GMRCXR("VAL",1,"LENGTH")=""

 +13       SET GMRCXR("VAL",1,"COLLATION")="F"

 +14       SET GMRCXR("VAL",2)=.01

 +15       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +16       SET GMRCXR("VAL",2,"LENGTH")=""

 +17       SET GMRCXR("VAL",2,"COLLATION")="F"

 +18       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +19       QUIT

 +20      ;

AVADPR44(SDCL) ;rebuild AVADPR for given Hospital Location in file 44

 +1        NEW DA,DIK,SDI

 +2        SET SDI=0

FOR

               SET SDI=$ORDER(^SC(SDCL,"PR",SDI))

               if SDI'>0

                   QUIT

               Begin DoDot:1

 +3                SET DIK="^SC("_SDCL_",""PR"","

 +4                SET DA(1)=SDCL

 +5                SET DA=SDI

 +6                SET DIK(1)=".01^AVADPR"

 +7                DO EN1^DIK

               End DoDot:1

 +8        QUIT

 +9       ;

AC4035()  ;create and build NEW style AC for all RECALL REMINDERS entries in file 403.5

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        KILL GMRCXR

 +3        SET GMRCXR("FILE")=403.5

 +4        SET GMRCXR("INDEX")="AC"

 +5        SET GMRCXR("FLAGS")="K"

 +6        DO DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 +7        KILL GMRCXR

 +8        SET GMRCXR("FILE")=403.5

 +9        SET GMRCXR("NAME")="AC"

 +10       SET GMRCXR("TYPE")="R"

 +11       SET GMRCXR("USE")="S"

 +12       SET GMRCXR("EXECUTION")="R"

 +13       SET GMRCXR("ACTIVITY")="IR"

 +14       SET GMRCXR("SHORT DESCR")="Index by DATE/TIME RECALL ADDED and USER WHO ENTERED RECALL"

 +15       SET GMRCXR("DESCR",1)="This cross reference is used to sort by DATE/TIME RECALL ADDED"

 +16       SET GMRCXR("DESCR",2)="and USER WHO ENTERED RECALL."

 +17       SET GMRCXR("VAL",1)=7.5

 +18       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +19       SET GMRCXR("VAL",1,"LENGTH")=""

 +20       SET GMRCXR("VAL",1,"COLLATION")="F"

 +21       SET GMRCXR("VAL",2)=7

 +22       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +23       SET GMRCXR("VAL",2,"LENGTH")=""

 +24       SET GMRCXR("VAL",2,"COLLATION")="F"

 +25       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +26       QUIT

 +27      ;

AC40356() ;create and build NEW style AC for all RECALL REMINDERS REMOVED entries in file 403.56

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        KILL GMRCXR

 +3        SET GMRCXR("FILE")=403.56

 +4        SET GMRCXR("INDEX")="AC"

 +5        SET GMRCXR("FLAGS")="K"

 +6        DO DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 +7        KILL GMRCXR

 +8        SET GMRCXR("FILE")=403.56

 +9        SET GMRCXR("NAME")="AC"

 +10       SET GMRCXR("TYPE")="R"

 +11       SET GMRCXR("USE")="S"

 +12       SET GMRCXR("EXECUTION")="R"

 +13       SET GMRCXR("ACTIVITY")="IR"

 +14       SET GMRCXR("SHORT DESCR")="Index by DATE/TIME RECALL ADDED and USER WHO ENTERED RECALL"

 +15       SET GMRCXR("DESCR",1)="This cross reference is used to sort by DATE/TIME RECALL ADDED"

 +16       SET GMRCXR("DESCR",2)="and USER WHO ENTERED RECALL."

 +17       SET GMRCXR("VAL",1)=7.5

 +18       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +19       SET GMRCXR("VAL",1,"LENGTH")=""

 +20       SET GMRCXR("VAL",1,"COLLATION")="F"

 +21       SET GMRCXR("VAL",2)=7

 +22       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +23       SET GMRCXR("VAL",2,"LENGTH")=""

 +24       SET GMRCXR("VAL",2,"COLLATION")="F"

 +25       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +26       QUIT

 +27      ;

E4093(SDWL) ;rebuild E for given SD WAIT LIST in file 409.3

 +1        NEW DA,DIK

 +2        SET DIK="^SDWL(409.3,"

 +3       ;S DA(1)=SDWL

 +4        SET DIK(1)=23

 +5        DO ENALL^DIK

 +6        QUIT

AF4093()  ;create and build NEW style AF for all SD WAIT LIST entries in file 409.3

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        SET GMRCXR("FILE")=409.3

 +3        SET GMRCXR("NAME")="AF"

 +4        SET GMRCXR("TYPE")="R"

 +5        SET GMRCXR("USE")="S"

 +6        SET GMRCXR("EXECUTION")="R"

 +7        SET GMRCXR("ACTIVITY")="IR"

 +8       ;S GMRCXR("ROOT TYPE")="W"

 +9       ;S GMRCXR("ROOT FILE")=123.02

 +10       SET GMRCXR("SHORT DESCR")="Index by CURRENT STATUS and ORIGINATING DATE."

 +11       SET GMRCXR("DESCR",1)="This xref is used to speed up the lookup of open or closed"

 +12       SET GMRCXR("DESCR",2)="wait list entries for a given time range.."

 +13       SET GMRCXR("VAL",1)=23

 +14       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +15       SET GMRCXR("VAL",1,"LENGTH")=""

 +16       SET GMRCXR("VAL",1,"COLLATION")="F"

 +17       SET GMRCXR("VAL",2)=1

 +18       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +19       SET GMRCXR("VAL",2,"LENGTH")=""

 +20       SET GMRCXR("VAL",2,"COLLATION")="F"

 +21       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +22       QUIT

AE4093(SDWL) ;rebuild AE for given SD WAIT LIST in file 409.3

 +1        NEW DA,DIK

 +2        SET DIK="^SDWL(409.3,"

 +3       ;S DA(1)=SDWL

 +4        SET DIK(1)=8.5

 +5        DO ENALL^DIK

 +6        QUIT

AC4093()  ;create and build NEW style AC for all SD WAIT LIST entries in file 409.3

 +1        NEW GMRCXR

 +2        KILL GMRCXR

 +3        SET GMRCXR("FILE")=409.3

 +4        SET GMRCXR("INDEX")="AC"

 +5        SET GMRCXR("FLAGS")="K"

 +6        DO DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 +7        KILL GMRCXR

 +8        NEW GMRCXR,GMRCRES,GMRCOUT

 +9        SET GMRCXR("FILE")=409.3

 +10       SET GMRCXR("NAME")="AC"

 +11       SET GMRCXR("TYPE")="R"

 +12       SET GMRCXR("USE")="S"

 +13       SET GMRCXR("EXECUTION")="R"

 +14       SET GMRCXR("ACTIVITY")="IR"

 +15       SET GMRCXR("SHORT DESCR")="Index by ORIGINATING DATE and ORIGINATING USER"

 +16       SET GMRCXR("DESCR",1)="This cross reference is used to sort by ORIGINATING DATE and"

 +17       SET GMRCXR("DESCR",2)="ORIGINATING USER."

 +18       SET GMRCXR("VAL",1)=9.5

 +19       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +20       SET GMRCXR("VAL",1,"LENGTH")=""

 +21       SET GMRCXR("VAL",1,"COLLATION")="F"

 +22       SET GMRCXR("VAL",2)=9

 +23       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +24       SET GMRCXR("VAL",2,"LENGTH")=""

 +25       SET GMRCXR("VAL",2,"COLLATION")="F"

 +26       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +27       QUIT

AD4093()  ;create and build NEW style AD for all SD WAIT LIST entries in file 409.3

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        NEW GMRCXR

 +3        KILL GMRCXR

 +4        SET GMRCXR("FILE")=409.3

 +5        SET GMRCXR("INDEX")="AD"

 +6        SET GMRCXR("FLAGS")="K"

 +7        DO DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 +8        KILL GMRCXR

 +9        SET GMRCXR("FILE")=409.3

 +10       SET GMRCXR("NAME")="AD"

 +11       SET GMRCXR("TYPE")="R"

 +12       SET GMRCXR("USE")="S"

 +13       SET GMRCXR("EXECUTION")="R"

 +14       SET GMRCXR("ACTIVITY")="IR"

 +15       SET GMRCXR("SHORT DESCR")="Index by PATIENT and WL SPECIFIC HOSPITAL LOCATION"

 +16       SET GMRCXR("DESCR",1)="This cross reference is used to sort by PATIENT and"

 +17       SET GMRCXR("DESCR",2)="WL SPECIFIC HOSPITAL LOCATION."

 +18       SET GMRCXR("VAL",1)=.01

 +19       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +20       SET GMRCXR("VAL",1,"LENGTH")=""

 +21       SET GMRCXR("VAL",1,"COLLATION")="F"

 +22       SET GMRCXR("VAL",2)=8.5

 +23       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +24       SET GMRCXR("VAL",2,"LENGTH")=""

 +25       SET GMRCXR("VAL",2,"COLLATION")="F"

 +26       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +27       QUIT

 +28      ;

E40985()  ;create NEW style E and AC for SDEC APPT REQUEST file 409.85

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        SET GMRCXR("FILE")=409.85

 +3        SET GMRCXR("NAME")="E"

 +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 CURRENT STATUS and CREATE DATE."

 +9        SET GMRCXR("DESCR",1)="This cross reference is used to sort by CURRENT STATUS and CREATE DATE."

 +10       SET GMRCXR("VAL",1)=23

 +11       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +12       SET GMRCXR("VAL",1,"LENGTH")=""

 +13       SET GMRCXR("VAL",1,"COLLATION")="F"

 +14       SET GMRCXR("VAL",2)=1

 +15       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +16       SET GMRCXR("VAL",2,"LENGTH")=""

 +17       SET GMRCXR("VAL",2,"COLLATION")="F"

 +18       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +19      ;AC

 +20       KILL GMRCXR

 +21       SET GMRCXR("FILE")=409.85

 +22       SET GMRCXR("INDEX")="AC"

 +23       SET GMRCXR("FLAGS")="K"

 +24       DO DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 +25       KILL GMRCXR

 +26       SET GMRCXR("FILE")=409.85

 +27       SET GMRCXR("NAME")="AC"

 +28       SET GMRCXR("TYPE")="R"

 +29       SET GMRCXR("USE")="S"

 +30       SET GMRCXR("EXECUTION")="R"

 +31       SET GMRCXR("ACTIVITY")="IR"

 +32       SET GMRCXR("SHORT DESCR")="Index by CREATE DATE and ORIGINATING USER"

 +33       SET GMRCXR("DESCR",1)="This cross reference is used to sort by CREATE DATE and"

 +34       SET GMRCXR("DESCR",2)="ORIGINATING USER."

 +35       SET GMRCXR("VAL",1)=9.5

 +36       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +37       SET GMRCXR("VAL",1,"LENGTH")=""

 +38       SET GMRCXR("VAL",1,"COLLATION")="F"

 +39       SET GMRCXR("VAL",2)=9

 +40       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +41       SET GMRCXR("VAL",2,"LENGTH")=""

 +42       SET GMRCXR("VAL",2,"COLLATION")="F"

 +43       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +44       QUIT

 +45      ;

AD833()   ;create and build NEW style AD for all SDEC RESOURCE USER entries in file 409.833

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        KILL GMRCXR

 +3        SET GMRCXR("FILE")=409.833

 +4        SET GMRCXR("INDEX")="AD"

 +5        SET GMRCXR("FLAGS")="K"

 +6        DO DELIXN^DDMOD(GMRCXR("FILE"),GMRCXR("INDEX"),GMRCXR("FLAGS"))

 +7        KILL GMRCXR

 +8        SET GMRCXR("FILE")=409.833

 +9        SET GMRCXR("NAME")="AD"

 +10       SET GMRCXR("TYPE")="R"

 +11       SET GMRCXR("USE")="S"

 +12       SET GMRCXR("EXECUTION")="R"

 +13       SET GMRCXR("ACTIVITY")="IR"

 +14      ;S GMRCXR("ROOT TYPE")="W"

 +15      ;S GMRCXR("ROOT FILE")=123.02

 +16       SET GMRCXR("SHORT DESCR")="Index by RESOURCENAME and USERNAME."

 +17       SET GMRCXR("DESCR",1)="This cross reference is used to sort by RESOURCENAME and USERNAME."

 +18       SET GMRCXR("VAL",1)=.01

 +19       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +20       SET GMRCXR("VAL",1,"LENGTH")=""

 +21       SET GMRCXR("VAL",1,"COLLATION")="F"

 +22       SET GMRCXR("VAL",2)=.02

 +23       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +24       SET GMRCXR("VAL",2,"LENGTH")=""

 +25       SET GMRCXR("VAL",2,"COLLATION")="F"

 +26       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +27       QUIT

 +28      ;

I123()    ;create and build NEW style AG for all REQUEST/CONSULTATION entries in file 123

 +1        NEW GMRCXR,GMRCRES,GMRCOUT

 +2        SET GMRCXR("FILE")=123

 +3        SET GMRCXR("NAME")="AG"

 +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 DATE/TIME OF ACTION ENTRY and WHO ENTERED ACTIVITY."

 +9        SET GMRCXR("ROOT TYPE")="W"

 +10       SET GMRCXR("ROOT FILE")=123.02

 +11       SET GMRCXR("DESCR",1)="This cross reference is used to sort by DATE/TIME OF ACTION ENTRY and"

 +12       SET GMRCXR("DESCR",2)="WHO ENTERED ACTIVITY."

 +13       SET GMRCXR("VAL",1)=.01

 +14       SET GMRCXR("VAL",1,"SUBSCRIPT")=1

 +15       SET GMRCXR("VAL",1,"LENGTH")=""

 +16       SET GMRCXR("VAL",1,"COLLATION")="F"

 +17       SET GMRCXR("VAL",2)=4

 +18       SET GMRCXR("VAL",2,"SUBSCRIPT")=2

 +19       SET GMRCXR("VAL",2,"LENGTH")=""

 +20       SET GMRCXR("VAL",2,"COLLATION")="F"

 +21       DO CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")

 +22       QUIT

SDECINI1.m