BSTSDSP ;GDIT/HSCD/BEE-Display BSTS information ; 27 Mar 2015 11:35 AM
;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
;
DSP(SERV) ; EP
;
I $G(SERV)="" Q
;
NEW DIR,X,Y,DTOUT,DUOUT,POP,PRCDT,ERRDT,DIRUT,DIROUT,ANS
;
;Clear screen
DSP1 W:$G(IOF)]"" @IOF
;
W "BSTS REPORTING"
W !!,"Select the information to display",!
S DIR(0)="LO^1:6"
S DIR("A")="Select number or return to quit"
S DIR("A",1)="1. Current BSTS status display"
S DIR("A",2)="2. BSTS codeset versions"
S DIR("A",3)="3. Current BSTS processing queue"
S DIR("A",4)="4. BSTS process history"
S DIR("A",5)="5. BSTS error listing"
S DIR("A",6)="6. All of the above information"
S DIR("A",7)=" "
D ^DIR
I Y="" Q
I $G(DTOUT)!$G(DUOUT)!$G(DIRUT)!$G(DIROUT) Q
S ANS=+Y
;
;Prompt for process history days
I (ANS=4)!(ANS=6) S PRCDT=$$DATE("completed processes from date") Q:'PRCDT
;
;Prompt for error listing days
I (ANS=5)!(ANS=6) S ERRDT=$$DATE("error listing from date") Q:'ERRDT
;
;Get maximum errors to display
I (ANS=5)!(ANS=6) S ERMAX=$$EMAX() Q:'ERMAX
;
;Get device
S POP="" D ^%ZIS I POP Q
U IO
;
NEW BSTSRPT
;
;Current BSTS status display
I (ANS=1)!(ANS=6) D SET(SERV,.BSTSRPT)
;
;Current codeset versions
I (ANS=2)!(ANS=6) D VRSN(.BSTSRPT)
;
;Current processing queue
I (ANS=3)!(ANS=6) D QUEUE(.BSTSRPT)
;
;Process history
I (ANS=4)!(ANS=6) D HIST(.BSTSRPT,PRCDT)
;
;Error listing
I (ANS=5)!(ANS=6) D ELIST(.BSTSRPT,ERRDT,SERV,ERMAX)
;
S CT=+$O(BSTSRPT(""),-1)
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)="<END OF REPORT>"
;
;Display the report
D EN^DDIOL(.BSTSRPT)
;
;Close the device
D ^%ZISC
;
I $D(IOST),IOST["C-",'$D(DIRUT),'$D(DTOUT) D
. NEW DIR,X,Y
. W ! S DIR(0)="E",DIR("A")="Press 'Return to continue'" D ^DIR
;
G DSP1
;
VRSN(BSTSRPT) ;Display current codeset version information
;
NEW CT,CODE,IEN,SPACE
;
S $P(SPACE," ",80)=" "
;
;Get latest entry
S CT=+$O(BSTSRPT(""),-1)
;
S:CT=0 CT=1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)="Current BSTS Codeset Version Information:"
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT,"F")="!?0",BSTSRPT(CT)=$E(SPACE,1,6)_$E(SPACE,1,20)_$E("CURRENT"_SPACE,1,12)_$E("COMPLETED"_SPACE,1,14)_$E("SUBSET"_SPACE,1,12)
S CT=CT+1,BSTSRPT(CT,"F")="!?0",BSTSRPT(CT)=$E("CODE"_SPACE,1,6)_$E("CODESET"_SPACE,1,20)_$E("VERSION"_SPACE,1,12)_$E("CHECKS"_SPACE,1,14)_$E("RUN"_SPACE,1,12)
;
S CODE="" F S CODE=$O(^BSTS(9002318.1,"B",CODE)) Q:CODE="" D
. S IEN="" F S IEN=$O(^BSTS(9002318.1,"B",CODE,IEN)) Q:IEN="" D
.. NEW NAME,CVRSN,LVCHK,LSCHK
.. ;
.. S NAME=$$GET1^DIQ(9002318.1,IEN_",",.02) Q:NAME=""
.. S CVRSN=$$GET1^DIQ(9002318.1,IEN_",",.04)
.. S LVCHK=$$GET1^DIQ(9002318.1,IEN_",",.05,"I") S:LVCHK]"" LVCHK=$$FMTE^XLFDT(LVCHK,"2ZD")
.. S LSCHK=$$GET1^DIQ(9002318.1,IEN_",",.1,"I") S:LSCHK]"" LSCHK=$$FMTE^XLFDT(LSCHK,"2ZD")
.. ;
.. S CT=CT+1,BSTSRPT(CT,"F")="!?0",BSTSRPT(CT)=$E(CODE_SPACE,1,6)_$E(NAME_SPACE,1,20)_$E(CVRSN_SPACE,1,12)_$E(LVCHK_SPACE,1,14)_$E(LSCHK_SPACE,1,12)
;
Q
;
QUEUE(BSTSRPT) ;Display processing queue
;
NEW IEN,CT,SPACE,QIEN,ZT1,ZTS,TFND
;
S $P(SPACE," ",80)=" "
;
;Get latest entry
S CT=+$O(BSTSRPT(""),-1)
;
S:CT=0 CT=1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)="Current BSTS Processing Queue:"
S CT=CT+1,BSTSRPT(CT)=" "
;
;Check if entry present
I '$O(^XTMP("BSTSPROCQ",0)) D
. S CT=CT+1,BSTSRPT(CT)="No entries currently scheduled to run"
. S CT=CT+1,BSTSRPT(CT)=" "
;
;Output Header
I $O(^XTMP("BSTSPROCQ",0)) D
. S CT=CT+1,BSTSRPT(CT)=$E("UPDATE TASK"_SPACE,1,25)_$E("SCHEDULED"_SPACE,1,16)_$E("STARTED"_SPACE,1,16)
. ;
. ;Loop through entries
. S QIEN=0 F S QIEN=$O(^XTMP("BSTSPROCQ",QIEN)) Q:'QIEN D
.. ;
.. ;Process each entry
.. D PRCENTRY(.BSTSRPT,QIEN,"")
;
S:CT=0 CT=1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)="Scheduled TaskMan BSTS processes:"
S CT=CT+1,BSTSRPT(CT)="(It is normal for a process to be scheduled to run more than once)"
S CT=CT+1,BSTSRPT(CT)=" "
;
;Get Taskman Processes
S TFND="",ZT1=$$H3^%ZTM($H) F S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1 D
. S ZTS=0 F S ZTS=$O(^%ZTSCH(ZT1,ZTS)) Q:'ZTS D
.. ;
.. NEW TASKND,SCHDT,RUNDT
.. ;
.. ;Get the task
.. S TASKND=$G(^%ZTSK(ZTS,0)) Q:TASKND=""
.. I $P(TASKND,U,2)'="BSTSVOFL",$P(TASKND,U,2)'="BSTSVOF1",$P(TASKND,U,2)'="BSTSVRSN" Q
.. ;
.. ;Output Header
.. I 'TFND S CT=CT+1,BSTSRPT(CT)=$E("TASKMAN TASK"_SPACE,1,25)_$E("SCHEDULED"_SPACE,1,16)_$E("RUN AT"_SPACE,1,16)
.. ;
.. S SCHDT=$$HTFM^XLFDT($P(TASKND,U,5))
.. S RUNDT=$$HTFM^XLFDT($P(TASKND,U,6))
.. S TFND=1
.. ;
.. S CT=CT+1,BSTSRPT(CT)=$E($P(TASKND,U)_"^"_$P(TASKND,U,2)_SPACE,1,25)_$E($$FMTE^XLFDT(SCHDT,"2ZM")_SPACE,1,16)_$E($$FMTE^XLFDT(RUNDT,"2ZM")_SPACE,1,16)
;
I 'TFND D
. S CT=CT+1,BSTSRPT(CT)="No scheduled TaskMan tasks"
;
Q
;
HIST(BSTSRPT,BDT) ;Display process history
;
NEW IEN,CT,SPACE,PDATE,QIEN,FND
;
S $P(SPACE," ",80)=" "
;
;Get latest entry
S CT=+$O(BSTSRPT(""),-1)
;
S:CT=0 CT=1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)="BSTS Processing History: "_$$FMTE^XLFDT(BDT,"2ZD")_" to present"
S CT=CT+1,BSTSRPT(CT)=" "
;
;Check if entry present
I '$D(^XTMP("BSTSPROCQ","PD")) D Q
. S CT=CT+1,BSTSRPT(CT)="No automatic BSTS tasks have been run"
;
;Output Header
S CT=CT+1,BSTSRPT(CT)=$E("UPDATE"_SPACE,1,25)_$E("SCHEDULED"_SPACE,1,16)_$E("STARTED"_SPACE,1,16)_$E("COMPLETED"_SPACE,1,16)
;
;Loop through entries
S PDATE="" F S PDATE=$O(^XTMP("BSTSPROCQ","PD",PDATE),-1) Q:PDATE=""!(PDATE<BDT) D
. S QIEN="" F S QIEN=$O(^XTMP("BSTSPROCQ","PD",PDATE,QIEN),-1) Q:'QIEN D
.. ;
.. ;Process each entry
.. D PRCENTRY(.BSTSRPT,QIEN,"P")
;
;Check if manual history entry present
;
;Output Header
;
;Loop through entries
S (FND,PDATE)="" F S PDATE=$O(^XTMP("BSTSPROCQ","M","D",PDATE),-1) Q:PDATE=""!(PDATE<BDT) D
. S QIEN="" F S QIEN=$O(^XTMP("BSTSPROCQ","M","D",PDATE,QIEN),-1) Q:'QIEN D
.. ;
.. NEW XDATE,MNODE,MUSER,MACT
.. ;
.. ;Process each entry
.. S MNODE=$G(^XTMP("BSTSPROCQ","M",QIEN))
.. S MUSER=$E($P(MNODE,U,2),1,25)
.. S MACT=$E($P(MNODE,U,3),1,35)
.. S XDATE=PDATE S:XDATE]"" XDATE=$$FMTE^XLFDT(XDATE,"2ZM")
.. ;
.. ;Display header
.. I 'FND D
... S CT=CT+1,BSTSRPT(CT)=" "
... S CT=CT+1,BSTSRPT(CT)="Manual Processes"
... S CT=CT+1,BSTSRPT(CT)=" "
... S CT=CT+1,BSTSRPT(CT)=$E("STARTED"_SPACE,1,16)_$E("USER"_SPACE,1,25)_$E("ACTION"_SPACE,1,35)
.. S CT=CT+1,BSTSRPT(CT)=$E(XDATE_SPACE,1,16)_$E(MUSER_SPACE,1,25)_$E(MACT_SPACE,1,35),FND=1
;
Q
;
ELIST(BSTSRPT,BDT,SERV,ERMAX) ;Display error listing
;
NEW IEN,CT,SPACE,PDATE,EIEN,MAX
;
S $P(SPACE," ",80)=" ",MAX=1
;
;Get latest entry
S CT=+$O(BSTSRPT(""),-1)
;
S:CT=0 CT=1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)="BSTS error listing: "_$$FMTE^XLFDT(BDT,"2ZD")_" to present. Last "_ERMAX_" errors"
S CT=CT+1,BSTSRPT(CT)=" "
;
;Check if entry present
I '$D(^BSTS(9002318.2,SERV,5,"B")) D Q
. S CT=CT+1,BSTSRPT(CT)="No errors recorded during that specified time period"
;
;Output Header
S CT=CT+1,BSTSRPT(CT)=$E("ERROR DATE"_SPACE,1,16)_$E("ERROR MESSAGE"_SPACE,1,25)
;
;Loop through entries
S PDATE="" F S PDATE=$O(^BSTS(9002318.2,SERV,5,"B",PDATE),-1) Q:PDATE=""!(PDATE<BDT) D Q:MAX'<ERMAX
. S EIEN="" F S EIEN=$O(^BSTS(9002318.2,SERV,5,"B",PDATE,EIEN),-1) Q:'EIEN D Q:MAX'<ERMAX
.. ;
.. NEW XDATE,DA,IENS,TMSG,TIME
.. ;
.. ;Process each entry
.. S XDATE=PDATE S:XDATE]"" XDATE=$$FMTE^XLFDT(XDATE,"2ZM")
.. S DA(1)=SERV,DA=EIEN,IENS=$$IENS^DILF(.DA)
.. S TMSG=$$GET1^DIQ(9002318.25,IENS,".02","I")
.. ;
.. S CT=CT+1,BSTSRPT(CT)=$E(XDATE_SPACE,1,16)_$E(TMSG_SPACE,1,60)
.. F S TMSG=$E(TMSG,61,$L(TMSG)) Q:TMSG="" D
... S CT=CT+1,BSTSRPT(CT,"F")="!?16"
... S BSTSRPT(CT)=$E(TMSG,1,60)
... S MAX=MAX+1
;
Q
;
PRCENTRY(BSTSRPT,QIEN,TYPE) ;Format one BSTS task entry
;
S TYPE=$G(TYPE)
;
NEW SPACE,ENTRY,UPDATE,START,SCHED,END
;
S $P(SPACE," ",80)=" "
;
;Pull entry information
I $G(TYPE)'="P" M ENTRY=^XTMP("BSTSPROCQ",QIEN) ;Queued entry
E M ENTRY=^XTMP("BSTSPROCQ","P",QIEN) ;Completed entry
;
S UPDATE=$G(ENTRY("RTN")) I $TR(UPDATE," ")="" Q
S SCHED=$G(ENTRY("SCHED")) S:SCHED]"" SCHED=$$FMTE^XLFDT(SCHED,"2ZM")
S START=$G(ENTRY("START")) S:START]"" START=$$FMTE^XLFDT(START,"2ZM")
S END=$G(ENTRY("END")) S:END]"" END=$$FMTE^XLFDT(END,"2ZM")
;
S CT=CT+1,BSTSRPT(CT)=$E(UPDATE_SPACE,1,25)_$E(SCHED_SPACE,1,16)_$E(START_SPACE,1,16)_$S(END]"":$E(END_SPACE,1,16),1:"")
Q
;
DATE(PROMPT,DEF,FDT) ;Prompt for from date
;
I $G(PROMPT)="" Q ""
S DEF=$G(DEF)
S FDT=$G(FDT)
;
NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
;
DT1 W !
S DIR(0)="D^:"_DT_"^"
S DIR("A")="Display "_PROMPT_": "
I DEF]"" S DIR("B")=DEF
E S DIR("B")="T-7"
D ^DIR
I Y="" Q ""
I $G(DTOUT)!$G(DUOUT)!$G(DIRUT)!$G(DIROUT) Q ""
;
;Check for future dates
I FDT]"",Y<FDT W !!,"<TO Date Must Be After From Date>" H 3 G DT1
;
Q Y
;
EMAX() ;Prompt for maximum errors to display
;
NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
;
W !
S DIR(0)="N^1:9999:4"
S DIR("A")="Maximum number of errors to return: "
S DIR("B")="25"
D ^DIR
I Y="" Q ""
I $G(DTOUT)!$G(DUOUT)!$G(DIRUT)!$G(DIROUT) Q ""
;
Q Y
;
SET(SERV,BSTSRPT) ;Return site/server settings
;
I '+$G(SERV) Q
;
NEW SDATA,DTSON,CT,FLD,SIEN
;
S SDATA=^BSTS(9002318.2,SERV,0)
S DTSON=$P(SDATA,"^",13)
I DTSON="" D
. D CHK^BSTSSTA
. S SDATA=^BSTS(9002318.2,SERV,0)
. S DTSON=$P(SDATA,"^",13)
;
;Get latest entry
S CT=+$O(BSTSRPT(""),-1)
;
S:CT=0 CT=1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(1)="Current Server Status:"
S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Web Service: "
S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)=$P(SDATA,"^",1)
S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Current Status: "
S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)=$S(DTSON="":"ONLINE",1:"OFFLINE")
S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Offline Until: "
S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)=$S(DTSON="":"N/A",1:$$FMTE^XLFDT(DTSON))
S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Last Error Message: "
S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)=$S(DTSON="":"N/A",1:$$GET1^DIQ(9002318.2,SERV_",",3,"E"))
;
;Check if any processes are running
L +^BSTS(9002318.1,0):0 E D
. S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Background process: "
. S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)=$P($G(^XTMP("BSTSLCMP",0)),U,3)
. I $G(^XTMP("BSTSLCMP","STS"))]"" S CT=CT+1,BSTSRPT(CT,"F")="!?25",BSTSRPT(CT)=$G(^XTMP("BSTSLCMP","STS"))
L -^BSTS(9002318.1,0)
;
;Check if Description Id Population Utility is running
L +^XTMP("BSTSCFIX"):0 E D
. NEW RUN
. S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Background process: "
. S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)="Description Id Population Utility is running"
. S RUN=$G(^XTMP("BSTSCFIX","RUN")) Q:RUN=""
. I $G(^XTMP("BSTSCFIX",RUN,"STS"))]"" S CT=CT+1,BSTSRPT(CT,"F")="!?25",BSTSRPT(CT)=$G(^XTMP("BSTSCFIX",RUN,"STS"))
L -^XTMP("BSTSCFIX")
;
;Check if ICD9 to SNOMED process is running
L +^TMP("BSTSICD2SMD"):0 E D
. S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Background process: "
. S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)="ICD9 to SNOMED process is running"
L -^TMP("BSTSICD2SMD")
;
;Check if install conversion process is running
L +^TMP("BSTSPBFH"):0 E D
. S CT=CT+1,BSTSRPT(CT,"F")="!?5",BSTSRPT(CT)="Background process: "
. S CT=CT+1,BSTSRPT(CT,"F")="?25",BSTSRPT(CT)="Installation conversion process is running"
L -^TMP("BSTSPBFH")
;
S CT=CT+1,BSTSRPT(CT,"F")="!!",BSTSRPT(CT)="Current Server Settings: "
S CT=CT+1,BSTSRPT(CT)=" "
;
;Site Parameters
S CT=CT+1,BSTSRPT(CT,"F")="!!",BSTSRPT(CT)="Site Parameters"
S CT=CT+1,BSTSRPT(CT)=" "
F FLD=.01,.02,.03 D
. S CT=CT+1,BSTSRPT(CT,"F")="!?2",BSTSRPT(CT)=$P($G(^DD(9002318,FLD,0)),U)_": "
. S CT=CT+1,BSTSRPT(CT,"F")="?32",BSTSRPT(CT)=$$GET1^DIQ(9002318,"1,",FLD,"E")
S SIEN=0 F S SIEN=$O(^BSTS(9002318,1,1,SIEN)) Q:'SIEN D
. F FLD=.01,.02,.03 D
.. NEW IENS,DA
.. S DA(1)=1,DA=SIEN,IENS=$$IENS^DILF(.DA)
.. I FLD=.01 S CT=CT+1,BSTSRPT(CT)=" "
.. S CT=CT+1,BSTSRPT(CT,"F")="!?2",BSTSRPT(CT)=$P($G(^DD(9002318.01,FLD,0)),U)_": "
.. S CT=CT+1,BSTSRPT(CT,"F")="?32",BSTSRPT(CT)=$$GET1^DIQ(9002318.01,IENS,FLD,"E")
;
;Web Service
S CT=CT+1,BSTSRPT(CT,"F")="!!",BSTSRPT(CT)="Selected Web Service"
S CT=CT+1,BSTSRPT(CT)=" "
F FLD=.01,.02,.03,.04,.05,.06,.07,.08,.09,.1,.11,.12,.13,.14,.15,2.01,4.01,4.02,4.03 D
. S CT=CT+1,BSTSRPT(CT,"F")="!?2",BSTSRPT(CT)=$P($G(^DD(9002318.2,FLD,0)),U)_": "
. S CT=CT+1,BSTSRPT(CT,"F")="?32",BSTSRPT(CT)=$$GET1^DIQ(9002318.2,SERV_",",FLD,"E")
;
Q
BSTSDSP ;GDIT/HSCD/BEE-Display BSTS information ; 27 Mar 2015 11:35 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
+2 ;
DSP(SERV) ; EP
+1 ;
+2 IF $GET(SERV)=""
QUIT
+3 ;
+4 NEW DIR,X,Y,DTOUT,DUOUT,POP,PRCDT,ERRDT,DIRUT,DIROUT,ANS
+5 ;
+6 ;Clear screen
DSP1 IF $GET(IOF)]""
WRITE @IOF
+1 ;
+2 WRITE "BSTS REPORTING"
+3 WRITE !!,"Select the information to display",!
+4 SET DIR(0)="LO^1:6"
+5 SET DIR("A")="Select number or return to quit"
+6 SET DIR("A",1)="1. Current BSTS status display"
+7 SET DIR("A",2)="2. BSTS codeset versions"
+8 SET DIR("A",3)="3. Current BSTS processing queue"
+9 SET DIR("A",4)="4. BSTS process history"
+10 SET DIR("A",5)="5. BSTS error listing"
+11 SET DIR("A",6)="6. All of the above information"
+12 SET DIR("A",7)=" "
+13 DO ^DIR
+14 IF Y=""
QUIT
+15 IF $GET(DTOUT)!$GET(DUOUT)!$GET(DIRUT)!$GET(DIROUT)
QUIT
+16 SET ANS=+Y
+17 ;
+18 ;Prompt for process history days
+19 IF (ANS=4)!(ANS=6)
SET PRCDT=$$DATE("completed processes from date")
IF 'PRCDT
QUIT
+20 ;
+21 ;Prompt for error listing days
+22 IF (ANS=5)!(ANS=6)
SET ERRDT=$$DATE("error listing from date")
IF 'ERRDT
QUIT
+23 ;
+24 ;Get maximum errors to display
+25 IF (ANS=5)!(ANS=6)
SET ERMAX=$$EMAX()
IF 'ERMAX
QUIT
+26 ;
+27 ;Get device
+28 SET POP=""
DO ^%ZIS
IF POP
QUIT
+29 USE IO
+30 ;
+31 NEW BSTSRPT
+32 ;
+33 ;Current BSTS status display
+34 IF (ANS=1)!(ANS=6)
DO SET(SERV,.BSTSRPT)
+35 ;
+36 ;Current codeset versions
+37 IF (ANS=2)!(ANS=6)
DO VRSN(.BSTSRPT)
+38 ;
+39 ;Current processing queue
+40 IF (ANS=3)!(ANS=6)
DO QUEUE(.BSTSRPT)
+41 ;
+42 ;Process history
+43 IF (ANS=4)!(ANS=6)
DO HIST(.BSTSRPT,PRCDT)
+44 ;
+45 ;Error listing
+46 IF (ANS=5)!(ANS=6)
DO ELIST(.BSTSRPT,ERRDT,SERV,ERMAX)
+47 ;
+48 SET CT=+$ORDER(BSTSRPT(""),-1)
+49 SET CT=CT+1
SET BSTSRPT(CT)=" "
+50 SET CT=CT+1
SET BSTSRPT(CT)="<END OF REPORT>"
+51 ;
+52 ;Display the report
+53 DO EN^DDIOL(.BSTSRPT)
+54 ;
+55 ;Close the device
+56 DO ^%ZISC
+57 ;
+58 IF $DATA(IOST)
IF IOST["C-"
IF '$DATA(DIRUT)
IF '$DATA(DTOUT)
Begin DoDot:1
+59 NEW DIR,X,Y
+60 WRITE !
SET DIR(0)="E"
SET DIR("A")="Press 'Return to continue'"
DO ^DIR
End DoDot:1
+61 ;
+62 GOTO DSP1
+63 ;
VRSN(BSTSRPT) ;Display current codeset version information
+1 ;
+2 NEW CT,CODE,IEN,SPACE
+3 ;
+4 SET $PIECE(SPACE," ",80)=" "
+5 ;
+6 ;Get latest entry
+7 SET CT=+$ORDER(BSTSRPT(""),-1)
+8 ;
+9 IF CT=0
SET CT=1
SET BSTSRPT(CT)=" "
+10 SET CT=CT+1
SET BSTSRPT(CT)=" "
+11 SET CT=CT+1
SET BSTSRPT(CT)="Current BSTS Codeset Version Information:"
+12 SET CT=CT+1
SET BSTSRPT(CT)=" "
+13 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?0"
SET BSTSRPT(CT)=$EXTRACT(SPACE,1,6)_$EXTRACT(SPACE,1,20)_$EXTRACT("CURRENT"_SPACE,1,12)_$EXTRACT("COMPLETED"_SPACE,1,14)_$EXTRACT("SUBSET"_SPACE,1,12)
+14 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?0"
SET BSTSRPT(CT)=$EXTRACT("CODE"_SPACE,1,6)_$EXTRACT("CODESET"_SPACE,1,20)_$EXTRACT("VERSION"_SPACE,1,12)_$EXTRACT("CHECKS"_SPACE,1,14)_$EXTRACT("RUN"_SPACE,1,12)
+15 ;
+16 SET CODE=""
FOR
SET CODE=$ORDER(^BSTS(9002318.1,"B",CODE))
IF CODE=""
QUIT
Begin DoDot:1
+17 SET IEN=""
FOR
SET IEN=$ORDER(^BSTS(9002318.1,"B",CODE,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+18 NEW NAME,CVRSN,LVCHK,LSCHK
+19 ;
+20 SET NAME=$$GET1^DIQ(9002318.1,IEN_",",.02)
IF NAME=""
QUIT
+21 SET CVRSN=$$GET1^DIQ(9002318.1,IEN_",",.04)
+22 SET LVCHK=$$GET1^DIQ(9002318.1,IEN_",",.05,"I")
IF LVCHK]""
SET LVCHK=$$FMTE^XLFDT(LVCHK,"2ZD")
+23 SET LSCHK=$$GET1^DIQ(9002318.1,IEN_",",.1,"I")
IF LSCHK]""
SET LSCHK=$$FMTE^XLFDT(LSCHK,"2ZD")
+24 ;
+25 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?0"
SET BSTSRPT(CT)=$EXTRACT(CODE_SPACE,1,6)_$EXTRACT(NAME_SPACE,1,20)_$EXTRACT(CVRSN_SPACE,1,12)_$EXTRACT(LVCHK_SPACE,1,14)_$EXTRACT(LSCHK_SPACE,1,12)
End DoDot:2
End DoDot:1
+26 ;
+27 QUIT
+28 ;
QUEUE(BSTSRPT) ;Display processing queue
+1 ;
+2 NEW IEN,CT,SPACE,QIEN,ZT1,ZTS,TFND
+3 ;
+4 SET $PIECE(SPACE," ",80)=" "
+5 ;
+6 ;Get latest entry
+7 SET CT=+$ORDER(BSTSRPT(""),-1)
+8 ;
+9 IF CT=0
SET CT=1
SET BSTSRPT(CT)=" "
+10 SET CT=CT+1
SET BSTSRPT(CT)=" "
+11 SET CT=CT+1
SET BSTSRPT(CT)="Current BSTS Processing Queue:"
+12 SET CT=CT+1
SET BSTSRPT(CT)=" "
+13 ;
+14 ;Check if entry present
+15 IF '$ORDER(^XTMP("BSTSPROCQ",0))
Begin DoDot:1
+16 SET CT=CT+1
SET BSTSRPT(CT)="No entries currently scheduled to run"
+17 SET CT=CT+1
SET BSTSRPT(CT)=" "
End DoDot:1
+18 ;
+19 ;Output Header
+20 IF $ORDER(^XTMP("BSTSPROCQ",0))
Begin DoDot:1
+21 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT("UPDATE TASK"_SPACE,1,25)_$EXTRACT("SCHEDULED"_SPACE,1,16)_$EXTRACT("STARTED"_SPACE,1,16)
+22 ;
+23 ;Loop through entries
+24 SET QIEN=0
FOR
SET QIEN=$ORDER(^XTMP("BSTSPROCQ",QIEN))
IF 'QIEN
QUIT
Begin DoDot:2
+25 ;
+26 ;Process each entry
+27 DO PRCENTRY(.BSTSRPT,QIEN,"")
End DoDot:2
End DoDot:1
+28 ;
+29 IF CT=0
SET CT=1
SET BSTSRPT(CT)=" "
+30 SET CT=CT+1
SET BSTSRPT(CT)=" "
+31 SET CT=CT+1
SET BSTSRPT(CT)="Scheduled TaskMan BSTS processes:"
+32 SET CT=CT+1
SET BSTSRPT(CT)="(It is normal for a process to be scheduled to run more than once)"
+33 SET CT=CT+1
SET BSTSRPT(CT)=" "
+34 ;
+35 ;Get Taskman Processes
+36 SET TFND=""
SET ZT1=$$H3^%ZTM($HOROLOG)
FOR
SET ZT1=$ORDER(^%ZTSCH(ZT1))
IF 'ZT1
QUIT
Begin DoDot:1
+37 SET ZTS=0
FOR
SET ZTS=$ORDER(^%ZTSCH(ZT1,ZTS))
IF 'ZTS
QUIT
Begin DoDot:2
+38 ;
+39 NEW TASKND,SCHDT,RUNDT
+40 ;
+41 ;Get the task
+42 SET TASKND=$GET(^%ZTSK(ZTS,0))
IF TASKND=""
QUIT
+43 IF $PIECE(TASKND,U,2)'="BSTSVOFL"
IF $PIECE(TASKND,U,2)'="BSTSVOF1"
IF $PIECE(TASKND,U,2)'="BSTSVRSN"
QUIT
+44 ;
+45 ;Output Header
+46 IF 'TFND
SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT("TASKMAN TASK"_SPACE,1,25)_$EXTRACT("SCHEDULED"_SPACE,1,16)_$EXTRACT("RUN AT"_SPACE,1,16)
+47 ;
+48 SET SCHDT=$$HTFM^XLFDT($PIECE(TASKND,U,5))
+49 SET RUNDT=$$HTFM^XLFDT($PIECE(TASKND,U,6))
+50 SET TFND=1
+51 ;
+52 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT($PIECE(TASKND,U)_"^"_$PIECE(TASKND,U,2)_SPACE,1,25)_$EXTRACT($$FMTE^XLFDT(SCHDT,"2ZM")_SPACE,1,16)_$EXTRACT($$FMTE^XLFDT(RUNDT,"2ZM")_SPACE,1,16)
End DoDot:2
End DoDot:1
+53 ;
+54 IF 'TFND
Begin DoDot:1
+55 SET CT=CT+1
SET BSTSRPT(CT)="No scheduled TaskMan tasks"
End DoDot:1
+56 ;
+57 QUIT
+58 ;
HIST(BSTSRPT,BDT) ;Display process history
+1 ;
+2 NEW IEN,CT,SPACE,PDATE,QIEN,FND
+3 ;
+4 SET $PIECE(SPACE," ",80)=" "
+5 ;
+6 ;Get latest entry
+7 SET CT=+$ORDER(BSTSRPT(""),-1)
+8 ;
+9 IF CT=0
SET CT=1
SET BSTSRPT(CT)=" "
+10 SET CT=CT+1
SET BSTSRPT(CT)=" "
+11 SET CT=CT+1
SET BSTSRPT(CT)="BSTS Processing History: "_$$FMTE^XLFDT(BDT,"2ZD")_" to present"
+12 SET CT=CT+1
SET BSTSRPT(CT)=" "
+13 ;
+14 ;Check if entry present
+15 IF '$DATA(^XTMP("BSTSPROCQ","PD"))
Begin DoDot:1
+16 SET CT=CT+1
SET BSTSRPT(CT)="No automatic BSTS tasks have been run"
End DoDot:1
QUIT
+17 ;
+18 ;Output Header
+19 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT("UPDATE"_SPACE,1,25)_$EXTRACT("SCHEDULED"_SPACE,1,16)_$EXTRACT("STARTED"_SPACE,1,16)_$EXTRACT("COMPLETED"_SPACE,1,16)
+20 ;
+21 ;Loop through entries
+22 SET PDATE=""
FOR
SET PDATE=$ORDER(^XTMP("BSTSPROCQ","PD",PDATE),-1)
IF PDATE=""!(PDATE<BDT)
QUIT
Begin DoDot:1
+23 SET QIEN=""
FOR
SET QIEN=$ORDER(^XTMP("BSTSPROCQ","PD",PDATE,QIEN),-1)
IF 'QIEN
QUIT
Begin DoDot:2
+24 ;
+25 ;Process each entry
+26 DO PRCENTRY(.BSTSRPT,QIEN,"P")
End DoDot:2
End DoDot:1
+27 ;
+28 ;Check if manual history entry present
+29 ;
+30 ;Output Header
+31 ;
+32 ;Loop through entries
+33 SET (FND,PDATE)=""
FOR
SET PDATE=$ORDER(^XTMP("BSTSPROCQ","M","D",PDATE),-1)
IF PDATE=""!(PDATE<BDT)
QUIT
Begin DoDot:1
+34 SET QIEN=""
FOR
SET QIEN=$ORDER(^XTMP("BSTSPROCQ","M","D",PDATE,QIEN),-1)
IF 'QIEN
QUIT
Begin DoDot:2
+35 ;
+36 NEW XDATE,MNODE,MUSER,MACT
+37 ;
+38 ;Process each entry
+39 SET MNODE=$GET(^XTMP("BSTSPROCQ","M",QIEN))
+40 SET MUSER=$EXTRACT($PIECE(MNODE,U,2),1,25)
+41 SET MACT=$EXTRACT($PIECE(MNODE,U,3),1,35)
+42 SET XDATE=PDATE
IF XDATE]""
SET XDATE=$$FMTE^XLFDT(XDATE,"2ZM")
+43 ;
+44 ;Display header
+45 IF 'FND
Begin DoDot:3
+46 SET CT=CT+1
SET BSTSRPT(CT)=" "
+47 SET CT=CT+1
SET BSTSRPT(CT)="Manual Processes"
+48 SET CT=CT+1
SET BSTSRPT(CT)=" "
+49 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT("STARTED"_SPACE,1,16)_$EXTRACT("USER"_SPACE,1,25)_$EXTRACT("ACTION"_SPACE,1,35)
End DoDot:3
+50 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT(XDATE_SPACE,1,16)_$EXTRACT(MUSER_SPACE,1,25)_$EXTRACT(MACT_SPACE,1,35)
SET FND=1
End DoDot:2
End DoDot:1
+51 ;
+52 QUIT
+53 ;
ELIST(BSTSRPT,BDT,SERV,ERMAX) ;Display error listing
+1 ;
+2 NEW IEN,CT,SPACE,PDATE,EIEN,MAX
+3 ;
+4 SET $PIECE(SPACE," ",80)=" "
SET MAX=1
+5 ;
+6 ;Get latest entry
+7 SET CT=+$ORDER(BSTSRPT(""),-1)
+8 ;
+9 IF CT=0
SET CT=1
SET BSTSRPT(CT)=" "
+10 SET CT=CT+1
SET BSTSRPT(CT)=" "
+11 SET CT=CT+1
SET BSTSRPT(CT)="BSTS error listing: "_$$FMTE^XLFDT(BDT,"2ZD")_" to present. Last "_ERMAX_" errors"
+12 SET CT=CT+1
SET BSTSRPT(CT)=" "
+13 ;
+14 ;Check if entry present
+15 IF '$DATA(^BSTS(9002318.2,SERV,5,"B"))
Begin DoDot:1
+16 SET CT=CT+1
SET BSTSRPT(CT)="No errors recorded during that specified time period"
End DoDot:1
QUIT
+17 ;
+18 ;Output Header
+19 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT("ERROR DATE"_SPACE,1,16)_$EXTRACT("ERROR MESSAGE"_SPACE,1,25)
+20 ;
+21 ;Loop through entries
+22 SET PDATE=""
FOR
SET PDATE=$ORDER(^BSTS(9002318.2,SERV,5,"B",PDATE),-1)
IF PDATE=""!(PDATE<BDT)
QUIT
Begin DoDot:1
+23 SET EIEN=""
FOR
SET EIEN=$ORDER(^BSTS(9002318.2,SERV,5,"B",PDATE,EIEN),-1)
IF 'EIEN
QUIT
Begin DoDot:2
+24 ;
+25 NEW XDATE,DA,IENS,TMSG,TIME
+26 ;
+27 ;Process each entry
+28 SET XDATE=PDATE
IF XDATE]""
SET XDATE=$$FMTE^XLFDT(XDATE,"2ZM")
+29 SET DA(1)=SERV
SET DA=EIEN
SET IENS=$$IENS^DILF(.DA)
+30 SET TMSG=$$GET1^DIQ(9002318.25,IENS,".02","I")
+31 ;
+32 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT(XDATE_SPACE,1,16)_$EXTRACT(TMSG_SPACE,1,60)
+33 FOR
SET TMSG=$EXTRACT(TMSG,61,$LENGTH(TMSG))
IF TMSG=""
QUIT
Begin DoDot:3
+34 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?16"
+35 SET BSTSRPT(CT)=$EXTRACT(TMSG,1,60)
+36 SET MAX=MAX+1
End DoDot:3
End DoDot:2
IF MAX'<ERMAX
QUIT
End DoDot:1
IF MAX'<ERMAX
QUIT
+37 ;
+38 QUIT
+39 ;
PRCENTRY(BSTSRPT,QIEN,TYPE) ;Format one BSTS task entry
+1 ;
+2 SET TYPE=$GET(TYPE)
+3 ;
+4 NEW SPACE,ENTRY,UPDATE,START,SCHED,END
+5 ;
+6 SET $PIECE(SPACE," ",80)=" "
+7 ;
+8 ;Pull entry information
+9 ;Queued entry
IF $GET(TYPE)'="P"
MERGE ENTRY=^XTMP("BSTSPROCQ",QIEN)
+10 ;Completed entry
IF '$TEST
MERGE ENTRY=^XTMP("BSTSPROCQ","P",QIEN)
+11 ;
+12 SET UPDATE=$GET(ENTRY("RTN"))
IF $TRANSLATE(UPDATE," ")=""
QUIT
+13 SET SCHED=$GET(ENTRY("SCHED"))
IF SCHED]""
SET SCHED=$$FMTE^XLFDT(SCHED,"2ZM")
+14 SET START=$GET(ENTRY("START"))
IF START]""
SET START=$$FMTE^XLFDT(START,"2ZM")
+15 SET END=$GET(ENTRY("END"))
IF END]""
SET END=$$FMTE^XLFDT(END,"2ZM")
+16 ;
+17 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT(UPDATE_SPACE,1,25)_$EXTRACT(SCHED_SPACE,1,16)_$EXTRACT(START_SPACE,1,16)_$SELECT(END]"":$EXTRACT(END_SPACE,1,16),1:"")
+18 QUIT
+19 ;
DATE(PROMPT,DEF,FDT) ;Prompt for from date
+1 ;
+2 IF $GET(PROMPT)=""
QUIT ""
+3 SET DEF=$GET(DEF)
+4 SET FDT=$GET(FDT)
+5 ;
+6 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+7 ;
DT1 WRITE !
+1 SET DIR(0)="D^:"_DT_"^"
+2 SET DIR("A")="Display "_PROMPT_": "
+3 IF DEF]""
SET DIR("B")=DEF
+4 IF '$TEST
SET DIR("B")="T-7"
+5 DO ^DIR
+6 IF Y=""
QUIT ""
+7 IF $GET(DTOUT)!$GET(DUOUT)!$GET(DIRUT)!$GET(DIROUT)
QUIT ""
+8 ;
+9 ;Check for future dates
+10 IF FDT]""
IF Y<FDT
WRITE !!,"<TO Date Must Be After From Date>"
HANG 3
GOTO DT1
+11 ;
+12 QUIT Y
+13 ;
EMAX() ;Prompt for maximum errors to display
+1 ;
+2 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+3 ;
+4 WRITE !
+5 SET DIR(0)="N^1:9999:4"
+6 SET DIR("A")="Maximum number of errors to return: "
+7 SET DIR("B")="25"
+8 DO ^DIR
+9 IF Y=""
QUIT ""
+10 IF $GET(DTOUT)!$GET(DUOUT)!$GET(DIRUT)!$GET(DIROUT)
QUIT ""
+11 ;
+12 QUIT Y
+13 ;
SET(SERV,BSTSRPT) ;Return site/server settings
+1 ;
+2 IF '+$GET(SERV)
QUIT
+3 ;
+4 NEW SDATA,DTSON,CT,FLD,SIEN
+5 ;
+6 SET SDATA=^BSTS(9002318.2,SERV,0)
+7 SET DTSON=$PIECE(SDATA,"^",13)
+8 IF DTSON=""
Begin DoDot:1
+9 DO CHK^BSTSSTA
+10 SET SDATA=^BSTS(9002318.2,SERV,0)
+11 SET DTSON=$PIECE(SDATA,"^",13)
End DoDot:1
+12 ;
+13 ;Get latest entry
+14 SET CT=+$ORDER(BSTSRPT(""),-1)
+15 ;
+16 IF CT=0
SET CT=1
SET BSTSRPT(CT)=" "
+17 SET CT=CT+1
SET BSTSRPT(CT)=" "
+18 SET CT=CT+1
SET BSTSRPT(1)="Current Server Status:"
+19 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Web Service: "
+20 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)=$PIECE(SDATA,"^",1)
+21 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Current Status: "
+22 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)=$SELECT(DTSON="":"ONLINE",1:"OFFLINE")
+23 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Offline Until: "
+24 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)=$SELECT(DTSON="":"N/A",1:$$FMTE^XLFDT(DTSON))
+25 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Last Error Message: "
+26 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)=$SELECT(DTSON="":"N/A",1:$$GET1^DIQ(9002318.2,SERV_",",3,"E"))
+27 ;
+28 ;Check if any processes are running
+29 LOCK +^BSTS(9002318.1,0):0
IF '$TEST
Begin DoDot:1
+30 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Background process: "
+31 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)=$PIECE($GET(^XTMP("BSTSLCMP",0)),U,3)
+32 IF $GET(^XTMP("BSTSLCMP","STS"))]""
SET CT=CT+1
SET BSTSRPT(CT,"F")="!?25"
SET BSTSRPT(CT)=$GET(^XTMP("BSTSLCMP","STS"))
End DoDot:1
+33 LOCK -^BSTS(9002318.1,0)
+34 ;
+35 ;Check if Description Id Population Utility is running
+36 LOCK +^XTMP("BSTSCFIX"):0
IF '$TEST
Begin DoDot:1
+37 NEW RUN
+38 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Background process: "
+39 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)="Description Id Population Utility is running"
+40 SET RUN=$GET(^XTMP("BSTSCFIX","RUN"))
IF RUN=""
QUIT
+41 IF $GET(^XTMP("BSTSCFIX",RUN,"STS"))]""
SET CT=CT+1
SET BSTSRPT(CT,"F")="!?25"
SET BSTSRPT(CT)=$GET(^XTMP("BSTSCFIX",RUN,"STS"))
End DoDot:1
+42 LOCK -^XTMP("BSTSCFIX")
+43 ;
+44 ;Check if ICD9 to SNOMED process is running
+45 LOCK +^TMP("BSTSICD2SMD"):0
IF '$TEST
Begin DoDot:1
+46 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Background process: "
+47 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)="ICD9 to SNOMED process is running"
End DoDot:1
+48 LOCK -^TMP("BSTSICD2SMD")
+49 ;
+50 ;Check if install conversion process is running
+51 LOCK +^TMP("BSTSPBFH"):0
IF '$TEST
Begin DoDot:1
+52 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?5"
SET BSTSRPT(CT)="Background process: "
+53 SET CT=CT+1
SET BSTSRPT(CT,"F")="?25"
SET BSTSRPT(CT)="Installation conversion process is running"
End DoDot:1
+54 LOCK -^TMP("BSTSPBFH")
+55 ;
+56 SET CT=CT+1
SET BSTSRPT(CT,"F")="!!"
SET BSTSRPT(CT)="Current Server Settings: "
+57 SET CT=CT+1
SET BSTSRPT(CT)=" "
+58 ;
+59 ;Site Parameters
+60 SET CT=CT+1
SET BSTSRPT(CT,"F")="!!"
SET BSTSRPT(CT)="Site Parameters"
+61 SET CT=CT+1
SET BSTSRPT(CT)=" "
+62 FOR FLD=.01,.02,.03
Begin DoDot:1
+63 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?2"
SET BSTSRPT(CT)=$PIECE($GET(^DD(9002318,FLD,0)),U)_": "
+64 SET CT=CT+1
SET BSTSRPT(CT,"F")="?32"
SET BSTSRPT(CT)=$$GET1^DIQ(9002318,"1,",FLD,"E")
End DoDot:1
+65 SET SIEN=0
FOR
SET SIEN=$ORDER(^BSTS(9002318,1,1,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+66 FOR FLD=.01,.02,.03
Begin DoDot:2
+67 NEW IENS,DA
+68 SET DA(1)=1
SET DA=SIEN
SET IENS=$$IENS^DILF(.DA)
+69 IF FLD=.01
SET CT=CT+1
SET BSTSRPT(CT)=" "
+70 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?2"
SET BSTSRPT(CT)=$PIECE($GET(^DD(9002318.01,FLD,0)),U)_": "
+71 SET CT=CT+1
SET BSTSRPT(CT,"F")="?32"
SET BSTSRPT(CT)=$$GET1^DIQ(9002318.01,IENS,FLD,"E")
End DoDot:2
End DoDot:1
+72 ;
+73 ;Web Service
+74 SET CT=CT+1
SET BSTSRPT(CT,"F")="!!"
SET BSTSRPT(CT)="Selected Web Service"
+75 SET CT=CT+1
SET BSTSRPT(CT)=" "
+76 FOR FLD=.01,.02,.03,.04,.05,.06,.07,.08,.09,.1,.11,.12,.13,.14,.15,2.01,4.01,4.02,4.03
Begin DoDot:1
+77 SET CT=CT+1
SET BSTSRPT(CT,"F")="!?2"
SET BSTSRPT(CT)=$PIECE($GET(^DD(9002318.2,FLD,0)),U)_": "
+78 SET CT=CT+1
SET BSTSRPT(CT,"F")="?32"
SET BSTSRPT(CT)=$$GET1^DIQ(9002318.2,SERV_",",FLD,"E")
End DoDot:1
+79 ;
+80 QUIT
