| 1 | MDKUTL ; HOIFO/DP - Renal Utilities ;11/29/07  14:45 | 
|---|
| 2 | ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01, 2004;Build 20 | 
|---|
| 3 | ; Reference IA #10045 [Supported] XUSHSHP call | 
|---|
| 4 | ;              #2241 [Supported] DECRYP^XUSRB1 call | 
|---|
| 5 | ;              #10060 [Supported] FILE 200 references | 
|---|
| 6 | ; | 
|---|
| 7 | CP(STUDY) ; Check to see if the CP Study is logged | 
|---|
| 8 | N DFN,MDFDA,MDIEN | 
|---|
| 9 | S DFN=$P(^MDD(702,STUDY,0),U) | 
|---|
| 10 | D:'$D(^MDK(704.202,STUDY,0))  ; Build study record (1..1) with file 702 | 
|---|
| 11 | .S MDFDA(704.202,"+1,",.01)=STUDY | 
|---|
| 12 | .;S MDFDA(704.202,"+1,",.02)=DFN | 
|---|
| 13 | .S MDFDA(704.202,"+1,",.09)=1 | 
|---|
| 14 | .S MDIEN(1)=STUDY | 
|---|
| 15 | .D UPDATE^DIE("","MDFDA","MDIEN") | 
|---|
| 16 | .K MDFDA,MDIEN | 
|---|
| 17 | D:'$D(^MDK(704.201,DFN,0))  ; Build access point record (1..1) with file 2 | 
|---|
| 18 | .S MDFDA(704.201,"+1,",.01)=DFN | 
|---|
| 19 | .S MDIEN(1)=DFN | 
|---|
| 20 | .D UPDATE^DIE("","MDFDA","MDIEN") | 
|---|
| 21 | .K MDFDA,MDIEN | 
|---|
| 22 | Q | 
|---|
| 23 | UPD(STUDY,NOTEID) ; Add entries to update CP_TRANSACTION_TIU_HISTORY | 
|---|
| 24 | N MDCHK,MDFDA,MDIEN | 
|---|
| 25 | Q:$G(STUDY)="" | 
|---|
| 26 | Q:$G(NOTEID)="" | 
|---|
| 27 | S MDCHK=$O(^MDD(702.001,"ASTUDY",+STUDY,NOTEID,0)) Q:+MDCHK | 
|---|
| 28 | D NOW^%DTC | 
|---|
| 29 | S MDFDA(702.001,"+1,",.01)=STUDY | 
|---|
| 30 | S MDFDA(702.001,"+1,",.02)=NOTEID | 
|---|
| 31 | S MDFDA(702.001,"+1,",.03)=% | 
|---|
| 32 | D UPDATE^DIE("","MDFDA") | 
|---|
| 33 | K %,X,MDFDA,MDIEN | 
|---|
| 34 | Q | 
|---|
| 35 | ; | 
|---|
| 36 | RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6) ; [Procedure] Main RPC call | 
|---|
| 37 | ; RPC: [MDK UTILITIES] | 
|---|
| 38 | ; | 
|---|
| 39 | D CLEAN^DILF | 
|---|
| 40 | S RESULTS=$NA(^TMP("MDKUTL",$J)) K @RESULTS | 
|---|
| 41 | I $T(@OPTION)="" D  Q | 
|---|
| 42 | .S @RESULTS@(0)="-1^Error in RPC: MDK UTILITIES at "_OPTION_U_$T(+0) | 
|---|
| 43 | D @OPTION S:'$D(@RESULTS) @RESULTS@(0)="-1^No return" | 
|---|
| 44 | D CLEAN^DILF | 
|---|
| 45 | Q | 
|---|
| 46 | ; | 
|---|
| 47 | ESIG ; [Procedure] Verify users electronic signature | 
|---|
| 48 | I $G(P1)="" D  Q | 
|---|
| 49 | .S @RESULTS@(0)="-1^Must supply electronic signature code" | 
|---|
| 50 | S X=$$DECRYP^XUSRB1(P1) | 
|---|
| 51 | D HASH^XUSHSHP | 
|---|
| 52 | I X'=$$GET1^DIQ(200,DUZ_",",20.4,"I") S @RESULTS@(0)="-1^E-Sig Invalid^" | 
|---|
| 53 | E  S @RESULTS@(0)="1^E-Sig Verifed^"_X | 
|---|
| 54 | Q | 
|---|
| 55 | ; | 
|---|
| 56 | LOCK ; [Procedure] Lock a record | 
|---|
| 57 | L @("+"_$$ROOT^DILFD(P1)_(+P2)_"):2") | 
|---|
| 58 | I '$T S @RESULTS@(0)="-1^Lock *NOT* acquired" Q | 
|---|
| 59 | E  S @RESULTS@(0)="1^Lock acquired" | 
|---|
| 60 | Q | 
|---|
| 61 | ; | 
|---|
| 62 | UNLOCK ; [Procedure] Unlock a record | 
|---|
| 63 | L @("-"_$$ROOT^DILFD(P1)_(+P2)_")") | 
|---|
| 64 | S @RESULTS@(0)="1^Lock released" | 
|---|
| 65 | Q | 
|---|
| 66 | ; | 
|---|