- MDKUTLR ; HOIFO/DP - Renal Utilities RPC;11/29/07 14:45
- ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
- ; Reference IA #10045 [Supported] XUSHSHP call
- ; #2241 [Supported] DECRYP^XUSRB1 call
- ; #10060 [Supported] FILE 200 references
- ;
- CP(STUDY) ; Check to see if the CP Study is logged
- N DFN,MDFDA,MDIEN
- S DFN=$P(^MDD(702,STUDY,0),U)
- D:'$D(^MDK(704.202,STUDY,0)) ; Build study record (1..1) with file 702
- .S MDFDA(704.202,"+1,",.01)=STUDY
- .;S MDFDA(704.202,"+1,",.02)=DFN
- .S MDFDA(704.202,"+1,",.09)=1
- .S MDIEN(1)=STUDY
- .D UPDATE^DIE("","MDFDA","MDIEN")
- .K MDFDA,MDIEN
- D:'$D(^MDK(704.201,DFN,0)) ; Build access point record (1..1) with file 2
- .S MDFDA(704.201,"+1,",.01)=DFN
- .S MDIEN(1)=DFN
- .D UPDATE^DIE("","MDFDA","MDIEN")
- .K MDFDA,MDIEN
- Q
- UPD(STUDY,NOTEID) ; Add entries to update CP_TRANSACTION_TIU_HISTORY
- N MDCHK,MDFDA,MDIEN
- Q:$G(STUDY)=""
- Q:$G(NOTEID)=""
- S MDCHK=$O(^MDD(702.001,"ASTUDY",+STUDY,NOTEID,0)) Q:+MDCHK
- D NOW^%DTC
- S MDFDA(702.001,"+1,",.01)=STUDY
- S MDFDA(702.001,"+1,",.02)=NOTEID
- S MDFDA(702.001,"+1,",.03)=%
- D UPDATE^DIE("","MDFDA")
- K %,X,MDFDA,MDIEN
- Q
- ;
- RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6) ; [Procedure] Main RPC call
- ; RPC: [MDK UTILITIES]
- ;
- D CLEAN^DILF
- S RESULTS=$NA(^TMP("MDKUTL",$J)) K @RESULTS
- I $T(@OPTION)="" D Q
- .S @RESULTS@(0)="-1^Error in RPC: MDK UTILITIES at "_OPTION_U_$T(+0)
- D @OPTION S:'$D(@RESULTS) @RESULTS@(0)="-1^No return"
- D CLEAN^DILF
- Q
- ;
- ESIG ; [Procedure] Verify users electronic signature
- I $G(P1)="" D Q
- .S @RESULTS@(0)="-1^Must supply electronic signature code"
- S X=$$DECRYP^XUSRB1(P1)
- D HASH^XUSHSHP
- I X'=$$GET1^DIQ(200,DUZ_",",20.4,"I") S @RESULTS@(0)="-1^E-Sig Invalid^"
- E S @RESULTS@(0)="1^E-Sig Verifed^"_X
- Q
- ;
- LOCK ; [Procedure] Lock a record
- L @("+"_$$ROOT^DILFD(P1)_(+P2)_"):2")
- I '$T S @RESULTS@(0)="-1^Lock *NOT* acquired" Q
- E S @RESULTS@(0)="1^Lock acquired"
- Q
- ;
- UNLOCK ; [Procedure] Unlock a record
- L @("-"_$$ROOT^DILFD(P1)_(+P2)_")")
- S @RESULTS@(0)="1^Lock released"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDKUTLR 2101 printed Feb 18, 2025@23:09:27 Page 2
- MDKUTLR ; HOIFO/DP - Renal Utilities RPC;11/29/07 14:45
- +1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
- +2 ; Reference IA #10045 [Supported] XUSHSHP call
- +3 ; #2241 [Supported] DECRYP^XUSRB1 call
- +4 ; #10060 [Supported] FILE 200 references
- +5 ;
- CP(STUDY) ; Check to see if the CP Study is logged
- +1 NEW DFN,MDFDA,MDIEN
- +2 SET DFN=$PIECE(^MDD(702,STUDY,0),U)
- +3 ; Build study record (1..1) with file 702
- if '$DATA(^MDK(704.202,STUDY,0))
- Begin DoDot:1
- +4 SET MDFDA(704.202,"+1,",.01)=STUDY
- +5 ;S MDFDA(704.202,"+1,",.02)=DFN
- +6 SET MDFDA(704.202,"+1,",.09)=1
- +7 SET MDIEN(1)=STUDY
- +8 DO UPDATE^DIE("","MDFDA","MDIEN")
- +9 KILL MDFDA,MDIEN
- End DoDot:1
- +10 ; Build access point record (1..1) with file 2
- if '$DATA(^MDK(704.201,DFN,0))
- Begin DoDot:1
- +11 SET MDFDA(704.201,"+1,",.01)=DFN
- +12 SET MDIEN(1)=DFN
- +13 DO UPDATE^DIE("","MDFDA","MDIEN")
- +14 KILL MDFDA,MDIEN
- End DoDot:1
- +15 QUIT
- UPD(STUDY,NOTEID) ; Add entries to update CP_TRANSACTION_TIU_HISTORY
- +1 NEW MDCHK,MDFDA,MDIEN
- +2 if $GET(STUDY)=""
- QUIT
- +3 if $GET(NOTEID)=""
- QUIT
- +4 SET MDCHK=$ORDER(^MDD(702.001,"ASTUDY",+STUDY,NOTEID,0))
- if +MDCHK
- QUIT
- +5 DO NOW^%DTC
- +6 SET MDFDA(702.001,"+1,",.01)=STUDY
- +7 SET MDFDA(702.001,"+1,",.02)=NOTEID
- +8 SET MDFDA(702.001,"+1,",.03)=%
- +9 DO UPDATE^DIE("","MDFDA")
- +10 KILL %,X,MDFDA,MDIEN
- +11 QUIT
- +12 ;
- RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6) ; [Procedure] Main RPC call
- +1 ; RPC: [MDK UTILITIES]
- +2 ;
- +3 DO CLEAN^DILF
- +4 SET RESULTS=$NAME(^TMP("MDKUTL",$JOB))
- KILL @RESULTS
- +5 IF $TEXT(@OPTION)=""
- Begin DoDot:1
- +6 SET @RESULTS@(0)="-1^Error in RPC: MDK UTILITIES at "_OPTION_U_$TEXT(+0)
- End DoDot:1
- QUIT
- +7 DO @OPTION
- if '$DATA(@RESULTS)
- SET @RESULTS@(0)="-1^No return"
- +8 DO CLEAN^DILF
- +9 QUIT
- +10 ;
- ESIG ; [Procedure] Verify users electronic signature
- +1 IF $GET(P1)=""
- Begin DoDot:1
- +2 SET @RESULTS@(0)="-1^Must supply electronic signature code"
- End DoDot:1
- QUIT
- +3 SET X=$$DECRYP^XUSRB1(P1)
- +4 DO HASH^XUSHSHP
- +5 IF X'=$$GET1^DIQ(200,DUZ_",",20.4,"I")
- SET @RESULTS@(0)="-1^E-Sig Invalid^"
- +6 IF '$TEST
- SET @RESULTS@(0)="1^E-Sig Verifed^"_X
- +7 QUIT
- +8 ;
- LOCK ; [Procedure] Lock a record
- +1 LOCK @("+"_$$ROOT^DILFD(P1)_(+P2)_"):2")
- +2 IF '$TEST
- SET @RESULTS@(0)="-1^Lock *NOT* acquired"
- QUIT
- +3 IF '$TEST
- SET @RESULTS@(0)="1^Lock acquired"
- +4 QUIT
- +5 ;
- UNLOCK ; [Procedure] Unlock a record
- +1 LOCK @("-"_$$ROOT^DILFD(P1)_(+P2)_")")
- +2 SET @RESULTS@(0)="1^Lock released"
- +3 QUIT
- +4 ;