ORRCQLPT ; SLC/TH - CPRS Query Tools - Libraries ; 25 Jul 2003 9:31 AM
;;1.0;CARE MANAGEMENT;;Jul 15, 2003;Build 0
;
PTDFN(VAL,ID) ; Return patient info given an order, consult, or note
N DFN,X,X0,X1,X101
S VAL="",DFN=0,X=$P(ID,":")
I X="ORD"!(X="CST") S DFN=+$P(^OR(100,+$P(ID,":",2),0),U,2)
I X="DOC" S DFN=+$P(^TIU(8925,+$P(ID,":",2),0),U,2)
I X="PTC" S DFN=+$P(ID,":",2)
;I X="VST" visits too?
Q:'DFN
S VAL=DFN
Q
;
PTDEMOS(ORY,DFN) ; Return patient info
; ORY="<dfn>^<name>^<ssn>^<dob>^<age>"
; RPC = ORRCQLPT PTDEMOS
N VADM,VA,VAERR
D DEM^VADPT
S ORY=DFN_U_VADM(1)_U_VA("PID")_U_$$FMTHL7^XLFDT(+VADM(3))_U_VADM(4)
Q
;
TESTPTD(DFN) ; Test PTDEMOS
N ORY
D PTDEMOS(.ORY,DFN)
W !,ORY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORRCQLPT 742 printed Sep 23, 2025@19:17:12 Page 2
ORRCQLPT ; SLC/TH - CPRS Query Tools - Libraries ; 25 Jul 2003 9:31 AM
+1 ;;1.0;CARE MANAGEMENT;;Jul 15, 2003;Build 0
+2 ;
PTDFN(VAL,ID) ; Return patient info given an order, consult, or note
+1 NEW DFN,X,X0,X1,X101
+2 SET VAL=""
SET DFN=0
SET X=$PIECE(ID,":")
+3 IF X="ORD"!(X="CST")
SET DFN=+$PIECE(^OR(100,+$PIECE(ID,":",2),0),U,2)
+4 IF X="DOC"
SET DFN=+$PIECE(^TIU(8925,+$PIECE(ID,":",2),0),U,2)
+5 IF X="PTC"
SET DFN=+$PIECE(ID,":",2)
+6 ;I X="VST" visits too?
+7 if 'DFN
QUIT
+8 SET VAL=DFN
+9 QUIT
+10 ;
PTDEMOS(ORY,DFN) ; Return patient info
+1 ; ORY="<dfn>^<name>^<ssn>^<dob>^<age>"
+2 ; RPC = ORRCQLPT PTDEMOS
+3 NEW VADM,VA,VAERR
+4 DO DEM^VADPT
+5 SET ORY=DFN_U_VADM(1)_U_VA("PID")_U_$$FMTHL7^XLFDT(+VADM(3))_U_VADM(4)
+6 QUIT
+7 ;
TESTPTD(DFN) ; Test PTDEMOS
+1 NEW ORY
+2 DO PTDEMOS(.ORY,DFN)
+3 WRITE !,ORY
+4 QUIT
