- ORRCACK ;SLC/MKB - Result Acknowledgement file utilities ; 25 Jul 2003 9:31 AM
- ;;1.0;CARE MANAGEMENT;;Jul 15, 2003;Build 8
- ;
- ; ID = "ORR:"_order# everywhere below
- ;
- PARAM(PROV) ; -- Return ORRC ACTIVATION DATE parameter for PROV
- N SERV,Y S PROV=+$G(PROV),SERV=+$G(^VA(200,PROV,5))
- S Y=$$GET^XPAR("ALL^USR.`"_PROV_"^SRV.`"_SERV,"ORRC ACTIVATION DATE")
- Q Y
- ;
- ADD(ORDER,PROV,ACK) ; -- Create new entry in file #102.4 when results are posted
- ; [called from HL7 messages: ORMLR, ORMRA, ORMGMRC]
- Q:'$G(ORDER) N X,Y,DIC,DO,STOP
- I '$G(ACK),+$G(PROV) D Q:$G(STOP)
- . I $D(^ORA(102.4,"ACK",PROV,+$G(ORDER))) S STOP=1 Q ;exists
- . N ACTDT S ACTDT=$$PARAM(PROV)
- . I (ACTDT<1)!(ACTDT>DT) S STOP=1 Q ;not [yet] active
- S DIC="^ORA(102.4,",DIC(0)="" S:$G(PROV) DIC("DR")="2////"_+PROV
- S X=+ORDER D FILE^DICN
- Q
- ;
- ACK(ORY,ORUSR,ORDER) ; -- Acknowledge results of ORDERs by ORUSR
- ; where ORDER(#) = ID ^ 1 or 0, if acknowledged
- ; Returns ORY(#) = ID ^ 1 or 0, if successful
- ; RPC = ORRC RESULTS ACKNOWLEDGE
- Q:'$G(ORUSR) N X,Y,DA,DR,DIE,ORI,ORIFN,ORACK,ORXQ
- S DIE="^ORA(102.4,",ORUSR=+$G(ORUSR)
- S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" D
- . S X=ORDER(ORI),ORIFN=$P(X,U),ORACK=+$P(X,U,2)
- . S ORY(ORI)=ORIFN_"^0",ORIFN=+$P(ORIFN,":",2) Q:ORIFN<1
- . I '$D(^ORA(102.4,"ACK",+ORUSR,+ORIFN)) D ADD(ORIFN,ORUSR,1)
- . S DA=+$O(^ORA(102.4,"ACK",+ORUSR,+ORIFN,0)) Q:DA<1
- . S DR="3///"_$S(ORACK:"NOW",1:"@") D ^DIE
- . S $P(ORY(ORI),U,2)=1,ORXQ(+ORIFN)=""
- D:$D(ORXQ) RSLT^ORRCXQ(.ORXQ,ORUSR)
- Q
- ;
- DEL(DA) ; -- Delete old acknowledgment stub
- N DIK S DIK="^ORA(102.4,"
- I $G(DA),'$P($G(^ORA(102.4,DA,0)),U,3) D ^DIK
- Q
- ;
- PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has unack'd results
- ; in @ORY@(PAT) = #orders ^ 1 if any are abnormal
- ; @ORY@(PAT,ID) = * if abnormal, else null
- ; [from ORRCDPT]
- N ORIFN,PAT,ABN,X,CNT,ACTDT,RDT,ACK
- S ORUSR=+$G(ORUSR),ACTDT=$$PARAM(ORUSR)
- S ORY=$NA(^TMP($J,"ORRCRSLT")) K @ORY,^TMP($J,"ORSLT")
- S ORIFN=0 F S ORIFN=+$O(^ORA(102.4,"ACK",ORUSR,ORIFN)) Q:ORIFN<1 D
- . Q:+$P($G(^OR(100,ORIFN,3)),U,3)=9 ;partial results
- . S PAT=+$P($G(^OR(100,ORIFN,0)),U,2),RDT=+$G(^(7)),ABN=$P($G(^(7)),U,2)
- . I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",PAT)) Q ;pt not on list
- . I 'ACTDT!(RDT<ACTDT) S ACK=+$O(^ORA(102.4,"ACK",ORUSR,ORIFN,0)) D DEL(ACK) Q ;remove old stub
- . S X=$G(ORY(PAT)),CNT=+X
- . S CNT=CNT+1,@ORY@(PAT)=CNT_$S(ABN!$P(X,U,2):"^1",1:"")
- . S @ORY@(PAT,"ORR:"_ORIFN)=$S(ABN:"*",1:"")
- . D ORSLT ;temp xref for PATS^ORRCEVT
- Q
- ;
- ORSLT ; -- Add ORIFN to ^TMP($J,"ORSLT",PAT,pkgid) for use by Events
- N OR0,OR4,NMSP,X
- S OR0=$G(^OR(100,+ORIFN,0)),OR4=$G(^(4)),X=""
- S NMSP=$$NMSP^ORCD($P(OR0,U,14)) I NMSP="RA" D Q
- . N IDX S IDX="^RADPT(""AO"",+OR4,PAT)"
- . F S IDX=$Q(@IDX) Q:$P(IDX,",",2)'=+OR4 Q:$P(IDX,",",3)'=PAT S X=$P(IDX,",",4)_"~"_$P(IDX,",",5),^TMP($J,"ORSLT",PAT,X)=+ORIFN
- I NMSP="LR" S X=+ORIFN_"@OR"
- I NMSP="GMRC" S X=+OR4
- S:$L(X) ^TMP($J,"ORSLT",PAT,X)=+ORIFN
- Q
- ;
- IDS(ORY,ORPAT,ORUSR,SDATE,EDATE) ; -- Return new results for ORPAT
- ; between ORBEG & OREND that ORUSR has not acknowledged
- ; in @ORY@(ORPAT) = #orders ^ 1 if any are abnormal
- ; @ORY@(ORPAT,ID) = * if abnormal, else null
- ; [from ORRCDPT1]
- N CNT,ORIFN,ORDT,ABN,X
- S ORY=$NA(^TMP($J,"ORRCRSLT")) K @ORY
- S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)_";DPT(",CNT=0
- S SDATE=$G(SDATE),EDATE=$G(EDATE) D DT1 ;defaults ??
- S ORDT=SDATE F S ORDT=$O(^OR(100,"ARS",ORPAT,ORDT)) Q:ORDT<1 Q:ORDT>EDATE D
- . S ORIFN=0 F S ORIFN=+$O(^OR(100,"ARS",ORPAT,ORDT,ORIFN)) Q:ORIFN<1 D
- .. Q:+$P($G(^OR(100,ORIFN,3)),U,3)=9 ;partial results
- .. Q:$$ACKD(ORIFN,ORUSR) S CNT=CNT+1,X=$P($G(^OR(100,ORIFN,7)),U,2)
- .. S @ORY@(+ORPAT,"ORR:"_ORIFN)=$S(X:"*",1:"") S:X ABN=1
- S:CNT @ORY@(+ORPAT)=CNT_U_$G(ABN)
- Q
- ;
- LIST(ORY,ORUSR,ORPAT,ORSLT) ; -- Return orders by ORUSR for ORPAT with new results
- ; in @ORY@(#) = Item=ID^Text^ResultDate in HL7 format, and also if ORSLT
- ; = Data=Test^Value^Units^ReferenceRange^CriticalFlag
- ; = Cmnt=result comment
- ; or Text=line of report text
- ; RPC = ORRC RESULTS BY PATIENT
- N ORN,ORIFN,ORTX,ORDT
- S ORY=$NA(^TMP($J,"ORRCRSLT")) K @ORY
- S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT),ORN=0
- S ORIFN=0 F S ORIFN=+$O(^ORA(102.4,"ACK",ORUSR,ORIFN)) Q:ORIFN<1 I +$P($G(^OR(100,ORIFN,0)),U,2)=ORPAT D
- . Q:+$P($G(^OR(100,ORIFN,3)),U,3)=9 ;partial results
- . D TEXT^ORQ12(.ORTX,ORIFN) S ORDT=+$G(^OR(100,ORIFN,7))
- . S ORN=ORN+1,@ORY@(ORN)="Item=ORR:"_ORIFN_U_ORTX(1)_U_$$FMTHL7^XLFDT(ORDT)
- . I $G(ORSLT) D ORD ;add results data to ORY(#)
- ;S ORY(0)=CNT
- Q
- ;
- LISTD(ORY,ORPAT,ORUSR,ORBEG,OREND,ORSLT) ; -- Return new results for ORPAT
- ; between ORBEG & OREND that ORUSR has not acknowledged
- ; in @ORY@(#) = Item=ID^Text^ResultDate in HL7 format, and also if ORSLT
- ; = Data=Test^Value^Units^ReferenceRange^CriticalFlag
- ; = Cmnt=result comment
- ; or Text=line of report text
- ; RPC = ORRC RESULTS BY DATE
- N ORN,ORIFN,ORTX,ORDT,SDATE,EDATE
- S ORY=$NA(^TMP($J,"ORRCRSLT")) K @ORY
- S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)_";DPT(",ORN=0 D DATES
- S ORDT=SDATE F S ORDT=$O(^OR(100,"ARS",ORPAT,ORDT)) Q:ORDT<1 Q:ORDT>EDATE D
- . S ORIFN=0 F S ORIFN=+$O(^OR(100,"ARS",ORPAT,ORDT,ORIFN)) Q:ORIFN<1 D
- .. Q:+$P($G(^OR(100,ORIFN,3)),U,3)=9 ;partial results
- .. Q:$$ACKD(ORIFN,ORUSR) D TEXT^ORQ12(.ORTX,ORIFN)
- .. S ORN=ORN+1,@ORY@(ORN)="Item=ORR:"_ORIFN_U_ORTX(1)_U_$$FMTHL7^XLFDT(ORDT)
- .. I $G(ORSLT) D ORD ;add results data to ORY(#)
- Q
- ;
- DATES ; -- Return SDATE and EDATE from ORBEG and OREND
- ; [Inverted for rev-chron search]
- S SDATE=$$HL7TFM^XLFDT($G(ORBEG)),EDATE=$$HL7TFM^XLFDT($G(OREND))
- DT1 I EDATE S EDATE=$S($L(EDATE,".")=2:EDATE+.0001,1:EDATE+1)
- I SDATE S SDATE=$S($L(SDATE,".")=2:SDATE-.0001,1:SDATE)
- S SDATE=9999999-$S(SDATE:SDATE,1:0),EDATE=9999999-$S(EDATE:EDATE,1:9999998)
- S X=EDATE,EDATE=SDATE,SDATE=X
- Q
- ;
- ACKD(ORDER,USER) ; -- Returns 1 or 0, if USER has acknowledged ORDER
- N Y S Y=0
- S IFN=0 F S IFN=$O(^ORA(102.4,"B",+$G(ORDER),IFN)) Q:IFN<1 D Q:Y
- . S X=$G(^ORA(102.4,IFN,0)) I $P(X,U,3),$P(X,U,2)=+$G(USER) S Y=1 Q
- Q Y
- ;
- RESULT(ORY,ORDER) ; -- Return results of ORDERs
- ; where ORDER(#) = ID
- ; in @ORY@(#) = Item=ID^Text^ResultDate in HL7 format, and
- ; = Data=Test^Value^Units^ReferenceRange^CriticalFlag
- ; = Cmnt=result comment
- ; or Text=line of report text
- ; RPC = ORRC RESULTS BY ID
- N ORN,ORI,ORIFN,ORDT,ORTX
- S ORN=0,ORY=$NA(^TMP($J,"ORRCRSLT")) K @ORY
- S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" S ORIFN=ORDER(ORI) D
- . S ORIFN=+$P(ORIFN,":",2),ORDT=+$G(^OR(100,ORIFN,7))
- . D TEXT^ORQ12(.ORTX,ORIFN)
- . S ORN=ORN+1,@ORY@(ORN)="Item=ORR:"_ORIFN_U_ORTX(1)_U_$$FMTHL7^XLFDT(ORDT)
- . D ORD
- Q
- ;
- ORD ; -- Add results for ORIFN to @ORY@(ORN)
- N PKG Q:'+$G(ORIFN)
- S PKG=+$P($G(^OR(100,ORIFN,0)),U,14),PKG=$$NMSP^ORCD(PKG)
- I "^LR^RA^GMRC^"'[(U_PKG_U)!'ORIFN S ORY(1)="Text=No results available." Q ;DT??
- D @PKG
- Q
- LR ; -- Lab results
- N ORVP,LRID,LRTST,LRSUB,I,X K ^TMP("LRRR",$J)
- S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),LRID=$G(^(4))
- I '$L(LRID) S ORN=ORN+1,@ORY@(ORN)="Text=No results available." Q
- S X=$$VALUE^ORCSAVE2(ORIFN,"ORDERABLE"),LRTST=+$P($G(^ORD(101.43,+X,0)),U,2)
- I +LRID D RR^LR7OR1(+ORVP,LRID,,,,LRTST) I '$D(^TMP("LRRR",$J,+ORVP)) S $P(LRID,";",1,3)=";;" ;Order possibly purged, reset to lookup on file 63
- I '+LRID,$P(LRID,";",5) D RR^LR7OR1(+ORVP,,9999999-$P(LRID,";",5),9999999-$P(LRID,";",5),$P(LRID,";",4),LRTST)
- I '$D(^TMP("LRRR",$J,+ORVP)) S ORN=ORN+1,@ORY@(ORN)="Text=No results available." Q
- S LRSUB=$O(^TMP("LRRR",$J,+ORVP,"")) Q:LRSUB=""
- S LRDT=$O(^TMP("LRRR",$J,+ORVP,LRSUB,0)) I LRDT S LRDT=9999999-LRDT,$P(@ORY@(ORN),U,3)=$$FMTHL7^XLFDT(LRDT) ;return Coll Dt instead of Results Dt
- I LRSUB="CH" D K ^TMP("LRRR",$J) Q
- . N TEST,LRDT,LRN,LRI M TEST=^TMP("LRRR",$J,+ORVP,"CH")
- . S LRDT=0 F S LRDT=$O(TEST(LRDT)) Q:LRDT<1 S LRN=0 F S LRN=$O(TEST(LRDT,LRN)) Q:LRN="" D
- .. I LRN S I=$G(TEST(LRDT,LRN)),X=$P($G(^LAB(60,+I,0)),U)_U_$P(I,U,2)_U_$P(I,U,4,5)_U_$P(I,U,3) S ORN=ORN+1,@ORY@(ORN)="Data="_X
- .. I LRN="N" S LRI=0 F S LRI=$O(TEST(LRDT,LRN,LRI)) Q:LRI<1 S ORN=ORN+1,@ORY@(ORN)="Cmnt="_$G(TEST(LRDT,LRN,LRI))
- K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP):LRSUB="BB",EN^LR7OSMZ0(+ORVP):LRSUB="MI"
- S I=0 F S I=+$O(^TMP("LRC",$J,I)) Q:I<1 S X=$G(^(I,0)),ORN=ORN+1,@ORY@(ORN)="Text="_X
- K ^TMP("LRC",$J),^TMP("LRRR",$J)
- Q
- RA ; -- Radiology results
- N ORVP,RAID,CASE,PROC,PSET,FIRST
- S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),RAID=+$G(^(4)) D EN30^RAO7PC3(RAID)
- S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET")),FIRST=1
- I 'PSET S CASE=0 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D
- . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D XRPT
- I PSET S CASE=$O(^TMP($J,"RAE3",+ORVP,0)),PROC=$O(^(CASE,"")) D XRPT
- K ^TMP($J,"RAE3",+ORVP)
- Q
- XRPT ; -- body of report for CASE, PROC
- N ORD,X,I
- I 'FIRST S ORN=ORN+1,@ORY@(ORN)="Text="_$$REPEAT^XLFSTR(" * ",24)
- S ORD=$S($L($G(^TMP($J,"RAE3",+ORVP,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"") I $L(ORD),ORD'=PROC S ORN=ORN+1,@ORY@(ORN)="Text=Proc Ord: "_ORD
- S I=1 F S I=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC,I)) Q:I'>0 S X=^(I),ORN=ORN+1,@ORY@(ORN)="Text="_X ;Skip pt ID on line 1
- S FIRST=0
- Q
- GMRC ; -- Consult results
- N GMRCID,I,X,SUB S GMRCID=+$G(^OR(100,ORIFN,4)),SUB="RT" N ORIFN ;protect
- I '$D(^GMR(123,GMRCID,50,"B")),'$D(^GMR(123,GMRCID,51,"B")) S SUB="DT"
- D RT^GMRCGUIA(GMRCID,"^TMP(""GMRCR"",$J,""RT"")"):SUB="RT",DT^GMRCSLM2(GMRCID):SUB="DT"
- S I=0 F S I=$O(^TMP("GMRCR",$J,SUB,I)) Q:I'>0 S X=$G(^(I,0)),ORN=ORN+1,@ORY@(ORN)="Text="_X
- K ^TMP("GMRCR",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORRCACK 9797 printed Feb 18, 2025@23:07:34 Page 2
- ORRCACK ;SLC/MKB - Result Acknowledgement file utilities ; 25 Jul 2003 9:31 AM
- +1 ;;1.0;CARE MANAGEMENT;;Jul 15, 2003;Build 8
- +2 ;
- +3 ; ID = "ORR:"_order# everywhere below
- +4 ;
- PARAM(PROV) ; -- Return ORRC ACTIVATION DATE parameter for PROV
- +1 NEW SERV,Y
- SET PROV=+$GET(PROV)
- SET SERV=+$GET(^VA(200,PROV,5))
- +2 SET Y=$$GET^XPAR("ALL^USR.`"_PROV_"^SRV.`"_SERV,"ORRC ACTIVATION DATE")
- +3 QUIT Y
- +4 ;
- ADD(ORDER,PROV,ACK) ; -- Create new entry in file #102.4 when results are posted
- +1 ; [called from HL7 messages: ORMLR, ORMRA, ORMGMRC]
- +2 if '$GET(ORDER)
- QUIT
- NEW X,Y,DIC,DO,STOP
- +3 IF '$GET(ACK)
- IF +$GET(PROV)
- Begin DoDot:1
- +4 ;exists
- IF $DATA(^ORA(102.4,"ACK",PROV,+$GET(ORDER)))
- SET STOP=1
- QUIT
- +5 NEW ACTDT
- SET ACTDT=$$PARAM(PROV)
- +6 ;not [yet] active
- IF (ACTDT<1)!(ACTDT>DT)
- SET STOP=1
- QUIT
- End DoDot:1
- if $GET(STOP)
- QUIT
- +7 SET DIC="^ORA(102.4,"
- SET DIC(0)=""
- if $GET(PROV)
- SET DIC("DR")="2////"_+PROV
- +8 SET X=+ORDER
- DO FILE^DICN
- +9 QUIT
- +10 ;
- ACK(ORY,ORUSR,ORDER) ; -- Acknowledge results of ORDERs by ORUSR
- +1 ; where ORDER(#) = ID ^ 1 or 0, if acknowledged
- +2 ; Returns ORY(#) = ID ^ 1 or 0, if successful
- +3 ; RPC = ORRC RESULTS ACKNOWLEDGE
- +4 if '$GET(ORUSR)
- QUIT
- NEW X,Y,DA,DR,DIE,ORI,ORIFN,ORACK,ORXQ
- +5 SET DIE="^ORA(102.4,"
- SET ORUSR=+$GET(ORUSR)
- +6 SET ORI=""
- FOR
- SET ORI=$ORDER(ORDER(ORI))
- if ORI=""
- QUIT
- Begin DoDot:1
- +7 SET X=ORDER(ORI)
- SET ORIFN=$PIECE(X,U)
- SET ORACK=+$PIECE(X,U,2)
- +8 SET ORY(ORI)=ORIFN_"^0"
- SET ORIFN=+$PIECE(ORIFN,":",2)
- if ORIFN<1
- QUIT
- +9 IF '$DATA(^ORA(102.4,"ACK",+ORUSR,+ORIFN))
- DO ADD(ORIFN,ORUSR,1)
- +10 SET DA=+$ORDER(^ORA(102.4,"ACK",+ORUSR,+ORIFN,0))
- if DA<1
- QUIT
- +11 SET DR="3///"_$SELECT(ORACK:"NOW",1:"@")
- DO ^DIE
- +12 SET $PIECE(ORY(ORI),U,2)=1
- SET ORXQ(+ORIFN)=""
- End DoDot:1
- +13 if $DATA(ORXQ)
- DO RSLT^ORRCXQ(.ORXQ,ORUSR)
- +14 QUIT
- +15 ;
- DEL(DA) ; -- Delete old acknowledgment stub
- +1 NEW DIK
- SET DIK="^ORA(102.4,"
- +2 IF $GET(DA)
- IF '$PIECE($GET(^ORA(102.4,DA,0)),U,3)
- DO ^DIK
- +3 QUIT
- +4 ;
- PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has unack'd results
- +1 ; in @ORY@(PAT) = #orders ^ 1 if any are abnormal
- +2 ; @ORY@(PAT,ID) = * if abnormal, else null
- +3 ; [from ORRCDPT]
- +4 NEW ORIFN,PAT,ABN,X,CNT,ACTDT,RDT,ACK
- +5 SET ORUSR=+$GET(ORUSR)
- SET ACTDT=$$PARAM(ORUSR)
- +6 SET ORY=$NAME(^TMP($JOB,"ORRCRSLT"))
- KILL @ORY,^TMP($JOB,"ORSLT")
- +7 SET ORIFN=0
- FOR
- SET ORIFN=+$ORDER(^ORA(102.4,"ACK",ORUSR,ORIFN))
- if ORIFN<1
- QUIT
- Begin DoDot:1
- +8 ;partial results
- if +$PIECE($GET(^OR(100,ORIFN,3)),U,3)=9
- QUIT
- +9 SET PAT=+$PIECE($GET(^OR(100,ORIFN,0)),U,2)
- SET RDT=+$GET(^(7))
- SET ABN=$PIECE($GET(^(7)),U,2)
- +10 ;pt not on list
- IF $DATA(^TMP($JOB,"ORRCLST"))
- IF '$DATA(^TMP($JOB,"ORRCY",PAT))
- QUIT
- +11 ;remove old stub
- IF 'ACTDT!(RDT<ACTDT)
- SET ACK=+$ORDER(^ORA(102.4,"ACK",ORUSR,ORIFN,0))
- DO DEL(ACK)
- QUIT
- +12 SET X=$GET(ORY(PAT))
- SET CNT=+X
- +13 SET CNT=CNT+1
- SET @ORY@(PAT)=CNT_$SELECT(ABN!$PIECE(X,U,2):"^1",1:"")
- +14 SET @ORY@(PAT,"ORR:"_ORIFN)=$SELECT(ABN:"*",1:"")
- +15 ;temp xref for PATS^ORRCEVT
- DO ORSLT
- End DoDot:1
- +16 QUIT
- +17 ;
- ORSLT ; -- Add ORIFN to ^TMP($J,"ORSLT",PAT,pkgid) for use by Events
- +1 NEW OR0,OR4,NMSP,X
- +2 SET OR0=$GET(^OR(100,+ORIFN,0))
- SET OR4=$GET(^(4))
- SET X=""
- +3 SET NMSP=$$NMSP^ORCD($PIECE(OR0,U,14))
- IF NMSP="RA"
- Begin DoDot:1
- +4 NEW IDX
- SET IDX="^RADPT(""AO"",+OR4,PAT)"
- +5 FOR
- SET IDX=$QUERY(@IDX)
- if $PIECE(IDX,",",2)'=+OR4
- QUIT
- if $PIECE(IDX,",",3)'=PAT
- QUIT
- SET X=$PIECE(IDX,",",4)_"~"_$PIECE(IDX,",",5)
- SET ^TMP($JOB,"ORSLT",PAT,X)=+ORIFN
- End DoDot:1
- QUIT
- +6 IF NMSP="LR"
- SET X=+ORIFN_"@OR"
- +7 IF NMSP="GMRC"
- SET X=+OR4
- +8 if $LENGTH(X)
- SET ^TMP($JOB,"ORSLT",PAT,X)=+ORIFN
- +9 QUIT
- +10 ;
- IDS(ORY,ORPAT,ORUSR,SDATE,EDATE) ; -- Return new results for ORPAT
- +1 ; between ORBEG & OREND that ORUSR has not acknowledged
- +2 ; in @ORY@(ORPAT) = #orders ^ 1 if any are abnormal
- +3 ; @ORY@(ORPAT,ID) = * if abnormal, else null
- +4 ; [from ORRCDPT1]
- +5 NEW CNT,ORIFN,ORDT,ABN,X
- +6 SET ORY=$NAME(^TMP($JOB,"ORRCRSLT"))
- KILL @ORY
- +7 SET ORUSR=+$GET(ORUSR)
- SET ORPAT=+$GET(ORPAT)_";DPT("
- SET CNT=0
- +8 ;defaults ??
- SET SDATE=$GET(SDATE)
- SET EDATE=$GET(EDATE)
- DO DT1
- +9 SET ORDT=SDATE
- FOR
- SET ORDT=$ORDER(^OR(100,"ARS",ORPAT,ORDT))
- if ORDT<1
- QUIT
- if ORDT>EDATE
- QUIT
- Begin DoDot:1
- +10 SET ORIFN=0
- FOR
- SET ORIFN=+$ORDER(^OR(100,"ARS",ORPAT,ORDT,ORIFN))
- if ORIFN<1
- QUIT
- Begin DoDot:2
- +11 ;partial results
- if +$PIECE($GET(^OR(100,ORIFN,3)),U,3)=9
- QUIT
- +12 if $$ACKD(ORIFN,ORUSR)
- QUIT
- SET CNT=CNT+1
- SET X=$PIECE($GET(^OR(100,ORIFN,7)),U,2)
- +13 SET @ORY@(+ORPAT,"ORR:"_ORIFN)=$SELECT(X:"*",1:"")
- if X
- SET ABN=1
- End DoDot:2
- End DoDot:1
- +14 if CNT
- SET @ORY@(+ORPAT)=CNT_U_$GET(ABN)
- +15 QUIT
- +16 ;
- LIST(ORY,ORUSR,ORPAT,ORSLT) ; -- Return orders by ORUSR for ORPAT with new results
- +1 ; in @ORY@(#) = Item=ID^Text^ResultDate in HL7 format, and also if ORSLT
- +2 ; = Data=Test^Value^Units^ReferenceRange^CriticalFlag
- +3 ; = Cmnt=result comment
- +4 ; or Text=line of report text
- +5 ; RPC = ORRC RESULTS BY PATIENT
- +6 NEW ORN,ORIFN,ORTX,ORDT
- +7 SET ORY=$NAME(^TMP($JOB,"ORRCRSLT"))
- KILL @ORY
- +8 SET ORUSR=+$GET(ORUSR)
- SET ORPAT=+$GET(ORPAT)
- SET ORN=0
- +9 SET ORIFN=0
- FOR
- SET ORIFN=+$ORDER(^ORA(102.4,"ACK",ORUSR,ORIFN))
- if ORIFN<1
- QUIT
- IF +$PIECE($GET(^OR(100,ORIFN,0)),U,2)=ORPAT
- Begin DoDot:1
- +10 ;partial results
- if +$PIECE($GET(^OR(100,ORIFN,3)),U,3)=9
- QUIT
- +11 DO TEXT^ORQ12(.ORTX,ORIFN)
- SET ORDT=+$GET(^OR(100,ORIFN,7))
- +12 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=ORR:"_ORIFN_U_ORTX(1)_U_$$FMTHL7^XLFDT(ORDT)
- +13 ;add results data to ORY(#)
- IF $GET(ORSLT)
- DO ORD
- End DoDot:1
- +14 ;S ORY(0)=CNT
- +15 QUIT
- +16 ;
- LISTD(ORY,ORPAT,ORUSR,ORBEG,OREND,ORSLT) ; -- Return new results for ORPAT
- +1 ; between ORBEG & OREND that ORUSR has not acknowledged
- +2 ; in @ORY@(#) = Item=ID^Text^ResultDate in HL7 format, and also if ORSLT
- +3 ; = Data=Test^Value^Units^ReferenceRange^CriticalFlag
- +4 ; = Cmnt=result comment
- +5 ; or Text=line of report text
- +6 ; RPC = ORRC RESULTS BY DATE
- +7 NEW ORN,ORIFN,ORTX,ORDT,SDATE,EDATE
- +8 SET ORY=$NAME(^TMP($JOB,"ORRCRSLT"))
- KILL @ORY
- +9 SET ORUSR=+$GET(ORUSR)
- SET ORPAT=+$GET(ORPAT)_";DPT("
- SET ORN=0
- DO DATES
- +10 SET ORDT=SDATE
- FOR
- SET ORDT=$ORDER(^OR(100,"ARS",ORPAT,ORDT))
- if ORDT<1
- QUIT
- if ORDT>EDATE
- QUIT
- Begin DoDot:1
- +11 SET ORIFN=0
- FOR
- SET ORIFN=+$ORDER(^OR(100,"ARS",ORPAT,ORDT,ORIFN))
- if ORIFN<1
- QUIT
- Begin DoDot:2
- +12 ;partial results
- if +$PIECE($GET(^OR(100,ORIFN,3)),U,3)=9
- QUIT
- +13 if $$ACKD(ORIFN,ORUSR)
- QUIT
- DO TEXT^ORQ12(.ORTX,ORIFN)
- +14 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=ORR:"_ORIFN_U_ORTX(1)_U_$$FMTHL7^XLFDT(ORDT)
- +15 ;add results data to ORY(#)
- IF $GET(ORSLT)
- DO ORD
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- DATES ; -- Return SDATE and EDATE from ORBEG and OREND
- +1 ; [Inverted for rev-chron search]
- +2 SET SDATE=$$HL7TFM^XLFDT($GET(ORBEG))
- SET EDATE=$$HL7TFM^XLFDT($GET(OREND))
- DT1 IF EDATE
- SET EDATE=$SELECT($LENGTH(EDATE,".")=2:EDATE+.0001,1:EDATE+1)
- +1 IF SDATE
- SET SDATE=$SELECT($LENGTH(SDATE,".")=2:SDATE-.0001,1:SDATE)
- +2 SET SDATE=9999999-$SELECT(SDATE:SDATE,1:0)
- SET EDATE=9999999-$SELECT(EDATE:EDATE,1:9999998)
- +3 SET X=EDATE
- SET EDATE=SDATE
- SET SDATE=X
- +4 QUIT
- +5 ;
- ACKD(ORDER,USER) ; -- Returns 1 or 0, if USER has acknowledged ORDER
- +1 NEW Y
- SET Y=0
- +2 SET IFN=0
- FOR
- SET IFN=$ORDER(^ORA(102.4,"B",+$GET(ORDER),IFN))
- if IFN<1
- QUIT
- Begin DoDot:1
- +3 SET X=$GET(^ORA(102.4,IFN,0))
- IF $PIECE(X,U,3)
- IF $PIECE(X,U,2)=+$GET(USER)
- SET Y=1
- QUIT
- End DoDot:1
- if Y
- QUIT
- +4 QUIT Y
- +5 ;
- RESULT(ORY,ORDER) ; -- Return results of ORDERs
- +1 ; where ORDER(#) = ID
- +2 ; in @ORY@(#) = Item=ID^Text^ResultDate in HL7 format, and
- +3 ; = Data=Test^Value^Units^ReferenceRange^CriticalFlag
- +4 ; = Cmnt=result comment
- +5 ; or Text=line of report text
- +6 ; RPC = ORRC RESULTS BY ID
- +7 NEW ORN,ORI,ORIFN,ORDT,ORTX
- +8 SET ORN=0
- SET ORY=$NAME(^TMP($JOB,"ORRCRSLT"))
- KILL @ORY
- +9 SET ORI=""
- FOR
- SET ORI=$ORDER(ORDER(ORI))
- if ORI=""
- QUIT
- SET ORIFN=ORDER(ORI)
- Begin DoDot:1
- +10 SET ORIFN=+$PIECE(ORIFN,":",2)
- SET ORDT=+$GET(^OR(100,ORIFN,7))
- +11 DO TEXT^ORQ12(.ORTX,ORIFN)
- +12 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=ORR:"_ORIFN_U_ORTX(1)_U_$$FMTHL7^XLFDT(ORDT)
- +13 DO ORD
- End DoDot:1
- +14 QUIT
- +15 ;
- ORD ; -- Add results for ORIFN to @ORY@(ORN)
- +1 NEW PKG
- if '+$GET(ORIFN)
- QUIT
- +2 SET PKG=+$PIECE($GET(^OR(100,ORIFN,0)),U,14)
- SET PKG=$$NMSP^ORCD(PKG)
- +3 ;DT??
- IF "^LR^RA^GMRC^"'[(U_PKG_U)!'ORIFN
- SET ORY(1)="Text=No results available."
- QUIT
- +4 DO @PKG
- +5 QUIT
- LR ; -- Lab results
- +1 NEW ORVP,LRID,LRTST,LRSUB,I,X
- KILL ^TMP("LRRR",$JOB)
- +2 SET ORVP=$PIECE($GET(^OR(100,ORIFN,0)),U,2)
- SET LRID=$GET(^(4))
- +3 IF '$LENGTH(LRID)
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text=No results available."
- QUIT
- +4 SET X=$$VALUE^ORCSAVE2(ORIFN,"ORDERABLE")
- SET LRTST=+$PIECE($GET(^ORD(101.43,+X,0)),U,2)
- +5 ;Order possibly purged, reset to lookup on file 63
- IF +LRID
- DO RR^LR7OR1(+ORVP,LRID,,,,LRTST)
- IF '$DATA(^TMP("LRRR",$JOB,+ORVP))
- SET $PIECE(LRID,";",1,3)=";;"
- +6 IF '+LRID
- IF $PIECE(LRID,";",5)
- DO RR^LR7OR1(+ORVP,,9999999-$PIECE(LRID,";",5),9999999-$PIECE(LRID,";",5),$PIECE(LRID,";",4),LRTST)
- +7 IF '$DATA(^TMP("LRRR",$JOB,+ORVP))
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text=No results available."
- QUIT
- +8 SET LRSUB=$ORDER(^TMP("LRRR",$JOB,+ORVP,""))
- if LRSUB=""
- QUIT
- +9 ;return Coll Dt instead of Results Dt
- SET LRDT=$ORDER(^TMP("LRRR",$JOB,+ORVP,LRSUB,0))
- IF LRDT
- SET LRDT=9999999-LRDT
- SET $PIECE(@ORY@(ORN),U,3)=$$FMTHL7^XLFDT(LRDT)
- +10 IF LRSUB="CH"
- Begin DoDot:1
- +11 NEW TEST,LRDT,LRN,LRI
- MERGE TEST=^TMP("LRRR",$JOB,+ORVP,"CH")
- +12 SET LRDT=0
- FOR
- SET LRDT=$ORDER(TEST(LRDT))
- if LRDT<1
- QUIT
- SET LRN=0
- FOR
- SET LRN=$ORDER(TEST(LRDT,LRN))
- if LRN=""
- QUIT
- Begin DoDot:2
- +13 IF LRN
- SET I=$GET(TEST(LRDT,LRN))
- SET X=$PIECE($GET(^LAB(60,+I,0)),U)_U_$PIECE(I,U,2)_U_$PIECE(I,U,4,5)_U_$PIECE(I,U,3)
- SET ORN=ORN+1
- SET @ORY@(ORN)="Data="_X
- +14 IF LRN="N"
- SET LRI=0
- FOR
- SET LRI=$ORDER(TEST(LRDT,LRN,LRI))
- if LRI<1
- QUIT
- SET ORN=ORN+1
- SET @ORY@(ORN)="Cmnt="_$GET(TEST(LRDT,LRN,LRI))
- End DoDot:2
- End DoDot:1
- KILL ^TMP("LRRR",$JOB)
- QUIT
- +15 KILL ^TMP("LRC",$JOB)
- if LRSUB="BB"
- DO EN1^LR7OSBR(+ORVP)
- if LRSUB="MI"
- DO EN^LR7OSMZ0(+ORVP)
- +16 SET I=0
- FOR
- SET I=+$ORDER(^TMP("LRC",$JOB,I))
- if I<1
- QUIT
- SET X=$GET(^(I,0))
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text="_X
- +17 KILL ^TMP("LRC",$JOB),^TMP("LRRR",$JOB)
- +18 QUIT
- RA ; -- Radiology results
- +1 NEW ORVP,RAID,CASE,PROC,PSET,FIRST
- +2 SET ORVP=$PIECE($GET(^OR(100,ORIFN,0)),U,2)
- SET RAID=+$GET(^(4))
- DO EN30^RAO7PC3(RAID)
- +3 SET PSET=$DATA(^TMP($JOB,"RAE3",+ORVP,"PRINT_SET"))
- SET FIRST=1
- +4 IF 'PSET
- SET CASE=0
- FOR
- SET CASE=$ORDER(^TMP($JOB,"RAE3",+ORVP,CASE))
- if CASE'>0
- QUIT
- Begin DoDot:1
- +5 SET PROC=""
- FOR
- SET PROC=$ORDER(^TMP($JOB,"RAE3",+ORVP,CASE,PROC))
- if PROC=""
- QUIT
- DO XRPT
- End DoDot:1
- +6 IF PSET
- SET CASE=$ORDER(^TMP($JOB,"RAE3",+ORVP,0))
- SET PROC=$ORDER(^(CASE,""))
- DO XRPT
- +7 KILL ^TMP($JOB,"RAE3",+ORVP)
- +8 QUIT
- XRPT ; -- body of report for CASE, PROC
- +1 NEW ORD,X,I
- +2 IF 'FIRST
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text="_$$REPEAT^XLFSTR(" * ",24)
- +3 SET ORD=$SELECT($LENGTH($GET(^TMP($JOB,"RAE3",+ORVP,"ORD"))):^("ORD"),$LENGTH($GET(^("ORD",CASE))):^(CASE),1:"")
- IF $LENGTH(ORD)
- IF ORD'=PROC
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text=Proc Ord: "_ORD
- +4 ;Skip pt ID on line 1
- SET I=1
- FOR
- SET I=$ORDER(^TMP($JOB,"RAE3",+ORVP,CASE,PROC,I))
- if I'>0
- QUIT
- SET X=^(I)
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text="_X
- +5 SET FIRST=0
- +6 QUIT
- GMRC ; -- Consult results
- +1 ;protect
- NEW GMRCID,I,X,SUB
- SET GMRCID=+$GET(^OR(100,ORIFN,4))
- SET SUB="RT"
- NEW ORIFN
- +2 IF '$DATA(^GMR(123,GMRCID,50,"B"))
- IF '$DATA(^GMR(123,GMRCID,51,"B"))
- SET SUB="DT"
- +3 if SUB="RT"
- DO RT^GMRCGUIA(GMRCID,"^TMP(""GMRCR"",$J,""RT"")")
- if SUB="DT"
- DO DT^GMRCSLM2(GMRCID)
- +4 SET I=0
- FOR
- SET I=$ORDER(^TMP("GMRCR",$JOB,SUB,I))
- if I'>0
- QUIT
- SET X=$GET(^(I,0))
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text="_X
- +5 KILL ^TMP("GMRCR",$JOB)
- +6 QUIT