- 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 Feb 18, 2025@23:09:25 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