MDKRPC2 ; HOIFO/DP - RPC Calls (Cont.) ;11/27/07 09:42
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
;
; Reference IA #1625 [Supported] Use routine XUA4A72
; #10060 [Supported] FILE 200 references
; #10112 [Supported] VASITE calls
; #10090 [Supported] Institution File (#4) Read w/FM
; #2263 [Supported] XPAR calls
; #4440 [Supported] XUPROD calls
; #3065 [Supported] XLFNAME calls
; #4815 [Controlled] GMVDCSAV call
; #4866 [Private] File 120.51
; #4867 [Private] File 120.5
; #4868 [Private] - VA(200,"AUSER"
RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6,P7,P8,P9) ; Generic RPC tag
S RESULTS=$NA(^TMP($J,"MDKRPC2")) K @RESULTS
D @OPTION
S:'$D(@RESULTS) @RESULTS@(0)="-1^No Results"
Q
;
ACTIVE ; Return all active dialysis treatments
N MDAS,MDFLD,MDLP,MDLIST,MDMORE K ^TMP("MDAS",$J)
F MDLP=1,2 S MDLIST=0 F S MDLIST=$O(^MDK(704.202,"AS",MDLP,MDLIST)) Q:MDLIST<1 S ^TMP("MDAS",$J,MDLIST)=""
S MDMORE=".03;;STUDY_CHECKIN^.05;;USER_ID^.06;;DATETIME_ACCESSED^.07;;WORKSTATION_ID"
D BLDFLD^MDXMLFM(.MDFLD,704.202,".01;I;STUDY_ID^.02;I;PATIENT_ID^.02:.01;;PATIENT_NAME^.02:.09;;PATIENT_SSN^.09;E;STATUS^.02:.02;I;PATIENT_SEX^.02:.03;I;PATIENT_DOB;DATE^.02:.033;;PATIENT_AGE^.04;;STUDY_LOCATION^"_MDMORE)
D LOADALL^MDXMLFM($NA(^TMP("MDAS",$J)),704.202,.MDFLD)
K ^TMP("MDAS",$J)
Q
;
ALLBYPT ; Return all treatments for a patient
N MDFLD
D BLDFLD^MDXMLFM(.MDFLD,704.202,".01;I;STUDY_ID^.02;I;PATIENT_ID^.03;I;STUDY_DATETIME^.09;I;STATUS")
D LOADALL^MDXMLFM($NA(^MDK(704.202,"C",+P1)),704.202,.MDFLD)
Q
;
ALLRSLT ; Get all available results for a study
;
; If P2=1 then whole list is forced, otherwise, only Unmatched
;
N MDFLD,MDFDA,MDLIST
D BLDFLD^MDXMLFM(.MDFLD,703.1,".001;;ID^.05;;STUDY_ID")
;D:'$G(P3) LOADALL^MDXMLFM($NA(^MDD(703.1,"ASTUDYID",+P1)),703.1,.MDFLD)
;
; Remove the P3 reference once it's working!
;
; Prepare the lists
S MDLIST=$NA(^TMP("MDTEMP",$J)) K @MDLIST
S MDFDA=$NA(^TMP("MDFDA",$J)) K @MDFDA
; Scan results by study id
F X=0:0 S X=$O(^MDD(703.1,"ASTUDYID",+P1,X)) Q:'X D
.Q:$P(^MDD(703.1,X,0),U,9)="P" ; Skip pendings being filed now
.Q:'$G(P2)&($P(^MDD(703.1,X,0),U,9)="M") ; Only new results requested
.S ^TMP("MDTEMP",$J,X)="" ; Add this study to the list
D LOADALL^MDXMLFM(.MDLIST,703.1,.MDFLD)
Q
;
CCOW ; Return CCOW site and production indicator
S @RESULTS@(0)=$P($$SITE^VASITE(),"^",3)_"^"_$$PROD^XUPROD()
Q
;
GETRSLT ; Get instrument XML Result
I '$D(^MDD(703.1,P1,.4)) S @RESULTS@(0)="0" Q
M @RESULTS=^MDD(703.1,P1,.4)
S @RESULTS@(0)=+$O(^MDD(703.1,P1,.4,""),-1)
; Set to matched
N MDFDA S MDFDA(703.1,P1_",",.09)="M" D FILE^DIE("","MDFDA")
Q
;
GETXML ; Get a single XML field
S X=$$GET1^DIQ(P1,P2,P3,,RESULTS)
Q
;
SETXML ; Set a single XML field
S @RESULTS@(0)=$$XMLFILER(P1,P2,P3,"P4")
Q
;
UPDUSER ; Update User Access Information
Q:$G(P1)=""
Q:$G(P2)=""
Q:$G(P3)=""
N MDFDA S P1=P1_","
S:+P2 MDFDA(704.202,P1,.05)=P2
S:P3'="" MDFDA(704.202,P1,.06)=P3
S:P4'="" MDFDA(704.202,P1,.07)=P4
S:+P5 MDFDA(704.202,P1,.09)=P5
D FILE^DIE("","MDFDA")
K MDFDA
S @RESULTS@(0)="1^Information Filed"
;
GETOPT ; Get option from the Parameters File
;
; P1=Setting Name
; P2=Owner
;
N MDOPT
S MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=P2")
I MDOPT<0 S @RESULTS@(0)="-1^No such setting" Q
S X=$$GET1^DIQ(704.209,MDOPT_",",.1,,RESULTS)
Q
;
LOCKOPT ; Lock/Unlock an option for update
;
; P1=Setting Name
; P2=0:Unlock;1:Lock
;
N MDOPT
S MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=.5")
I 'MDOPT S @RESULTS@(0)="-1^No such setting." Q
I 'P2 D Q
.L -(^MDK(704.209,+MDOPT,0)) S @RESULTS@(0)="1^Option Unlocked"
.N MDFDA
.S MDFDA(704.209,+MDOPT_",",.03)=""
.S MDFDA(704.209,+MDOPT_",",.04)=""
.S MDFDA(704.209,+MDOPT_",",.05)=""
.D FILE^DIE("","MDFDA")
.Q
I +P2 L +(^MDK(704.209,+MDOPT,0)):0 I '$T S @RESULTS@(0)="-1^Unable to lock"_"^"_$P($G(^MDK(704.209,+MDOPT,0)),"^",3,5) Q
N MDFDA D NOW^%DTC
S MDFDA(704.209,+MDOPT_",",.03)=DUZ
S MDFDA(704.209,+MDOPT_",",.04)=%
S MDFDA(704.209,+MDOPT_",",.05)=$J
D FILE^DIE("","MDFDA")
S @RESULTS@(0)="1^Option locked"
Q
;
DELOPT ; Delete option from the RENAL SETTING file(#704.209)
;
; P1=Setting Name
; P2=Owner
;
N DA,DIK,MDOPT
S MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=P2")
I 'MDOPT S @RESULTS@(0)="1^No such setting." Q
S DA=MDOPT,DIK="^MDK(704.209," D ^DIK
S @RESULTS@(0)="1^Setting deleted."
Q
;
SETOPT ; Set option into RENAL SETTING file (#704.209)
;
; P1=Setting Name
; P2=Owner
; P3=Array of text
;
N MDOPT
S MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=P2")
D:'MDOPT ; Try to create a new entry
.N MDFDA,MDIEN
.S MDFDA(704.209,"+1,",.01)=P1
.S MDFDA(704.209,"+1,",.02)=P2
.D UPDATE^DIE("","MDFDA","MDIEN")
.S MDOPT=+$G(MDIEN(1),-1)
I 'MDOPT S @RESULTS@(0)="-1^Unable to create entry" Q
S @RESULTS@(0)=$$XMLFILER(704.209,MDOPT_",",.1,"P3")
Q
;
ALLOPT ; Get all options by user
N MDFLD
D BLDFLD^MDXMLFM(.MDFLD,704.209,".001;;NUMBER^.01;;SETTING NAME")
K ^TMP("DILIST",$J)
D LIST^DIC(704.209,,"@;.01","P","*",,,"B","I $P(^(0),U,2)=P2")
F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X S ^TMP("DILIST",$J,"B",+^(X,0),X)=""
D LOADALL^MDXMLFM($NA(^TMP("DILIST",$J,"B")),704.209,.MDFLD)
Q
;
XMLFILER(DD,IENS,FLD,ROOT) ; This files UUEncoded XML into Fileman WP
N MDFLAG,MDERR,MDL,MDXL ; Set to control appending
K ^TMP("MDKXML",$J)
S MDXL="",MDL=0
F S MDXL=$O(@ROOT@(MDXL)) Q:MDXL="" S MDL=MDL+1,^TMP("MDKXML",$J,MDL)=@ROOT@(MDXL)
S MDFLAG=$S(@ROOT@(0)["-- Begin UUEncoded Data --":"",1:"A")
D WP^DIE(DD,IENS,FLD,MDFLAG,$NA(^TMP("MDKXML",$J)),"MDERR")
I $D(MDERR) Q "-1^"_$G(MDERR("DIERR",1,"TEXT",1),"Unknown Error")
Q "1^Filed"_"^"_MDL
;
GETPROV ; Get list of available providers with name starting with P1
N MDFLD,MDDATE,MDDUP,MDRI,MDI1,MDI2,MDLAST,MDMAX,MDPREV,MDTTL,X,X1,X2
D BLDFLD^MDXMLFM(.MDFLD,200,".001;;ID^.01;;PROV_NAME^8;;TITLE")
S MDRI=0,MDMAX=44,(MDLAST,MDPREV)="",X1=DT,MDFROM=P1,X2=-30 D C^%DTC S MDDATE=DT K X
S RESULTS=$NA(^TMP("MDPLIST",$J)) K @RESULTS K ^TMP("DILIST",$J)
F Q:MDRI'<MDMAX S MDFROM=$O(^VA(200,"AUSER",MDFROM),1) Q:MDFROM="" D
.S MDI1=""
.F S MDI1=$O(^VA(200,"AUSER",MDFROM,MDI1),1) Q:'MDI1 D
..I MDDATE>0,$$GET^XUA4A72(MDI1,MDDATE)<1 Q ; Check date?
..S MDDUP=0 ; Init flag, check dupe.
..I ($P(MDPREV_" "," ")=$P(MDFROM_" "," ")) S MDDUP=1
..;
..; Append Title if not duplicated:
..I 'MDDUP D
...S MDI2=MDI1
...D TITLE ; Get Title.
...S MDRI=MDRI+1,^TMP("DILIST",$J,MDRI)=MDI1_U_$$NAMEFMT^XLFNAME(MDFROM,"F","DcMPC")_$S(MDTTL'="":U_"- "_MDTTL,1:"")
;F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X S ^TMP("DILIST",$J,"B",+^(X),X)=""
D LOADALL^MDXMLFM1($NA(^TMP("DILIST",$J)),200,.MDFLD)
Q
;
TITLE ; Retrieve Title or Title and Service/Section.
; (Assumes certain vars already set/new'd in calling code.)
;
S MDTTL="" ; Init each time.
; DBIA# 4329:
S MDTTL=$P($G(^VA(200,MDI2,0)),U,9) ; Get Title pointer.
I MDTTL<1 S MDTTL="" ; Reset var if none.
; DBIA# 1234:
I MDTTL>0 S MDTTL=$G(^DIC(3.1,MDTTL,0)) ; Actual Title value.
Q
;
VITALS ; File a vitals sign
S P3=$$FIND1^DIC(120.51,,"MX",P3)
I P3<1 S @RESULTS@(0)="-1^Unknown Vital Type" Q
S X=P1_U_P2_U_P3_";"_P4_U_P5_U_P6
L +^GMR(120.5,0)
D EN1^GMVDCSAV(.ZZZ,X)
S @RESULTS@(0)=+$O(^GMR(120.5,"A"),-1)
S @RESULTS@(1)=X
L -^GMR(120.5,0)
Q
;
GETINST ; Get list of Institutions with name starting with P1
N MDFLD
D BLDFLD^MDXMLFM(.MDFLD,4,".001;;STATION NUMBER^.01;;STATION NAME")
K ^TMP("DILIST",$J)
D FIND^DIC(4,,"@;.01","P",P1,"*")
F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X S ^TMP("DILIST",$J,"B",+^(X,0),X)=""
D LOADALL^MDXMLFM($NA(^TMP("DILIST",$J,"B")),4,.MDFLD)
Q
GETADM ; Get Administrators
N MDFLD
D BLDFLD^MDXMLFM(.MDFLD,200,".001;;NUMBER^.01;;NAME")
K ^TMP("DILIST",$J)
D FIND^DIC(200,,"@;.01","P",P1,"*")
F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X S ^TMP("DILIST",$J,"B",+^(X,0),X)=""
D LOADALL^MDXMLFM($NA(^TMP("DILIST",$J,"B")),200,.MDFLD)
Q
GUI ; Returns Hemodialysis version check
; Returns yes or no
S @RESULTS@(0)=$$GET^XPAR("SYS","MDK GUI VERSION",P1,"E")
S:@RESULTS@(0)="" @RESULTS@(0)="NO"
Q
CURRENT ; Current Version
N MDKLST,MDK,MDKY,MDKY1 S @RESULTS@(0)=""
D GETLST^XPAR(.MDKLST,"SYS","MDK GUI VERSION")
F MDK=0:0 S MDK=$O(MDKLST(MDK)) Q:MDK<1 S MDKY=$G(MDKLST(MDK)) D
. S MDKY1=$P(MDKY,"^")
. I $$GET^XPAR("SYS","MDK GUI VERSION",MDKY1,"I") S:@RESULTS@(0)="" @RESULTS@(0)=MDKY1
. Q
S:@RESULTS@(0)="" @RESULTS@(0)="No Current Version Recorded."
Q
USERINF ; Current User Information
N MDUSER
S MDUSER(0)=DUZ
S MDUSER(1)=$$GET1^DIQ(200,+MDUSER(0)_",",.01)
S MDUSER(2)=MDUSER(1)
S MDUSER(3)=""
S MDUSER(4)=$$GET1^DIQ(200,+MDUSER(0)_",",8)
S MDUSER(5)=$$GET1^DIQ(200,+MDUSER(0)_",",29)
S MDUSER(6)=$$GET1^DIQ(200,+MDUSER(0)_",",200.07)
S MDUSER(7)=$$GET1^DIQ(200,+MDUSER(0)_",",200.1)
M @RESULTS=MDUSER K MDUSER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDKRPC2 9367 printed Nov 22, 2024@16:53:13 Page 2
MDKRPC2 ; HOIFO/DP - RPC Calls (Cont.) ;11/27/07 09:42
+1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
+2 ;
+3 ; Reference IA #1625 [Supported] Use routine XUA4A72
+4 ; #10060 [Supported] FILE 200 references
+5 ; #10112 [Supported] VASITE calls
+6 ; #10090 [Supported] Institution File (#4) Read w/FM
+7 ; #2263 [Supported] XPAR calls
+8 ; #4440 [Supported] XUPROD calls
+9 ; #3065 [Supported] XLFNAME calls
+10 ; #4815 [Controlled] GMVDCSAV call
+11 ; #4866 [Private] File 120.51
+12 ; #4867 [Private] File 120.5
+13 ; #4868 [Private] - VA(200,"AUSER"
RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6,P7,P8,P9) ; Generic RPC tag
+1 SET RESULTS=$NAME(^TMP($JOB,"MDKRPC2"))
KILL @RESULTS
+2 DO @OPTION
+3 if '$DATA(@RESULTS)
SET @RESULTS@(0)="-1^No Results"
+4 QUIT
+5 ;
ACTIVE ; Return all active dialysis treatments
+1 NEW MDAS,MDFLD,MDLP,MDLIST,MDMORE
KILL ^TMP("MDAS",$JOB)
+2 FOR MDLP=1,2
SET MDLIST=0
FOR
SET MDLIST=$ORDER(^MDK(704.202,"AS",MDLP,MDLIST))
if MDLIST<1
QUIT
SET ^TMP("MDAS",$JOB,MDLIST)=""
+3 SET MDMORE=".03;;STUDY_CHECKIN^.05;;USER_ID^.06;;DATETIME_ACCESSED^.07;;WORKSTATION_ID"
+4 DO BLDFLD^MDXMLFM(.MDFLD,704.202,".01;I;STUDY_ID^.02;I;PATIENT_ID^.02:.01;;PATIENT_NAME^.02:.09;;PATIENT_SSN^.09;E;STATUS^.02:.02;I;PATIENT_SEX^.02:.03;I;PATIENT_DOB;DATE^.02:.033;;PATIENT_AGE^.04;;STUDY_LOCATION^"_MDMORE)
+5 DO LOADALL^MDXMLFM($NAME(^TMP("MDAS",$JOB)),704.202,.MDFLD)
+6 KILL ^TMP("MDAS",$JOB)
+7 QUIT
+8 ;
ALLBYPT ; Return all treatments for a patient
+1 NEW MDFLD
+2 DO BLDFLD^MDXMLFM(.MDFLD,704.202,".01;I;STUDY_ID^.02;I;PATIENT_ID^.03;I;STUDY_DATETIME^.09;I;STATUS")
+3 DO LOADALL^MDXMLFM($NAME(^MDK(704.202,"C",+P1)),704.202,.MDFLD)
+4 QUIT
+5 ;
ALLRSLT ; Get all available results for a study
+1 ;
+2 ; If P2=1 then whole list is forced, otherwise, only Unmatched
+3 ;
+4 NEW MDFLD,MDFDA,MDLIST
+5 DO BLDFLD^MDXMLFM(.MDFLD,703.1,".001;;ID^.05;;STUDY_ID")
+6 ;D:'$G(P3) LOADALL^MDXMLFM($NA(^MDD(703.1,"ASTUDYID",+P1)),703.1,.MDFLD)
+7 ;
+8 ; Remove the P3 reference once it's working!
+9 ;
+10 ; Prepare the lists
+11 SET MDLIST=$NAME(^TMP("MDTEMP",$JOB))
KILL @MDLIST
+12 SET MDFDA=$NAME(^TMP("MDFDA",$JOB))
KILL @MDFDA
+13 ; Scan results by study id
+14 FOR X=0:0
SET X=$ORDER(^MDD(703.1,"ASTUDYID",+P1,X))
if 'X
QUIT
Begin DoDot:1
+15 ; Skip pendings being filed now
if $PIECE(^MDD(703.1,X,0),U,9)="P"
QUIT
+16 ; Only new results requested
if '$GET(P2)&($PIECE(^MDD(703.1,X,0),U,9)="M")
QUIT
+17 ; Add this study to the list
SET ^TMP("MDTEMP",$JOB,X)=""
End DoDot:1
+18 DO LOADALL^MDXMLFM(.MDLIST,703.1,.MDFLD)
+19 QUIT
+20 ;
CCOW ; Return CCOW site and production indicator
+1 SET @RESULTS@(0)=$PIECE($$SITE^VASITE(),"^",3)_"^"_$$PROD^XUPROD()
+2 QUIT
+3 ;
GETRSLT ; Get instrument XML Result
+1 IF '$DATA(^MDD(703.1,P1,.4))
SET @RESULTS@(0)="0"
QUIT
+2 MERGE @RESULTS=^MDD(703.1,P1,.4)
+3 SET @RESULTS@(0)=+$ORDER(^MDD(703.1,P1,.4,""),-1)
+4 ; Set to matched
+5 NEW MDFDA
SET MDFDA(703.1,P1_",",.09)="M"
DO FILE^DIE("","MDFDA")
+6 QUIT
+7 ;
GETXML ; Get a single XML field
+1 SET X=$$GET1^DIQ(P1,P2,P3,,RESULTS)
+2 QUIT
+3 ;
SETXML ; Set a single XML field
+1 SET @RESULTS@(0)=$$XMLFILER(P1,P2,P3,"P4")
+2 QUIT
+3 ;
UPDUSER ; Update User Access Information
+1 if $GET(P1)=""
QUIT
+2 if $GET(P2)=""
QUIT
+3 if $GET(P3)=""
QUIT
+4 NEW MDFDA
SET P1=P1_","
+5 if +P2
SET MDFDA(704.202,P1,.05)=P2
+6 if P3'=""
SET MDFDA(704.202,P1,.06)=P3
+7 if P4'=""
SET MDFDA(704.202,P1,.07)=P4
+8 if +P5
SET MDFDA(704.202,P1,.09)=P5
+9 DO FILE^DIE("","MDFDA")
+10 KILL MDFDA
+11 SET @RESULTS@(0)="1^Information Filed"
+12 ;
GETOPT ; Get option from the Parameters File
+1 ;
+2 ; P1=Setting Name
+3 ; P2=Owner
+4 ;
+5 NEW MDOPT
+6 SET MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=P2")
+7 IF MDOPT<0
SET @RESULTS@(0)="-1^No such setting"
QUIT
+8 SET X=$$GET1^DIQ(704.209,MDOPT_",",.1,,RESULTS)
+9 QUIT
+10 ;
LOCKOPT ; Lock/Unlock an option for update
+1 ;
+2 ; P1=Setting Name
+3 ; P2=0:Unlock;1:Lock
+4 ;
+5 NEW MDOPT
+6 SET MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=.5")
+7 IF 'MDOPT
SET @RESULTS@(0)="-1^No such setting."
QUIT
+8 IF 'P2
Begin DoDot:1
+9 LOCK -(^MDK(704.209,+MDOPT,0))
SET @RESULTS@(0)="1^Option Unlocked"
+10 NEW MDFDA
+11 SET MDFDA(704.209,+MDOPT_",",.03)=""
+12 SET MDFDA(704.209,+MDOPT_",",.04)=""
+13 SET MDFDA(704.209,+MDOPT_",",.05)=""
+14 DO FILE^DIE("","MDFDA")
+15 QUIT
End DoDot:1
QUIT
+16 IF +P2
LOCK +(^MDK(704.209,+MDOPT,0)):0
IF '$TEST
SET @RESULTS@(0)="-1^Unable to lock"_"^"_$PIECE($GET(^MDK(704.209,+MDOPT,0)),"^",3,5)
QUIT
+17 NEW MDFDA
DO NOW^%DTC
+18 SET MDFDA(704.209,+MDOPT_",",.03)=DUZ
+19 SET MDFDA(704.209,+MDOPT_",",.04)=%
+20 SET MDFDA(704.209,+MDOPT_",",.05)=$JOB
+21 DO FILE^DIE("","MDFDA")
+22 SET @RESULTS@(0)="1^Option locked"
+23 QUIT
+24 ;
DELOPT ; Delete option from the RENAL SETTING file(#704.209)
+1 ;
+2 ; P1=Setting Name
+3 ; P2=Owner
+4 ;
+5 NEW DA,DIK,MDOPT
+6 SET MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=P2")
+7 IF 'MDOPT
SET @RESULTS@(0)="1^No such setting."
QUIT
+8 SET DA=MDOPT
SET DIK="^MDK(704.209,"
DO ^DIK
+9 SET @RESULTS@(0)="1^Setting deleted."
+10 QUIT
+11 ;
SETOPT ; Set option into RENAL SETTING file (#704.209)
+1 ;
+2 ; P1=Setting Name
+3 ; P2=Owner
+4 ; P3=Array of text
+5 ;
+6 NEW MDOPT
+7 SET MDOPT=$$FIND1^DIC(704.209,,"X",P1,"B","I $P(^(0),U,2)=P2")
+8 ; Try to create a new entry
if 'MDOPT
Begin DoDot:1
+9 NEW MDFDA,MDIEN
+10 SET MDFDA(704.209,"+1,",.01)=P1
+11 SET MDFDA(704.209,"+1,",.02)=P2
+12 DO UPDATE^DIE("","MDFDA","MDIEN")
+13 SET MDOPT=+$GET(MDIEN(1),-1)
End DoDot:1
+14 IF 'MDOPT
SET @RESULTS@(0)="-1^Unable to create entry"
QUIT
+15 SET @RESULTS@(0)=$$XMLFILER(704.209,MDOPT_",",.1,"P3")
+16 QUIT
+17 ;
ALLOPT ; Get all options by user
+1 NEW MDFLD
+2 DO BLDFLD^MDXMLFM(.MDFLD,704.209,".001;;NUMBER^.01;;SETTING NAME")
+3 KILL ^TMP("DILIST",$JOB)
+4 DO LIST^DIC(704.209,,"@;.01","P","*",,,"B","I $P(^(0),U,2)=P2")
+5 FOR X=0:0
SET X=$ORDER(^TMP("DILIST",$JOB,X))
if 'X
QUIT
SET ^TMP("DILIST",$JOB,"B",+^(X,0),X)=""
+6 DO LOADALL^MDXMLFM($NAME(^TMP("DILIST",$JOB,"B")),704.209,.MDFLD)
+7 QUIT
+8 ;
XMLFILER(DD,IENS,FLD,ROOT) ; This files UUEncoded XML into Fileman WP
+1 ; Set to control appending
NEW MDFLAG,MDERR,MDL,MDXL
+2 KILL ^TMP("MDKXML",$JOB)
+3 SET MDXL=""
SET MDL=0
+4 FOR
SET MDXL=$ORDER(@ROOT@(MDXL))
if MDXL=""
QUIT
SET MDL=MDL+1
SET ^TMP("MDKXML",$JOB,MDL)=@ROOT@(MDXL)
+5 SET MDFLAG=$SELECT(@ROOT@(0)["-- Begin UUEncoded Data --":"",1:"A")
+6 DO WP^DIE(DD,IENS,FLD,MDFLAG,$NAME(^TMP("MDKXML",$JOB)),"MDERR")
+7 IF $DATA(MDERR)
QUIT "-1^"_$GET(MDERR("DIERR",1,"TEXT",1),"Unknown Error")
+8 QUIT "1^Filed"_"^"_MDL
+9 ;
GETPROV ; Get list of available providers with name starting with P1
+1 NEW MDFLD,MDDATE,MDDUP,MDRI,MDI1,MDI2,MDLAST,MDMAX,MDPREV,MDTTL,X,X1,X2
+2 DO BLDFLD^MDXMLFM(.MDFLD,200,".001;;ID^.01;;PROV_NAME^8;;TITLE")
+3 SET MDRI=0
SET MDMAX=44
SET (MDLAST,MDPREV)=""
SET X1=DT
SET MDFROM=P1
SET X2=-30
DO C^%DTC
SET MDDATE=DT
KILL X
+4 SET RESULTS=$NAME(^TMP("MDPLIST",$JOB))
KILL @RESULTS
KILL ^TMP("DILIST",$JOB)
+5 FOR
if MDRI'<MDMAX
QUIT
SET MDFROM=$ORDER(^VA(200,"AUSER",MDFROM),1)
if MDFROM=""
QUIT
Begin DoDot:1
+6 SET MDI1=""
+7 FOR
SET MDI1=$ORDER(^VA(200,"AUSER",MDFROM,MDI1),1)
if 'MDI1
QUIT
Begin DoDot:2
+8 ; Check date?
IF MDDATE>0
IF $$GET^XUA4A72(MDI1,MDDATE)<1
QUIT
+9 ; Init flag, check dupe.
SET MDDUP=0
+10 IF ($PIECE(MDPREV_" "," ")=$PIECE(MDFROM_" "," "))
SET MDDUP=1
+11 ;
+12 ; Append Title if not duplicated:
+13 IF 'MDDUP
Begin DoDot:3
+14 SET MDI2=MDI1
+15 ; Get Title.
DO TITLE
+16 SET MDRI=MDRI+1
SET ^TMP("DILIST",$JOB,MDRI)=MDI1_U_$$NAMEFMT^XLFNAME(MDFROM,"F","DcMPC")_$SELECT(MDTTL'="":U_"- "_MDTTL,1:"")
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X S ^TMP("DILIST",$J,"B",+^(X),X)=""
+18 DO LOADALL^MDXMLFM1($NAME(^TMP("DILIST",$JOB)),200,.MDFLD)
+19 QUIT
+20 ;
TITLE ; Retrieve Title or Title and Service/Section.
+1 ; (Assumes certain vars already set/new'd in calling code.)
+2 ;
+3 ; Init each time.
SET MDTTL=""
+4 ; DBIA# 4329:
+5 ; Get Title pointer.
SET MDTTL=$PIECE($GET(^VA(200,MDI2,0)),U,9)
+6 ; Reset var if none.
IF MDTTL<1
SET MDTTL=""
+7 ; DBIA# 1234:
+8 ; Actual Title value.
IF MDTTL>0
SET MDTTL=$GET(^DIC(3.1,MDTTL,0))
+9 QUIT
+10 ;
VITALS ; File a vitals sign
+1 SET P3=$$FIND1^DIC(120.51,,"MX",P3)
+2 IF P3<1
SET @RESULTS@(0)="-1^Unknown Vital Type"
QUIT
+3 SET X=P1_U_P2_U_P3_";"_P4_U_P5_U_P6
+4 LOCK +^GMR(120.5,0)
+5 DO EN1^GMVDCSAV(.ZZZ,X)
+6 SET @RESULTS@(0)=+$ORDER(^GMR(120.5,"A"),-1)
+7 SET @RESULTS@(1)=X
+8 LOCK -^GMR(120.5,0)
+9 QUIT
+10 ;
GETINST ; Get list of Institutions with name starting with P1
+1 NEW MDFLD
+2 DO BLDFLD^MDXMLFM(.MDFLD,4,".001;;STATION NUMBER^.01;;STATION NAME")
+3 KILL ^TMP("DILIST",$JOB)
+4 DO FIND^DIC(4,,"@;.01","P",P1,"*")
+5 FOR X=0:0
SET X=$ORDER(^TMP("DILIST",$JOB,X))
if 'X
QUIT
SET ^TMP("DILIST",$JOB,"B",+^(X,0),X)=""
+6 DO LOADALL^MDXMLFM($NAME(^TMP("DILIST",$JOB,"B")),4,.MDFLD)
+7 QUIT
GETADM ; Get Administrators
+1 NEW MDFLD
+2 DO BLDFLD^MDXMLFM(.MDFLD,200,".001;;NUMBER^.01;;NAME")
+3 KILL ^TMP("DILIST",$JOB)
+4 DO FIND^DIC(200,,"@;.01","P",P1,"*")
+5 FOR X=0:0
SET X=$ORDER(^TMP("DILIST",$JOB,X))
if 'X
QUIT
SET ^TMP("DILIST",$JOB,"B",+^(X,0),X)=""
+6 DO LOADALL^MDXMLFM($NAME(^TMP("DILIST",$JOB,"B")),200,.MDFLD)
+7 QUIT
GUI ; Returns Hemodialysis version check
+1 ; Returns yes or no
+2 SET @RESULTS@(0)=$$GET^XPAR("SYS","MDK GUI VERSION",P1,"E")
+3 if @RESULTS@(0)=""
SET @RESULTS@(0)="NO"
+4 QUIT
CURRENT ; Current Version
+1 NEW MDKLST,MDK,MDKY,MDKY1
SET @RESULTS@(0)=""
+2 DO GETLST^XPAR(.MDKLST,"SYS","MDK GUI VERSION")
+3 FOR MDK=0:0
SET MDK=$ORDER(MDKLST(MDK))
if MDK<1
QUIT
SET MDKY=$GET(MDKLST(MDK))
Begin DoDot:1
+4 SET MDKY1=$PIECE(MDKY,"^")
+5 IF $$GET^XPAR("SYS","MDK GUI VERSION",MDKY1,"I")
if @RESULTS@(0)=""
SET @RESULTS@(0)=MDKY1
+6 QUIT
End DoDot:1
+7 if @RESULTS@(0)=""
SET @RESULTS@(0)="No Current Version Recorded."
+8 QUIT
USERINF ; Current User Information
+1 NEW MDUSER
+2 SET MDUSER(0)=DUZ
+3 SET MDUSER(1)=$$GET1^DIQ(200,+MDUSER(0)_",",.01)
+4 SET MDUSER(2)=MDUSER(1)
+5 SET MDUSER(3)=""
+6 SET MDUSER(4)=$$GET1^DIQ(200,+MDUSER(0)_",",8)
+7 SET MDUSER(5)=$$GET1^DIQ(200,+MDUSER(0)_",",29)
+8 SET MDUSER(6)=$$GET1^DIQ(200,+MDUSER(0)_",",200.07)
+9 SET MDUSER(7)=$$GET1^DIQ(200,+MDUSER(0)_",",200.1)
+10 MERGE @RESULTS=MDUSER
KILL MDUSER
+11 QUIT
