| 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 |         ;
 | 
|---|