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

SDECINIT.m

Go to the documentation of this file.
  1. SDECINIT ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
  1. ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
  1. ;
  1. Q
  1. ;
  1. PRE ;
  1. Q
  1. ;
  1. POST ;
  1. D RPC
  1. D CHK^SDECINI2
  1. D INDEX^SDECINI1
  1. ;D SDWLCL^SDECINI1
  1. D RESCLIN
  1. D RESAV
  1. ;D RESAB^SDECINI1
  1. D SDAPPT^SDECINI2
  1. D SCH
  1. Q
  1. ;
  1. SCH ;schedule options
  1. N NOW,QTIME,Y
  1. S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
  1. W !!,"Scheduling SDEC IDX REFRESH ..."
  1. W !,Y
  1. ;schedule SDEC IDX REFRESH to run nightly
  1. S QTIME=$G(XPDQUES("POS1 NIGHTJOB")) ;cannot NEW XPDQUES in this routine - XPDQUES is defined during the install questions
  1. D:QTIME SCHTSK("SDEC IDX REFRESH",QTIME,"24H")
  1. ;schedule SDEC IDX REFRESH to run one time 'NOW'
  1. S NOW=$G(XPDQUES("POS2 NOWJOB")) ;cannot NEW XPDQUES in this routine - XPDQUES is defined during the install questions
  1. D:$$UP^XLFSTR(NOW)=1 ONE
  1. Q
  1. SCHTSK(OPTNAME,QTIME,QFREQ) ; Schedule Option
  1. N FDA,SCHNM,DIC,X,Y,SDIEN S SDIEN=""
  1. Q:$G(OPTNAME)=""
  1. I $G(QTIME)="" S QTIME=$P($$NOW^XLFDT,".",1)_".02"
  1. S QFREQ=$G(QFREQ)
  1. S DIC(0)="I",X=OPTNAME,DIC="^DIC(19,"
  1. D ^DIC Q:'(Y>0) S SCHNM=+Y
  1. ;D CLEAN^DILF
  1. S FDA(19.2,"?+1,",.01)=SCHNM,X=SCHNM
  1. I 'SCHNM D Q
  1. .W !,OPTNAME," option can't be scheduled - option does not exist"
  1. ;S FDA(19.2,"?+1,",1)=SCHNM
  1. S FDA(19.2,"?+1,",2)=QTIME ;$P($$NOW^XLFDT,".")_".01"
  1. S FDA(19.2,"?+1,",6)=QFREQ
  1. ;S FDA(19.2,"?+1,",9)="SP" SP is STARTUP/PERSISTENT
  1. D UPDATE^DIE("","FDA","SDIEN")
  1. W !,"Scheduled option ",OPTNAME
  1. D CLEAN^DILF
  1. Q
  1. ONE ;One time queue setup for SDEC IDX REFRESH
  1. N ZTDESC,ZTDTH,ZTIO,ZTRTN
  1. S ZTRTN="ENTRY^SDECIDX"
  1. S ZTIO=""
  1. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
  1. S ZTDESC="One time Queue: SDEC IDX REFRESH"
  1. D ^%ZTLOAD
  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","SDECRPC")
  1. D REGNMSP^SDECRPC("DG SENSITIVE RECORD ACCESS","SDECRPC")
  1. D REGNMSP^SDECRPC("DG CHK BS5 XREF ARRAY","SDECRPC")
  1. D REGNMSP^SDECRPC("ORPRF HASFLG","SDECRPC")
  1. D REGNMSP^SDECRPC("ORPRF GETFLG","SDECRPC")
  1. D REGNMSP^SDECRPC("ORWPT DIEDON","SDECRPC")
  1. D REGNMSP^SDECRPC("ORWPT ID INFO","SDECRPC")
  1. D REGNMSP^SDECRPC("ORWPT LAST5","SDECRPC")
  1. D REGNMSP^SDECRPC("ORWPT LAST5 RPL","SDECRPC")
  1. D REGNMSP^SDECRPC("ORWU USERINFO","SDECRPC")
  1. Q
  1. ;
  1. RESCLIN ;populate SDEC RESOURCE with clinics from file 44
  1. N SDCL,SDCLN,SDDATA,SDFDA,SDFIELDS,SDFOUND,SDI,SDIEN,SDMSG,SDRESH,SDRES11,SDTS,Y
  1. N SDIN,SDRN
  1. S SDRESH=""
  1. S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
  1. W !!,"Updating new SDEC RESOURCE file 409.831 with clinics and providers from file 44..."
  1. W !,Y
  1. ;D SDRTYP(.SDRTYP)
  1. D CLEAR^SDECU ;purge SDEC RESOURCE USER file
  1. D RESDGA^SDEC01B ;remove inactive resources from SDEC RESOURCE GROUPs
  1. S SDCL=0 F S SDCL=$O(^SC(SDCL)) Q:SDCL'>0 D
  1. .D RESCLIN1^SDEC01B(SDCL,.SDRESH)
  1. .;populate from providers and privileged users
  1. .D RESPRVA
  1. Q
  1. ;
  1. RESPRVA ;called from RSCLIN
  1. ;K SDDATA,SDMSG
  1. N SDFOUND,TD
  1. S SDFOUND=0
  1. S SDJ=0 F S SDJ=$O(^SC(SDCL,"PR",SDJ)) Q:SDJ'>0 D
  1. .S SDPRV=$P($G(^SC(SDCL,"PR",SDJ,0)),U,1)
  1. .S SDPRVN=$$UP^XLFSTR($$GET1^DIQ(200,SDPRV_",",.01))
  1. .Q:SDPRVN=""
  1. .D RESPRV1^SDEC01B(SDPRV,SDCL,SDPRVN)
  1. S SDJ=0 F S SDJ=$O(^SC(SDCL,"SDPRIV",SDJ)) Q:SDJ'>0 D
  1. .S SDPRV=$P($G(^SC(SDCL,"SDPRIV",SDJ,0)),U,1)
  1. .S SDPRVN=$$UP^XLFSTR($$GET1^DIQ(200,SDPRV_",",.01))
  1. .Q:SDPRVN=""
  1. .S TD=$$GET1^DIQ(200,SDJ_",",9.2,"I")
  1. .I TD'="",$P(TD,".",1)'>$P($$NOW^XLFDT,".",1) Q ;only process active entries
  1. .;MGH commented out
  1. .D RESPRV1^SDEC01B(SDPRV,SDCL,SDPRVN) ;add to SDEC RESOURCE
  1. .D:$G(SDRESH)'="" RESUPRV1 ;add to SDEC RESOURCE USER
  1. Q
  1. RESUPRV1 ;add privileged provider to SDEC RESOURCE USER
  1. N SDF,SDFDA,SDIEN,SDMSG,SDNOD,SDRU
  1. S SDF=0
  1. Q:$O(^SDEC(409.833,"AD",SDRESH,SDPRV,0)) ;stop if existing SDEC RESOURCE USER id with provider ID.
  1. S SDRU="+1"
  1. ;
  1. S SDFDA=$NA(SDFDA(409.833,SDRU_","))
  1. S @SDFDA@(.01)=SDRESH
  1. S @SDFDA@(.02)=SDPRV
  1. D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
  1. Q
  1. ;
  1. SDRTYP(SDRTYP) ;build array of resource types
  1. ;INPUT: none
  1. ;RETURN:
  1. ; .SDRTYP - array of resource types
  1. ; SDRTYP(<ien><file ref> , <SDEC RESOURCE ien>)=""
  1. Q
  1. N SDI,SDTYP
  1. K SDRTYP
  1. S SDI=0 F S SDI=$O(^SDEC(409.831,SDI)) Q:SDI'>0 D
  1. .S SDTYP=$$GET1^DIQ(409.831,SDI_",",.012,"I")
  1. .I SDTYP'="" S SDRTYP(SDTYP,SDI)=""
  1. Q
  1. ;
  1. RESAV ;add AVAILABLE and UNAVAILABLE 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 entries for ""AVAILABLE"" and ""UNAVAILABLE""..."
  1. W !,Y
  1. I '$O(^SDEC(409.823,"B","AVAILABLE",0)) D AVAILADD("AVAILABLE")
  1. I '$O(^SDEC(409.823,"B","UNAVAILABLE",0)) D AVAILADD("UNAVAILABLE")
  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",1:"GRAY")
  1. S SDFDA(409.823,"+1,",.05)=$S(SDTXT="AVAILABLE":247,1:230)
  1. S SDFDA(409.823,"+1,",.06)=$S(SDTXT="AVAILABLE":254,1:230)
  1. S SDFDA(409.823,"+1,",.07)=$S(SDTXT="AVAILABLE":46,1:230)
  1. S SDFDA(409.823,"+1,",.08)=0 ;$S(SDTXT="AVAILABLE":0,1:1)
  1. D UPDATE^DIE("","SDFDA")
  1. Q