| 1 | MDRPCOD ; 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.
|
|---|
| 5 | ADDINST ; [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 | ;
|
|---|
| 12 | CONLIST ; [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 | ;
|
|---|
| 19 | CONSYN ; [Procedure] Returns 0/1 for linked to Consults
|
|---|
| 20 | S @RESULTS@(0)=+$$CPLINK^GMRCCP(MDPROC)
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | DELINST ; [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 | ;
|
|---|
| 30 | GETINST ; [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 | ;
|
|---|
| 37 | GETPROC ; [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 | ;
|
|---|
| 49 | GETSPEC ; [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 | ;
|
|---|
| 66 | LINK(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 | ;
|
|---|
| 70 | LINKS(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 | ;
|
|---|
| 75 | RPC(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 | ;
|
|---|
