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

ORMBLDSD.m

Go to the documentation of this file.
  1. ORMBLDSD ; SLC/MKB - Build outgoing SCHEDULING ORM msgs ;01/09/18
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**434,475,377**;Dec 17, 1997;Build 582
  1. ;
  1. ;
  1. ;
  1. ESC(STR) ;
  1. Q $$ESC^ORHLESC(STR)
  1. ;
  1. HL7DATE(DATE) ; -- FM -> HL7 format
  1. Q $$FMTHL7^XLFDT(DATE) ;**97
  1. ;
  1. PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
  1. Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
  1. ;
  1. DC ;
  1. N OR0,ORDIALOG
  1. S OR0=$G(^OR(100,+IFN,0)) Q:'$L(OR0)
  1. S ORDIALOG=+$P(OR0,U,5) Q:'ORDIALOG
  1. D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(+IFN)
  1. D EN("DC")
  1. Q
  1. ;
  1. EN(CODE) ; -- Segments for new Scheduling order
  1. N A,ACT,DATEUPD,DAYS,ORNOW,APPTNUM,APPTINV,CLINIC,COMMENT,INC,INST,LOC,LOCSEG
  1. N NODE,OFFSET,ORIFN,ORDER,PREREQ,PKGREF,PTR,ROOM,RTCDATE,SEGCNT,START,TIME,VALUE
  1. N TEMP,WHOENTER,WHOSIGN,X0,X1,X2,X3,X8
  1. S ACT=$S(IFN[";":$P(IFN,";",2),1:1),DATEUPD=0
  1. S X0=$G(^OR(100,+IFN,0)),X3=$G(^OR(100,+IFN,3)),X8=$G(^OR(100,+IFN,8,ACT,0))
  1. S PKGREF=$P($G(^OR(100,+IFN,4)),U)
  1. S WHOSIGN=$P(X8,U,5)
  1. S WHOENTER=$P(X0,U,6)
  1. S WHOSIGN=$$WHOSIGN(X8)
  1. I WHOSIGN="" S WHOSIGN=WHOENTER
  1. ;I WHOSIGN'>0 S WHOSIGN=$P(X8,U,7)
  1. S WHOSIGN=WHOSIGN_U_$$GET1^DIQ(200,WHOSIGN,.01)
  1. S WHOENTER=WHOENTER_U_$$GET1^DIQ(200,WHOENTER,.01)
  1. I CODE'="DC" S ORDER=$P(ORMSG(4),"|",3) K ORMSG(4)
  1. S SEGCNT=$S(CODE="DC":3,1:4)
  1. S LOC=+$P(X0,U,10),LOCSEG=""
  1. I LOC>0 S LOCSEG=+LOC_":"_$$GET1^DIQ(44,LOC,.01)_U
  1. I $P($G(^SC(LOC,0)),U,3)="W" S LOCSEG=LOCSEG_$P($G(^DPT(+ORVP,.101)),U)
  1. S ORIFN=$S(IFN[";":IFN,1:IFN_";1")
  1. ;I PKGREF'>0,CODE="XO" D
  1. ;.S ORPREV=$P(X3,U,5) I ORPREV'>0 Q
  1. ;.S PKGREF=$P($G(^OR(100,ORPREV,4)),U)
  1. ;S ORMSG(SEGCNT)="ARQ|"_ORIFN_"^OR|"_PKGREF_"|||^followup^^^^|"_$S(CODE="DC":"S05",CODE="XO":"S03",1:"S01")_"||"
  1. S ORMSG(SEGCNT)="ARQ|"_ORIFN_"^OR|"_PKGREF_"|||^followup^^^^|"_$S(CODE="DC":"S05",1:"S01")_"||"
  1. S $P(ORMSG(1),"|",9)="SRM|"_ORIFN_U_$S(CODE="DC":"S05",CODE="XX":"S03",1:"S01")
  1. S A=$G(ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1))
  1. I A="T" S ORNOW=$$NOW^XLFDT() S A=$P(ORNOW,".")
  1. I A["+" D
  1. . S ORNOW=$$NOW^XLFDT()
  1. . S OFFSET=$$UP^XLFSTR($P(A,"+",2)) S DAYS=$S(OFFSET["W":+OFFSET*7,OFFSET["M":+OFFSET*30,1:+OFFSET)
  1. . S X1=$P(ORNOW,"."),X2=DAYS D C^%DTC S A=X_$S(A?1"N".E:"."_$P(ORNOW,"."),1:"")
  1. . ;S X1=$P(ORNOW,"."),X2=$P(A,"+",2) D C^%DTC S A=X_$S(A?1"N".E:"."_$P(ORNOW,"."),1:"")
  1. . S ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1)=A,DATEUPD=1
  1. S RTCDATE=$$HL7DATE(A)
  1. S START=$P(X0,U,8),TIME=$G(ORDIALOG($$PTR("YES/NO"),1))
  1. S ORMSG(SEGCNT)=ORMSG(SEGCNT)_$S(TIME=1:U_RTCDATE_"|T|",1:RTCDATE_U_"||")
  1. I +TIME=1 S ORLEAD="no later than ",ORTRAIL="",DATEUPD=1
  1. I +TIME=0 S ORLEAD="on or around (",ORTRAIL=")"
  1. S APPTNUM=$G(ORDIALOG($$PTR("APPT NUM"),1))
  1. S APPTINV=+$G(ORDIALOG($$PTR("SCH INTERVAL"),1))
  1. S ORMSG(SEGCNT)=ORMSG(SEGCNT)_$S(APPTINV>0:"Q"_APPTINV_"D",1:"")_"|"
  1. S ORMSG(SEGCNT)=ORMSG(SEGCNT)_APPTNUM_"|"
  1. S ORMSG(SEGCNT)=ORMSG(SEGCNT)_WHOSIGN_"||||"
  1. S ORMSG(SEGCNT)=ORMSG(SEGCNT)_WHOENTER_"||"
  1. S ORMSG(SEGCNT)=ORMSG(SEGCNT)_LOCSEG_"|||"
  1. S ORMSG(SEGCNT)=ORMSG(SEGCNT)_IFN_"|"_PKGREF_"|"
  1. AIL ;
  1. S SEGCNT=SEGCNT+1
  1. S CLINIC=$G(ORDIALOG($$PTR("LOCATION"),1))
  1. S CLINIC=CLINIC_U_$$GET1^DIQ(44,CLINIC,.01)
  1. S ORMSG(SEGCNT)="AIL|||"_CLINIC
  1. S PTR=$$PTR("PRE REQ")
  1. ;
  1. AIG ;
  1. S INST=0 F S INST=$O(ORDIALOG(PTR,INST)) Q:INST'>0 S PREREQ(INST)=ORDIALOG(PTR,INST)
  1. I $D(PREREQ) D
  1. .S SEGCNT=SEGCNT+1,INC=0
  1. .S INST=0 F S INST=$O(PREREQ(INST)) Q:INST'>0 D
  1. ..S INC=INC+1
  1. ..I INC=1 S ORMSG(SEGCNT)="AIG|"_INC_"|"_U_PREREQ(INST)_U_U_U_U_"|||||||||||" Q
  1. ..I INC>1 S ORMSG(SEGCNT,INC-1)="AIG|"_INC_"|"_U_PREREQ(INST)_U_U_U_U_"|||||||||||"
  1. NXT ;
  1. S COMMENT=$G(ORDIALOG($$PTR("SD COMMENT"),1))
  1. I COMMENT'="" S SEGCNT=SEGCNT+1,ORMSG(SEGCNT)="NTE|6|P|"_$$ESC(COMMENT)
  1. I DATEUPD=1 S ORIFN=+ORIFN K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ACT)
  1. Q
  1. WHOSIGN(X8) ;
  1. I $P(X8,U,5)>0 Q $P(X8,U,5)
  1. I $P(X8,U,7)>0 Q $P(X8,U,7)
  1. I $P(X8,U,3)>0 Q $P(X8,U,3)
  1. I $P(X8,U,17)>0 Q $P(X8,U,17)
  1. Q ""
  1. ;