ORRCQLPT ; SLC/TH - CPRS Query Tools - Libraries ;Oct 27, 2023@12:14:25
;;3.0;ORDER ENTRY/RESULTS REPORTING;**535**;Dec 17, 1997;Build 20
;Reference to ^TIU(8925 in ICR #2937 (Field .02)
;Reference to DEM^VADPT in ICR #10061
;Reference to $$FMTHL7^XLFDT in ICR #10103
;
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 900 printed Nov 22, 2024@16:51:25 Page 2
ORRCQLPT ; SLC/TH - CPRS Query Tools - Libraries ;Oct 27, 2023@12:14:25
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**535**;Dec 17, 1997;Build 20
+2 ;Reference to ^TIU(8925 in ICR #2937 (Field .02)
+3 ;Reference to DEM^VADPT in ICR #10061
+4 ;Reference to $$FMTHL7^XLFDT in ICR #10103
+5 ;
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