- ORRCEVT ; SLC/MKB,JFR - Event utilities ; 7/5/05 11:15
- ;;1.0;CARE MANAGEMENT;**2**;Jul 15, 2003
- ;
- ; ID = "VST:"_alertID (="OR,<dfn>,<nien><user><date.time>")
- ; or _apptID (="A;<date.time><hospital location><dfn>")
- ; or _visitID (="V;<date.time><hospital location><dfn>")
- ; or _procID (=order#)
- ;
- PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has ADT alerts
- ; in @ORY@(PAT) = #event alerts
- ; @ORY@(PAT,ID) = "" per alert
- ; [from ORRCDPT]
- N ORXQ,ORI,XQAID,PAT,NOT,X,ACTDT
- S ORY=$NA(^TMP($J,"ORRCEVT")) K @ORY
- S ORXQ=$NA(^TMP($J,"ORXQ")) K @ORXQ
- S ORUSR=+$G(ORUSR),ACTDT=$$PARAM^ORRCACK(ORUSR)
- D USER^XQALERT(ORXQ,ORUSR) Q:+$G(@ORXQ)<1
- S ORI=0 F S ORI=$O(@ORXQ@(ORI)) Q:ORI<1 S XQAID=$P(@ORXQ@(ORI),U,2) D
- . Q:XQAID'?1"OR,".E S PAT=+$P(XQAID,",",2),NOT=+$P(XQAID,",",3)
- . I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",PAT)) Q
- . I $D(^TMP($J,"ORRCLST")) D
- .. I "^18^19^20^35^36^"'[(U_NOT_U) D:'$$INCLD Q ;non-ADT alerts
- ... S ^TMP($J,"ORRCNOTF",PAT)=1
- .. S X=+$G(@ORY@(PAT)),@ORY@(PAT)=X+1,@ORY@(PAT,"VST:"_XQAID)=""
- . I '$D(^TMP($J,"ORRCLST")) D ; add pts to dynamic if other notifs
- .. I "^18^19^20^35^36^"'[(U_NOT_U) D:'$$INCLD Q ;non-ADT alerts
- ... S ^TMP($J,"ORRCNOTF",PAT)=1
- ... I '$D(^TMP($J,"ORRCY",PAT)) S ^TMP($J,"ORRCY",PAT)="" ; add patient
- .. S X=+$G(@ORY@(PAT)),@ORY@(PAT)=X+1,@ORY@(PAT,"VST:"_XQAID)=""
- K @ORXQ,^TMP($J,"ORSLT")
- Q
- ;
- INCLD() ; -- Order already in Results column?
- I "^3^14^21^22^23^24^25^53^57^58^"'[(U_NOT_U) Q 0
- I (ACTDT<1)!(ACTDT>DT) Q 0
- N X,DATE,DATA
- S DATE=$P(XQAID,";",3),DATA=$G(^XTV(8992,ORUSR,"XQA",DATE,1))
- S X=$P(DATA,"|") S:$L(X,"~")>2 X=$P(X,"~",2,3) I X="" Q 0
- I '$G(^TMP($J,"ORSLT",PAT,X)) Q 0
- Q 1
- ;
- IDS(ORY,ORPAT,ORBEG,OREND) ; -- Return appointments for ORPAT
- ; in @ORY@(ORPAT) = #appts
- ; @ORY@(ORPAT,ID) = "" per appt
- ; [from ORRCDPT1]
- N ORRCVST,ORVST,ORI,CNT,ID,ORDG,ORLIST,ORIFN,STS,STRT,ORDT
- S ORY=$NA(^TMP($J,"ORRCEVT")) K @ORY
- S ORPAT=+$G(ORPAT),ORBEG=$G(ORBEG),OREND=$G(OREND)
- D VST^ORWCV(.ORRCVST,ORPAT,ORBEG,OREND,1) ;=ID^FMdate^ClinicName^StatusName
- M ORVST=ORRCVST
- S (CNT,ORI)=0 F S ORI=$O(ORVST(ORI)) Q:ORI<1 D
- . S ID="VST:"_$P(ORVST(ORI),U)_";"_ORPAT
- . S CNT=CNT+1,@ORY@(ORPAT,ID)=""
- ;+scheduled Radiology procedures
- S ORDG=+$O(^ORD(100.98,"B","XRAY",0)),ORPAT=+ORPAT_";DPT("
- D EN^ORQ1(ORPAT,ORDG,2) S ORDT=$S($G(DT):DT,1:$P($$NOW^XLFDT,"."))
- S ORI=0 F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
- . S STS=$P($G(^OR(100,+ORIFN,3)),U,3),STRT=$P($G(^(0)),U,8)
- . Q:"^1^2^7^12^13^14^"[(U_STS_U) I STRT,STRT<ORDT Q ;done
- . S CNT=CNT+1,@ORY@(ORPAT,"VST:"_+ORIFN)=""
- S:CNT @ORY@(ORPAT)=CNT K ^TMP("ORR",$J,ORLIST)
- Q
- ;
- LIST(ORY,ORPAT,ORUSR,ORDET) ; -- Return alerted events to ORUSR for ORPAT
- ; in @ORY@(#) = Item=ID^Text^Date in HL7 format, and also if ORDET
- ; = Text=line of associated document text
- ; RPC = ORRC EVENTS BY PATIENT
- N ORXQ,ORN,I,XQAID,NOT,TEXT,DATE
- S ORXQ=$NA(^TMP($J,"ORXQ")) K @ORXQ D USER^XQALERT(ORXQ,+$G(ORUSR))
- S ORY=$NA(^TMP($J,"ORRCEVT")),ORN=0 K @ORY
- S I=0 F S I=$O(@ORXQ@(I)) Q:I<1 D
- . S TEXT=$P(@ORXQ@(I),U),XQAID=$P(@ORXQ@(I),U,2),DATE=$P(XQAID,";",3)
- . Q:XQAID'?1"OR,".E Q:+$P(XQAID,",",2)'=ORPAT
- . S NOT=+$P(XQAID,",",3) Q:"^18^19^20^35^36^"'[(U_NOT_U)
- . S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_XQAID_U_$E(TEXT,23,99)_U_$$FMTHL7^XLFDT(DATE)
- . I $G(ORDET) D NOTE
- K @ORXQ
- Q
- ;
- APPT(ORY,ORPAT,ORBEG,OREND,ORDET) ; -- Return past/future appointments
- ; in @ORY@(#) = Item=ID^Text^Date in HL7 format^Status, and also if ORDET
- ; = Text=line of associated document text
- ; RPC = ORRC APPTS BY PATIENT
- N ORN,ORVST,ORI,X,ID,LOC,DATE,VISIT,ORNOTE,ORJ,ORDG,ORLIST,ORIFN,ORNOW
- N STS,STRT,NOW,ORRCVST,ORRCNOTE
- S ORPAT=+$G(ORPAT),ORBEG=$$HL7TFM^XLFDT($G(ORBEG)),OREND=$$HL7TFM^XLFDT($G(OREND)),NOW=$$NOW^XLFDT
- D VST^ORWCV(.ORRCVST,ORPAT,ORBEG,OREND,1) ;=ID^FMdate^ClinicName^StatusName
- M ORVST=ORRCVST
- S ORY=$NA(^TMP($J,"ORRCAPPT")),ORN=0 K @ORY
- S ORI=0 F S ORI=$O(ORVST(ORI)) Q:ORI<1 D
- . S X=ORVST(ORI),DATE=$P(X,U,2)
- . S ID="VST:"_$P(X,U)_";"_ORPAT,LOC=+$P(ID,";",3)
- . S ORN=ORN+1,@ORY@(ORN)="Item="_ID_U_$P(X,U,3)_U_$$FMTHL7^XLFDT(DATE)_U_$P(X,U,4)
- . I $G(ORDET) D
- .. I DATE>NOW S ORN=ORN+1,@ORY@(ORN)="Text=Scheduled Appointment" Q
- .. I $G(^SC(LOC,"OOS")) S ORN=ORN+1,@ORY@(ORN)="Text=No note available" Q
- .. S VISIT=+$$GETENC^PXAPI(ORPAT,DATE,LOC) K ORNOTE
- .. D DETNOTE^ORQQVS(.ORRCNOTE,ORPAT,VISIT)
- .. M ORNOTE=ORRCNOTE
- .. S ORJ=0 F S ORJ=$O(ORNOTE(ORJ)) Q:ORJ<1 S ORN=ORN+1,@ORY@(ORN)="Text="_ORNOTE(ORJ)
- ;+future Radiology procedures in #100
- S ORDG=+$O(^ORD(100.98,"B","XRAY",0)),ORPAT=+ORPAT_";DPT("
- D EN^ORQ1(ORPAT,ORDG,2) S ORNOW=$$NOW^XLFDT
- S ORI=0 F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
- . S STS=$P($G(^OR(100,+ORIFN,3)),U,3),STRT=$P($G(^(0)),U,8)
- . Q:"^1^2^7^12^13^14^"[(U_STS_U) I STRT,STRT<ORNOW Q ;done
- . S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_+ORIFN_U_$$TXT^ORRCOR(+ORIFN)_U_$$FMTHL7^XLFDT(STRT)_U_$$STS^ORRCOR(+ORIFN)
- . I $G(ORDET) D ORD^ORRCOR
- K ^TMP("ORR",$J,ORLIST)
- Q
- ;
- TEXT(ORY,VISIT) ; -- Return associated document text of VISITs
- ; where VISIT(#) = ID
- ; in @ORY@(#) = Item=ID^Text^Date in HL7 format
- ; = Text=line of document text
- ; RPC = ORRC EVENTS BY ID
- N ORN,ORI,ID,XQAID,LOC,TEXT,DATE,VST,ORIFN,DFN,ORNOTE,ORRCNOTE,NOW
- S NOW=$$NOW^XLFDT,ORN=0,ORY=$NA(^TMP($J,"ORRCEVT")) K @ORY
- S ORI="" F S ORI=$O(VISIT(ORI)) Q:ORI="" S ID=$P(VISIT(ORI),":",2) D
- . I ID D Q ;order
- .. S DATE=$P($G(^OR(100,+ID,0)),U,8)
- .. S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_ID_U_$$TXT^ORRCOR(+ID)_U_$$FMTHL7^XLFDT(DATE)
- .. S ORIFN=ID D ORD^ORRCOR
- . I ID?1"OR,".E D Q ;alert
- .. S TEXT=$$MSGTXT^ORRCXQ(ID),DATE=+$P(ID,";",3)
- .. S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_ID_U_TEXT_U_$$FMTHL7^XLFDT(DATE)
- .. S XQAID=ID D NOTE
- . S DATE=$P(ID,";",2),LOC=+$P(ID,";",3),DFN=+$P(ID,";",4)
- . S ORN=ORN+1,@ORY@(ORN)="Item=VST:"_ID_U_$P($G(^SC(LOC,0)),U)_U_DATE
- . I DATE>NOW S ORN=ORN+1,@ORY@(ORN)="Text=Scheduled Appointment" Q
- . S VST=+$$GETENC^PXAPI(DFN,DATE,LOC) K ORNOTE,ORRCNOTE
- . D DETNOTE^ORQQVS(.ORRCNOTE,DFN,VST)
- . M ORNOTE=ORRCNOTE
- . S ORJ=0 F S ORJ=$O(ORNOTE(ORJ)) Q:ORJ<1 S ORN=ORN+1,@ORY@(ORN)="Text="_ORNOTE(ORJ)
- Q
- ;
- NOTE ; -- Add note text associated with event in alert XQAID to @ORY@(ORN)
- ; Expects TEXT,DATE from alert
- N DFN,NOT,VDT,VAIP,VAERR,LOC,VISIT,ORZ,ORI,ENC,X0,ORRCZ
- S DFN=+$P(XQAID,",",2),NOT=+$P(XQAID,",",3),VDT=$$MSGDT^ORRCXQ(DATE,TEXT)
- I NOT=20,TEXT?1"Died on ".E S ORN=ORN+1,@ORY@(ORN)="Text=No details available." Q
- I NOT=19 D ;Unsched visit
- . S LOC=0,VISIT=0 ;IA #2065
- . S ENC=0 F S ENC=$O(^SCE("ADFN",DFN,VDT,ENC)) Q:ENC<1 D Q:LOC
- .. S X0=$G(^SCE(ENC,0)) Q:$P(X0,U,6) Q:$P(X0,U,8)=1 ;not parent, appt
- .. Q:$G(^SC(+$P(X0,U,4),"OOS")) ;not OOS loc
- .. S LOC=+$P(X0,U,4),VISIT=+$P(X0,U,5)
- . S:VISIT<1 VISIT=+$$GETENC^PXAPI(DFN,VDT,LOC)
- . K ORZ D DETNOTE^ORQQVS(.ORRCZ,DFN,VISIT)
- . M ORZ=ORRCZ
- I NOT'=19 D ;inpt mvt
- . S VAIP("D")=$S(NOT=18!(NOT=36):DATE,1:VDT) D IN5^VADPT
- . S VDT=+VAIP(13,1),LOC=+$G(^DIC(42,+VAIP(13,4),44))
- . S VISIT=+$$GETENC^PXAPI(DFN,VDT,LOC)
- . K ORZ D DETSUM^ORQQVS(.ORRCZ,DFN,VISIT)
- . M ORZ=ORRCZ
- . K ^TMP("PXKENC",$J)
- S ORI=0 F S ORI=$O(ORZ(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)="Text="_ORZ(ORI)
- Q
- ;
- CLEAR(ORY,ORUSR,VISIT) ; -- Clear VISIT alerts for ORUSR
- ; where VISIT(#) = ID
- ; returns ORY(#) = ID ^ 1 or 0, if successful
- ; RPC = ORRC EVENTS ACKNOWLEDGE
- Q:'$G(ORUSR) N ORN,ORI,XQAID S ORN=0 K ORY
- S ORI="" F S ORI=$O(VISIT(ORI)) Q:ORI="" D
- . S XQAID=$P(VISIT(ORI),":",2)
- . D DELETE^ORRCXQ(XQAID)
- . S ORN=ORN+1,ORY(ORN)="VST:"_XQAID_"^1"
- Q
- ;
- TEST19(USR) ; -- Trigger Unsched Visit alert to test
- N XQA,XQAID,XQAMSG
- S XQA(USR)="",XQAID="OR,54,19",XQAMSG="CPRS,JOH (C1239): Unscheduled visit on OCT 14,1999@17:16:21"
- D SETUP^XQALERT
- Q
- ;
- TEST35(USR) ; -- Trigger Discharge alert to test
- N XQA,XQAID,XQAMSG
- S XQA(USR)="",XQAID="OR,?,35",XQAMSG="Discharged on ?"
- D SETUP^XQALERT
- Q
- ;
- TEST20(USR) ; -- Trigger Deceased alert to test
- N XQA,XQAID,XQAMSG
- S XQA(USR)="",XQAID="OR,91265,20",XQAMSG="CPRS,K (C8838): Died on AUG 31,1999"
- D SETUP^XQALERT
- Q
- ORRCEVT ; SLC/MKB,JFR - Event utilities ; 7/5/05 11:15
- +1 ;;1.0;CARE MANAGEMENT;**2**;Jul 15, 2003
- +2 ;
- +3 ; ID = "VST:"_alertID (="OR,<dfn>,<nien><user><date.time>")
- +4 ; or _apptID (="A;<date.time><hospital location><dfn>")
- +5 ; or _visitID (="V;<date.time><hospital location><dfn>")
- +6 ; or _procID (=order#)
- +7 ;
- PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has ADT alerts
- +1 ; in @ORY@(PAT) = #event alerts
- +2 ; @ORY@(PAT,ID) = "" per alert
- +3 ; [from ORRCDPT]
- +4 NEW ORXQ,ORI,XQAID,PAT,NOT,X,ACTDT
- +5 SET ORY=$NAME(^TMP($JOB,"ORRCEVT"))
- KILL @ORY
- +6 SET ORXQ=$NAME(^TMP($JOB,"ORXQ"))
- KILL @ORXQ
- +7 SET ORUSR=+$GET(ORUSR)
- SET ACTDT=$$PARAM^ORRCACK(ORUSR)
- +8 DO USER^XQALERT(ORXQ,ORUSR)
- IF +$GET(@ORXQ)<1
- QUIT
- +9 SET ORI=0
- FOR
- SET ORI=$ORDER(@ORXQ@(ORI))
- IF ORI<1
- QUIT
- SET XQAID=$PIECE(@ORXQ@(ORI),U,2)
- Begin DoDot:1
- +10 IF XQAID'?1"OR,".E
- QUIT
- SET PAT=+$PIECE(XQAID,",",2)
- SET NOT=+$PIECE(XQAID,",",3)
- +11 IF $DATA(^TMP($JOB,"ORRCLST"))
- IF '$DATA(^TMP($JOB,"ORRCY",PAT))
- QUIT
- +12 IF $DATA(^TMP($JOB,"ORRCLST"))
- Begin DoDot:2
- +13 ;non-ADT alerts
- IF "^18^19^20^35^36^"'[(U_NOT_U)
- IF '$$INCLD
- Begin DoDot:3
- +14 SET ^TMP($JOB,"ORRCNOTF",PAT)=1
- End DoDot:3
- QUIT
- +15 SET X=+$GET(@ORY@(PAT))
- SET @ORY@(PAT)=X+1
- SET @ORY@(PAT,"VST:"_XQAID)=""
- End DoDot:2
- +16 ; add pts to dynamic if other notifs
- IF '$DATA(^TMP($JOB,"ORRCLST"))
- Begin DoDot:2
- +17 ;non-ADT alerts
- IF "^18^19^20^35^36^"'[(U_NOT_U)
- IF '$$INCLD
- Begin DoDot:3
- +18 SET ^TMP($JOB,"ORRCNOTF",PAT)=1
- +19 ; add patient
- IF '$DATA(^TMP($JOB,"ORRCY",PAT))
- SET ^TMP($JOB,"ORRCY",PAT)=""
- End DoDot:3
- QUIT
- +20 SET X=+$GET(@ORY@(PAT))
- SET @ORY@(PAT)=X+1
- SET @ORY@(PAT,"VST:"_XQAID)=""
- End DoDot:2
- End DoDot:1
- +21 KILL @ORXQ,^TMP($JOB,"ORSLT")
- +22 QUIT
- +23 ;
- INCLD() ; -- Order already in Results column?
- +1 IF "^3^14^21^22^23^24^25^53^57^58^"'[(U_NOT_U)
- QUIT 0
- +2 IF (ACTDT<1)!(ACTDT>DT)
- QUIT 0
- +3 NEW X,DATE,DATA
- +4 SET DATE=$PIECE(XQAID,";",3)
- SET DATA=$GET(^XTV(8992,ORUSR,"XQA",DATE,1))
- +5 SET X=$PIECE(DATA,"|")
- IF $LENGTH(X,"~")>2
- SET X=$PIECE(X,"~",2,3)
- IF X=""
- QUIT 0
- +6 IF '$GET(^TMP($JOB,"ORSLT",PAT,X))
- QUIT 0
- +7 QUIT 1
- +8 ;
- IDS(ORY,ORPAT,ORBEG,OREND) ; -- Return appointments for ORPAT
- +1 ; in @ORY@(ORPAT) = #appts
- +2 ; @ORY@(ORPAT,ID) = "" per appt
- +3 ; [from ORRCDPT1]
- +4 NEW ORRCVST,ORVST,ORI,CNT,ID,ORDG,ORLIST,ORIFN,STS,STRT,ORDT
- +5 SET ORY=$NAME(^TMP($JOB,"ORRCEVT"))
- KILL @ORY
- +6 SET ORPAT=+$GET(ORPAT)
- SET ORBEG=$GET(ORBEG)
- SET OREND=$GET(OREND)
- +7 ;=ID^FMdate^ClinicName^StatusName
- DO VST^ORWCV(.ORRCVST,ORPAT,ORBEG,OREND,1)
- +8 MERGE ORVST=ORRCVST
- +9 SET (CNT,ORI)=0
- FOR
- SET ORI=$ORDER(ORVST(ORI))
- IF ORI<1
- QUIT
- Begin DoDot:1
- +10 SET ID="VST:"_$PIECE(ORVST(ORI),U)_";"_ORPAT
- +11 SET CNT=CNT+1
- SET @ORY@(ORPAT,ID)=""
- End DoDot:1
- +12 ;+scheduled Radiology procedures
- +13 SET ORDG=+$ORDER(^ORD(100.98,"B","XRAY",0))
- SET ORPAT=+ORPAT_";DPT("
- +14 DO EN^ORQ1(ORPAT,ORDG,2)
- SET ORDT=$SELECT($GET(DT):DT,1:$PIECE($$NOW^XLFDT,"."))
- +15 SET ORI=0
- FOR
- SET ORI=$ORDER(^TMP("ORR",$JOB,ORLIST,ORI))
- IF ORI<1
- QUIT
- SET ORIFN=^(ORI)
- Begin DoDot:1
- +16 SET STS=$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
- SET STRT=$PIECE($GET(^(0)),U,8)
- +17 ;done
- IF "^1^2^7^12^13^14^"[(U_STS_U)
- QUIT
- IF STRT
- IF STRT<ORDT
- QUIT
- +18 SET CNT=CNT+1
- SET @ORY@(ORPAT,"VST:"_+ORIFN)=""
- End DoDot:1
- +19 IF CNT
- SET @ORY@(ORPAT)=CNT
- KILL ^TMP("ORR",$JOB,ORLIST)
- +20 QUIT
- +21 ;
- LIST(ORY,ORPAT,ORUSR,ORDET) ; -- Return alerted events to ORUSR for ORPAT
- +1 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format, and also if ORDET
- +2 ; = Text=line of associated document text
- +3 ; RPC = ORRC EVENTS BY PATIENT
- +4 NEW ORXQ,ORN,I,XQAID,NOT,TEXT,DATE
- +5 SET ORXQ=$NAME(^TMP($JOB,"ORXQ"))
- KILL @ORXQ
- DO USER^XQALERT(ORXQ,+$GET(ORUSR))
- +6 SET ORY=$NAME(^TMP($JOB,"ORRCEVT"))
- SET ORN=0
- KILL @ORY
- +7 SET I=0
- FOR
- SET I=$ORDER(@ORXQ@(I))
- IF I<1
- QUIT
- Begin DoDot:1
- +8 SET TEXT=$PIECE(@ORXQ@(I),U)
- SET XQAID=$PIECE(@ORXQ@(I),U,2)
- SET DATE=$PIECE(XQAID,";",3)
- +9 IF XQAID'?1"OR,".E
- QUIT
- IF +$PIECE(XQAID,",",2)'=ORPAT
- QUIT
- +10 SET NOT=+$PIECE(XQAID,",",3)
- IF "^18^19^20^35^36^"'[(U_NOT_U)
- QUIT
- +11 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=VST:"_XQAID_U_$EXTRACT(TEXT,23,99)_U_$$FMTHL7^XLFDT(DATE)
- +12 IF $GET(ORDET)
- DO NOTE
- End DoDot:1
- +13 KILL @ORXQ
- +14 QUIT
- +15 ;
- APPT(ORY,ORPAT,ORBEG,OREND,ORDET) ; -- Return past/future appointments
- +1 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format^Status, and also if ORDET
- +2 ; = Text=line of associated document text
- +3 ; RPC = ORRC APPTS BY PATIENT
- +4 NEW ORN,ORVST,ORI,X,ID,LOC,DATE,VISIT,ORNOTE,ORJ,ORDG,ORLIST,ORIFN,ORNOW
- +5 NEW STS,STRT,NOW,ORRCVST,ORRCNOTE
- +6 SET ORPAT=+$GET(ORPAT)
- SET ORBEG=$$HL7TFM^XLFDT($GET(ORBEG))
- SET OREND=$$HL7TFM^XLFDT($GET(OREND))
- SET NOW=$$NOW^XLFDT
- +7 ;=ID^FMdate^ClinicName^StatusName
- DO VST^ORWCV(.ORRCVST,ORPAT,ORBEG,OREND,1)
- +8 MERGE ORVST=ORRCVST
- +9 SET ORY=$NAME(^TMP($JOB,"ORRCAPPT"))
- SET ORN=0
- KILL @ORY
- +10 SET ORI=0
- FOR
- SET ORI=$ORDER(ORVST(ORI))
- IF ORI<1
- QUIT
- Begin DoDot:1
- +11 SET X=ORVST(ORI)
- SET DATE=$PIECE(X,U,2)
- +12 SET ID="VST:"_$PIECE(X,U)_";"_ORPAT
- SET LOC=+$PIECE(ID,";",3)
- +13 SET ORN=ORN+1
- SET @ORY@(ORN)="Item="_ID_U_$PIECE(X,U,3)_U_$$FMTHL7^XLFDT(DATE)_U_$PIECE(X,U,4)
- +14 IF $GET(ORDET)
- Begin DoDot:2
- +15 IF DATE>NOW
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text=Scheduled Appointment"
- QUIT
- +16 IF $GET(^SC(LOC,"OOS"))
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text=No note available"
- QUIT
- +17 SET VISIT=+$$GETENC^PXAPI(ORPAT,DATE,LOC)
- KILL ORNOTE
- +18 DO DETNOTE^ORQQVS(.ORRCNOTE,ORPAT,VISIT)
- +19 MERGE ORNOTE=ORRCNOTE
- +20 SET ORJ=0
- FOR
- SET ORJ=$ORDER(ORNOTE(ORJ))
- IF ORJ<1
- QUIT
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text="_ORNOTE(ORJ)
- End DoDot:2
- End DoDot:1
- +21 ;+future Radiology procedures in #100
- +22 SET ORDG=+$ORDER(^ORD(100.98,"B","XRAY",0))
- SET ORPAT=+ORPAT_";DPT("
- +23 DO EN^ORQ1(ORPAT,ORDG,2)
- SET ORNOW=$$NOW^XLFDT
- +24 SET ORI=0
- FOR
- SET ORI=$ORDER(^TMP("ORR",$JOB,ORLIST,ORI))
- IF ORI<1
- QUIT
- SET ORIFN=^(ORI)
- Begin DoDot:1
- +25 SET STS=$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
- SET STRT=$PIECE($GET(^(0)),U,8)
- +26 ;done
- IF "^1^2^7^12^13^14^"[(U_STS_U)
- QUIT
- IF STRT
- IF STRT<ORNOW
- QUIT
- +27 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=VST:"_+ORIFN_U_$$TXT^ORRCOR(+ORIFN)_U_$$FMTHL7^XLFDT(STRT)_U_$$STS^ORRCOR(+ORIFN)
- +28 IF $GET(ORDET)
- DO ORD^ORRCOR
- End DoDot:1
- +29 KILL ^TMP("ORR",$JOB,ORLIST)
- +30 QUIT
- +31 ;
- TEXT(ORY,VISIT) ; -- Return associated document text of VISITs
- +1 ; where VISIT(#) = ID
- +2 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format
- +3 ; = Text=line of document text
- +4 ; RPC = ORRC EVENTS BY ID
- +5 NEW ORN,ORI,ID,XQAID,LOC,TEXT,DATE,VST,ORIFN,DFN,ORNOTE,ORRCNOTE,NOW
- +6 SET NOW=$$NOW^XLFDT
- SET ORN=0
- SET ORY=$NAME(^TMP($JOB,"ORRCEVT"))
- KILL @ORY
- +7 SET ORI=""
- FOR
- SET ORI=$ORDER(VISIT(ORI))
- IF ORI=""
- QUIT
- SET ID=$PIECE(VISIT(ORI),":",2)
- Begin DoDot:1
- +8 ;order
- IF ID
- Begin DoDot:2
- +9 SET DATE=$PIECE($GET(^OR(100,+ID,0)),U,8)
- +10 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=VST:"_ID_U_$$TXT^ORRCOR(+ID)_U_$$FMTHL7^XLFDT(DATE)
- +11 SET ORIFN=ID
- DO ORD^ORRCOR
- End DoDot:2
- QUIT
- +12 ;alert
- IF ID?1"OR,".E
- Begin DoDot:2
- +13 SET TEXT=$$MSGTXT^ORRCXQ(ID)
- SET DATE=+$PIECE(ID,";",3)
- +14 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=VST:"_ID_U_TEXT_U_$$FMTHL7^XLFDT(DATE)
- +15 SET XQAID=ID
- DO NOTE
- End DoDot:2
- QUIT
- +16 SET DATE=$PIECE(ID,";",2)
- SET LOC=+$PIECE(ID,";",3)
- SET DFN=+$PIECE(ID,";",4)
- +17 SET ORN=ORN+1
- SET @ORY@(ORN)="Item=VST:"_ID_U_$PIECE($GET(^SC(LOC,0)),U)_U_DATE
- +18 IF DATE>NOW
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text=Scheduled Appointment"
- QUIT
- +19 SET VST=+$$GETENC^PXAPI(DFN,DATE,LOC)
- KILL ORNOTE,ORRCNOTE
- +20 DO DETNOTE^ORQQVS(.ORRCNOTE,DFN,VST)
- +21 MERGE ORNOTE=ORRCNOTE
- +22 SET ORJ=0
- FOR
- SET ORJ=$ORDER(ORNOTE(ORJ))
- IF ORJ<1
- QUIT
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text="_ORNOTE(ORJ)
- End DoDot:1
- +23 QUIT
- +24 ;
- NOTE ; -- Add note text associated with event in alert XQAID to @ORY@(ORN)
- +1 ; Expects TEXT,DATE from alert
- +2 NEW DFN,NOT,VDT,VAIP,VAERR,LOC,VISIT,ORZ,ORI,ENC,X0,ORRCZ
- +3 SET DFN=+$PIECE(XQAID,",",2)
- SET NOT=+$PIECE(XQAID,",",3)
- SET VDT=$$MSGDT^ORRCXQ(DATE,TEXT)
- +4 IF NOT=20
- IF TEXT?1"Died on ".E
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text=No details available."
- QUIT
- +5 ;Unsched visit
- IF NOT=19
- Begin DoDot:1
- +6 ;IA #2065
- SET LOC=0
- SET VISIT=0
- +7 SET ENC=0
- FOR
- SET ENC=$ORDER(^SCE("ADFN",DFN,VDT,ENC))
- IF ENC<1
- QUIT
- Begin DoDot:2
- +8 ;not parent, appt
- SET X0=$GET(^SCE(ENC,0))
- IF $PIECE(X0,U,6)
- QUIT
- IF $PIECE(X0,U,8)=1
- QUIT
- +9 ;not OOS loc
- IF $GET(^SC(+$PIECE(X0,U,4),"OOS"))
- QUIT
- +10 SET LOC=+$PIECE(X0,U,4)
- SET VISIT=+$PIECE(X0,U,5)
- End DoDot:2
- IF LOC
- QUIT
- +11 IF VISIT<1
- SET VISIT=+$$GETENC^PXAPI(DFN,VDT,LOC)
- +12 KILL ORZ
- DO DETNOTE^ORQQVS(.ORRCZ,DFN,VISIT)
- +13 MERGE ORZ=ORRCZ
- End DoDot:1
- +14 ;inpt mvt
- IF NOT'=19
- Begin DoDot:1
- +15 SET VAIP("D")=$SELECT(NOT=18!(NOT=36):DATE,1:VDT)
- DO IN5^VADPT
- +16 SET VDT=+VAIP(13,1)
- SET LOC=+$GET(^DIC(42,+VAIP(13,4),44))
- +17 SET VISIT=+$$GETENC^PXAPI(DFN,VDT,LOC)
- +18 KILL ORZ
- DO DETSUM^ORQQVS(.ORRCZ,DFN,VISIT)
- +19 MERGE ORZ=ORRCZ
- +20 KILL ^TMP("PXKENC",$JOB)
- End DoDot:1
- +21 SET ORI=0
- FOR
- SET ORI=$ORDER(ORZ(ORI))
- IF ORI<1
- QUIT
- SET ORN=ORN+1
- SET @ORY@(ORN)="Text="_ORZ(ORI)
- +22 QUIT
- +23 ;
- CLEAR(ORY,ORUSR,VISIT) ; -- Clear VISIT alerts for ORUSR
- +1 ; where VISIT(#) = ID
- +2 ; returns ORY(#) = ID ^ 1 or 0, if successful
- +3 ; RPC = ORRC EVENTS ACKNOWLEDGE
- +4 IF '$GET(ORUSR)
- QUIT
- NEW ORN,ORI,XQAID
- SET ORN=0
- KILL ORY
- +5 SET ORI=""
- FOR
- SET ORI=$ORDER(VISIT(ORI))
- IF ORI=""
- QUIT
- Begin DoDot:1
- +6 SET XQAID=$PIECE(VISIT(ORI),":",2)
- +7 DO DELETE^ORRCXQ(XQAID)
- +8 SET ORN=ORN+1
- SET ORY(ORN)="VST:"_XQAID_"^1"
- End DoDot:1
- +9 QUIT
- +10 ;
- TEST19(USR) ; -- Trigger Unsched Visit alert to test
- +1 NEW XQA,XQAID,XQAMSG
- +2 SET XQA(USR)=""
- SET XQAID="OR,54,19"
- SET XQAMSG="CPRS,JOH (C1239): Unscheduled visit on OCT 14,1999@17:16:21"
- +3 DO SETUP^XQALERT
- +4 QUIT
- +5 ;
- TEST35(USR) ; -- Trigger Discharge alert to test
- +1 NEW XQA,XQAID,XQAMSG
- +2 SET XQA(USR)=""
- SET XQAID="OR,?,35"
- SET XQAMSG="Discharged on ?"
- +3 DO SETUP^XQALERT
- +4 QUIT
- +5 ;
- TEST20(USR) ; -- Trigger Deceased alert to test
- +1 NEW XQA,XQAID,XQAMSG
- +2 SET XQA(USR)=""
- SET XQAID="OR,91265,20"
- SET XQAMSG="CPRS,K (C8838): Died on AUG 31,1999"
- +3 DO SETUP^XQALERT
- +4 QUIT
