source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOD.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1MDRPCOD ; HOIFO/DP - Object RPCs (TMDProcedureDef) ; [01-09-2003 15:20]
2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
3 ; Integration Agreements:
4 ; IA# 3468 [Subscription] Consult APIs.
5ADDINST ; [Procedure] Add instrument to the list
6 D:'$D(^MDS(702.01,MDPROC,.1,"B",DATA))
7 .S MDFDA(702.011,"+1,"_MDPROC_",",.01)=DATA
8 .D UPDATE^DIE("","MDFDA")
9 S @RESULTS@(0)="1^Updated"
10 Q
11 ;
12CONLIST ; [Procedure] Returns list of Consult Procedures linked to CP Def
13 D CPLINKS^GMRCCP(.MDRET,MDPROC)
14 F X=0:0 S X=$O(MDRET(X)) Q:'X D
15 .S ^TMP($J,X)=$P(MDRET(X),U,1)_" Consults IEN: "_$P(MDRET(X),U,2)
16 S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
17 Q
18 ;
19CONSYN ; [Procedure] Returns 0/1 for linked to Consults
20 S @RESULTS@(0)=+$$CPLINK^GMRCCP(MDPROC)
21 Q
22 ;
23DELINST ; [Procedure] Delete instrument from procedure
24 S X=$O(^MDS(702.01,MDPROC,.1,"B",DATA,0)) D:X
25 .S MDFDA(702.011,X_","_MDPROC_",",.01)=""
26 .D FILE^DIE("","MDFDA")
27 S @RESULTS@(0)="1^Updated"
28 Q
29 ;
30GETINST ; [Procedure] Return all instruments and IEN if assigned
31 F X=0:0 S X=$O(^MDS(702.09,X)) Q:'X D
32 .S Y=$O(@RESULTS@(""),-1)+1
33 .S @RESULTS@(Y)="702.09;"_X_U_$P(^MDS(702.09,X,0),U)_U_($D(^MDS(702.01,MDPROC,.1,"B",X))>0)
34 S @RESULTS@(0)=$O(@RESULTS@(""),-1)
35 Q
36 ;
37GETPROC ; [Procedure] Get procedure list
38 I MDPROC D Q
39 .F X=0:0 S X=$O(^MDS(702.01,"ASPEC",MDPROC,X)) Q:'X D
40 ..S Y="702.01;"_X_U_^MDS(702.01,X,0)
41 ..S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=Y
42 .S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
43 F X=0:0 S X=$O(^MDS(702.01,X)) Q:'X D:'$P(^MDS(702.01,X,0),U,2)
44 .S Y="702.01;"_X_U_^MDS(702.01,X,0)
45 .S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=Y
46 S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
47 Q
48 ;
49GETSPEC ; [Procedure] Return all/active specialties (Default = ACTIVE)
50 S MDPROC=$G(MDPROC,"ACTIVE")
51 D:MDPROC="ACTIVE"
52 .F X=0:0 S X=$O(^MDS(702.01,"ASPEC",X)) Q:'X D
53 ..S Y=$O(^TMP($J,""),-1)+1
54 ..S @RESULTS@(Y)="45.7;"_X_U_$$GET1^DIQ(45.7,X_",",.01)_U_$D(^MDS(702.01,"ASPEC",X))
55 D:MDPROC="ALL"
56 .D LIST^DIC(45.7,,,"P")
57 .F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X D
58 ..S @RESULTS@(X)="45.7;"_^TMP("DILIST",$J,X,0)
59 ..S $P(@RESULTS@(X),U,3)=$D(^MDS(702.01,"ASPEC",+^TMP("DILIST",$J,X,0)))
60 .S Y=$O(@RESULTS@(""),-1)+1
61 .S @RESULTS@(Y)="45.7;^Unassigned^1"
62 S Y=$O(@RESULTS@(""),-1)+1
63 S @RESULTS@(0)=Y_"^SPECIALTY"
64 Q
65 ;
66LINK(MDPROC) ; [Procedure] Check if CP Procedure Link to Consult
67 I '$G(MDPROC) Q "-1^No Procedure Internal Entry Number"
68 Q $$CPLINK^GMRCCP(MDPROC)
69 ;
70LINKS(RESULTS,MDPROC) ; [Procedure] Get list of Consults Procedure names linked to a CP
71 I '$G(MDPROC) S RESULTS(1)="-1^No Procedure Internal Entry Number" Q
72 D CPLINKS^GMRCCP(.RESULTS,MDPROC)
73 Q
74 ;
75RPC(RESULTS,OPTION,MDPROC,DATA) ; [Procedure] Main RPC Call
76 N MDX,MDENT,MDINST,MDRET,MDFDA
77 S RESULTS=$NA(^TMP($J)) K @RESULTS
78 I $T(@OPTION)]"" D @OPTION
79 D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDPROCEDURE","MDRPCOD",OPTION)
80 D CLEAN^DILF
81 Q
82 ;
Note: See TracBrowser for help on using the repository browser.