MDRPCOD ; HOIFO/DP - Object RPCs (TMDProcedureDef) ; [01-09-2003 15:20]
;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
; Integration Agreements:
; IA# 3468 [Subscription] Consult APIs.
ADDINST ; [Procedure] Add instrument to the list
D:'$D(^MDS(702.01,MDPROC,.1,"B",DATA))
.S MDFDA(702.011,"+1,"_MDPROC_",",.01)=DATA
.D UPDATE^DIE("","MDFDA")
S @RESULTS@(0)="1^Updated"
Q
;
CONLIST ; [Procedure] Returns list of Consult Procedures linked to CP Def
D CPLINKS^GMRCCP(.MDRET,MDPROC)
F X=0:0 S X=$O(MDRET(X)) Q:'X D
.S ^TMP($J,X)=$P(MDRET(X),U,1)_" Consults IEN: "_$P(MDRET(X),U,2)
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
Q
;
CONSYN ; [Procedure] Returns 0/1 for linked to Consults
S @RESULTS@(0)=+$$CPLINK^GMRCCP(MDPROC)
Q
;
DELINST ; [Procedure] Delete instrument from procedure
S X=$O(^MDS(702.01,MDPROC,.1,"B",DATA,0)) D:X
.S MDFDA(702.011,X_","_MDPROC_",",.01)=""
.D FILE^DIE("","MDFDA")
S @RESULTS@(0)="1^Updated"
Q
;
GETINST ; [Procedure] Return all instruments and IEN if assigned
F X=0:0 S X=$O(^MDS(702.09,X)) Q:'X D
.S Y=$O(@RESULTS@(""),-1)+1
.S @RESULTS@(Y)="702.09;"_X_U_$P(^MDS(702.09,X,0),U)_U_($D(^MDS(702.01,MDPROC,.1,"B",X))>0)
S @RESULTS@(0)=$O(@RESULTS@(""),-1)
Q
;
GETPROC ; [Procedure] Get procedure list
I MDPROC D Q
.F X=0:0 S X=$O(^MDS(702.01,"ASPEC",MDPROC,X)) Q:'X D
..S Y="702.01;"_X_U_^MDS(702.01,X,0)
..S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=Y
.S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
F X=0:0 S X=$O(^MDS(702.01,X)) Q:'X D:'$P(^MDS(702.01,X,0),U,2)
.S Y="702.01;"_X_U_^MDS(702.01,X,0)
.S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=Y
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
Q
;
GETSPEC ; [Procedure] Return all/active specialties (Default = ACTIVE)
S MDPROC=$G(MDPROC,"ACTIVE")
D:MDPROC="ACTIVE"
.F X=0:0 S X=$O(^MDS(702.01,"ASPEC",X)) Q:'X D
..S Y=$O(^TMP($J,""),-1)+1
..S @RESULTS@(Y)="45.7;"_X_U_$$GET1^DIQ(45.7,X_",",.01)_U_$D(^MDS(702.01,"ASPEC",X))
D:MDPROC="ALL"
.D LIST^DIC(45.7,,,"P")
.F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X D
..S @RESULTS@(X)="45.7;"_^TMP("DILIST",$J,X,0)
..S $P(@RESULTS@(X),U,3)=$D(^MDS(702.01,"ASPEC",+^TMP("DILIST",$J,X,0)))
.S Y=$O(@RESULTS@(""),-1)+1
.S @RESULTS@(Y)="45.7;^Unassigned^1"
S Y=$O(@RESULTS@(""),-1)+1
S @RESULTS@(0)=Y_"^SPECIALTY"
Q
;
LINK(MDPROC) ; [Procedure] Check if CP Procedure Link to Consult
I '$G(MDPROC) Q "-1^No Procedure Internal Entry Number"
Q $$CPLINK^GMRCCP(MDPROC)
;
LINKS(RESULTS,MDPROC) ; [Procedure] Get list of Consults Procedure names linked to a CP
I '$G(MDPROC) S RESULTS(1)="-1^No Procedure Internal Entry Number" Q
D CPLINKS^GMRCCP(.RESULTS,MDPROC)
Q
;
RPC(RESULTS,OPTION,MDPROC,DATA) ; [Procedure] Main RPC Call
N MDX,MDENT,MDINST,MDRET,MDFDA
S RESULTS=$NA(^TMP($J)) K @RESULTS
I $T(@OPTION)]"" D @OPTION
D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDPROCEDURE","MDRPCOD",OPTION)
D CLEAN^DILF
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCOD 2925 printed Dec 13, 2024@01:44 Page 2
MDRPCOD ; HOIFO/DP - Object RPCs (TMDProcedureDef) ; [01-09-2003 15:20]
+1 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
+2 ; Integration Agreements:
+3 ; IA# 3468 [Subscription] Consult APIs.
ADDINST ; [Procedure] Add instrument to the list
+1 if '$DATA(^MDS(702.01,MDPROC,.1,"B",DATA))
Begin DoDot:1
+2 SET MDFDA(702.011,"+1,"_MDPROC_",",.01)=DATA
+3 DO UPDATE^DIE("","MDFDA")
End DoDot:1
+4 SET @RESULTS@(0)="1^Updated"
+5 QUIT
+6 ;
CONLIST ; [Procedure] Returns list of Consult Procedures linked to CP Def
+1 DO CPLINKS^GMRCCP(.MDRET,MDPROC)
+2 FOR X=0:0
SET X=$ORDER(MDRET(X))
if 'X
QUIT
Begin DoDot:1
+3 SET ^TMP($JOB,X)=$PIECE(MDRET(X),U,1)_" Consults IEN: "_$PIECE(MDRET(X),U,2)
End DoDot:1
+4 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+5 QUIT
+6 ;
CONSYN ; [Procedure] Returns 0/1 for linked to Consults
+1 SET @RESULTS@(0)=+$$CPLINK^GMRCCP(MDPROC)
+2 QUIT
+3 ;
DELINST ; [Procedure] Delete instrument from procedure
+1 SET X=$ORDER(^MDS(702.01,MDPROC,.1,"B",DATA,0))
if X
Begin DoDot:1
+2 SET MDFDA(702.011,X_","_MDPROC_",",.01)=""
+3 DO FILE^DIE("","MDFDA")
End DoDot:1
+4 SET @RESULTS@(0)="1^Updated"
+5 QUIT
+6 ;
GETINST ; [Procedure] Return all instruments and IEN if assigned
+1 FOR X=0:0
SET X=$ORDER(^MDS(702.09,X))
if 'X
QUIT
Begin DoDot:1
+2 SET Y=$ORDER(@RESULTS@(""),-1)+1
+3 SET @RESULTS@(Y)="702.09;"_X_U_$PIECE(^MDS(702.09,X,0),U)_U_($DATA(^MDS(702.01,MDPROC,.1,"B",X))>0)
End DoDot:1
+4 SET @RESULTS@(0)=$ORDER(@RESULTS@(""),-1)
+5 QUIT
+6 ;
GETPROC ; [Procedure] Get procedure list
+1 IF MDPROC
Begin DoDot:1
+2 FOR X=0:0
SET X=$ORDER(^MDS(702.01,"ASPEC",MDPROC,X))
if 'X
QUIT
Begin DoDot:2
+3 SET Y="702.01;"_X_U_^MDS(702.01,X,0)
+4 SET @RESULTS@(+$ORDER(@RESULTS@(""),-1)+1)=Y
End DoDot:2
+5 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
End DoDot:1
QUIT
+6 FOR X=0:0
SET X=$ORDER(^MDS(702.01,X))
if 'X
QUIT
if '$PIECE(^MDS(702.01,X,0),U,2)
Begin DoDot:1
+7 SET Y="702.01;"_X_U_^MDS(702.01,X,0)
+8 SET @RESULTS@(+$ORDER(@RESULTS@(""),-1)+1)=Y
End DoDot:1
+9 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+10 QUIT
+11 ;
GETSPEC ; [Procedure] Return all/active specialties (Default = ACTIVE)
+1 SET MDPROC=$GET(MDPROC,"ACTIVE")
+2 if MDPROC="ACTIVE"
Begin DoDot:1
+3 FOR X=0:0
SET X=$ORDER(^MDS(702.01,"ASPEC",X))
if 'X
QUIT
Begin DoDot:2
+4 SET Y=$ORDER(^TMP($JOB,""),-1)+1
+5 SET @RESULTS@(Y)="45.7;"_X_U_$$GET1^DIQ(45.7,X_",",.01)_U_$DATA(^MDS(702.01,"ASPEC",X))
End DoDot:2
End DoDot:1
+6 if MDPROC="ALL"
Begin DoDot:1
+7 DO LIST^DIC(45.7,,,"P")
+8 FOR X=0:0
SET X=$ORDER(^TMP("DILIST",$JOB,X))
if 'X
QUIT
Begin DoDot:2
+9 SET @RESULTS@(X)="45.7;"_^TMP("DILIST",$JOB,X,0)
+10 SET $PIECE(@RESULTS@(X),U,3)=$DATA(^MDS(702.01,"ASPEC",+^TMP("DILIST",$JOB,X,0)))
End DoDot:2
+11 SET Y=$ORDER(@RESULTS@(""),-1)+1
+12 SET @RESULTS@(Y)="45.7;^Unassigned^1"
End DoDot:1
+13 SET Y=$ORDER(@RESULTS@(""),-1)+1
+14 SET @RESULTS@(0)=Y_"^SPECIALTY"
+15 QUIT
+16 ;
LINK(MDPROC) ; [Procedure] Check if CP Procedure Link to Consult
+1 IF '$GET(MDPROC)
QUIT "-1^No Procedure Internal Entry Number"
+2 QUIT $$CPLINK^GMRCCP(MDPROC)
+3 ;
LINKS(RESULTS,MDPROC) ; [Procedure] Get list of Consults Procedure names linked to a CP
+1 IF '$GET(MDPROC)
SET RESULTS(1)="-1^No Procedure Internal Entry Number"
QUIT
+2 DO CPLINKS^GMRCCP(.RESULTS,MDPROC)
+3 QUIT
+4 ;
RPC(RESULTS,OPTION,MDPROC,DATA) ; [Procedure] Main RPC Call
+1 NEW MDX,MDENT,MDINST,MDRET,MDFDA
+2 SET RESULTS=$NAME(^TMP($JOB))
KILL @RESULTS
+3 IF $TEXT(@OPTION)]""
DO @OPTION
+4 if '$DATA(@RESULTS)
DO BADRPC^MDRPCU("MD TMDPROCEDURE","MDRPCOD",OPTION)
+5 DO CLEAN^DILF
+6 QUIT
+7 ;
