- 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 Feb 18, 2025@23:58:24 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 ;