- 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 Feb 18, 2025@23:54:19 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