170 lines
5.5 KiB
Mathematica
170 lines
5.5 KiB
Mathematica
MDRPCOG ; HOIFO/DP - CP Gateway ; [01-09-2003 15:20]
|
|
;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
|
|
; Description:
|
|
; This is the main routine that manages the CLINICAL PROCEDURES Gateway functions.
|
|
; Access to these functions is controlled via the MD GATEWAY RPC.
|
|
;
|
|
; Integration Agreements:
|
|
; IA# 10097 [Supported] %ZOSV calls
|
|
; IA# 10103 [Supported] Calls to XLFDT
|
|
; IA# 2263 [Supported] Calls to XPAR
|
|
;
|
|
CLEANUP ; [Procedure] Cleanup a past results report
|
|
F X=0:0 S X=$O(^MDD(703.1,DATA,.1,X)) Q:'X D
|
|
.S:$G(^MDD(703.1,DATA,.1,X,.1))]"" MDFDA(703.11,X_","_DATA_",",.1)="@"
|
|
.S:$O(^MDD(703.1,DATA,.1,X,.2,0)) MDFDA(703.11,X_","_DATA_",",.2)="@"
|
|
D:$D(MDFDA) FILE^DIE("K","MDFDA","MDERR")
|
|
I $D(MDERR) D ERROR^MDRPCU(RESULTS,.MDERR) Q
|
|
; Manual cleanup of the empty UNC nodes and WP root
|
|
F X=0:0 S X=$O(^MDD(703.1,DATA,.1,X)) Q:'X D
|
|
.K ^MDD(703.1,DATA,.1,X,.1)
|
|
.K ^MDD(703.1,DATA,.1,X,.2)
|
|
S @RESULTS@(0)="1^Item purged"
|
|
Q
|
|
;
|
|
DONE ; [Procedure] Done processing, Mark study status
|
|
S MDFDA(703.1,+DATA_",",.09)=$G(P1,"U")
|
|
D FILE^DIE("","MDFDA")
|
|
Q
|
|
;
|
|
GETATT ; [Procedure] Get attachments for study
|
|
F X=0:0 S X=$O(^MDD(703.1,+DATA,.1,X)) Q:'X D
|
|
.S Y=+$O(@RESULTS@(""),-1)+1
|
|
.S @RESULTS@(Y)="703.11;"_X_U_^MDD(703.1,+DATA,.1,X,0)
|
|
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
|
|
Q
|
|
;
|
|
GETOLD ; [Procedure] Returns old results by date
|
|
; Variables:
|
|
; LOGDATE: [Private] Loop variable
|
|
; STOPDATE: [Private] Date to stop retrieving entries
|
|
;
|
|
; New private variables
|
|
NEW LOGDATE,STOPDATE,MDX
|
|
S LOGDATE=+DATA,STOPDATE=+$P(DATA,U,2)+.2359
|
|
F S LOGDATE=$O(^MDD(703.1,"ADTP",LOGDATE)) W !,"-->",LOGDATE Q:'LOGDATE!(LOGDATE>STOPDATE) D Q:Y>50
|
|
.F MDX=0:0 S MDX=$O(^MDD(703.1,"ADTP",LOGDATE,MDX)) Q:'MDX D
|
|
..I '$$CHECK(MDX) Q
|
|
..S Y=$O(@RESULTS@(""),-1)+1
|
|
..S @RESULTS@(Y)="703.1;"_MDX_U_$G(^MDD(703.1,MDX,0))
|
|
S:'LOGDATE!(LOGDATE>STOPDATE) LOGDATE=STOPDATE
|
|
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)_U_LOGDATE_U_$$FMTE^XLFDT(LOGDATE)
|
|
Q
|
|
;
|
|
GETPAR ; [Procedure] Get a parameter value for an RPC Call
|
|
S @RESULTS@(0)=$$PARVAL(DATA)
|
|
Q
|
|
;
|
|
GETTXT ; [Procedure] Get attachment text for processing
|
|
N X,STUDY,ATT
|
|
S X=0,STUDY=$P(DATA,",",2),ATT=+DATA
|
|
I '$O(^MDD(703.1,STUDY,.1,ATT,.2,0)) S @RESULTS@(0)="-1^No Data" Q
|
|
F S X=$O(^MDD(703.1,STUDY,.1,ATT,.2,X)) Q:'X S @RESULTS@(X)=^(X,0)
|
|
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
|
|
Q
|
|
;
|
|
NEXT ; [Procedure] Get the next study to process
|
|
S Y=+$O(^MDD(703.1,"ASTATUS","P",$G(DATA)))
|
|
S @RESULTS@(0)=$S($D(^MDD(703.1,Y,0)):"703.1;"_Y_U_^MDD(703.1,Y,0),1:0)
|
|
Q
|
|
;
|
|
PARVAL(INSTANCE) ; [Procedure] Extrinsic get of parameter values
|
|
; Input parameters
|
|
; 1. INSTANCE [Literal/Required] XPAR instance
|
|
;
|
|
Q $$GET^XPAR("SYS","MD GATEWAY",INSTANCE)
|
|
;
|
|
POLL ; [Procedure] Returns server time and flag for studies to process
|
|
I $$PARVAL("Shutdown Flag")]"" D Q
|
|
.S @RESULTS@(0)="-1^SHUTDOWN"
|
|
.D SETPAR("Shutdown Flag","")
|
|
S @RESULTS@(0)=$$FMTE^XLFDT($$NOW^XLFDT)
|
|
S @RESULTS@(1)=$D(^MDD(703.1,"ASTATUS","P"))
|
|
Q
|
|
;
|
|
POLLER(RESULTS) ; [Procedure] Non-Disk activity poller
|
|
; With the exception of a shutdown request pending, this stand alone RPC will operate
|
|
; without creating any disk activity and not crash during backup operations on the main
|
|
; VistA server.
|
|
;
|
|
; Input parameters
|
|
; 1. RESULTS [Reference/Required]
|
|
;
|
|
I $$PARVAL("Shutdown Flag")]"" D Q
|
|
.S RESULTS(0)="-1^SHUTDOWN"
|
|
.D SETPAR("Shutdown Flag","")
|
|
S RESULTS(0)=$$FMTE^XLFDT($$NOW^XLFDT)
|
|
S RESULTS(1)=$D(^MDD(703.1,"ASTATUS","P"))
|
|
Q
|
|
;
|
|
RPC(RESULTS,OPTION,DATA,P1) ; [Procedure]
|
|
; Input parameters
|
|
; 1. RESULTS [Literal/Required] RPC Return Array
|
|
; 2. OPTION [Literal/Required] Gateway Option to execute
|
|
; 3. DATA [Literal/Required] Other information
|
|
; 4. P1 [Literal/Required] Overflow variable
|
|
;
|
|
; Variables:
|
|
; MDENV: [Private] Server environment variable
|
|
; MDERR: [Private] Fileman return array
|
|
; MDFDA: [Private] Fileman FDA
|
|
;
|
|
; New private variables
|
|
NEW MDENV,MDERR,MDFDA
|
|
S RESULTS=$NA(^TMP("MDRPCOB",$J)) K @RESULTS
|
|
D @OPTION
|
|
Q
|
|
;
|
|
SETFILE ; [Procedure] Set filename of new attachment
|
|
S MDFDA(703.11,$P(DATA,U,1),.02)=$P(DATA,U,2)
|
|
D FILE^DIE("","MDFDA")
|
|
Q
|
|
;
|
|
SETPAR(INSTANCE,VALUE) ; [Procedure] Set value into XPAR parameter
|
|
; Input parameters
|
|
; 1. INSTANCE [Literal/Required] Parameter Instance
|
|
; 2. VALUE [Literal/Required] Parameter Value
|
|
;
|
|
D EN^XPAR("SYS","MD GATEWAY",INSTANCE,VALUE)
|
|
Q
|
|
;
|
|
START ; [Procedure] Can we begin?
|
|
; Ensure only one Gateway per system by locking the phantom global node
|
|
L +^MDD("CPGATEWAY"):1
|
|
I '$T D STATUS S @RESULTS@(0)="-1^FAIL" Q
|
|
; Clear all process settings
|
|
D NDEL^XPAR("SYS","MD GATEWAY")
|
|
S DATA=$G(DATA,"30^1000") ; Default poll interval and log entries
|
|
D SETPAR("Polling Interval",+$P(DATA,U,1))
|
|
D SETPAR("Maximum Log Entries",+$P(DATA,U,2))
|
|
D SETPAR("Job ID",$J)
|
|
D SETPAR("Started At",$$FMTE^XLFDT($$NOW^XLFDT))
|
|
D SETPAR("Started By",$$GET1^DIQ(200,DUZ_",",.01))
|
|
D GETENV^%ZOSV S MDENV=Y
|
|
D SETPAR("UCI",$P(MDENV,U,1))
|
|
D SETPAR("Volume",$P(MDENV,U,2))
|
|
D SETPAR("Node",$P(MDENV,U,3))
|
|
D SETNM^%ZOSV("CP Gateway")
|
|
S @RESULTS@(0)="1^OK"
|
|
Q
|
|
;
|
|
STATUS ; [Procedure] Return status of BP
|
|
D GETLST^XPAR(.MDRET,"SYS","MD GATEWAY","Q")
|
|
F X=0:0 S X=$O(MDRET(X)) Q:'X S @RESULTS@(X)=MDRET(X)
|
|
Q
|
|
;
|
|
STOP ; [Procedure] Flag client to stop via cal to POLL
|
|
D SETPAR("Shutdown Flag","Yes")
|
|
Q
|
|
;
|
|
XFERDIR ; [Procedure] Return Imaging xfer directory
|
|
S @RESULTS@(0)=$$GET^XPAR("SYS","MD IMAGING XFER")
|
|
Q
|
|
;
|
|
CHECK(MDRI) ; Check if Upload Value and Upload Text has already been purged.
|
|
N MDFLG S MDFLG=0
|
|
F X=0:0 S X=$O(^MDD(703.1,MDRI,.1,X)) Q:'X D Q:MDFLG
|
|
.S:$G(^MDD(703.1,MDRI,.1,X,.1))]"" MDFLG=1
|
|
.S:$O(^MDD(703.1,MDRI,.1,X,.2,0)) MDFLG=1
|
|
Q MDFLG
|