SDECHL7 ;TUS/STAFF - VSE HL7 MESSAGING ;4:17 PM 29 Jun 2017
;;5.3;Scheduling;**671**;Aug 13, 1993;Build 25
;
Q
;
ARDISP(ARIEN,DISPOTN) ;
Q:(ARIEN?.N)=0
N SDHL7IN,RET,PRIEN,PR
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")=DUZ_U_$$GET1^DIQ(200,DUZ,.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 1460 printed Jan 19, 2023@22:14:18 Page 2
SDECHL7 ;TUS/STAFF - VSE HL7 MESSAGING ;4:17 PM 29 Jun 2017
+1 ;;5.3;Scheduling;**671**;Aug 13, 1993;Build 25
+2 ;
+3 QUIT
+4 ;
ARDISP(ARIEN,DISPOTN) ;
+1 if (ARIEN?.N)=0
QUIT
+2 NEW SDHL7IN,RET,PRIEN,PR
+3 SET (SDHL7IN,RET)=""
+4 SET AREQ0=^SDEC(409.85,ARIEN,0)
+5 SET AREQ3=^SDEC(409.85,ARIEN,3)
+6 SET AREQ7=^SDEC(409.85,ARIEN,7)
+7 SET SDHL7IN("REQ FILE IEN")=ARIEN
+8 ;PARTIAL
+9 IF $PIECE(AREQ3,U,5)>0
SET SDHL7IN("PARTIAL")=1
+10 ;APPT TYPE
+11 SET APTYPEN=$PIECE(AREQ0,U,6)
IF APTYPEN'=""
Begin DoDot:1
+12 SET SDHL7IN("APPT TYPE")=$$GET1^DIQ(409.1,APTYPEN,.01,"E")
End DoDot:1
+13 ;CLINIC
+14 SET CLIEN=$PIECE(AREQ0,U,9)
IF CLIEN'=""
Begin DoDot:1
+15 SET SDHL7IN("CLINIC")=CLIEN_U_$$GET1^DIQ(44,CLIEN,.01,"E")
End DoDot:1
+16 ;COMMENT
+17 SET COMMENT=$PIECE(AREQ0,U,18)
IF COMMENT'=""
Begin DoDot:1
+18 SET SDHL7IN("COMMENT")=COMMENT
End DoDot:1
+19 ;DISPOSITIONED BY
+20 SET SDHL7IN("DISPOSITION BY")=DUZ_U_$$GET1^DIQ(200,DUZ,.01,"E")
+21 ;MULTIPLE APPOINTMENT INFO
+22 SET SDHL7IN("NUMBER APPT")=$SELECT(+$PIECE(AREQ3,U,3)>0:$PIECE(AREQ3,U,3),1:1)
+23 IF +$PIECE(AREQ3,U,2)>0
Begin DoDot:1
+24 SET SDHL7IN("INTERVAL")="Q"_+$PIECE(AREQ3,U,2)_"D"
End DoDot:1
+25 ;DISCONTINUE
+26 IF DISPOTN=1
Begin DoDot:1
+27 SET SDHL7IN("DISCONTINUE")=1
End DoDot:1
+28 ;#NLT#
+29 SET SDHL7IN("NLT")=$PIECE(AREQ7,U,2)
+30 ;ORDER IEN
+31 SET SDHL7IN("ORDER IEN")=$PIECE(AREQ7,U)
+32 ;PATIENT
+33 SET PATIEN=$PIECE($GET(AREQ0),U,1)
+34 SET SDHL7IN("PATIENT")=PATIEN_U_$$GET1^DIQ(2,PATIEN,.01,"E")
+35 ;PREREQ
+36 SET PRIEN=0
FOR
SET PRIEN=$ORDER(^SDEC(409.85,ARIEN,8,PRIEN))
if PRIEN'>0
QUIT
Begin DoDot:1
+37 SET PR=$PIECE($GET(^SDEC(409.85,ARIEN,8,PRIEN,0)),U)
if PR=""
QUIT
+38 SET SDHL7IN("PREREQ",PRIEN)=PR
End DoDot:1
+39 ;RTC DATE
+40 SET SDHL7IN("RTC DATE")=$PIECE($GET(AREQ0),U,16)
+41 DO EN^SDHL7BLD(.SDHL7IN)
+42 QUIT
