- 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 Feb 18, 2025@23:10:24 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 ;