Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECI2

SDECI2.m

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