- SDEC658 ;ALB/SAT/JSM - VISTA SCHEDULING PRE/POST ;MAR 15, 2017
- ;;5.3;Scheduling;**658**;Aug 13, 1993;Build 23
- ;
- Q
- ;
- PRE ;
- Q
- ;
- POST ;
- D RPC
- D INDEX^SDEC658A
- D RESOURCE
- D OPTION
- D NOTE
- D SCH
- 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","SDECRPC")
- D REGNMSP^SDECRPC("ORWU CLINLOC","SDECRPC")
- D REGNMSP^SDECRPC("XUS GET USER INFO","SDECRPC")
- D REGNMSP^SDECRPC("XUS GET CCOW TOKEN","SDECRPC")
- D REGNMSP^SDECRPC("XUS GET VAULT PARAM","SDECRPC")
- D REGNMSP^SDECRPC("ORWPT SHARE","SDECRPC")
- D REGNMSP^SDECRPC("ORWPT TOP","SDECRPC")
- D REGNMSP^SDECRPC("DG SENSITIVE RECORD BULLETIN","SDECRPC")
- Q
- ;
- RESOURCE ;populate new ABBREVIATION field in 409.831
- N Y
- S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
- W !!,"Populating new ABBREVIATION fields in 409.831..."
- W !,Y
- D AF44
- Q
- AF44 ;AF in 44
- N DIK
- S DIK="^SC(",DIK(1)="1^AF"
- D ENALL^DIK
- Q
- OPTION ;Add new item to SDOUTPUT option
- N Y
- S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
- W !!,"Adding new SDEC REQ REOPENED BY SDCANCEL to SDOUTPUT menu..."
- W !,Y
- N OPTIEN,NIEN,SDFDA
- S (OPTIEN,NIEN)=""
- S NIEN=$O(^DIC(19,"B","SDEC REQ REOPENED BY SDCANCEL",0))
- S OPTIEN=$O(^DIC(19,"B","SDOUTPUT",0))
- Q:$D(^DIC(19,OPTIEN,10,"B",NIEN)) ;already added
- S SDFDA(19.01,"+1,"_OPTIEN_",",.01)=NIEN
- D UPDATE^DIE("","SDFDA")
- Q
- ;
- NOTE ;sync OTHER in HOSPITAL LOCATION appointment record and NOTE in SDEC APPOINTMENT
- ;per Irene Smith, Debbie Malkovich 2/8/2017
- ; If NOTE is empty AND OTHER is defined, OTHER data will be set to NOTE.
- ; If NOTE is defined AND OTHER is defined, OTHER data will be set to NOTE - NOTE data is replaced by OTHER data. (VistA wins!)
- ; If NOTE is defined AND OTHER is empty, NOTE data will be set to OTHER
- N Y
- S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
- W !!,"Syncing OTHER in clinic appointments with NOTE in SDEC APPOINTMENTs ..."
- W !,Y
- N ZTDESC,ZTDTH,ZTIO,ZTRTN
- S ZTRTN="N1^SDEC658"
- S ZTIO=""
- S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
- S ZTDESC="SD*5.3*658 NOTE UPDATE REPORT DATA"
- D ^%ZTLOAD
- Q
- N1 ;called by background job
- ;GET conflicts
- N AIEN,ANOD,CNOT,ARR,CNT,LCNT,LINE,SC,SCN,SDR,SDT,SDTMP,SDX,SID,SNOD,SNOT,SSC,X,XMSUB,XMTEXT,XMY,SDECSDT
- K ^XTMP("VSGUI_OI")
- S ^XTMP("VSGUI_OI",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT S $P(LINE,"=",78)="="
- S (CNT,LCNT)=0
- S SDX="^XTMP(""SDEC658M"")"
- K @SDX
- S @SDX@(0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
- S SDECSDT=$O(^SDEC(409.84,"B",0)) ;alb/jsm set very first starttime of SDEC APPOINTMENTS
- D BLD("CONFLICTS:"),BLD("=========")
- D BLD(LINE)
- S SCN="" F S SCN=$O(^SC("AG","C",SCN)) Q:SCN="" D
- .S SC=0 F S SC=$O(^SC("AG","C",SCN,SC)) Q:SC="" D
- ..S SDT=$P(SDECSDT,".",1) F S SDT=$O(^SC(SC,"S",SDT)) Q:SDT'>0 D ;alb/jsm reset SDT to the starttime from SDEC APPOINTMENTS
- ...S AIEN=0 F S AIEN=$O(^SC(SC,"S",SDT,1,AIEN)) Q:AIEN'>0 D
- ....S ANOD=$G(^SC(SC,"S",SDT,1,AIEN,0))
- ....S CNOT=$P(ANOD,U,4)
- ....S SID=0 F S SID=$O(^SDEC(409.84,"B",SDT,SID)) Q:SID="" D
- .....S SNOD=$G(^SDEC(409.84,SID,0))
- .....S SDR=$P(SNOD,U,7),SSC=$$GET1^DIQ(409.831,SDR_",",.04,"I")
- .....I $P(SNOD,U,5)=$P(ANOD,U,1),SC=SSC D
- ......K ARR
- ......S SNOT=""
- ......S X=$$GET1^DIQ(409.84,SID_",",1,,"ARR")
- ......S SNOT=$$WPSTR^SDECUTL(.ARR)
- ......S SNOT=$E(SNOT,1,150)
- ......I SNOT["^" D STRIP K ARR S X=$$GET1^DIQ(409.84,SID_",",1,,"ARR") S SNOT=$$WPSTR^SDECUTL(.ARR) S SNOT=$E(SNOT,1,150)
- ......I CNOT'=SNOT D
- .......S CNT=CNT+1,(XSTR,^XTMP("VSGUI_OI","DIFF",SCN,CNT))=SDT_U_SC_U_SCN_U_AIEN_U_$P(SNOD,U,5)_U_CNOT_U_SID_U_SNOT
- .......S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")"
- .......D BLD(SDTMP)
- .......S SDTMP="CLINIC: "_$E("("_$P(XSTR,U,2)_") "_$P(XSTR,U,3),1,39),SDTMP=SDTMP_$$FILL^SDECU(49-$L(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($P(XSTR,U,1))
- .......D BLD(SDTMP)
- .......S SDTMP="OTHER:"
- .......D BLD(SDTMP)
- .......D BLD($P(XSTR,U,6)),BLD("")
- .......S SDTMP="NOTE ("_$P(XSTR,U,7)_"):"
- .......D BLD(SDTMP)
- .......D BLD($P(XSTR,U,8)),BLD(LINE)
- ;FIX conflicts
- K ANOD,CNOT,CNT,IENS,LINE,SCN,SNOT,X,XSTR
- S $P(LINE,"=",78)="="
- D BLD(""),BLD(""),BLD(""),BLD("RESOLUTIONS:"),BLD("===========")
- D BLD(LINE)
- S SCN="" F S SCN=$O(^XTMP("VSGUI_OI","DIFF",SCN)) Q:SCN="" D
- .S CNT=0 F S CNT=$O(^XTMP("VSGUI_OI","DIFF",SCN,CNT)) Q:CNT="" D
- ..K ARR,FDA
- ..S XSTR=$G(^XTMP("VSGUI_OI","DIFF",SCN,CNT))
- ..S CNOT=$P(XSTR,U,6)
- ..S SNOT=$P(XSTR,U,8)
- ..S IENS=$P(XSTR,U,4)_","_$P(XSTR,U,1)_","_$P(XSTR,U,2)_","
- ..S:(CNOT="")&(SNOT'="") FDA(44.003,IENS,3)=SNOT
- ..D:(CNOT'="")&(SNOT="") WP^SDECUTL(.ARR,CNOT)
- ..D:(CNOT'="")&(SNOT'="")&(CNOT'=SNOT) WP^SDECUTL(.ARR,CNOT)
- ..D:$D(FDA) UPDATE^DIE("","FDA")
- ..D:$D(ARR) WP^DIE(409.84,$P(XSTR,U,7)_",",1,"","ARR")
- ..S ANOD=$G(^SC($P(XSTR,U,2),"S",$P(XSTR,U,1),1,$P(XSTR,U,4),0))
- ..S CNOT=$P(ANOD,U,4)
- ..K ARR
- ..S X=$$GET1^DIQ(409.84,$P(XSTR,U,7)_",",1,,"ARR")
- ..S SNOT=$$WPSTR^SDECUTL(.ARR)
- ..S SNOT=$E(SNOT,1,150)
- ..S SDTMP=$$GET1^DIQ(2,+$P(XSTR,U,5),.01)_" ("_$P(XSTR,U,5)_")"
- ..D BLD(SDTMP)
- ..S SDTMP="CLINIC: "_$E("("_$P(XSTR,U,2)_") "_$P(XSTR,U,3),1,39),SDTMP=SDTMP_$$FILL^SDECU(49-$L(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($P(XSTR,U,1))
- ..D BLD(SDTMP)
- ..S SDTMP="OTHER:"
- ..D BLD(SDTMP)
- ..D BLD(CNOT)
- ..D BLD("")
- ..S SDTMP="NOTE ("_$P(XSTR,U,7)_"):"
- ..D BLD(SDTMP)
- ..D BLD(SNOT)
- ..D BLD(LINE)
- ;SEND message
- S XMY(DUZ)="",XMSUB="SD*5.3*658 NOTE UPDATE REPORT DATA for "_$$FMTE^XLFDT($$NOW^XLFDT)
- S XMTEXT=$P(SDX,")")_","
- D ^XMD
- Q
- ;
- BLD(TXT) ;build output text for email
- S LCNT=LCNT+1
- S @SDX@(LCNT)=TXT
- Q
- STRIP ;
- N FDA
- Q:SNOT'["^"
- S SNOT=$TR(SNOT,"^"," ")
- D WP^SDECUTL(.ARR,SNOT)
- D WP^DIE(409.84,SID_",",1,"","ARR")
- Q
- ;
- SCH ;schedule options
- ;schedule SDEC IDX REFRESH to run one time 'NOW'
- S NOW=$G(XPDQUES("POS2 NOWJOB")) ;cannot NEW XPDQUES in this routine - XPDQUES is defined during the install questions
- D:$$UP^XLFSTR(NOW)=1 ONE
- Q
- ONE ;One time queue setup for SDEC IDX REFRESH
- N NOW,QTIME,Y
- S Y=$$NOW^XLFDT,Y=$$FMTE^XLFDT(Y)
- W !!,"Scheduling SDEC IDX REFRESH ..."
- W !,Y
- N ZTDESC,ZTDTH,ZTIO,ZTRTN
- S ZTRTN="ENTRY^SDECIDX"
- S ZTIO=""
- S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
- S ZTDESC="One time Queue: SDEC IDX REFRESH"
- D ^%ZTLOAD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC658 6329 printed Jan 18, 2025@03:52:09 Page 2
- SDEC658 ;ALB/SAT/JSM - VISTA SCHEDULING PRE/POST ;MAR 15, 2017
- +1 ;;5.3;Scheduling;**658**;Aug 13, 1993;Build 23
- +2 ;
- +3 QUIT
- +4 ;
- PRE ;
- +1 QUIT
- +2 ;
- POST ;
- +1 DO RPC
- +2 DO INDEX^SDEC658A
- +3 DO RESOURCE
- +4 DO OPTION
- +5 DO NOTE
- +6 DO SCH
- +7 QUIT
- +8 ;
- 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","SDECRPC")
- +6 DO REGNMSP^SDECRPC("ORWU CLINLOC","SDECRPC")
- +7 DO REGNMSP^SDECRPC("XUS GET USER INFO","SDECRPC")
- +8 DO REGNMSP^SDECRPC("XUS GET CCOW TOKEN","SDECRPC")
- +9 DO REGNMSP^SDECRPC("XUS GET VAULT PARAM","SDECRPC")
- +10 DO REGNMSP^SDECRPC("ORWPT SHARE","SDECRPC")
- +11 DO REGNMSP^SDECRPC("ORWPT TOP","SDECRPC")
- +12 DO REGNMSP^SDECRPC("DG SENSITIVE RECORD BULLETIN","SDECRPC")
- +13 QUIT
- +14 ;
- RESOURCE ;populate new ABBREVIATION field in 409.831
- +1 NEW Y
- +2 SET Y=$$NOW^XLFDT
- SET Y=$$FMTE^XLFDT(Y)
- +3 WRITE !!,"Populating new ABBREVIATION fields in 409.831..."
- +4 WRITE !,Y
- +5 DO AF44
- +6 QUIT
- AF44 ;AF in 44
- +1 NEW DIK
- +2 SET DIK="^SC("
- SET DIK(1)="1^AF"
- +3 DO ENALL^DIK
- +4 QUIT
- OPTION ;Add new item to SDOUTPUT option
- +1 NEW Y
- +2 SET Y=$$NOW^XLFDT
- SET Y=$$FMTE^XLFDT(Y)
- +3 WRITE !!,"Adding new SDEC REQ REOPENED BY SDCANCEL to SDOUTPUT menu..."
- +4 WRITE !,Y
- +5 NEW OPTIEN,NIEN,SDFDA
- +6 SET (OPTIEN,NIEN)=""
- +7 SET NIEN=$ORDER(^DIC(19,"B","SDEC REQ REOPENED BY SDCANCEL",0))
- +8 SET OPTIEN=$ORDER(^DIC(19,"B","SDOUTPUT",0))
- +9 ;already added
- if $DATA(^DIC(19,OPTIEN,10,"B",NIEN))
- QUIT
- +10 SET SDFDA(19.01,"+1,"_OPTIEN_",",.01)=NIEN
- +11 DO UPDATE^DIE("","SDFDA")
- +12 QUIT
- +13 ;
- NOTE ;sync OTHER in HOSPITAL LOCATION appointment record and NOTE in SDEC APPOINTMENT
- +1 ;per Irene Smith, Debbie Malkovich 2/8/2017
- +2 ; If NOTE is empty AND OTHER is defined, OTHER data will be set to NOTE.
- +3 ; If NOTE is defined AND OTHER is defined, OTHER data will be set to NOTE - NOTE data is replaced by OTHER data. (VistA wins!)
- +4 ; If NOTE is defined AND OTHER is empty, NOTE data will be set to OTHER
- +5 NEW Y
- +6 SET Y=$$NOW^XLFDT
- SET Y=$$FMTE^XLFDT(Y)
- +7 WRITE !!,"Syncing OTHER in clinic appointments with NOTE in SDEC APPOINTMENTs ..."
- +8 WRITE !,Y
- +9 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN
- +10 SET ZTRTN="N1^SDEC658"
- +11 SET ZTIO=""
- +12 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
- +13 SET ZTDESC="SD*5.3*658 NOTE UPDATE REPORT DATA"
- +14 DO ^%ZTLOAD
- +15 QUIT
- N1 ;called by background job
- +1 ;GET conflicts
- +2 NEW AIEN,ANOD,CNOT,ARR,CNT,LCNT,LINE,SC,SCN,SDR,SDT,SDTMP,SDX,SID,SNOD,SNOT,SSC,X,XMSUB,XMTEXT,XMY,SDECSDT
- +3 KILL ^XTMP("VSGUI_OI")
- +4 SET ^XTMP("VSGUI_OI",0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
- SET $PIECE(LINE,"=",78)="="
- +5 SET (CNT,LCNT)=0
- +6 SET SDX="^XTMP(""SDEC658M"")"
- +7 KILL @SDX
- +8 SET @SDX@(0)=$$FMADD^XLFDT(DT,7)_U_$$DT^XLFDT
- +9 ;alb/jsm set very first starttime of SDEC APPOINTMENTS
- SET SDECSDT=$ORDER(^SDEC(409.84,"B",0))
- +10 DO BLD("CONFLICTS:")
- DO BLD("=========")
- +11 DO BLD(LINE)
- +12 SET SCN=""
- FOR
- SET SCN=$ORDER(^SC("AG","C",SCN))
- if SCN=""
- QUIT
- Begin DoDot:1
- +13 SET SC=0
- FOR
- SET SC=$ORDER(^SC("AG","C",SCN,SC))
- if SC=""
- QUIT
- Begin DoDot:2
- +14 ;alb/jsm reset SDT to the starttime from SDEC APPOINTMENTS
- SET SDT=$PIECE(SDECSDT,".",1)
- FOR
- SET SDT=$ORDER(^SC(SC,"S",SDT))
- if SDT'>0
- QUIT
- Begin DoDot:3
- +15 SET AIEN=0
- FOR
- SET AIEN=$ORDER(^SC(SC,"S",SDT,1,AIEN))
- if AIEN'>0
- QUIT
- Begin DoDot:4
- +16 SET ANOD=$GET(^SC(SC,"S",SDT,1,AIEN,0))
- +17 SET CNOT=$PIECE(ANOD,U,4)
- +18 SET SID=0
- FOR
- SET SID=$ORDER(^SDEC(409.84,"B",SDT,SID))
- if SID=""
- QUIT
- Begin DoDot:5
- +19 SET SNOD=$GET(^SDEC(409.84,SID,0))
- +20 SET SDR=$PIECE(SNOD,U,7)
- SET SSC=$$GET1^DIQ(409.831,SDR_",",.04,"I")
- +21 IF $PIECE(SNOD,U,5)=$PIECE(ANOD,U,1)
- IF SC=SSC
- Begin DoDot:6
- +22 KILL ARR
- +23 SET SNOT=""
- +24 SET X=$$GET1^DIQ(409.84,SID_",",1,,"ARR")
- +25 SET SNOT=$$WPSTR^SDECUTL(.ARR)
- +26 SET SNOT=$EXTRACT(SNOT,1,150)
- +27 IF SNOT["^"
- DO STRIP
- KILL ARR
- SET X=$$GET1^DIQ(409.84,SID_",",1,,"ARR")
- SET SNOT=$$WPSTR^SDECUTL(.ARR)
- SET SNOT=$EXTRACT(SNOT,1,150)
- +28 IF CNOT'=SNOT
- Begin DoDot:7
- +29 SET CNT=CNT+1
- SET (XSTR,^XTMP("VSGUI_OI","DIFF",SCN,CNT))=SDT_U_SC_U_SCN_U_AIEN_U_$PIECE(SNOD,U,5)_U_CNOT_U_SID_U_SNOT
- +30 SET SDTMP=$$GET1^DIQ(2,+$PIECE(XSTR,U,5),.01)_" ("_$PIECE(XSTR,U,5)_")"
- +31 DO BLD(SDTMP)
- +32 SET SDTMP="CLINIC: "_$EXTRACT("("_$PIECE(XSTR,U,2)_") "_$PIECE(XSTR,U,3),1,39)
- SET SDTMP=SDTMP_$$FILL^SDECU(49-$LENGTH(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($PIECE(XSTR,U,1))
- +33 DO BLD(SDTMP)
- +34 SET SDTMP="OTHER:"
- +35 DO BLD(SDTMP)
- +36 DO BLD($PIECE(XSTR,U,6))
- DO BLD("")
- +37 SET SDTMP="NOTE ("_$PIECE(XSTR,U,7)_"):"
- +38 DO BLD(SDTMP)
- +39 DO BLD($PIECE(XSTR,U,8))
- DO BLD(LINE)
- End DoDot:7
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +40 ;FIX conflicts
- +41 KILL ANOD,CNOT,CNT,IENS,LINE,SCN,SNOT,X,XSTR
- +42 SET $PIECE(LINE,"=",78)="="
- +43 DO BLD("")
- DO BLD("")
- DO BLD("")
- DO BLD("RESOLUTIONS:")
- DO BLD("===========")
- +44 DO BLD(LINE)
- +45 SET SCN=""
- FOR
- SET SCN=$ORDER(^XTMP("VSGUI_OI","DIFF",SCN))
- if SCN=""
- QUIT
- Begin DoDot:1
- +46 SET CNT=0
- FOR
- SET CNT=$ORDER(^XTMP("VSGUI_OI","DIFF",SCN,CNT))
- if CNT=""
- QUIT
- Begin DoDot:2
- +47 KILL ARR,FDA
- +48 SET XSTR=$GET(^XTMP("VSGUI_OI","DIFF",SCN,CNT))
- +49 SET CNOT=$PIECE(XSTR,U,6)
- +50 SET SNOT=$PIECE(XSTR,U,8)
- +51 SET IENS=$PIECE(XSTR,U,4)_","_$PIECE(XSTR,U,1)_","_$PIECE(XSTR,U,2)_","
- +52 if (CNOT="")&(SNOT'="")
- SET FDA(44.003,IENS,3)=SNOT
- +53 if (CNOT'="")&(SNOT="")
- DO WP^SDECUTL(.ARR,CNOT)
- +54 if (CNOT'="")&(SNOT'="")&(CNOT'=SNOT)
- DO WP^SDECUTL(.ARR,CNOT)
- +55 if $DATA(FDA)
- DO UPDATE^DIE("","FDA")
- +56 if $DATA(ARR)
- DO WP^DIE(409.84,$PIECE(XSTR,U,7)_",",1,"","ARR")
- +57 SET ANOD=$GET(^SC($PIECE(XSTR,U,2),"S",$PIECE(XSTR,U,1),1,$PIECE(XSTR,U,4),0))
- +58 SET CNOT=$PIECE(ANOD,U,4)
- +59 KILL ARR
- +60 SET X=$$GET1^DIQ(409.84,$PIECE(XSTR,U,7)_",",1,,"ARR")
- +61 SET SNOT=$$WPSTR^SDECUTL(.ARR)
- +62 SET SNOT=$EXTRACT(SNOT,1,150)
- +63 SET SDTMP=$$GET1^DIQ(2,+$PIECE(XSTR,U,5),.01)_" ("_$PIECE(XSTR,U,5)_")"
- +64 DO BLD(SDTMP)
- +65 SET SDTMP="CLINIC: "_$EXTRACT("("_$PIECE(XSTR,U,2)_") "_$PIECE(XSTR,U,3),1,39)
- SET SDTMP=SDTMP_$$FILL^SDECU(49-$LENGTH(SDTMP))_"APPT TIME: "_$$FMTE^XLFDT($PIECE(XSTR,U,1))
- +66 DO BLD(SDTMP)
- +67 SET SDTMP="OTHER:"
- +68 DO BLD(SDTMP)
- +69 DO BLD(CNOT)
- +70 DO BLD("")
- +71 SET SDTMP="NOTE ("_$PIECE(XSTR,U,7)_"):"
- +72 DO BLD(SDTMP)
- +73 DO BLD(SNOT)
- +74 DO BLD(LINE)
- End DoDot:2
- End DoDot:1
- +75 ;SEND message
- +76 SET XMY(DUZ)=""
- SET XMSUB="SD*5.3*658 NOTE UPDATE REPORT DATA for "_$$FMTE^XLFDT($$NOW^XLFDT)
- +77 SET XMTEXT=$PIECE(SDX,")")_","
- +78 DO ^XMD
- +79 QUIT
- +80 ;
- BLD(TXT) ;build output text for email
- +1 SET LCNT=LCNT+1
- +2 SET @SDX@(LCNT)=TXT
- +3 QUIT
- STRIP ;
- +1 NEW FDA
- +2 if SNOT'["^"
- QUIT
- +3 SET SNOT=$TRANSLATE(SNOT,"^"," ")
- +4 DO WP^SDECUTL(.ARR,SNOT)
- +5 DO WP^DIE(409.84,SID_",",1,"","ARR")
- +6 QUIT
- +7 ;
- SCH ;schedule options
- +1 ;schedule SDEC IDX REFRESH to run one time 'NOW'
- +2 ;cannot NEW XPDQUES in this routine - XPDQUES is defined during the install questions
- SET NOW=$GET(XPDQUES("POS2 NOWJOB"))
- +3 if $$UP^XLFSTR(NOW)=1
- DO ONE
- +4 QUIT
- ONE ;One time queue setup for SDEC IDX REFRESH
- +1 NEW NOW,QTIME,Y
- +2 SET Y=$$NOW^XLFDT
- SET Y=$$FMTE^XLFDT(Y)
- +3 WRITE !!,"Scheduling SDEC IDX REFRESH ..."
- +4 WRITE !,Y
- +5 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN
- +6 SET ZTRTN="ENTRY^SDECIDX"
- +7 SET ZTIO=""
- +8 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,1)
- +9 SET ZTDESC="One time Queue: SDEC IDX REFRESH"
- +10 DO ^%ZTLOAD
- +11 QUIT