SDECI2 ;ALB/SAT - VISTA SCHEDULING RELEASE 2 PRE/POST INSTALL ;APR 08, 2016
;;5.3;Scheduling;**642**;Aug 13, 1993;Build 23
;
Q
;
PRE ;
I $P($G(^DD(409.852,.02,0)),U,1)'="MULT APPTS MADE" D
.S ^XTMP("SD*5.3*642",0)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT
.S ^XTMP("SD*5.3*642","MULT")=1
Q
;
POST ;
D RPC
D RESAV
D INDEX
D BSE
K ^XTMP("SD*5.3*642")
N Y
S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
W !!,"Post-Installation completed."
W !,Y
Q
;
RESAV ;add CANCELED to SDEC ACCESS TYPE file
N Y
S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
W !!,"Updating SDEC ACCESS TYPE file 409.823 with entry for ""CANCELED"" ..."
W !,Y
I '$O(^SDEC(409.823,"B","CANCELED",0)) D AVAILADD("CANCELED")
Q
AVAILADD(SDTXT) ;add to SDEC ACCESS TYPE file
N SDAV,SDFDA
S SDAV=$O(^SDEC(409.823,"B",SDTXT,0))
Q:+SDAV
S SDFDA(409.823,"+1,",.01)=SDTXT
S SDFDA(409.823,"+1,",.04)=$S(SDTXT="AVAILABLE":"YELLOW",SDTXT="CANCELED":"GRAY",1:"LT. GRAY")
S SDFDA(409.823,"+1,",.05)=$S(SDTXT="AVAILABLE":247,SDTXT="CANCELED":190,1:230)
S SDFDA(409.823,"+1,",.06)=$S(SDTXT="AVAILABLE":254,SDTXT="CANCELED":190,1:230)
S SDFDA(409.823,"+1,",.07)=$S(SDTXT="AVAILABLE":46,SDTXT="CANCELED":190,1:230)
S SDFDA(409.823,"+1,",.08)=0 ;$S(SDTXT="AVAILABLE":0,1:1)
D UPDATE^DIE("","SDFDA")
Q
;
INDEX ;update indexes
D AF4093 ;AF in SD WAIT LIST
D AC409831 ;AC in SDEC RESOURCE
D AC40984 ;AC in SDEC APPOINTMENT
D AD40984 ;AD in SDEC APPOINTMENT
D AD40985 ;AD in SDEC APPT REQUEST
Q
AF4093 ;create and build NEW style AF for SD WAIT LIST file #409.3
N SDXR,SDRES,SDOUT
S SDXR("FILE")=409.3
S SDXR("NAME")="AF"
S SDXR("SHORT DESCR")="Sort by DATE ENTERED and ENTERED BY USER of PATIENT CONTACTS"
S SDXR("TYPE")="R"
S SDXR("EXECUTION")="R"
S SDXR("ACTIVITY")="IR"
S SDXR("ROOT TYPE")="W"
S SDXR("ROOT FILE")=409.344
S SDXR("USE")="S"
S SDXR("DESCR",1)="This cross reference sorts the whole SD WAIT LIST file by the"
S SDXR("DESCR",2)="DATE ENTERED and ENTERED BY USER of the PATIENT CONTACTS multiple"
S SDXR("DESCR",3)="field #44."
S SDXR("VAL",1)=.01
S SDXR("VAL",1,"SUBSCRIPT")=1
S SDXR("VAL",1,"LENGTH")=""
S SDXR("VAL",1,"COLLATION")="F"
S SDXR("VAL",1,"TYPE")="F"
S SDXR("VAL",2)=2
S SDXR("VAL",2,"SUBSCRIPT")=2
S SDXR("VAL",2,"LENGTH")=""
S SDXR("VAL",2,"COLLATION")="F"
S SDXR("VAL",2,"TYPE")="F"
D CREIXN^DDMOD(.SDXR,"S",.SDRES,"SDOUT")
Q
AD40985 ;create and build NEW style AD for SDEC APPT REQUEST file #409.85
N SDXR,SDRES,SDOUT
S SDXR("FILE")=409.85
S SDXR("NAME")="AD"
S SDXR("SHORT DESCR")="Sort by DATE ENTERED and ENTERED BY USER of PATIENT CONTACTS"
S SDXR("TYPE")="R"
S SDXR("EXECUTION")="R"
S SDXR("ACTIVITY")="IR"
S SDXR("ROOT TYPE")="W"
S SDXR("ROOT FILE")=409.8544
S SDXR("USE")="S"
S SDXR("DESCR",1)="This cross reference sorts the whole SDEC APPT REQUEST file by the"
S SDXR("DESCR",2)="DATE ENTERED and ENTERED BY USER of the PATIENT CONTACTS multiple"
S SDXR("DESCR",3)="field #44."
S SDXR("VAL",1)=.01
S SDXR("VAL",1,"SUBSCRIPT")=1
S SDXR("VAL",1,"LENGTH")=""
S SDXR("VAL",1,"COLLATION")="F"
S SDXR("VAL",1,"TYPE")="F"
S SDXR("VAL",2)=2
S SDXR("VAL",2,"SUBSCRIPT")=2
S SDXR("VAL",2,"LENGTH")=""
S SDXR("VAL",2,"COLLATION")="F"
S SDXR("VAL",2,"TYPE")="F"
D CREIXN^DDMOD(.SDXR,"S",.SDRES,"SDOUT")
Q
AC40984 ;rebuild AC for SDEC APPOINTMENT
N DA,DIK
S DIK="^SDEC(409.84,"
S DIK(1)=.09
D ENALL^DIK
Q
AD40984 ;rebuild AD for SDEC APPOINTMENT
N DA,DIK
S DIK="^SDEC(409.84,"
S DIK(1)=.12
D ENALL^DIK
Q
AC409831 ;change NEW style AC or all SDEC RESOURCE entries in file 44
N SDXR,SDRES,SDOUT
S SDXR("FILE")=409.831
S SDXR("NAME")="AC"
S SDXR("TYPE")="R"
S SDXR("USE")="S"
S SDXR("EXECUTION")="F"
S SDXR("ACTIVITY")="IR"
S SDXR("SHORT DESCR")="Index of RESOURCE TYPE"
S SDXR("DESCR",1)="This cross-reference is built from both pieces of the"
S SDXR("DESCR",2)="RESOURCE TYPE variable pointer field to speed up the"
S SDXR("DESCR",3)="sorting of resources when given a specific source and ID."
S SDXR("DESCR",4)="The sources could be HOSPITAL LOCATION, NEW PERSON, or SDEC"
S SDXR("DESCR",5)="ADDITIONAL RESOURCE."
;S SDXR("SET")="D RTS^SDEC03(DA,X) Q" ;only for MUMPS type
;S SDXR("KILL")="D RTK^SDEC03(DA,X) Q" ;only for MUMPS type
;S SDXR("WHOLE KILL")="K ^SDEC(409.831,""AC"")" ;only for MUMPS type
S SDXR("VAL",1)=.012
S SDXR("VAL",1,"SUBSCRIPT")=1
S SDXR("VAL",1,"LENGTH")=""
S SDXR("VAL",1,"COLLATION")="F"
S SDXR("VAL",1,"TYPE")="F"
S SDXR("VAL",1,"XFORM FOR STORAGE")="S X=$E($$OT1^SDEC03(X),1)"
S SDXR("VAL",2)=.012
S SDXR("VAL",2,"SUBSCRIPT")=2
S SDXR("VAL",2,"LENGTH")=""
S SDXR("VAL",2,"COLLATION")="F"
S SDXR("VAL",2,"TYPE")="F"
S SDXR("VAL",2,"XFORM FOR STORAGE")="S X=$P(X,"";"",1)"
D CREIXN^DDMOD(.SDXR,"S",.SDRES,"SDOUT")
Q
;
RPC ;register SDEC rpcs
N Y
S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
W !!,"Registering new RPCs..."
W !,Y
D REGNMSP^SDECRPC("SDEC APPSLOTS","SDECRPC")
D REGNMSP^SDECRPC("SDEC NOAVAIL","SDECRPC")
D REGNMSP^SDECRPC("SDECAPP GETYPE","SDECRPC")
D REGNMSP^SDECRPC("SDECAR ARMULT","SDECRPC")
D REGNMSP^SDECRPC("SDECAR AUDITGET","SDECRPC")
D REGNMSP^SDECRPC("SDECCAP CAN","SDECRPC")
D REGNMSP^SDECRPC("SDECCAP GET","SDECRPC")
D REGNMSP^SDECRPC("SDECCAP SET","SDECRPC")
D REGNMSP^SDECRPC("SDECWL AUDITGET","SDECRPC")
D REGNMSP^SDECRPC("ROR LIST STATES","SDECRPC")
D REGNMSP^SDECRPC("SDEC NETLOC","SDECRPC")
D REGNMSP^SDECRPC("SDECXUS ENCRYP","SDECRPC")
D REGNMSP^SDECRPC("XUS SIGNON SETUP","SDECRPC")
D REGNMSP^SDECRPC("XUS GET VISITOR","SDECRPC")
D REGNMSP^SDECRPC("XUS SET VISITOR","SDECRPC")
D REGNMSP^SDECRPC("XUS AV CODE","SDECRPC")
Q
;
MULT ;update child requests in SDEC APPT REQUEST file 409.85
N Y
S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
W !!,"updating child requests in SDEC APPT REQUEST..."
W !,Y
Q:$D(^XTMP("SD*5.3*642","MULT"))
N Y
S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
W !!,"Updating SDEC APPT REQUEST file 409.85 with child requests..."
W !,Y
N SDI,SDJ,SDLIST,SDMULT,SDRET,SD1,SD2
S (SDLIST,SDRET)=""
S SDI=0 F S SDI=$O(^SDEC(409.85,SDI)) Q:SDI'>0 D
.S SDLIST=""
.S SDJ=0 F S SDJ=$O(^SDEC(409.85,SDI,2,SDJ)) Q:SDJ'>0 D
..S SDMULT=$G(^SDEC(409.85,SDI,2,SDJ,0))
..Q:SDMULT=""
..S SD1=$P(SDMULT,U,1)
..S SD2=$P($$GET1^DIQ(409.84,+SDMULT_",",.22,"I"),";",1)
..S SDLIST=$S(SDLIST'="":SDLIST_"|",1:"")_SD1_"^"_SD2
.D:SDLIST'="" ARMULT^SDECAR(.SDRET,SDI,SDLIST)
Q
;
BSE ;add/update entry in 8994.5 for VS SCHEDULING CALL CENTER
N Y
S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
W !!,"adding entry to 8994.5 for VS SCHEDULING CALL CENTER..."
W !,Y
N RESULT,APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT
S APCODE="q2pt~%x|D5dPOhQMAN" ;APPLICATIONCODE
S APNAME="VS SCHEDULING CALL CENTER" ;NAME
S APIP="XXX" ;CALLBACKSERVER
S APPORT="-1" ;CALLBACKPORT
S APPATH="" ;URLSTRING
S APCONTEXT="SDECRPC" ;CONTEXTOPTION (OPTION file NAME)
D BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
Q
;
BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT) ;
N SDIEN
D DELBSE(APNAME,APCODE)
D SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
Q
;
DELBSE(NAME,APCODE) ;remove existing entries with the same name
N ERR,LIST
D FIND^DIC(8994.5,"","@","X",NAME,"*","B","","","LIST","ERR")
N I,FDA S I=0
F S I=$O(LIST("DILIST",2,I)) Q:'I D
.K FDA S FDA(8994.5,LIST("DILIST",2,I)_",",.01)="@"
.D FILE^DIE("","FDA","ERR")
D FIND^DIC(8994.5,"","@","X",APCODE,"*","ACODE","","","LIST","ERR")
N I,FDA S I=0
F S I=$O(LIST("DILIST",2,I)) Q:'I D
.K FDA S FDA(8994.5,LIST("DILIST",2,I)_",",.01)="@"
.D FILE^DIE("","FDA","ERR")
Q
;
SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT) ;
N FDA,ERR,INDEX
S FDA(8994.5,"+1,",.01)=APNAME
S INDEX=$$CPRSOPT(APCONTEXT)
I +$G(INDEX)'>0 D Q 0
.W "COULD NOT FIND CPRS OPTION:"_INDEX,!
S FDA(8994.5,"+1,",.02)=INDEX
S FDA(8994.5,"+1,",.03)=APCODE
S FDA(8994.51,"+2,+1,",.01)="S"
S FDA(8994.51,"+2,+1,",.02)=APPORT
S FDA(8994.51,"+2,+1,",.03)=APIP
S FDA(8994.51,"+2,+1,",.04)=APPATH
D UPDATE^DIE("","FDA","","ERR")
Q
;
CPRSOPT(ACONTEXT) ;Finds the IEN of the option for a context
;W "LOOKING FOR '"_ACONTEXT_"':"
N INDEX,ERR S INDEX=$$FIND1^DIC(19,"","X",ACONTEXT,"B","","ERR")
Q INDEX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECI2 8441 printed Apr 09, 2024@21:49:23 Page 2
SDECI2 ;ALB/SAT - VISTA SCHEDULING RELEASE 2 PRE/POST INSTALL ;APR 08, 2016
+1 ;;5.3;Scheduling;**642**;Aug 13, 1993;Build 23
+2 ;
+3 QUIT
+4 ;
PRE ;
+1 IF $PIECE($GET(^DD(409.852,.02,0)),U,1)'="MULT APPTS MADE"
Begin DoDot:1
+2 SET ^XTMP("SD*5.3*642",0)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT
+3 SET ^XTMP("SD*5.3*642","MULT")=1
End DoDot:1
+4 QUIT
+5 ;
POST ;
+1 DO RPC
+2 DO RESAV
+3 DO INDEX
+4 DO BSE
+5 KILL ^XTMP("SD*5.3*642")
+6 NEW Y
+7 SET Y=$$NOW^XLFDT
SET Y=$$FMTE^XLFDT(Y)
+8 WRITE !!,"Post-Installation completed."
+9 WRITE !,Y
+10 QUIT
+11 ;
RESAV ;add CANCELED to SDEC ACCESS TYPE file
+1 NEW Y
+2 SET Y=$$NOW^XLFDT
SET Y=$$FMTE^XLFDT(Y)
+3 WRITE !!,"Updating SDEC ACCESS TYPE file 409.823 with entry for ""CANCELED"" ..."
+4 WRITE !,Y
+5 IF '$ORDER(^SDEC(409.823,"B","CANCELED",0))
DO AVAILADD("CANCELED")
+6 QUIT
AVAILADD(SDTXT) ;add to SDEC ACCESS TYPE file
+1 NEW SDAV,SDFDA
+2 SET SDAV=$ORDER(^SDEC(409.823,"B",SDTXT,0))
+3 if +SDAV
QUIT
+4 SET SDFDA(409.823,"+1,",.01)=SDTXT
+5 SET SDFDA(409.823,"+1,",.04)=$SELECT(SDTXT="AVAILABLE":"YELLOW",SDTXT="CANCELED":"GRAY",1:"LT. GRAY")
+6 SET SDFDA(409.823,"+1,",.05)=$SELECT(SDTXT="AVAILABLE":247,SDTXT="CANCELED":190,1:230)
+7 SET SDFDA(409.823,"+1,",.06)=$SELECT(SDTXT="AVAILABLE":254,SDTXT="CANCELED":190,1:230)
+8 SET SDFDA(409.823,"+1,",.07)=$SELECT(SDTXT="AVAILABLE":46,SDTXT="CANCELED":190,1:230)
+9 ;$S(SDTXT="AVAILABLE":0,1:1)
SET SDFDA(409.823,"+1,",.08)=0
+10 DO UPDATE^DIE("","SDFDA")
+11 QUIT
+12 ;
INDEX ;update indexes
+1 ;AF in SD WAIT LIST
DO AF4093
+2 ;AC in SDEC RESOURCE
DO AC409831
+3 ;AC in SDEC APPOINTMENT
DO AC40984
+4 ;AD in SDEC APPOINTMENT
DO AD40984
+5 ;AD in SDEC APPT REQUEST
DO AD40985
+6 QUIT
AF4093 ;create and build NEW style AF for SD WAIT LIST file #409.3
+1 NEW SDXR,SDRES,SDOUT
+2 SET SDXR("FILE")=409.3
+3 SET SDXR("NAME")="AF"
+4 SET SDXR("SHORT DESCR")="Sort by DATE ENTERED and ENTERED BY USER of PATIENT CONTACTS"
+5 SET SDXR("TYPE")="R"
+6 SET SDXR("EXECUTION")="R"
+7 SET SDXR("ACTIVITY")="IR"
+8 SET SDXR("ROOT TYPE")="W"
+9 SET SDXR("ROOT FILE")=409.344
+10 SET SDXR("USE")="S"
+11 SET SDXR("DESCR",1)="This cross reference sorts the whole SD WAIT LIST file by the"
+12 SET SDXR("DESCR",2)="DATE ENTERED and ENTERED BY USER of the PATIENT CONTACTS multiple"
+13 SET SDXR("DESCR",3)="field #44."
+14 SET SDXR("VAL",1)=.01
+15 SET SDXR("VAL",1,"SUBSCRIPT")=1
+16 SET SDXR("VAL",1,"LENGTH")=""
+17 SET SDXR("VAL",1,"COLLATION")="F"
+18 SET SDXR("VAL",1,"TYPE")="F"
+19 SET SDXR("VAL",2)=2
+20 SET SDXR("VAL",2,"SUBSCRIPT")=2
+21 SET SDXR("VAL",2,"LENGTH")=""
+22 SET SDXR("VAL",2,"COLLATION")="F"
+23 SET SDXR("VAL",2,"TYPE")="F"
+24 DO CREIXN^DDMOD(.SDXR,"S",.SDRES,"SDOUT")
+25 QUIT
AD40985 ;create and build NEW style AD for SDEC APPT REQUEST file #409.85
+1 NEW SDXR,SDRES,SDOUT
+2 SET SDXR("FILE")=409.85
+3 SET SDXR("NAME")="AD"
+4 SET SDXR("SHORT DESCR")="Sort by DATE ENTERED and ENTERED BY USER of PATIENT CONTACTS"
+5 SET SDXR("TYPE")="R"
+6 SET SDXR("EXECUTION")="R"
+7 SET SDXR("ACTIVITY")="IR"
+8 SET SDXR("ROOT TYPE")="W"
+9 SET SDXR("ROOT FILE")=409.8544
+10 SET SDXR("USE")="S"
+11 SET SDXR("DESCR",1)="This cross reference sorts the whole SDEC APPT REQUEST file by the"
+12 SET SDXR("DESCR",2)="DATE ENTERED and ENTERED BY USER of the PATIENT CONTACTS multiple"
+13 SET SDXR("DESCR",3)="field #44."
+14 SET SDXR("VAL",1)=.01
+15 SET SDXR("VAL",1,"SUBSCRIPT")=1
+16 SET SDXR("VAL",1,"LENGTH")=""
+17 SET SDXR("VAL",1,"COLLATION")="F"
+18 SET SDXR("VAL",1,"TYPE")="F"
+19 SET SDXR("VAL",2)=2
+20 SET SDXR("VAL",2,"SUBSCRIPT")=2
+21 SET SDXR("VAL",2,"LENGTH")=""
+22 SET SDXR("VAL",2,"COLLATION")="F"
+23 SET SDXR("VAL",2,"TYPE")="F"
+24 DO CREIXN^DDMOD(.SDXR,"S",.SDRES,"SDOUT")
+25 QUIT
AC40984 ;rebuild AC for SDEC APPOINTMENT
+1 NEW DA,DIK
+2 SET DIK="^SDEC(409.84,"
+3 SET DIK(1)=.09
+4 DO ENALL^DIK
+5 QUIT
AD40984 ;rebuild AD for SDEC APPOINTMENT
+1 NEW DA,DIK
+2 SET DIK="^SDEC(409.84,"
+3 SET DIK(1)=.12
+4 DO ENALL^DIK
+5 QUIT
AC409831 ;change NEW style AC or all SDEC RESOURCE entries in file 44
+1 NEW SDXR,SDRES,SDOUT
+2 SET SDXR("FILE")=409.831
+3 SET SDXR("NAME")="AC"
+4 SET SDXR("TYPE")="R"
+5 SET SDXR("USE")="S"
+6 SET SDXR("EXECUTION")="F"
+7 SET SDXR("ACTIVITY")="IR"
+8 SET SDXR("SHORT DESCR")="Index of RESOURCE TYPE"
+9 SET SDXR("DESCR",1)="This cross-reference is built from both pieces of the"
+10 SET SDXR("DESCR",2)="RESOURCE TYPE variable pointer field to speed up the"
+11 SET SDXR("DESCR",3)="sorting of resources when given a specific source and ID."
+12 SET SDXR("DESCR",4)="The sources could be HOSPITAL LOCATION, NEW PERSON, or SDEC"
+13 SET SDXR("DESCR",5)="ADDITIONAL RESOURCE."
+14 ;S SDXR("SET")="D RTS^SDEC03(DA,X) Q" ;only for MUMPS type
+15 ;S SDXR("KILL")="D RTK^SDEC03(DA,X) Q" ;only for MUMPS type
+16 ;S SDXR("WHOLE KILL")="K ^SDEC(409.831,""AC"")" ;only for MUMPS type
+17 SET SDXR("VAL",1)=.012
+18 SET SDXR("VAL",1,"SUBSCRIPT")=1
+19 SET SDXR("VAL",1,"LENGTH")=""
+20 SET SDXR("VAL",1,"COLLATION")="F"
+21 SET SDXR("VAL",1,"TYPE")="F"
+22 SET SDXR("VAL",1,"XFORM FOR STORAGE")="S X=$E($$OT1^SDEC03(X),1)"
+23 SET SDXR("VAL",2)=.012
+24 SET SDXR("VAL",2,"SUBSCRIPT")=2
+25 SET SDXR("VAL",2,"LENGTH")=""
+26 SET SDXR("VAL",2,"COLLATION")="F"
+27 SET SDXR("VAL",2,"TYPE")="F"
+28 SET SDXR("VAL",2,"XFORM FOR STORAGE")="S X=$P(X,"";"",1)"
+29 DO CREIXN^DDMOD(.SDXR,"S",.SDRES,"SDOUT")
+30 QUIT
+31 ;
RPC ;register SDEC rpcs
+1 NEW Y
+2 SET Y=$$NOW^XLFDT
SET Y=$$FMTE^XLFDT(Y)
+3 WRITE !!,"Registering new RPCs..."
+4 WRITE !,Y
+5 DO REGNMSP^SDECRPC("SDEC APPSLOTS","SDECRPC")
+6 DO REGNMSP^SDECRPC("SDEC NOAVAIL","SDECRPC")
+7 DO REGNMSP^SDECRPC("SDECAPP GETYPE","SDECRPC")
+8 DO REGNMSP^SDECRPC("SDECAR ARMULT","SDECRPC")
+9 DO REGNMSP^SDECRPC("SDECAR AUDITGET","SDECRPC")
+10 DO REGNMSP^SDECRPC("SDECCAP CAN","SDECRPC")
+11 DO REGNMSP^SDECRPC("SDECCAP GET","SDECRPC")
+12 DO REGNMSP^SDECRPC("SDECCAP SET","SDECRPC")
+13 DO REGNMSP^SDECRPC("SDECWL AUDITGET","SDECRPC")
+14 DO REGNMSP^SDECRPC("ROR LIST STATES","SDECRPC")
+15 DO REGNMSP^SDECRPC("SDEC NETLOC","SDECRPC")
+16 DO REGNMSP^SDECRPC("SDECXUS ENCRYP","SDECRPC")
+17 DO REGNMSP^SDECRPC("XUS SIGNON SETUP","SDECRPC")
+18 DO REGNMSP^SDECRPC("XUS GET VISITOR","SDECRPC")
+19 DO REGNMSP^SDECRPC("XUS SET VISITOR","SDECRPC")
+20 DO REGNMSP^SDECRPC("XUS AV CODE","SDECRPC")
+21 QUIT
+22 ;
MULT ;update child requests in SDEC APPT REQUEST file 409.85
+1 NEW Y
+2 SET Y=$$NOW^XLFDT
SET Y=$$FMTE^XLFDT(Y)
+3 WRITE !!,"updating child requests in SDEC APPT REQUEST..."
+4 WRITE !,Y
+5 if $DATA(^XTMP("SD*5.3*642","MULT"))
QUIT
+6 NEW Y
+7 SET Y=$$NOW^XLFDT
SET Y=$$FMTE^XLFDT(Y)
+8 WRITE !!,"Updating SDEC APPT REQUEST file 409.85 with child requests..."
+9 WRITE !,Y
+10 NEW SDI,SDJ,SDLIST,SDMULT,SDRET,SD1,SD2
+11 SET (SDLIST,SDRET)=""
+12 SET SDI=0
FOR
SET SDI=$ORDER(^SDEC(409.85,SDI))
if SDI'>0
QUIT
Begin DoDot:1
+13 SET SDLIST=""
+14 SET SDJ=0
FOR
SET SDJ=$ORDER(^SDEC(409.85,SDI,2,SDJ))
if SDJ'>0
QUIT
Begin DoDot:2
+15 SET SDMULT=$GET(^SDEC(409.85,SDI,2,SDJ,0))
+16 if SDMULT=""
QUIT
+17 SET SD1=$PIECE(SDMULT,U,1)
+18 SET SD2=$PIECE($$GET1^DIQ(409.84,+SDMULT_",",.22,"I"),";",1)
+19 SET SDLIST=$SELECT(SDLIST'="":SDLIST_"|",1:"")_SD1_"^"_SD2
End DoDot:2
+20 if SDLIST'=""
DO ARMULT^SDECAR(.SDRET,SDI,SDLIST)
End DoDot:1
+21 QUIT
+22 ;
BSE ;add/update entry in 8994.5 for VS SCHEDULING CALL CENTER
+1 NEW Y
+2 SET Y=$$NOW^XLFDT
SET Y=$$FMTE^XLFDT(Y)
+3 WRITE !!,"adding entry to 8994.5 for VS SCHEDULING CALL CENTER..."
+4 WRITE !,Y
+5 NEW RESULT,APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT
+6 ;APPLICATIONCODE
SET APCODE="q2pt~%x|D5dPOhQMAN"
+7 ;NAME
SET APNAME="VS SCHEDULING CALL CENTER"
+8 ;CALLBACKSERVER
SET APIP="XXX"
+9 ;CALLBACKPORT
SET APPORT="-1"
+10 ;URLSTRING
SET APPATH=""
+11 ;CONTEXTOPTION (OPTION file NAME)
SET APCONTEXT="SDECRPC"
+12 DO BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
+13 QUIT
+14 ;
BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT) ;
+1 NEW SDIEN
+2 DO DELBSE(APNAME,APCODE)
+3 DO SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
+4 QUIT
+5 ;
DELBSE(NAME,APCODE) ;remove existing entries with the same name
+1 NEW ERR,LIST
+2 DO FIND^DIC(8994.5,"","@","X",NAME,"*","B","","","LIST","ERR")
+3 NEW I,FDA
SET I=0
+4 FOR
SET I=$ORDER(LIST("DILIST",2,I))
if 'I
QUIT
Begin DoDot:1
+5 KILL FDA
SET FDA(8994.5,LIST("DILIST",2,I)_",",.01)="@"
+6 DO FILE^DIE("","FDA","ERR")
End DoDot:1
+7 DO FIND^DIC(8994.5,"","@","X",APCODE,"*","ACODE","","","LIST","ERR")
+8 NEW I,FDA
SET I=0
+9 FOR
SET I=$ORDER(LIST("DILIST",2,I))
if 'I
QUIT
Begin DoDot:1
+10 KILL FDA
SET FDA(8994.5,LIST("DILIST",2,I)_",",.01)="@"
+11 DO FILE^DIE("","FDA","ERR")
End DoDot:1
+12 QUIT
+13 ;
SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT) ;
+1 NEW FDA,ERR,INDEX
+2 SET FDA(8994.5,"+1,",.01)=APNAME
+3 SET INDEX=$$CPRSOPT(APCONTEXT)
+4 IF +$GET(INDEX)'>0
Begin DoDot:1
+5 WRITE "COULD NOT FIND CPRS OPTION:"_INDEX,!
End DoDot:1
QUIT 0
+6 SET FDA(8994.5,"+1,",.02)=INDEX
+7 SET FDA(8994.5,"+1,",.03)=APCODE
+8 SET FDA(8994.51,"+2,+1,",.01)="S"
+9 SET FDA(8994.51,"+2,+1,",.02)=APPORT
+10 SET FDA(8994.51,"+2,+1,",.03)=APIP
+11 SET FDA(8994.51,"+2,+1,",.04)=APPATH
+12 DO UPDATE^DIE("","FDA","","ERR")
+13 QUIT
+14 ;
CPRSOPT(ACONTEXT) ;Finds the IEN of the option for a context
+1 ;W "LOOKING FOR '"_ACONTEXT_"':"
+2 NEW INDEX,ERR
SET INDEX=$$FIND1^DIC(19,"","X",ACONTEXT,"B","","ERR")
+3 QUIT INDEX
