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

ORKCHK.m

Go to the documentation of this file.
  1. ORKCHK ; SLC/CLA - Main routine called by OE/RR to initiate order checks ; Oct 11, 2023@08:49:55
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,94,105,123,232,267,243,280,345,539,405,612**;Dec 17, 1997;Build 3
  1. EN(ORKY,ORKDFN,ORKA,ORKMODE,OROIL,ORDODSG) ;initiate order checking
  1. ;ORKY: array of returned msgs in format: ornum^orderchk ien^clin danger^msg
  1. ;ORKDFN: patient dfn
  1. ;ORKA: array of order information in the format:
  1. ; orderable item ien|
  1. ; display group-filler app|
  1. ; nat'l id^nat'l text^nat'l code sys^local id^local text^local code sys|
  1. ; effective d/t|
  1. ; order number|
  1. ; filler data (LR: specimen ien, PS: meds prev ordered during this session in format med1^med2^...)
  1. ;ORKMODE: mode/event trigger (DISPLAY,SELECT,ACCEPT,SESSION,ALL,NOTIF,ALLERGY,ALLACC)
  1. ; PS: meds previously ordered during this session med1^med2^...
  1. ;OROIL: array containing the order info passed in (oly for ACCEPT mode)
  1. ;ORDODSG: flag that denotes if dosage checks should be performed
  1. ; 1 for perform dosage checks
  1. ; 0 for do not perform dosage checks
  1. N ORKQ,ORKN S ORKQ=0,ORKN=1
  1. S:+$G(ORKDFN)<1 ORKY(ORKN)="^^^Order Checking Unavailable - invalid patient id",ORKQ=1,ORKN=ORKN+1
  1. S:'$L($G(ORKMODE)) ORKY(ORKN)="^^^Order Checking Unavailable - invalid mode/event",ORKQ=1,ORKN=ORKN+1
  1. Q:$G(ORKQ)=1
  1. Q:+$G(ORKA)<1
  1. N ORKX,ORKS,DNGR,ORENT,ORKENT,ORKNENT,ORNUM,ORKOFF,ORKTMODE
  1. N ORKADUZ,ORKNDUZ,ORKI,ORKPRIM,ORKNMSG,ORKMSG,ORKLOG,ORKLD,ORKLI,ORKOI
  1. N ORKDG,ORKLPS,ORKPSA,ORKCNT,ORKDGI,ORIVORDR
  1. ;
  1. ;save array of orders for use in session processing:
  1. M ^TMP("ORKA",$J)=ORKA
  1. ;
  1. ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
  1. ;reliably determined, and many simultaneous outpt locations can occur):
  1. N DFN,ORKLOC
  1. S DFN=ORKDFN,VA200="" D OERR^VADPT
  1. S ORKLOC=+$G(^DIC(42,+VAIN(4),44))
  1. K VA200,VAIN
  1. ;
  1. ;get user's service/section flag:
  1. N ORKSRV
  1. S ORKSRV=$$GET1^DIQ(200,DUZ,29,"I") I +ORKSRV>0 S ORKSRV=$P(ORKSRV,U)
  1. ;
  1. ;log order check debug messages (or not)
  1. S ORKLOG=$$GET^XPAR("DIV^SYS^PKG","ORK DEBUG ENABLE/DISABLE",1,"I")
  1. I $G(ORKLOG)="D" K ^XTMP("ORKLOG") S ^XTMP("ORKLOG",0)=""
  1. I +$P($G(^XTMP("ORKLOG",0)),U,3)>5000 K ^XTMP("ORKLOG")
  1. ;
  1. ;if SESSION mode & pharmacy order occurred in session get unsigned med orders
  1. I ORKMODE="SESSION" D
  1. .N I,J S I=1,J=0 F S I=$O(ORKA(I)) Q:'I!(J) D
  1. ..S ORKDG=$P(ORKA(I),"|",2)
  1. ..I $E($G(ORKDG),1,2)="PS" D
  1. ...S ORKDGI=0,ORKDGI=$O(^ORD(100.98,"B","PHARMACY",ORKDGI))
  1. ...K ^TMP("ORR",$J)
  1. ...D EN^ORQ1(DFN_";DPT(",ORKDGI,11,"","","",0,0) S J=1
  1. ...;store unsigned med orders in ^TMP("ORR",$J for processing in ORKPS
  1. ;main processing loop:
  1. S (ORKX,ORIVORDR)="" F S ORKX=$O(ORKA(ORKX)) Q:ORKX="" D
  1. .S ORKOI=$P(ORKA(ORKX),"|")
  1. .;
  1. .;log debug msgs if parameter is enabled:
  1. .I $G(ORKLOG)="E" D
  1. ..S ORKLD=$$NOW^XLFDT
  1. ..S ORKLI=0
  1. ..I +$P($G(^XTMP("ORKLOG",0)),U,3)<1 S $P(^XTMP("ORKLOG",0),U,3)=0
  1. ..S ORKCNT=$P(^XTMP("ORKLOG",0),U,3)+1
  1. ..S ^XTMP("ORKLOG",0)=$$FMADD^XLFDT(ORKLD,3,"","","")_U_ORKLD_U_ORKCNT
  1. ..S ^XTMP("ORKLOG",ORKLD,ORKDFN,+$G(ORKOI),ORKMODE,DUZ,ORKLI)=ORKA(ORKX)
  1. .;
  1. .S ORKDG=$P(ORKA(ORKX),"|",2),ORKTMODE=""
  1. .S ORKENT="USR^LOC.`"_+$G(ORKLOC)_"^SRV.`"_+$G(ORKSRV)_"^DIV^SYS^PKG"
  1. .Q:'$L($G(ORKDG))
  1. .;
  1. .;if pharmacy order and multiple pharmacy orders in session add data node:
  1. .I $E(ORKDG,1,2)="PS",($L($G(ORKPSA))) D
  1. ..S $P(ORKA(ORKX),"|",6)=ORKPSA
  1. .;
  1. .S ORNUM=$P(ORKA(ORKX),"|",5)
  1. .; get correct DUZ for notification processing if in NOTIF mode:
  1. .I ORKMODE="NOTIF" D
  1. ..S:+$G(ORNUM)>0 ORKNDUZ=$$ORDERER^ORQOR2(ORNUM) ;ordering provider
  1. ..S:+$G(ORNUM)<1 ORKNDUZ=$P($$PRIM^ORQPTQ4(ORKDFN),U) ;prim provider
  1. ..I +$G(ORKNDUZ)>0 D
  1. ...S ORKSRV=$$GET1^DIQ(200,ORKNDUZ,29,"I") I +ORKSRV>0 S ORKSRV=$P(ORKSRV,U)
  1. ...S ORKNENT="USR.`"_+ORKNDUZ_"^LOC.`"_+$G(ORKLOC)_"^SRV.`"_+$G(ORKSRV)_"^DIV^SYS^PKG"
  1. ..S:+$G(ORKNDUZ)<1 ORKNENT="LOC.`"_+$G(ORKLOC)_"^DIV^SYS^PKG"
  1. .S ORENT=$S(ORKMODE="NOTIF":ORKNENT,1:ORKENT)
  1. .;
  1. .;If the order is a delayed release order (NOTIF) process all nodes.
  1. .;If it is a renewal, edit or delayed signature order (ALL) process all
  1. .;modes except SESSION which gets processed just before signature:
  1. .I ORKMODE="NOTIF"!(ORKMODE="ALL") S ORKTMODE=ORKMODE D
  1. ..D EN^ORKCHK3(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE) ;DISPLAY
  1. ..D EN^ORKCHK4(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORIVORDR,.ORDODSG) ;SELECT
  1. ..D EN^ORKCHK5(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORDODSG) ;ACCEPT
  1. ..I ORKMODE="NOTIF" D EN^ORKCHK6(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE) ;SESSION
  1. ..S ORKMODE=ORKTMODE
  1. .;
  1. .;Process regular orders/modes:
  1. .I '$L($G(ORKTMODE)) D
  1. ..I ORKMODE="DISPLAY" D EN^ORKCHK3(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
  1. ..I ORKMODE="SELECT" D EN^ORKCHK4(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORIVORDR,.ORDODSG)
  1. ..I ORKMODE="ACCEPT"!(ORKMODE="ALLERGY")!(ORKMODE="ALLACC") D EN^ORKCHK5(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORDODSG)
  1. ..I ORKMODE="SESSION" D EN^ORKCHK6(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
  1. ;
  1. ;set messages into sorting array then into ORKY ORKS("ORK",clinical danger level,oi,msg)=ornum^order check ien^clin danger level^message
  1. S ORKX="",ORKI=1
  1. F S ORKX=$O(ORKS("ORK",ORKX)) Q:ORKX="" D
  1. .S ORKY(ORKI)=ORKS("ORK",ORKX)
  1. .;S ORKY(ORKI)=$E(ORKS("ORK",ORKX),1,500)
  1. .;
  1. .;log debug msgs if parameter is enabled:
  1. .I $G(ORKLOG)="E" D
  1. ..S ORKLI=$G(ORKLI)+1
  1. ..S ^XTMP("ORKLOG",$$NOW^XLFDT,ORKDFN,+$G(ORKOI),ORKMODE,DUZ,ORKLI)=ORKY(ORKI)
  1. ..S $P(^XTMP("ORKLOG",0),U,3)=$P($G(^XTMP("ORKLOG",0)),U,3)+1
  1. .;
  1. .;send moderate and high danger order checks for delayed orders as notifications:
  1. .I ORKMODE="NOTIF" S DNGR=$P(ORKY(ORKI),U,3) I $G(DNGR)<3 D
  1. ..S ORKADUZ="",ORNUM=$P(ORKY(ORKI),U)
  1. ..S:+$G(ORKNDUZ)>0 ORKADUZ(ORKNDUZ)=""
  1. ..S ORKNMSG="Order check: "_$P(ORKY(ORKI),U,4)
  1. ..D EN^ORB3(54,ORKDFN,$G(ORNUM),.ORKADUZ,ORKNMSG,"")
  1. .S ORKI=ORKI+1
  1. ;
  1. K ^TMP("ORKA",$J),^TMP("ORR",$J)
  1. I $G(ORKLOG)="E" D
  1. .S ORKLI=$G(ORKLI)+1
  1. .S ^XTMP("ORKLOG",$$NOW^XLFDT,ORKDFN,+$G(ORKOI),ORKMODE,DUZ,ORKLI)="LEAVING ORDER CHECKING"
  1. .S $P(^XTMP("ORKLOG",0),U,3)=$P($G(^XTMP("ORKLOG",0)),U,3)+1
  1. D CHKRMT
  1. Q
  1. ;
  1. CHKRMT ;
  1. N I,ORQFLAG
  1. S ORQFLAG=1
  1. S I=0 F S I=$O(ORKA(I)) Q:'I I $E($P(ORKA(I),"|",2),1,2)="PS"!($E($P(ORKA(I),"|",2),1,2)="RA") S ORQFLAG=0
  1. Q:$G(ORQFLAG)
  1. Q:'$$HAVEHDR^ORRDI1
  1. Q:$$LDPTTVAL^ORRDI2($G(DFN))
  1. Q:$P($G(^XTMP("ORRDI","PSOO",ORKDFN,0)),U,3)'<0&($P($G(^XTMP("ORRDI","ART",ORKDFN,0)),U,3)'<0)
  1. I $G(ORKMODE)="ACCEPT"!($G(ORKMODE)="ALLACC") D
  1. . N IFN
  1. . S IFN=$O(ORKY(""),-1)+1
  1. . S ORKY(IFN)="^99^2^Remote Order Checking not available - checks done on local data only"
  1. . K ^TMP($J,"ORRDI") S ^TMP($J,"ORRDI",ORKDFN)=1
  1. I $G(ORKMODE)="SESSION" D
  1. . N I,IFN,ORARR
  1. . S IFN=$O(ORKY(""),-1)
  1. . S I=0 F S I=$O(ORKY(I)) Q:'I S ORARR(+ORKY(I))=""
  1. . S I=0 F S I=$O(ORARR(I)) Q:'I S IFN=IFN+1,ORKY(IFN)=I_"^99^2^Remote Order Checking not available - checks done on local data only"
  1. . K ^TMP($J,"ORRDI") S ^TMP($J,"ORRDI",ORKDFN)=1
  1. Q