ORMBLDSD ; SLC/MKB - Build outgoing SCHEDULING ORM msgs ;01/09/18
;;3.0;ORDER ENTRY/RESULTS REPORTING;**434,475,377**;Dec 17, 1997;Build 582
;
;
;
ESC(STR) ;
Q $$ESC^ORHLESC(STR)
;
HL7DATE(DATE) ; -- FM -> HL7 format
Q $$FMTHL7^XLFDT(DATE) ;**97
;
PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
;
DC ;
N OR0,ORDIALOG
S OR0=$G(^OR(100,+IFN,0)) Q:'$L(OR0)
S ORDIALOG=+$P(OR0,U,5) Q:'ORDIALOG
D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(+IFN)
D EN("DC")
Q
;
EN(CODE) ; -- Segments for new Scheduling order
N A,ACT,DATEUPD,DAYS,ORNOW,APPTNUM,APPTINV,CLINIC,COMMENT,INC,INST,LOC,LOCSEG
N NODE,OFFSET,ORIFN,ORDER,PREREQ,PKGREF,PTR,ROOM,RTCDATE,SEGCNT,START,TIME,VALUE
N TEMP,WHOENTER,WHOSIGN,X0,X1,X2,X3,X8
S ACT=$S(IFN[";":$P(IFN,";",2),1:1),DATEUPD=0
S X0=$G(^OR(100,+IFN,0)),X3=$G(^OR(100,+IFN,3)),X8=$G(^OR(100,+IFN,8,ACT,0))
S PKGREF=$P($G(^OR(100,+IFN,4)),U)
S WHOSIGN=$P(X8,U,5)
S WHOENTER=$P(X0,U,6)
S WHOSIGN=$$WHOSIGN(X8)
I WHOSIGN="" S WHOSIGN=WHOENTER
;I WHOSIGN'>0 S WHOSIGN=$P(X8,U,7)
S WHOSIGN=WHOSIGN_U_$$GET1^DIQ(200,WHOSIGN,.01)
S WHOENTER=WHOENTER_U_$$GET1^DIQ(200,WHOENTER,.01)
I CODE'="DC" S ORDER=$P(ORMSG(4),"|",3) K ORMSG(4)
S SEGCNT=$S(CODE="DC":3,1:4)
S LOC=+$P(X0,U,10),LOCSEG=""
I LOC>0 S LOCSEG=+LOC_":"_$$GET1^DIQ(44,LOC,.01)_U
I $P($G(^SC(LOC,0)),U,3)="W" S LOCSEG=LOCSEG_$P($G(^DPT(+ORVP,.101)),U)
S ORIFN=$S(IFN[";":IFN,1:IFN_";1")
;I PKGREF'>0,CODE="XO" D
;.S ORPREV=$P(X3,U,5) I ORPREV'>0 Q
;.S PKGREF=$P($G(^OR(100,ORPREV,4)),U)
;S ORMSG(SEGCNT)="ARQ|"_ORIFN_"^OR|"_PKGREF_"|||^followup^^^^|"_$S(CODE="DC":"S05",CODE="XO":"S03",1:"S01")_"||"
S ORMSG(SEGCNT)="ARQ|"_ORIFN_"^OR|"_PKGREF_"|||^followup^^^^|"_$S(CODE="DC":"S05",1:"S01")_"||"
S $P(ORMSG(1),"|",9)="SRM|"_ORIFN_U_$S(CODE="DC":"S05",CODE="XX":"S03",1:"S01")
S A=$G(ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1))
I A="T" S ORNOW=$$NOW^XLFDT() S A=$P(ORNOW,".")
I A["+" D
. S ORNOW=$$NOW^XLFDT()
. S OFFSET=$$UP^XLFSTR($P(A,"+",2)) S DAYS=$S(OFFSET["W":+OFFSET*7,OFFSET["M":+OFFSET*30,1:+OFFSET)
. S X1=$P(ORNOW,"."),X2=DAYS D C^%DTC S A=X_$S(A?1"N".E:"."_$P(ORNOW,"."),1:"")
. ;S X1=$P(ORNOW,"."),X2=$P(A,"+",2) D C^%DTC S A=X_$S(A?1"N".E:"."_$P(ORNOW,"."),1:"")
. S ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1)=A,DATEUPD=1
S RTCDATE=$$HL7DATE(A)
S START=$P(X0,U,8),TIME=$G(ORDIALOG($$PTR("YES/NO"),1))
S ORMSG(SEGCNT)=ORMSG(SEGCNT)_$S(TIME=1:U_RTCDATE_"|T|",1:RTCDATE_U_"||")
I +TIME=1 S ORLEAD="no later than ",ORTRAIL="",DATEUPD=1
I +TIME=0 S ORLEAD="on or around (",ORTRAIL=")"
S APPTNUM=$G(ORDIALOG($$PTR("APPT NUM"),1))
S APPTINV=+$G(ORDIALOG($$PTR("SCH INTERVAL"),1))
S ORMSG(SEGCNT)=ORMSG(SEGCNT)_$S(APPTINV>0:"Q"_APPTINV_"D",1:"")_"|"
S ORMSG(SEGCNT)=ORMSG(SEGCNT)_APPTNUM_"|"
S ORMSG(SEGCNT)=ORMSG(SEGCNT)_WHOSIGN_"||||"
S ORMSG(SEGCNT)=ORMSG(SEGCNT)_WHOENTER_"||"
S ORMSG(SEGCNT)=ORMSG(SEGCNT)_LOCSEG_"|||"
S ORMSG(SEGCNT)=ORMSG(SEGCNT)_IFN_"|"_PKGREF_"|"
AIL ;
S SEGCNT=SEGCNT+1
S CLINIC=$G(ORDIALOG($$PTR("LOCATION"),1))
S CLINIC=CLINIC_U_$$GET1^DIQ(44,CLINIC,.01)
S ORMSG(SEGCNT)="AIL|||"_CLINIC
S PTR=$$PTR("PRE REQ")
;
AIG ;
S INST=0 F S INST=$O(ORDIALOG(PTR,INST)) Q:INST'>0 S PREREQ(INST)=ORDIALOG(PTR,INST)
I $D(PREREQ) D
.S SEGCNT=SEGCNT+1,INC=0
.S INST=0 F S INST=$O(PREREQ(INST)) Q:INST'>0 D
..S INC=INC+1
..I INC=1 S ORMSG(SEGCNT)="AIG|"_INC_"|"_U_PREREQ(INST)_U_U_U_U_"|||||||||||" Q
..I INC>1 S ORMSG(SEGCNT,INC-1)="AIG|"_INC_"|"_U_PREREQ(INST)_U_U_U_U_"|||||||||||"
NXT ;
S COMMENT=$G(ORDIALOG($$PTR("SD COMMENT"),1))
I COMMENT'="" S SEGCNT=SEGCNT+1,ORMSG(SEGCNT)="NTE|6|P|"_$$ESC(COMMENT)
I DATEUPD=1 S ORIFN=+ORIFN K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ACT)
Q
WHOSIGN(X8) ;
I $P(X8,U,5)>0 Q $P(X8,U,5)
I $P(X8,U,7)>0 Q $P(X8,U,7)
I $P(X8,U,3)>0 Q $P(X8,U,3)
I $P(X8,U,17)>0 Q $P(X8,U,17)
Q ""
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMBLDSD 3987 printed Apr 09, 2024@21:29:45 Page 2
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
+2 ;
+3 ;
+4 ;
ESC(STR) ;
+1 QUIT $$ESC^ORHLESC(STR)
+2 ;
HL7DATE(DATE) ; -- FM -> HL7 format
+1 ;**97
QUIT $$FMTHL7^XLFDT(DATE)
+2 ;
PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
+1 QUIT $ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_NAME,1,63),0))
+2 ;
DC ;
+1 NEW OR0,ORDIALOG
+2 SET OR0=$GET(^OR(100,+IFN,0))
if '$LENGTH(OR0)
QUIT
+3 SET ORDIALOG=+$PIECE(OR0,U,5)
if 'ORDIALOG
QUIT
+4 DO GETDLG1^ORCD(ORDIALOG)
DO GETORDER^ORCD(+IFN)
+5 DO EN("DC")
+6 QUIT
+7 ;
EN(CODE) ; -- Segments for new Scheduling order
+1 NEW A,ACT,DATEUPD,DAYS,ORNOW,APPTNUM,APPTINV,CLINIC,COMMENT,INC,INST,LOC,LOCSEG
+2 NEW NODE,OFFSET,ORIFN,ORDER,PREREQ,PKGREF,PTR,ROOM,RTCDATE,SEGCNT,START,TIME,VALUE
+3 NEW TEMP,WHOENTER,WHOSIGN,X0,X1,X2,X3,X8
+4 SET ACT=$SELECT(IFN[";":$PIECE(IFN,";",2),1:1)
SET DATEUPD=0
+5 SET X0=$GET(^OR(100,+IFN,0))
SET X3=$GET(^OR(100,+IFN,3))
SET X8=$GET(^OR(100,+IFN,8,ACT,0))
+6 SET PKGREF=$PIECE($GET(^OR(100,+IFN,4)),U)
+7 SET WHOSIGN=$PIECE(X8,U,5)
+8 SET WHOENTER=$PIECE(X0,U,6)
+9 SET WHOSIGN=$$WHOSIGN(X8)
+10 IF WHOSIGN=""
SET WHOSIGN=WHOENTER
+11 ;I WHOSIGN'>0 S WHOSIGN=$P(X8,U,7)
+12 SET WHOSIGN=WHOSIGN_U_$$GET1^DIQ(200,WHOSIGN,.01)
+13 SET WHOENTER=WHOENTER_U_$$GET1^DIQ(200,WHOENTER,.01)
+14 IF CODE'="DC"
SET ORDER=$PIECE(ORMSG(4),"|",3)
KILL ORMSG(4)
+15 SET SEGCNT=$SELECT(CODE="DC":3,1:4)
+16 SET LOC=+$PIECE(X0,U,10)
SET LOCSEG=""
+17 IF LOC>0
SET LOCSEG=+LOC_":"_$$GET1^DIQ(44,LOC,.01)_U
+18 IF $PIECE($GET(^SC(LOC,0)),U,3)="W"
SET LOCSEG=LOCSEG_$PIECE($GET(^DPT(+ORVP,.101)),U)
+19 SET ORIFN=$SELECT(IFN[";":IFN,1:IFN_";1")
+20 ;I PKGREF'>0,CODE="XO" D
+21 ;.S ORPREV=$P(X3,U,5) I ORPREV'>0 Q
+22 ;.S PKGREF=$P($G(^OR(100,ORPREV,4)),U)
+23 ;S ORMSG(SEGCNT)="ARQ|"_ORIFN_"^OR|"_PKGREF_"|||^followup^^^^|"_$S(CODE="DC":"S05",CODE="XO":"S03",1:"S01")_"||"
+24 SET ORMSG(SEGCNT)="ARQ|"_ORIFN_"^OR|"_PKGREF_"|||^followup^^^^|"_$SELECT(CODE="DC":"S05",1:"S01")_"||"
+25 SET $PIECE(ORMSG(1),"|",9)="SRM|"_ORIFN_U_$SELECT(CODE="DC":"S05",CODE="XX":"S03",1:"S01")
+26 SET A=$GET(ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1))
+27 IF A="T"
SET ORNOW=$$NOW^XLFDT()
SET A=$PIECE(ORNOW,".")
+28 IF A["+"
Begin DoDot:1
+29 SET ORNOW=$$NOW^XLFDT()
+30 SET OFFSET=$$UP^XLFSTR($PIECE(A,"+",2))
SET DAYS=$SELECT(OFFSET["W":+OFFSET*7,OFFSET["M":+OFFSET*30,1:+OFFSET)
+31 SET X1=$PIECE(ORNOW,".")
SET X2=DAYS
DO C^%DTC
SET A=X_$SELECT(A?1"N".E:"."_$PIECE(ORNOW,"."),1:"")
+32 ;S X1=$P(ORNOW,"."),X2=$P(A,"+",2) D C^%DTC S A=X_$S(A?1"N".E:"."_$P(ORNOW,"."),1:"")
+33 SET ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1)=A
SET DATEUPD=1
End DoDot:1
+34 SET RTCDATE=$$HL7DATE(A)
+35 SET START=$PIECE(X0,U,8)
SET TIME=$GET(ORDIALOG($$PTR("YES/NO"),1))
+36 SET ORMSG(SEGCNT)=ORMSG(SEGCNT)_$SELECT(TIME=1:U_RTCDATE_"|T|",1:RTCDATE_U_"||")
+37 IF +TIME=1
SET ORLEAD="no later than "
SET ORTRAIL=""
SET DATEUPD=1
+38 IF +TIME=0
SET ORLEAD="on or around ("
SET ORTRAIL=")"
+39 SET APPTNUM=$GET(ORDIALOG($$PTR("APPT NUM"),1))
+40 SET APPTINV=+$GET(ORDIALOG($$PTR("SCH INTERVAL"),1))
+41 SET ORMSG(SEGCNT)=ORMSG(SEGCNT)_$SELECT(APPTINV>0:"Q"_APPTINV_"D",1:"")_"|"
+42 SET ORMSG(SEGCNT)=ORMSG(SEGCNT)_APPTNUM_"|"
+43 SET ORMSG(SEGCNT)=ORMSG(SEGCNT)_WHOSIGN_"||||"
+44 SET ORMSG(SEGCNT)=ORMSG(SEGCNT)_WHOENTER_"||"
+45 SET ORMSG(SEGCNT)=ORMSG(SEGCNT)_LOCSEG_"|||"
+46 SET ORMSG(SEGCNT)=ORMSG(SEGCNT)_IFN_"|"_PKGREF_"|"
AIL ;
+1 SET SEGCNT=SEGCNT+1
+2 SET CLINIC=$GET(ORDIALOG($$PTR("LOCATION"),1))
+3 SET CLINIC=CLINIC_U_$$GET1^DIQ(44,CLINIC,.01)
+4 SET ORMSG(SEGCNT)="AIL|||"_CLINIC
+5 SET PTR=$$PTR("PRE REQ")
+6 ;
AIG ;
+1 SET INST=0
FOR
SET INST=$ORDER(ORDIALOG(PTR,INST))
if INST'>0
QUIT
SET PREREQ(INST)=ORDIALOG(PTR,INST)
+2 IF $DATA(PREREQ)
Begin DoDot:1
+3 SET SEGCNT=SEGCNT+1
SET INC=0
+4 SET INST=0
FOR
SET INST=$ORDER(PREREQ(INST))
if INST'>0
QUIT
Begin DoDot:2
+5 SET INC=INC+1
+6 IF INC=1
SET ORMSG(SEGCNT)="AIG|"_INC_"|"_U_PREREQ(INST)_U_U_U_U_"|||||||||||"
QUIT
+7 IF INC>1
SET ORMSG(SEGCNT,INC-1)="AIG|"_INC_"|"_U_PREREQ(INST)_U_U_U_U_"|||||||||||"
End DoDot:2
End DoDot:1
NXT ;
+1 SET COMMENT=$GET(ORDIALOG($$PTR("SD COMMENT"),1))
+2 IF COMMENT'=""
SET SEGCNT=SEGCNT+1
SET ORMSG(SEGCNT)="NTE|6|P|"_$$ESC(COMMENT)
+3 IF DATEUPD=1
SET ORIFN=+ORIFN
KILL ^OR(100,ORIFN,4.5)
DO RESPONSE^ORCSAVE
DO ORDTEXT^ORCSAVE1(ORIFN_";"_ACT)
+4 QUIT
WHOSIGN(X8) ;
+1 IF $PIECE(X8,U,5)>0
QUIT $PIECE(X8,U,5)
+2 IF $PIECE(X8,U,7)>0
QUIT $PIECE(X8,U,7)
+3 IF $PIECE(X8,U,3)>0
QUIT $PIECE(X8,U,3)
+4 IF $PIECE(X8,U,17)>0
QUIT $PIECE(X8,U,17)
+5 QUIT ""
+6 ;
