MDRPCOP1 ; HOIFO/DP - Object RPCs (TMDPatient) - Cont. ; 01-09-2003 15:21
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
; Integration Agreements:
; IA# 3027 [Supported] Calls to DGSEC4
; IA# 3266 [Subscription] Call to DPTLK1
; IA# 10035 [Supported] DPT references
; IA# 3267 [Subscription] Call to DPTLK1
; IA# 3593 [Supported] Access to routine DPTLK6 utilities for lookup
;
ADD(X) ; [Procedure] Add line to @RESULTS@(...
S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
Q
;
SELECT ; [Procedure] Select patient
I '$D(^DPT(+$G(DFN),0))#2 S @RESULTS@(0)="-1^No such patient" Q
S @RESULTS@(0)="1^Required Identifiers & messages"
S IENS=DFN_","
D FILE^DID(2,,"REQUIRED IDENTIFIERS","MDIDS")
F MDX=0:0 S MDX=$O(MDIDS("REQUIRED IDENTIFIERS",MDX)) Q:'MDX D
.S MDFLD=MDIDS("REQUIRED IDENTIFIERS",MDX,"FIELD")
.S MDID="$$PTID^"_$$GET1^DID(2,MDFLD,"","LABEL")
.S MDID=MDID_U_$$GET1^DIQ(2,IENS,MDFLD)
.D:MDFLD=.03
..S MDID=MDID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
..S MDID=MDID_U_$$DOB^DPTLK1(+IENS)
.D:MDFLD=.09
..S X=$P(MDID,U,3),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
..S $P(MDID,U,3)=X,$P(MDID,U,4)=$$SSN^DPTLK1(+IENS)
.S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
S MDID="$$PTID^"_$$GET1^DID(2,.1,"","LABEL")
S MDID=MDID_U_$$GET1^DIQ(2,IENS,.1)
S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
S MDID="$$PTID^"_$$GET1^DID(2,.101,"","LABEL")
S MDID=MDID_U_$$GET1^DIQ(2,IENS,.101)
S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
K MDRET
D GUIBS5A^DPTLK6(.MDRET,DFN) D:MDRET(1)=1
.D ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
.S MDX=1
.F S MDX=$O(MDRET(MDX)) Q:'MDX!(+$G(MDRET(MDX))) D
..D ADD($P(MDRET(MDX),U,2))
.D ADD(" ")
.S MDX=1
.F S MDX=$O(MDRET(MDX)) Q:'MDX D:+MDRET(MDX)
..S MDDFN=+$P(MDRET(MDX),U,2)
..D ADD($$GET1^DIQ(2,MDDFN_",",.01)_" "_$$DOB^DPTLK1(MDDFN)_" "_$$SSN^DPTLK1(MDDFN))
.D ADD(" ")
.D ADD("Please review carefully before continuing")
.D ADD("$$MSGEND")
K MDRET
D PTSEC^DGSEC4(.MDRET,DFN) D:MDRET(1)'=0
.D:MDRET(1)=3
..D ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
.D:MDRET(1)=-1
..D ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
.D:MDRET(1)=1
..D ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
.D:MDRET(1)'=-1&(MDRET(1)'=3)&(MDRET(1)'=1)
..D ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
.S MDX=1
.F S MDX=$O(MDRET(MDX)) Q:'MDX D ADD($TR(MDRET(MDX),"*"," "))
.D ADD("$$MSGEND")
D GUIMTD^DPTLK6(.MDRET,DFN) D:MDRET(1)=1
.D ADD("$$MSGHDR^1^NOTICE")
.F MDX=1:0 S MDX=$O(MDRET(MDX)) Q:'MDX D ADD(MDRET(MDX))
.D ADD("$$MSGEND")
Q
;
X2FM(X) ; [Function] return FM date given relative date
N %DT S %DT="TS" D ^%DT
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCOP1 2672 printed Sep 23, 2025@19:20:07 Page 2
MDRPCOP1 ; HOIFO/DP - Object RPCs (TMDPatient) - Cont. ; 01-09-2003 15:21
+1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
+2 ; Integration Agreements:
+3 ; IA# 3027 [Supported] Calls to DGSEC4
+4 ; IA# 3266 [Subscription] Call to DPTLK1
+5 ; IA# 10035 [Supported] DPT references
+6 ; IA# 3267 [Subscription] Call to DPTLK1
+7 ; IA# 3593 [Supported] Access to routine DPTLK6 utilities for lookup
+8 ;
ADD(X) ; [Procedure] Add line to @RESULTS@(...
+1 SET @RESULTS@(+$ORDER(@RESULTS@(""),-1)+1)=X
+2 QUIT
+3 ;
SELECT ; [Procedure] Select patient
+1 IF '$DATA(^DPT(+$GET(DFN),0))#2
SET @RESULTS@(0)="-1^No such patient"
QUIT
+2 SET @RESULTS@(0)="1^Required Identifiers & messages"
+3 SET IENS=DFN_","
+4 DO FILE^DID(2,,"REQUIRED IDENTIFIERS","MDIDS")
+5 FOR MDX=0:0
SET MDX=$ORDER(MDIDS("REQUIRED IDENTIFIERS",MDX))
if 'MDX
QUIT
Begin DoDot:1
+6 SET MDFLD=MDIDS("REQUIRED IDENTIFIERS",MDX,"FIELD")
+7 SET MDID="$$PTID^"_$$GET1^DID(2,MDFLD,"","LABEL")
+8 SET MDID=MDID_U_$$GET1^DIQ(2,IENS,MDFLD)
+9 if MDFLD=.03
Begin DoDot:2
+10 SET MDID=MDID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
+11 SET MDID=MDID_U_$$DOB^DPTLK1(+IENS)
End DoDot:2
+12 if MDFLD=.09
Begin DoDot:2
+13 SET X=$PIECE(MDID,U,3)
SET X=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10)
+14 SET $PIECE(MDID,U,3)=X
SET $PIECE(MDID,U,4)=$$SSN^DPTLK1(+IENS)
End DoDot:2
+15 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=MDID
End DoDot:1
+16 SET MDID="$$PTID^"_$$GET1^DID(2,.1,"","LABEL")
+17 SET MDID=MDID_U_$$GET1^DIQ(2,IENS,.1)
+18 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=MDID
+19 SET MDID="$$PTID^"_$$GET1^DID(2,.101,"","LABEL")
+20 SET MDID=MDID_U_$$GET1^DIQ(2,IENS,.101)
+21 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=MDID
+22 KILL MDRET
+23 DO GUIBS5A^DPTLK6(.MDRET,DFN)
if MDRET(1)=1
Begin DoDot:1
+24 DO ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
+25 SET MDX=1
+26 FOR
SET MDX=$ORDER(MDRET(MDX))
if 'MDX!(+$GET(MDRET(MDX)))
QUIT
Begin DoDot:2
+27 DO ADD($PIECE(MDRET(MDX),U,2))
End DoDot:2
+28 DO ADD(" ")
+29 SET MDX=1
+30 FOR
SET MDX=$ORDER(MDRET(MDX))
if 'MDX
QUIT
if +MDRET(MDX)
Begin DoDot:2
+31 SET MDDFN=+$PIECE(MDRET(MDX),U,2)
+32 DO ADD($$GET1^DIQ(2,MDDFN_",",.01)_" "_$$DOB^DPTLK1(MDDFN)_" "_$$SSN^DPTLK1(MDDFN))
End DoDot:2
+33 DO ADD(" ")
+34 DO ADD("Please review carefully before continuing")
+35 DO ADD("$$MSGEND")
End DoDot:1
+36 KILL MDRET
+37 DO PTSEC^DGSEC4(.MDRET,DFN)
if MDRET(1)'=0
Begin DoDot:1
+38 if MDRET(1)=3
Begin DoDot:2
+39 DO ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
End DoDot:2
+40 if MDRET(1)=-1
Begin DoDot:2
+41 DO ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
End DoDot:2
+42 if MDRET(1)=1
Begin DoDot:2
+43 DO ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
End DoDot:2
+44 if MDRET(1)'=-1&(MDRET(1)'=3)&(MDRET(1)'=1)
Begin DoDot:2
+45 DO ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
End DoDot:2
+46 SET MDX=1
+47 FOR
SET MDX=$ORDER(MDRET(MDX))
if 'MDX
QUIT
DO ADD($TRANSLATE(MDRET(MDX),"*"," "))
+48 DO ADD("$$MSGEND")
End DoDot:1
+49 DO GUIMTD^DPTLK6(.MDRET,DFN)
if MDRET(1)=1
Begin DoDot:1
+50 DO ADD("$$MSGHDR^1^NOTICE")
+51 FOR MDX=1:0
SET MDX=$ORDER(MDRET(MDX))
if 'MDX
QUIT
DO ADD(MDRET(MDX))
+52 DO ADD("$$MSGEND")
End DoDot:1
+53 QUIT
+54 ;
X2FM(X) ; [Function] return FM date given relative date
+1 NEW %DT
SET %DT="TS"
DO ^%DT
+2 QUIT Y
+3 ;
