Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECHL7

SDECHL7.m

Go to the documentation of this file.
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