SDECHL7 ;TUS/STAFF,LAB - VSE HL7 MESSAGING ;Mar 19,2024
;;5.3;Scheduling;**671,875**;Aug 13, 1993;Build 25
;
Q
;
ARDISP(ARIEN,DISPOTN,SDDUZ) ;
Q:(ARIEN?.N)=0
N SDHL7IN,RET,PRIEN,PR
S:$G(SDDUZ)="" SDDUZ=DUZ
S (SDHL7IN,RET)=""
S AREQ0=^SDEC(409.85,ARIEN,0)
S AREQ3=^SDEC(409.85,ARIEN,3)
S AREQ7=^SDEC(409.85,ARIEN,7)
S SDHL7IN("REQ FILE IEN")=ARIEN
;PARTIAL
I $P(AREQ3,U,5)>0 S SDHL7IN("PARTIAL")=1
;APPT TYPE
S APTYPEN=$P(AREQ0,U,6) I APTYPEN'="" D
.S SDHL7IN("APPT TYPE")=$$GET1^DIQ(409.1,APTYPEN,.01,"E")
;CLINIC
S CLIEN=$P(AREQ0,U,9) I CLIEN'="" D
.S SDHL7IN("CLINIC")=CLIEN_U_$$GET1^DIQ(44,CLIEN,.01,"E")
;COMMENT
S COMMENT=$P(AREQ0,U,18) I COMMENT'="" D
.S SDHL7IN("COMMENT")=COMMENT
;DISPOSITIONED BY
S SDHL7IN("DISPOSITION BY")=SDDUZ_U_$$GET1^DIQ(200,SDDUZ,.01,"E")
;MULTIPLE APPOINTMENT INFO
S SDHL7IN("NUMBER APPT")=$S(+$P(AREQ3,U,3)>0:$P(AREQ3,U,3),1:1)
I +$P(AREQ3,U,2)>0 D
.S SDHL7IN("INTERVAL")="Q"_+$P(AREQ3,U,2)_"D"
;DISCONTINUE
I DISPOTN=1 D
.S SDHL7IN("DISCONTINUE")=1
;#NLT#
S SDHL7IN("NLT")=$P(AREQ7,U,2)
;ORDER IEN
S SDHL7IN("ORDER IEN")=$P(AREQ7,U)
;PATIENT
S PATIEN=$P($G(AREQ0),U,1)
S SDHL7IN("PATIENT")=PATIEN_U_$$GET1^DIQ(2,PATIEN,.01,"E")
;PREREQ
S PRIEN=0 F S PRIEN=$O(^SDEC(409.85,ARIEN,8,PRIEN)) Q:PRIEN'>0 D
.S PR=$P($G(^SDEC(409.85,ARIEN,8,PRIEN,0)),U) Q:PR=""
.S SDHL7IN("PREREQ",PRIEN)=PR
;RTC DATE
S SDHL7IN("RTC DATE")=$P($G(AREQ0),U,16)
D EN^SDHL7BLD(.SDHL7IN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECHL7 1496 printed Nov 22, 2024@18:02:09 Page 2
SDECHL7 ;TUS/STAFF,LAB - VSE HL7 MESSAGING ;Mar 19,2024
+1 ;;5.3;Scheduling;**671,875**;Aug 13, 1993;Build 25
+2 ;
+3 QUIT
+4 ;
ARDISP(ARIEN,DISPOTN,SDDUZ) ;
+1 if (ARIEN?.N)=0
QUIT
+2 NEW SDHL7IN,RET,PRIEN,PR
+3 if $GET(SDDUZ)=""
SET SDDUZ=DUZ
+4 SET (SDHL7IN,RET)=""
+5 SET AREQ0=^SDEC(409.85,ARIEN,0)
+6 SET AREQ3=^SDEC(409.85,ARIEN,3)
+7 SET AREQ7=^SDEC(409.85,ARIEN,7)
+8 SET SDHL7IN("REQ FILE IEN")=ARIEN
+9 ;PARTIAL
+10 IF $PIECE(AREQ3,U,5)>0
SET SDHL7IN("PARTIAL")=1
+11 ;APPT TYPE
+12 SET APTYPEN=$PIECE(AREQ0,U,6)
IF APTYPEN'=""
Begin DoDot:1
+13 SET SDHL7IN("APPT TYPE")=$$GET1^DIQ(409.1,APTYPEN,.01,"E")
End DoDot:1
+14 ;CLINIC
+15 SET CLIEN=$PIECE(AREQ0,U,9)
IF CLIEN'=""
Begin DoDot:1
+16 SET SDHL7IN("CLINIC")=CLIEN_U_$$GET1^DIQ(44,CLIEN,.01,"E")
End DoDot:1
+17 ;COMMENT
+18 SET COMMENT=$PIECE(AREQ0,U,18)
IF COMMENT'=""
Begin DoDot:1
+19 SET SDHL7IN("COMMENT")=COMMENT
End DoDot:1
+20 ;DISPOSITIONED BY
+21 SET SDHL7IN("DISPOSITION BY")=SDDUZ_U_$$GET1^DIQ(200,SDDUZ,.01,"E")
+22 ;MULTIPLE APPOINTMENT INFO
+23 SET SDHL7IN("NUMBER APPT")=$SELECT(+$PIECE(AREQ3,U,3)>0:$PIECE(AREQ3,U,3),1:1)
+24 IF +$PIECE(AREQ3,U,2)>0
Begin DoDot:1
+25 SET SDHL7IN("INTERVAL")="Q"_+$PIECE(AREQ3,U,2)_"D"
End DoDot:1
+26 ;DISCONTINUE
+27 IF DISPOTN=1
Begin DoDot:1
+28 SET SDHL7IN("DISCONTINUE")=1
End DoDot:1
+29 ;#NLT#
+30 SET SDHL7IN("NLT")=$PIECE(AREQ7,U,2)
+31 ;ORDER IEN
+32 SET SDHL7IN("ORDER IEN")=$PIECE(AREQ7,U)
+33 ;PATIENT
+34 SET PATIEN=$PIECE($GET(AREQ0),U,1)
+35 SET SDHL7IN("PATIENT")=PATIEN_U_$$GET1^DIQ(2,PATIEN,.01,"E")
+36 ;PREREQ
+37 SET PRIEN=0
FOR
SET PRIEN=$ORDER(^SDEC(409.85,ARIEN,8,PRIEN))
if PRIEN'>0
QUIT
Begin DoDot:1
+38 SET PR=$PIECE($GET(^SDEC(409.85,ARIEN,8,PRIEN,0)),U)
if PR=""
QUIT
+39 SET SDHL7IN("PREREQ",PRIEN)=PR
End DoDot:1
+40 ;RTC DATE
+41 SET SDHL7IN("RTC DATE")=$PIECE($GET(AREQ0),U,16)
+42 DO EN^SDHL7BLD(.SDHL7IN)
+43 QUIT
