Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MDRPCOD

MDRPCOD.m

Go to the documentation of this file.
  1. MDRPCOD ; HOIFO/DP - Object RPCs (TMDProcedureDef) ; [01-09-2003 15:20]
  1. ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
  1. ; Integration Agreements:
  1. ; IA# 3468 [Subscription] Consult APIs.
  1. ADDINST ; [Procedure] Add instrument to the list
  1. D:'$D(^MDS(702.01,MDPROC,.1,"B",DATA))
  1. .S MDFDA(702.011,"+1,"_MDPROC_",",.01)=DATA
  1. .D UPDATE^DIE("","MDFDA")
  1. S @RESULTS@(0)="1^Updated"
  1. Q
  1. ;
  1. CONLIST ; [Procedure] Returns list of Consult Procedures linked to CP Def
  1. D CPLINKS^GMRCCP(.MDRET,MDPROC)
  1. F X=0:0 S X=$O(MDRET(X)) Q:'X D
  1. .S ^TMP($J,X)=$P(MDRET(X),U,1)_" Consults IEN: "_$P(MDRET(X),U,2)
  1. S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
  1. Q
  1. ;
  1. CONSYN ; [Procedure] Returns 0/1 for linked to Consults
  1. S @RESULTS@(0)=+$$CPLINK^GMRCCP(MDPROC)
  1. Q
  1. ;
  1. DELINST ; [Procedure] Delete instrument from procedure
  1. S X=$O(^MDS(702.01,MDPROC,.1,"B",DATA,0)) D:X
  1. .S MDFDA(702.011,X_","_MDPROC_",",.01)=""
  1. .D FILE^DIE("","MDFDA")
  1. S @RESULTS@(0)="1^Updated"
  1. Q
  1. ;
  1. GETINST ; [Procedure] Return all instruments and IEN if assigned
  1. F X=0:0 S X=$O(^MDS(702.09,X)) Q:'X D
  1. .S Y=$O(@RESULTS@(""),-1)+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)
  1. S @RESULTS@(0)=$O(@RESULTS@(""),-1)
  1. Q
  1. ;
  1. GETPROC ; [Procedure] Get procedure list
  1. I MDPROC D Q
  1. .F X=0:0 S X=$O(^MDS(702.01,"ASPEC",MDPROC,X)) Q:'X D
  1. ..S Y="702.01;"_X_U_^MDS(702.01,X,0)
  1. ..S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=Y
  1. .S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
  1. F X=0:0 S X=$O(^MDS(702.01,X)) Q:'X D:'$P(^MDS(702.01,X,0),U,2)
  1. .S Y="702.01;"_X_U_^MDS(702.01,X,0)
  1. .S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=Y
  1. S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
  1. Q
  1. ;
  1. GETSPEC ; [Procedure] Return all/active specialties (Default = ACTIVE)
  1. S MDPROC=$G(MDPROC,"ACTIVE")
  1. D:MDPROC="ACTIVE"
  1. .F X=0:0 S X=$O(^MDS(702.01,"ASPEC",X)) Q:'X D
  1. ..S Y=$O(^TMP($J,""),-1)+1
  1. ..S @RESULTS@(Y)="45.7;"_X_U_$$GET1^DIQ(45.7,X_",",.01)_U_$D(^MDS(702.01,"ASPEC",X))
  1. D:MDPROC="ALL"
  1. .D LIST^DIC(45.7,,,"P")
  1. .F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X D
  1. ..S @RESULTS@(X)="45.7;"_^TMP("DILIST",$J,X,0)
  1. ..S $P(@RESULTS@(X),U,3)=$D(^MDS(702.01,"ASPEC",+^TMP("DILIST",$J,X,0)))
  1. .S Y=$O(@RESULTS@(""),-1)+1
  1. .S @RESULTS@(Y)="45.7;^Unassigned^1"
  1. S Y=$O(@RESULTS@(""),-1)+1
  1. S @RESULTS@(0)=Y_"^SPECIALTY"
  1. Q
  1. ;
  1. I '$G(MDPROC) Q "-1^No Procedure Internal Entry Number"
  1. Q $$CPLINK^GMRCCP(MDPROC)
  1. ;
  1. I '$G(MDPROC) S RESULTS(1)="-1^No Procedure Internal Entry Number" Q
  1. D CPLINKS^GMRCCP(.RESULTS,MDPROC)
  1. Q
  1. ;
  1. RPC(RESULTS,OPTION,MDPROC,DATA) ; [Procedure] Main RPC Call
  1. N MDX,MDENT,MDINST,MDRET,MDFDA
  1. S RESULTS=$NA(^TMP($J)) K @RESULTS
  1. I $T(@OPTION)]"" D @OPTION
  1. D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDPROCEDURE","MDRPCOD",OPTION)
  1. D CLEAN^DILF
  1. Q
  1. ;