ONCSAPIU ;Hines OIFO/SG - COLLABORATIVE STAGING (UTILITIES) ; 12/7/06 9:08am
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
Q
;
;***** RETURNS THE CS WEB-SERVICE URL
;
; Return values:
; <0 Error Descriptor
; ... The CS URL
;
GETCSURL() ;
N DIV,HOST,IEN,ONCMSG,PATH,PORT,RC,URL
;--- Try to get the URL from the site parameters
S DIV=+$G(DUZ(2)),IEN=+$O(^ONCO(160.1,"C",DIV,""))
I IEN'>0 S IEN=+$O(^ONCO(160.1,0)) Q:IEN'>0 $$ERROR^ONCSAPIE(-22)
S URL=$$GET1^DIQ(160.1,IEN,19,,,"ONCMSG")
Q:URL="" $$ERROR^ONCSAPIE(-22)
;--- Parse the URL and supply the missing parts
S RC=$$PARSE^ONCXURL(URL,.HOST,.PORT,.PATH)
Q:RC<0 $$ERROR^ONCSAPIE(-11,URL)
S:$G(PORT)'>0 PORT=7005
S:$G(PATH)="" PATH="/cgi-bin/CStage"
;--- Construct the resulting URL
Q $$CREATE^ONCXURL(HOST,PORT,PATH)
;
;***** PAUSES THE OUTPUT AT PAGE END
;
; Return values:
; -2 Timeout
; -1 User entered a '^'
; 0 Continue
;
PAGE() ;
I $E(IOST,1,2)'="C-" S $Y=0 Q 0
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="E" D ^DIR S $Y=0
Q $S($D(DUOUT):-1,$D(DTOUT):-2,1:0)
;
;***** UPDATES THE CS WEB-SERVICE URL
;
; URL New URL of the CS web-service
;
; Return values:
;
; <0 Error Descriptor
; 0 Ok
;
UPDCSURL(URL) ;
N IEN,IENS,ONCFDA,ONCMSG,RC
Q:$G(URL)?." " $$ERROR^ONCSAPIE(-6,,"URL",$G(URL))
;--- Lock the ONCOLOGY SITE PARAMETERS file
L +^ONCO(160.1):1 E D Q RC
. S RC=$$ERROR^ONCSAPIE(-15,,"ONCOLOGY SITE PARAMETERS file")
;--- Update the record(s)
S (IEN,RC)=0
F S IEN=$O(^ONCO(160.1,IEN)) Q:IEN'>0 D Q:RC<0
. S IENS=IEN_"," K ONCFDA,ONCMSG
. S ONCFDA(160.1,IENS,19)=URL
. D FILE^DIE(,"ONCFDA","ONCMSG")
. S:$G(DIERR) RC=$$DBS^ONCSAPIE("ONCMSG",-9,160.1,IENS)
;--- Cleanup and error processing
L -^ONCO(160.1)
Q $S(RC<0:RC,1:0)
;
;***** WRAPS THE STRING AND PRINTS IT
;
; X Source string
; [DIWR] Output width (IOM, by default)
;
WW(X,DIWR) ;
N DIWF,DIWL,I,TMP
S:$G(DIWR)'>0 DIWR=$G(IOM,80)
K ^UTILITY($J,"W")
;--- Wrap the string
S DIWL=1,DIWF="|" D ^DIWP
;--- Print the text
S I=""
F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I="" D
. S TMP=$G(^UTILITY($J,"W",DIWL,I,0))
. D EN^DDIOL($$TRIM^XLFSTR(TMP,"R"))
;--- Cleanup
K ^UTILITY($J,"W")
Q
;
;***** EMULATES AND EXTENDS THE ZWRITE COMMAND :-)
;
; ROR8NODE Closed root of the sub-tree to display
; (either local array or global variable)
; [TITLE] Title of the output
; [NONAME] Do not print node names
;
ZW(ONC8NODE,TITLE,NONAME) ;
Q:ONC8NODE="" Q:'$D(@ONC8NODE)
N FLT,L,PI W !
W:$G(TITLE)'="" TITLE,!!
S NONAME=+$G(NONAME)
W:$D(@ONC8NODE)#10 ONC8NODE_"="""_@ONC8NODE_"""",!
S L=$L(ONC8NODE) S:$E(ONC8NODE,L)=")" L=L-1
S FLT=$E(ONC8NODE,1,L),PI=ONC8NODE
F S PI=$Q(@PI) Q:$E(PI,1,L)'=FLT D
. W:'NONAME PI_"=" W """"_@PI_"""",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSAPIU 2965 printed Apr 09, 2024@21:24:37 Page 2
ONCSAPIU ;Hines OIFO/SG - COLLABORATIVE STAGING (UTILITIES) ; 12/7/06 9:08am
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 QUIT
+4 ;
+5 ;***** RETURNS THE CS WEB-SERVICE URL
+6 ;
+7 ; Return values:
+8 ; <0 Error Descriptor
+9 ; ... The CS URL
+10 ;
GETCSURL() ;
+1 NEW DIV,HOST,IEN,ONCMSG,PATH,PORT,RC,URL
+2 ;--- Try to get the URL from the site parameters
+3 SET DIV=+$GET(DUZ(2))
SET IEN=+$ORDER(^ONCO(160.1,"C",DIV,""))
+4 IF IEN'>0
SET IEN=+$ORDER(^ONCO(160.1,0))
if IEN'>0
QUIT $$ERROR^ONCSAPIE(-22)
+5 SET URL=$$GET1^DIQ(160.1,IEN,19,,,"ONCMSG")
+6 if URL=""
QUIT $$ERROR^ONCSAPIE(-22)
+7 ;--- Parse the URL and supply the missing parts
+8 SET RC=$$PARSE^ONCXURL(URL,.HOST,.PORT,.PATH)
+9 if RC<0
QUIT $$ERROR^ONCSAPIE(-11,URL)
+10 if $GET(PORT)'>0
SET PORT=7005
+11 if $GET(PATH)=""
SET PATH="/cgi-bin/CStage"
+12 ;--- Construct the resulting URL
+13 QUIT $$CREATE^ONCXURL(HOST,PORT,PATH)
+14 ;
+15 ;***** PAUSES THE OUTPUT AT PAGE END
+16 ;
+17 ; Return values:
+18 ; -2 Timeout
+19 ; -1 User entered a '^'
+20 ; 0 Continue
+21 ;
PAGE() ;
+1 IF $EXTRACT(IOST,1,2)'="C-"
SET $Y=0
QUIT 0
+2 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="E"
DO ^DIR
SET $Y=0
+4 QUIT $SELECT($DATA(DUOUT):-1,$DATA(DTOUT):-2,1:0)
+5 ;
+6 ;***** UPDATES THE CS WEB-SERVICE URL
+7 ;
+8 ; URL New URL of the CS web-service
+9 ;
+10 ; Return values:
+11 ;
+12 ; <0 Error Descriptor
+13 ; 0 Ok
+14 ;
UPDCSURL(URL) ;
+1 NEW IEN,IENS,ONCFDA,ONCMSG,RC
+2 if $GET(URL)?." "
QUIT $$ERROR^ONCSAPIE(-6,,"URL",$GET(URL))
+3 ;--- Lock the ONCOLOGY SITE PARAMETERS file
+4 LOCK +^ONCO(160.1):1
IF '$TEST
Begin DoDot:1
+5 SET RC=$$ERROR^ONCSAPIE(-15,,"ONCOLOGY SITE PARAMETERS file")
End DoDot:1
QUIT RC
+6 ;--- Update the record(s)
+7 SET (IEN,RC)=0
+8 FOR
SET IEN=$ORDER(^ONCO(160.1,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+9 SET IENS=IEN_","
KILL ONCFDA,ONCMSG
+10 SET ONCFDA(160.1,IENS,19)=URL
+11 DO FILE^DIE(,"ONCFDA","ONCMSG")
+12 if $GET(DIERR)
SET RC=$$DBS^ONCSAPIE("ONCMSG",-9,160.1,IENS)
End DoDot:1
if RC<0
QUIT
+13 ;--- Cleanup and error processing
+14 LOCK -^ONCO(160.1)
+15 QUIT $SELECT(RC<0:RC,1:0)
+16 ;
+17 ;***** WRAPS THE STRING AND PRINTS IT
+18 ;
+19 ; X Source string
+20 ; [DIWR] Output width (IOM, by default)
+21 ;
WW(X,DIWR) ;
+1 NEW DIWF,DIWL,I,TMP
+2 if $GET(DIWR)'>0
SET DIWR=$GET(IOM,80)
+3 KILL ^UTILITY($JOB,"W")
+4 ;--- Wrap the string
+5 SET DIWL=1
SET DIWF="|"
DO ^DIWP
+6 ;--- Print the text
+7 SET I=""
+8 FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I=""
QUIT
Begin DoDot:1
+9 SET TMP=$GET(^UTILITY($JOB,"W",DIWL,I,0))
+10 DO EN^DDIOL($$TRIM^XLFSTR(TMP,"R"))
End DoDot:1
+11 ;--- Cleanup
+12 KILL ^UTILITY($JOB,"W")
+13 QUIT
+14 ;
+15 ;***** EMULATES AND EXTENDS THE ZWRITE COMMAND :-)
+16 ;
+17 ; ROR8NODE Closed root of the sub-tree to display
+18 ; (either local array or global variable)
+19 ; [TITLE] Title of the output
+20 ; [NONAME] Do not print node names
+21 ;
ZW(ONC8NODE,TITLE,NONAME) ;
+1 if ONC8NODE=""
QUIT
if '$DATA(@ONC8NODE)
QUIT
+2 NEW FLT,L,PI
WRITE !
+3 if $GET(TITLE)'=""
WRITE TITLE,!!
+4 SET NONAME=+$GET(NONAME)
+5 if $DATA(@ONC8NODE)#10
WRITE ONC8NODE_"="""_@ONC8NODE_"""",!
+6 SET L=$LENGTH(ONC8NODE)
if $EXTRACT(ONC8NODE,L)=")"
SET L=L-1
+7 SET FLT=$EXTRACT(ONC8NODE,1,L)
SET PI=ONC8NODE
+8 FOR
SET PI=$QUERY(@PI)
if $EXTRACT(PI,1,L)'=FLT
QUIT
Begin DoDot:1
+9 if 'NONAME
WRITE PI_"="
WRITE """"_@PI_"""",!
End DoDot:1
+10 QUIT
