SDUPDATECONSPID ;ALB/BLB - Feb 29, 2024 - Entry point for SD PID/CID UPDATE OR protocol - attached to GMRC EVSEND OR
;;5.3;Scheduling;**877,885**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
UPDATECONSULTPID(CONSULT) ;
N CONSULTIEN,PID,DFN,COUNT
;
I $D(SDCONTEXT)!($L($G(CANBYCLINORPAT)))!($L($G(SDECTYP))) Q
I $D(APPOINTMENT) Q
I $G(SDDDT)!($D(APPTARRAY)) Q
I $L($G(NOSHOW))!($L($G(SDECNS))) Q
I $D(NOSHOW) Q
;
S COUNT=0
F S COUNT=$O(CONSULT(COUNT)) Q:'COUNT D
.I $E($G(CONSULT(COUNT)),1,3)="ORC" D
..S CONSULTIEN=$P($P($P($G(CONSULT(COUNT)),U,2),"|",2),";")
..S PID=$$HL7TFM^XLFDT($P($G(CONSULT(COUNT)),U,6))
.;
.I $E($G(CONSULT(COUNT)),1,3)="PID" D
..S DFN=$P($G(CONSULT(COUNT)),"|",4)
I '$G(CONSULTIEN)!('$G(DFN))!('$G(PID)) Q
;
D UPDATECONSULTPID^SDES2APPTUTIL(CONSULTIEN,PID,DFN) ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDUPDATECONSPID 893 printed Dec 13, 2024@03:01:50 Page 2
SDUPDATECONSPID ;ALB/BLB - Feb 29, 2024 - Entry point for SD PID/CID UPDATE OR protocol - attached to GMRC EVSEND OR
+1 ;;5.3;Scheduling;**877,885**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
UPDATECONSULTPID(CONSULT) ;
+1 NEW CONSULTIEN,PID,DFN,COUNT
+2 ;
+3 IF $DATA(SDCONTEXT)!($LENGTH($GET(CANBYCLINORPAT)))!($LENGTH($GET(SDECTYP)))
QUIT
+4 IF $DATA(APPOINTMENT)
QUIT
+5 IF $GET(SDDDT)!($DATA(APPTARRAY))
QUIT
+6 IF $LENGTH($GET(NOSHOW))!($LENGTH($GET(SDECNS)))
QUIT
+7 IF $DATA(NOSHOW)
QUIT
+8 ;
+9 SET COUNT=0
+10 FOR
SET COUNT=$ORDER(CONSULT(COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+11 IF $EXTRACT($GET(CONSULT(COUNT)),1,3)="ORC"
Begin DoDot:2
+12 SET CONSULTIEN=$PIECE($PIECE($PIECE($GET(CONSULT(COUNT)),U,2),"|",2),";")
+13 SET PID=$$HL7TFM^XLFDT($PIECE($GET(CONSULT(COUNT)),U,6))
End DoDot:2
+14 ;
+15 IF $EXTRACT($GET(CONSULT(COUNT)),1,3)="PID"
Begin DoDot:2
+16 SET DFN=$PIECE($GET(CONSULT(COUNT)),"|",4)
End DoDot:2
End DoDot:1
+17 IF '$GET(CONSULTIEN)!('$GET(DFN))!('$GET(PID))
QUIT
+18 ;
+19 ;
DO UPDATECONSULTPID^SDES2APPTUTIL(CONSULTIEN,PID,DFN)
+20 QUIT
+21 ;
