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

ORB3.m

Go to the documentation of this file.
  1. ORB3 ;SLC/CLA,WAT,TC - MAIN ROUTINE FOR OE/RR 3 NOTIFICATIONS ;Nov 18, 2020@09:02:55
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,74,91,105,139,190,220,253,265,296,348,350,452,377,453**;Dec 17, 1997;Build 47
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;This routine invokes to following ICR(s):
  1. ;ICR 4156 ;REGISTRATION, COMBAT VETERAN STATUS
  1. ;ICR 5697 ;SCHEDULING, PCMM MHTC API's
  1. ;ICR 1252 ;Calls to SDUTL3
  1. ;ICR 1916 ;Call to SCAPMC
  1. ;ICR 5697 ;Call to SCMCMHTC
  1. EN(ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA,ORFORCE) ;
  1. ;
  1. N ORBENT
  1. S ORN=+$G(ORN)
  1. S ORBENT=$$ENTITY^ORB31($G(ORNUM))
  1. ;
  1. Q:$$GET^XPAR(ORBENT,"ORB SYSTEM ENABLE/DISABLE",1,"I")="D"
  1. Q:'$L($G(^ORD(100.9,ORN,0)))
  1. Q:+$$ONOFF^ORB3FN(ORN)=0
  1. ;
  1. ;add hook for smart
  1. N ORHOOK S ORHOOK=$$HOOK^ORBSMART(ORN,$G(ORBDFN),$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA))
  1. Q:ORHOOK
  1. ;
  1. ;if msg from notif file or oc notif (#54), quit if dup w/in past 1 min:
  1. N ORBDUP,ORBN
  1. S ORBN=^ORD(100.9,ORN,0)
  1. I ($P(ORBN,U,4)="NOT")!(ORN=54) D
  1. .S ORBDUP=$$DUP^ORB31(ORN,$G(ORBDFN),$G(ORBPMSG),$G(ORNUM))
  1. Q:+$G(ORBDUP)=1
  1. ;
  1. N ORBDESC
  1. S ORBDESC=" Send Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_" "
  1. ;
  1. N ORQUD S ORQUD=0
  1. I ORN=90 D START S ORQUD=1
  1. I ORQUD=0 D QUEUE^ORB31(ORN,$G(ORBDFN),$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$H,ORBDESC,$G(DGPMA),.ORFORCE)
  1. Q
  1. ZTSK ;
  1. D START
  1. S ZTREQ="@"
  1. Q
  1. UTL(ORBU,ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA,ORFORCE) ;
  1. Q:$G(ORBU)'=1
  1. START Q:$G(ORN)=""!($G(ORBDFN)="")
  1. Q:'$L($G(^ORD(100.9,ORN,0)))
  1. N ORBNOW,ORBID,ORBLOCK,ORBDESC
  1. S ORBNOW=$$NOW^XLFDT
  1. S ORBLOCK=0
  1. ;
  1. ;lock to prevent concurrent processing by other resource slots:
  1. I '$D(ORBU) D
  1. .S ^XTMP("ORBLOCK",0)=$$FMADD^XLFDT(ORBNOW,1,"","","")_U_ORBNOW
  1. .S ORBID=$P($P($G(ORBPDATA),"|",2),"@") ;get unique data id
  1. .I $L(ORBID) D
  1. ..LOCK +^XTMP("ORBLOCK",ORBDFN,ORN,ORBID):60 E D Q
  1. ...S ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_" "
  1. ...D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$$HADD^XLFDT($H,"","",5,""),ORBDESC,$G(DGPMA),.ORFORCE) ;requeue in 5 min.
  1. ...S ORBLOCK=1
  1. .;
  1. .I '$L(ORBID) D
  1. ..LOCK +^XTMP("ORBLOCK",ORBDFN,ORN):60 E D Q
  1. ...S ORBDESC=" Requeue Alert Notification ("_(+ORN)_") "_$P($G(^ORD(100.9,+ORN,0)),U,1)_" "
  1. ...D QUEUE^ORB31(ORN,ORBDFN,$G(ORNUM),.ORBADUZ,$G(ORBPMSG),$G(ORBPDATA),$$HADD^XLFDT($H,"","",5,""),ORBDESC,$G(DGPMA),.ORFORCE) ;requeue in 5 min.
  1. ...S ORBLOCK=1
  1. .;
  1. I ORBLOCK=1 D QUIT Q
  1. ;
  1. DOALERT ; Entry point for alert logic outside of TaskMan
  1. N ORBDUZ,ORBN,ORBXQAID,ORPTNAM,ORBPRIM,ORBATTD,ORBDEV,ORBENT
  1. N ORBUI,ORBASPEC,ORBSMSG,ORBADT,ORBSDEV,ORBDEL,ORBDI,ORBTDEV,ORY
  1. N ORBIDX,ORBFLAGS
  1. S ORBUI=1,ORBADT=0
  1. S:'$L($G(ORBPMSG)) ORBPMSG=""
  1. I '$L(ORBPDATA),(+$G(ORNUM)>0) S ORBPDATA=+$G(ORNUM)_"@"
  1. S ORBN=^ORD(100.9,ORN,0)
  1. S ORBIDX=0 F S ORBIDX=$O(^ORD(100.9,ORN,5,ORBIDX)) Q:'ORBIDX D
  1. .S ORBFLAGS=$P($G(^ORD(100.9,ORN,5,ORBIDX,0)),U)
  1. .S:ORBFLAGS'="" ORBFLAGS(ORBFLAGS)="",ORBFLAGS=""
  1. ;
  1. S ORBENT=$$ENTITY^ORB31(ORNUM)
  1. ;
  1. N DFN S DFN=ORBDFN,VA200="" D OERR^VADPT
  1. I ('$L($G(VA("BID"))))!('$L($G(VADM(1)))) D QUIT Q
  1. I (ORN=18)!(ORN=20)!(ORN=35) S ORBADT=1 ;A/D/T notif
  1. ;if not an A/D/T notif, get primary & attending from OERR^VADPT:
  1. I ORBADT=0 S ORBPRIM=+$P(VAIN(2),U),ORBATTD=+$P(VAIN(11),U)
  1. I ORBADT=1 D ADT^ORB31(ORN,ORBDFN,.ORBPRIM,.ORBATTD,$G(ORDGPMA)) ;A/D/T notif
  1. I $D(ORBU) D ;create debug msg
  1. .S ORBU(ORBUI)="Processing notification: "_$P(ORBN,U),ORBUI=ORBUI+1
  1. .S ORBU(ORBUI)=" for patient: "_VADM(1),ORBUI=ORBUI+1
  1. .I $G(ORNUM)>0 S ORBU(ORBUI)=" for order: "_ORNUM,ORBUI=ORBUI+1
  1. D REGULAR^ORB3REG(ORN,.XQA,.ORBU,.ORBUI,.ORBDEV,ORBDFN)
  1. D SPECIAL^ORB3SPEC(ORN,.ORBASPEC,.ORBU,.ORBUI,$G(ORNUM),ORBDFN,$G(ORBPDATA),.ORBSMSG,$G(ORBPMSG),.ORBSDEV,$G(ORBPRIM),$G(ORBATTD))
  1. I $D(ORBASPEC)>1 D SPECDUZS ;special recips
  1. I $D(ORBADUZ)>1 D PKGDUZS ;pkg-supplied recips
  1. D TITLE ;provider recips
  1. S ORBXQAID=$P(ORBN,U,2)_","_ORBDFN_","_ORN
  1. ;
  1. I ($D(XQA)>1)!($D(ORBDEV)>1)!($D(ORBSDEV)>1) D ;recips found
  1. .S XQAFLG=$P(ORBN,U,5)
  1. .S XQADFN=ORBDFN
  1. .I XQAFLG="R" S XQAROU=$P(ORBN,U,6)_U_$P(ORBN,U,7)
  1. .I $G(ORBPDATA)'="" S XQADATA=ORBPDATA
  1. .S ORPTNAM=$E(VADM(1)_" ",1,9)
  1. .I $G(ORN)=27 N CVMRKR,RSLT S RSLT=$$CVEDT^DGCV(DFN) I $P($G(RSLT),U)&($P($G(RSLT),U,3)) S CVMRKR=" CV "_$$FMTE^XLFDT($P($G(RSLT),U,2),"5DZ") ;WAT
  1. .S XQAMSG=ORPTNAM_" ("_$E(ORPTNAM)_$E(VA("BID"),1,4)_")"_$G(CVMRKR)_": " ;WAT
  1. .S XQAMSG=XQAMSG_$S(ORBPMSG'="":ORBPMSG,1:$P(ORBN,U,3))
  1. .S XQAARCH=$$GET^XPAR(ORBENT,"ORB ARCHIVE PERIOD",ORN,"I")
  1. .S XQASUPV=$$GET^XPAR(ORBENT,"ORB FORWARD SUPERVISOR",ORN,"I")
  1. .S XQASURO=$$GET^XPAR(ORBENT,"ORB FORWARD SURROGATES",ORN,"I")
  1. .S XQAREVUE=$$GET^XPAR(ORBENT,"ORB FORWARD BACKUP REVIEWER",ORN,"I")
  1. .S XQACNDEL=$$GET^XPAR(ORBENT,"ORB REMOVE",ORN,"I")
  1. .S XQACNDEL=$S(XQACNDEL=1:1,1:"")
  1. .I ORN=90 M XQATEXT=ORBPMSG
  1. .I $D(ORBDEV)>1 D REGDEV^ORB31(.ORBDEV)
  1. .I $D(ORBSDEV)>1 D REGDEV^ORB31(.ORBSDEV)
  1. .I $D(ORBTDEV)>1 D REGDEV^ORB31(.ORBTDEV)
  1. .S XQAID=ORBXQAID
  1. .I $D(ORBFLAGS("ONPP")) D COMDUP
  1. .I $D(XQA) D SETUP^XQALERT ;if no [new] recips don't send alert
  1. QUIT ;
  1. K VA,VA200,VADM,VAERR,VAIN,XQA,XQADATA,XQAID,XQAFLG,XQAMSG,XQAROU,XQAARCH,XQASUPV,XQASURO,XQADFN,XQACNDEL,XQAREVUE
  1. K ^XTMP("ORBUSER",$J)
  1. I '$D(ORBU),$D(ORBLOCK) D
  1. .I $G(ORBID)]"" LOCK -^XTMP("ORBLOCK",ORBDFN,ORN,ORBID)
  1. .E LOCK -^XTMP("ORBLOCK",ORBDFN,ORN)
  1. Q
  1. PKGDUZS ;get DUZs from pkg-passed ORBADUZ() array
  1. N ORBPDUZ
  1. I $D(ORBU) D
  1. .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
  1. .I ORN=68 S ORBU(ORBUI)="Recipients with Lab Threshold Exceeded:",ORBUI=ORBUI+1
  1. .E S ORBU(ORBUI)="Recipients defined when notif was triggered:",ORBUI=ORBUI+1
  1. S ORBPDUZ=""
  1. F S ORBPDUZ=$O(ORBADUZ(ORBPDUZ)) Q:ORBPDUZ="" S ORBDUZ=ORBPDUZ D USER
  1. Q
  1. SPECDUZS ;get DUZs rtn by SPECIAL^ORB3SPEC
  1. N ORBSDUZ
  1. I $D(ORBU) D
  1. .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
  1. .S ORBU(ORBUI)="Special recipients associated with the notification:",ORBUI=ORBUI+1
  1. S ORBSDUZ=""
  1. F S ORBSDUZ=$O(ORBASPEC(ORBSDUZ)) Q:ORBSDUZ="" S ORBDUZ=ORBSDUZ D USER
  1. Q
  1. TITLE ;get provider recips
  1. N TITLES
  1. I $D(ORBU) D
  1. .S ORBU(ORBUI)=" ",ORBUI=ORBUI+1
  1. .S ORBU(ORBUI)="Recipients determined by Provider Recipient parameter:",ORBUI=ORBUI+1
  1. ;
  1. S TITLES=$$GET^XPAR(ORBENT,"ORB PROVIDER RECIPIENTS",ORN,"I")
  1. I TITLES["O" D ORDERER
  1. I TITLES["P" D PRIMARY
  1. I TITLES["A" D ATTEND
  1. I TITLES["T" D TEAMS
  1. I TITLES["E" D ENTERBY
  1. I TITLES["R" D PCMMPRIM
  1. I TITLES["S" D PCMMASSC
  1. I TITLES["M" D PCMMTEAM
  1. I TITLES["C" D PCMMMHTC
  1. Q
  1. PRIMARY ;
  1. I $D(ORBU),ORBADT=0 S ORBU(ORBUI)=" Inpt primary provider:",ORBUI=ORBUI+1
  1. I $D(ORBU),ORBADT=1 S ORBU(ORBUI)=" Inpt primary provider: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
  1. I +$G(ORBPRIM)>0 S ORBDUZ=ORBPRIM D USER
  1. Q
  1. ATTEND ;
  1. I $D(ORBU),ORBADT=0 S ORBU(ORBUI)=" Attending physician:",ORBUI=ORBUI+1
  1. I $D(ORBU),ORBADT=1 S ORBU(ORBUI)=" Attending physician: option cannot determine without A/D/T event data.",ORBUI=ORBUI+1
  1. I +$G(ORBATTD)>0 S ORBDUZ=ORBATTD D USER
  1. Q
  1. TEAMS ;
  1. I $D(ORBU) S ORBU(ORBUI)=" Teams/Personal Lists related to patient:",ORBUI=ORBUI+1
  1. N ORBLST,ORBI,ORBJ,ORBTM,ORBTNAME,ORBTTYPE,ORBTD
  1. D TMSPT^ORQPTQ1(.ORBLST,ORBDFN)
  1. Q:+$G(ORBLST(1))<1
  1. S ORBI="" F S ORBI=$O(ORBLST(ORBI)) Q:ORBI="" D
  1. .S ORBTM=$P(ORBLST(ORBI),U),ORBTNAME=$P(ORBLST(ORBI),U,2)
  1. .S ORBTTYPE=$P(ORBLST(ORBI),U,3)
  1. .I $D(ORBU) D
  1. ..S ORBU(ORBUI)=" Patient list "_ORBTNAME_" ["_ORBTTYPE_"]:",ORBUI=ORBUI+1
  1. .N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBTM)
  1. .Q:+$G(ORBLST2(1))<1
  1. .S ORBJ="" F S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ="" D
  1. ..S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBTM I +$G(ORBDUZ)>0 D USER
  1. .;
  1. .S ORBTD=$P($$TMDEV^ORB31(ORBTM),U,2) ;Team's device
  1. .I $L(ORBTD) D
  1. ..S ORBTDEV(ORBTD)=""
  1. ..I $D(ORBU) D
  1. ...S ORBU(ORBUI)=" Team's Device "_ORBTD_" is a recipient",ORBUI=ORBUI+1
  1. Q
  1. ORDERER ;
  1. Q:+$G(ORNUM)<1
  1. I $D(ORBU) S ORBU(ORBUI)=" Ordering provider:",ORBUI=ORBUI+1
  1. N ORBLST,ORBI,ORBTM,ORBJ,ORBTNAME,ORBPLST,ORBPI,ORBPTM,ORBTTYPE
  1. S ORBDUZ=$S(ORN=12:+$$UNSIGNOR^ORQOR2(ORNUM),1:$$ORDERER^ORQOR2(ORNUM))
  1. I +$G(ORBDUZ)>0 D
  1. . ; RBD OR*3.0*453 Intercept User (Provider) to receive alert to see if it permanently routes to another User (Provider)
  1. . ; Then check if that User can receive Alerts
  1. . N ORTRDAT,ORTRNUM,ORTRREC,ORTRREC2 I +$G(ORNUM)>0 D
  1. .. S ORTRDAT=$O(^OR(100,ORNUM,11,"B",$$NOW^XLFDT()),-1) I +ORTRDAT>0 D
  1. ... S ORTRNUM=$O(^OR(100,ORNUM,11,"B",ORTRDAT,""),-1) I +ORTRNUM>0 D
  1. .... S ORTRREC2=$G(^OR(100,ORNUM,11,ORTRNUM,0)) I ORTRREC2]"" D
  1. ..... S:ORTRNUM=1 ORTRREC=ORTRREC2
  1. ..... S:ORTRNUM'=1 ORTRREC=$G(^OR(100,ORNUM,11,1,0))
  1. ..... I $P(ORTRREC,U,2)=ORBDUZ,$P(ORTRREC2,U,3) K ORBADUZ(ORBDUZ),XQA(ORBDUZ) S ORBDUZ=$P(ORTRREC2,U,3)
  1. .D USER
  1. .;if notif = Order Req E/S (#12) or Order Req Co-sign (#37) and
  1. .;user doesn't have ES authority, send to fellow team members w/ES:
  1. .I ((ORN=12)!(ORN=37)),('$D(^XUSEC("ORES",ORBDUZ))) D
  1. ..I $D(ORBU) S ORBU(ORBUI)=" Orderer can't elec sign, getting teams orderer belongs to:",ORBUI=ORBUI+1
  1. ..D TEAMPR^ORQPTQ1(.ORBLST,ORBDUZ) ;get orderer's tms
  1. ..Q:+$G(ORBLST(1))<1
  1. ..D TMSPT^ORQPTQ1(.ORBPLST,ORBDFN) ;get pt's tms
  1. ..Q:+$G(ORBPLST(1))<1
  1. ..S ORBI="" F S ORBI=$O(ORBLST(ORBI)) Q:ORBI="" D
  1. ...S ORBPI="" F S ORBPI=$O(ORBPLST(ORBPI)) Q:ORBPI="" D
  1. ....S ORBTM=$P(ORBLST(ORBI),U),ORBPTM=$P(ORBPLST(ORBPI),U)
  1. ....I ORBTM=ORBPTM D ;if pt is on provider's team
  1. .....I +$G(ORBPTM)>0 D
  1. ......S ORBTNAME=$P(ORBPLST(ORBPI),U,2)
  1. ......S ORBTTYPE=$P(ORBPLST(ORBPI),U,3)
  1. ......I $D(ORBU) S ORBU(ORBUI)=" Orderer's pt list "_ORBTNAME_" ["_ORBTTYPE_"] recipients: ",ORBUI=ORBUI+1
  1. ......N ORBLST2 D TEAMPROV^ORQPTQ1(.ORBLST2,ORBPTM)
  1. ......Q:+$G(ORBLST2(1))<1
  1. ......S ORBJ="" F S ORBJ=$O(ORBLST2(ORBJ)) Q:ORBJ="" D
  1. .......S ORBDUZ=$P(ORBLST2(ORBJ),U)_U_ORBPTM I +$G(ORBDUZ)>0,($D(^XUSEC("ORES",+ORBDUZ))) D USER
  1. Q
  1. ENTERBY ;
  1. I $D(ORBU) S ORBU(ORBUI)=" User entering order's most recent activity:",ORBUI=ORBUI+1
  1. Q:+$G(ORNUM)<1
  1. I $D(^OR(100,ORNUM,8,0)) D
  1. .S ORBDUZ=$P(^OR(100,ORNUM,8,$P(^OR(100,ORNUM,8,0),U,3),0),U,13)
  1. I +$G(ORBDUZ)>0 D USER
  1. Q
  1. PCMMPRIM ;
  1. I $D(ORBU) S ORBU(ORBUI)=" PCMM Primary Care Practitioner:",ORBUI=ORBUI+1
  1. S ORBDUZ=+$$OUTPTPR^SDUTL3(ORBDFN,$$NOW^XLFDT,1)
  1. I +$G(ORBDUZ)>0 D USER
  1. Q
  1. PCMMASSC ;
  1. I $D(ORBU) S ORBU(ORBUI)=" PCMM Associate Provider:",ORBUI=ORBUI+1
  1. S ORBDUZ=+$$OUTPTAP^SDUTL3(ORBDFN,$$NOW^XLFDT)
  1. I +$G(ORBDUZ)>0 D USER
  1. Q
  1. PCMMTEAM ;
  1. N ORPCMM,ORPCMMDZ
  1. I $D(ORBU) S ORBU(ORBUI)=" PCMM Team Position Assignments:",ORBUI=ORBUI+1
  1. S ORPCMM=$$PRPT^SCAPMC(ORBDFN,,,,,,"^TMP(""ORPCMM"",$J)",)
  1. S ORPCMMDZ=0
  1. F S ORPCMMDZ=$O(^TMP("ORPCMM",$J,"SCPR",ORPCMMDZ)) Q:'ORPCMMDZ D
  1. .S ORBDUZ=ORPCMMDZ D USER
  1. K ^TMP("ORPCMM",$J)
  1. Q
  1. PCMMMHTC ;
  1. I $D(ORBU) S ORBU(ORBUI)=" PCMM Mental Health Treatment Coordinator:",ORBUI=ORBUI+1
  1. S ORBDUZ=+$$START^SCMCMHTC(ORBDFN)
  1. I +$G(ORBDUZ)>0 D USER
  1. Q
  1. USER ;should USER (ORBDUZ) be a recip
  1. ;I '$$PATCH^XPDUTL("OR*3.0*498") D USER^ORB3USER(.XQA,ORBDUZ,ORN,.ORBU,.ORBUI,ORBDFN,+$G(ORNUM))
  1. ;I $$PATCH^XPDUTL("OR*3.0*498") D USER^ORB3USER(.XQA,ORBDUZ,ORN,.ORBU,.ORBUI,ORBDFN,+$G(ORNUM),$G(ORBADUZ(ORBDUZ)))
  1. D USER^ORB3USER(.XQA,ORBDUZ,ORN,.ORBU,.ORBUI,ORBDFN,+$G(ORNUM))
  1. I $D(ORFORCE(ORBDUZ)) S XQA(ORBDUZ)=""
  1. Q
  1. COMDUP ; Combine XQADATA from existing alert(s) with new alert, delete existing alert
  1. ;and then generate the new alert for the current individual user
  1. N ORVAR,ORDUZ,ORAID,ORODATA
  1. F ORVAR="XQA","XQADATA","XQAID","XQAFLG","XQAMSG","XQAROU","XQAARCH","XQASUPV","XQASURO","XQADFN","XQACNDEL","XQAREVUE","XQAOPT","XQAEXIT","XQAUSER" D
  1. .Q:'$D(@ORVAR)
  1. .I $D(@ORVAR)<10 S ORVAR(ORVAR)=$G(@ORVAR)
  1. .I $D(@ORVAR)>9 M ORVAR(ORVAR)=@ORVAR
  1. .S ORVAR(0,ORVAR)=""
  1. S ORDUZ=0 F S ORDUZ=$O(XQA(ORDUZ)) Q:'+ORDUZ D
  1. .N ORDATA,ORGEN
  1. .K ^TMP($J,"ORB3DATA")
  1. .D USER^XQALERT($NA(^TMP($J,"ORB3DATA")),ORDUZ)
  1. .S ORAID=0 F S ORAID=$O(^TMP($J,"ORB3DATA",ORAID)) Q:'+ORAID D
  1. ..Q:$P($P(^TMP($J,"ORB3DATA",ORAID),U,2),";")'=($P(ORBN,U,2)_","_ORBDFN_","_ORN)
  1. ..I $P(ORBN,U,4)="PKG",$P(^TMP($J,"ORB3DATA",ORAID),U)'[ORVAR("XQAMSG") Q
  1. ..N XQAID,XQADATA,XQAOPT,XQAROU,XQAUSER,XQAKILL
  1. ..N XQADFN,XQAMSG,XQAFLG,XQADFN,XQAARCH,XQASUPV,XQASURO,XQAREVUE,XQACNDEL
  1. ..K ^TMP($J,"ORB3ADATA")
  1. ..D ALERTDAT^XQALBUTL($P(^TMP($J,"ORB3DATA",ORAID),U,2),$NA(^TMP($J,"ORB3ADATA")))
  1. ..S XQADATA=$G(^TMP($J,"ORB3ADATA",2))
  1. ..K ^TMP($J,"ORB3ADATA")
  1. ..I XQADATA'="" D Q:'$G(ORGEN)
  1. ...I $D(ORBFLAGS("CD")) D
  1. ....N OROLD,ORNEW,ORSPEC,ORIDX
  1. ....S OROLD=U_$S(XQADATA[";":$P(XQADATA,";",2),1:XQADATA)_U,ORNEW=U_$S(ORVAR("XQADATA")[";":$P(ORVAR("XQADATA"),";",2),1:ORVAR("XQADATA"))_U
  1. ....S ORSPEC(U)=""
  1. ....F ORIDX=2:1:$L(ORNEW,U) I OROLD[(U_$P(ORNEW,U,ORIDX)_U) S $P(ORNEW,U,ORIDX)=""
  1. ....S ORNEW=$$REPLACE^XLFSTR(ORNEW,.ORSPEC)
  1. ....I ORNEW="" K ORVAR("XQA",ORDUZ) Q
  1. ....S ORDATA=$S(XQADATA[";":$P(XQADATA,";",2),1:XQADATA)_$S($G(ORDATA)'="":U_ORDATA,1:"")
  1. ....S ORGEN=1
  1. ...I '$D(ORBFLAGS("CD")),XQADATA=$G(ORVAR("XQADATA")) S ORGEN=2
  1. ..S XQAUSER=ORDUZ,XQAID=$P(^TMP($J,"ORB3DATA",ORAID),U,2),XQAKILL=1
  1. ..D DELETE^XQALERT
  1. .Q:$G(ORGEN)'=1
  1. .I $G(XQADATA)'=""!($G(ORDATA)'="") S ORODATA=$G(XQADATA)_$S($G(ORDATA)'="":U_ORDATA,1:"")
  1. .K ORVAR("XQA",ORDUZ)
  1. .D XQRESTOR
  1. .N XQA,XQADATA
  1. .S XQA(ORDUZ)="",XQADATA=ORODATA D SETUP^XQALERT
  1. K ^TMP($J,"ORB3DATA")
  1. D XQRESTOR
  1. Q
  1. XQRESTOR ; Restore XQA* variables saved off in COMDUP
  1. S ORVAR="" F S ORVAR=$O(ORVAR(0,ORVAR)) Q:$G(ORVAR)="" K @ORVAR
  1. S ORVAR="?" F S ORVAR=$O(ORVAR(ORVAR)) Q:$G(ORVAR)="" D
  1. .I $D(ORVAR(ORVAR))<10 S @ORVAR=ORVAR(ORVAR)
  1. .I $D(ORVAR(ORVAR))>9 M @ORVAR=ORVAR(ORVAR)
  1. Q