- ORKCHK ; SLC/CLA - Main routine called by OE/RR to initiate order checks ; Oct 11, 2023@08:49:55
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,94,105,123,232,267,243,280,345,539,405,612**;Dec 17, 1997;Build 3
- EN(ORKY,ORKDFN,ORKA,ORKMODE,OROIL,ORDODSG) ;initiate order checking
- ;ORKY: array of returned msgs in format: ornum^orderchk ien^clin danger^msg
- ;ORKDFN: patient dfn
- ;ORKA: array of order information in the format:
- ; orderable item ien|
- ; display group-filler app|
- ; nat'l id^nat'l text^nat'l code sys^local id^local text^local code sys|
- ; effective d/t|
- ; order number|
- ; filler data (LR: specimen ien, PS: meds prev ordered during this session in format med1^med2^...)
- ;ORKMODE: mode/event trigger (DISPLAY,SELECT,ACCEPT,SESSION,ALL,NOTIF,ALLERGY,ALLACC)
- ; PS: meds previously ordered during this session med1^med2^...
- ;OROIL: array containing the order info passed in (oly for ACCEPT mode)
- ;ORDODSG: flag that denotes if dosage checks should be performed
- ; 1 for perform dosage checks
- ; 0 for do not perform dosage checks
- N ORKQ,ORKN S ORKQ=0,ORKN=1
- S:+$G(ORKDFN)<1 ORKY(ORKN)="^^^Order Checking Unavailable - invalid patient id",ORKQ=1,ORKN=ORKN+1
- S:'$L($G(ORKMODE)) ORKY(ORKN)="^^^Order Checking Unavailable - invalid mode/event",ORKQ=1,ORKN=ORKN+1
- Q:$G(ORKQ)=1
- Q:+$G(ORKA)<1
- N ORKX,ORKS,DNGR,ORENT,ORKENT,ORKNENT,ORNUM,ORKOFF,ORKTMODE
- N ORKADUZ,ORKNDUZ,ORKI,ORKPRIM,ORKNMSG,ORKMSG,ORKLOG,ORKLD,ORKLI,ORKOI
- N ORKDG,ORKLPS,ORKPSA,ORKCNT,ORKDGI,ORIVORDR
- ;
- ;save array of orders for use in session processing:
- M ^TMP("ORKA",$J)=ORKA
- ;
- ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
- ;reliably determined, and many simultaneous outpt locations can occur):
- N DFN,ORKLOC
- S DFN=ORKDFN,VA200="" D OERR^VADPT
- S ORKLOC=+$G(^DIC(42,+VAIN(4),44))
- K VA200,VAIN
- ;
- ;get user's service/section flag:
- N ORKSRV
- S ORKSRV=$$GET1^DIQ(200,DUZ,29,"I") I +ORKSRV>0 S ORKSRV=$P(ORKSRV,U)
- ;
- ;log order check debug messages (or not)
- S ORKLOG=$$GET^XPAR("DIV^SYS^PKG","ORK DEBUG ENABLE/DISABLE",1,"I")
- I $G(ORKLOG)="D" K ^XTMP("ORKLOG") S ^XTMP("ORKLOG",0)=""
- I +$P($G(^XTMP("ORKLOG",0)),U,3)>5000 K ^XTMP("ORKLOG")
- ;
- ;if SESSION mode & pharmacy order occurred in session get unsigned med orders
- I ORKMODE="SESSION" D
- .N I,J S I=1,J=0 F S I=$O(ORKA(I)) Q:'I!(J) D
- ..S ORKDG=$P(ORKA(I),"|",2)
- ..I $E($G(ORKDG),1,2)="PS" D
- ...S ORKDGI=0,ORKDGI=$O(^ORD(100.98,"B","PHARMACY",ORKDGI))
- ...K ^TMP("ORR",$J)
- ...D EN^ORQ1(DFN_";DPT(",ORKDGI,11,"","","",0,0) S J=1
- ...;store unsigned med orders in ^TMP("ORR",$J for processing in ORKPS
- ;main processing loop:
- S (ORKX,ORIVORDR)="" F S ORKX=$O(ORKA(ORKX)) Q:ORKX="" D
- .S ORKOI=$P(ORKA(ORKX),"|")
- .;
- .;log debug msgs if parameter is enabled:
- .I $G(ORKLOG)="E" D
- ..S ORKLD=$$NOW^XLFDT
- ..S ORKLI=0
- ..I +$P($G(^XTMP("ORKLOG",0)),U,3)<1 S $P(^XTMP("ORKLOG",0),U,3)=0
- ..S ORKCNT=$P(^XTMP("ORKLOG",0),U,3)+1
- ..S ^XTMP("ORKLOG",0)=$$FMADD^XLFDT(ORKLD,3,"","","")_U_ORKLD_U_ORKCNT
- ..S ^XTMP("ORKLOG",ORKLD,ORKDFN,+$G(ORKOI),ORKMODE,DUZ,ORKLI)=ORKA(ORKX)
- .;
- .S ORKDG=$P(ORKA(ORKX),"|",2),ORKTMODE=""
- .S ORKENT="USR^LOC.`"_+$G(ORKLOC)_"^SRV.`"_+$G(ORKSRV)_"^DIV^SYS^PKG"
- .Q:'$L($G(ORKDG))
- .;
- .;if pharmacy order and multiple pharmacy orders in session add data node:
- .I $E(ORKDG,1,2)="PS",($L($G(ORKPSA))) D
- ..S $P(ORKA(ORKX),"|",6)=ORKPSA
- .;
- .S ORNUM=$P(ORKA(ORKX),"|",5)
- .; get correct DUZ for notification processing if in NOTIF mode:
- .I ORKMODE="NOTIF" D
- ..S:+$G(ORNUM)>0 ORKNDUZ=$$ORDERER^ORQOR2(ORNUM) ;ordering provider
- ..S:+$G(ORNUM)<1 ORKNDUZ=$P($$PRIM^ORQPTQ4(ORKDFN),U) ;prim provider
- ..I +$G(ORKNDUZ)>0 D
- ...S ORKSRV=$$GET1^DIQ(200,ORKNDUZ,29,"I") I +ORKSRV>0 S ORKSRV=$P(ORKSRV,U)
- ...S ORKNENT="USR.`"_+ORKNDUZ_"^LOC.`"_+$G(ORKLOC)_"^SRV.`"_+$G(ORKSRV)_"^DIV^SYS^PKG"
- ..S:+$G(ORKNDUZ)<1 ORKNENT="LOC.`"_+$G(ORKLOC)_"^DIV^SYS^PKG"
- .S ORENT=$S(ORKMODE="NOTIF":ORKNENT,1:ORKENT)
- .;
- .;If the order is a delayed release order (NOTIF) process all nodes.
- .;If it is a renewal, edit or delayed signature order (ALL) process all
- .;modes except SESSION which gets processed just before signature:
- .I ORKMODE="NOTIF"!(ORKMODE="ALL") S ORKTMODE=ORKMODE D
- ..D EN^ORKCHK3(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE) ;DISPLAY
- ..D EN^ORKCHK4(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORIVORDR,.ORDODSG) ;SELECT
- ..D EN^ORKCHK5(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORDODSG) ;ACCEPT
- ..I ORKMODE="NOTIF" D EN^ORKCHK6(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE) ;SESSION
- ..S ORKMODE=ORKTMODE
- .;
- .;Process regular orders/modes:
- .I '$L($G(ORKTMODE)) D
- ..I ORKMODE="DISPLAY" D EN^ORKCHK3(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
- ..I ORKMODE="SELECT" D EN^ORKCHK4(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORIVORDR,.ORDODSG)
- ..I ORKMODE="ACCEPT"!(ORKMODE="ALLERGY")!(ORKMODE="ALLACC") D EN^ORKCHK5(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORDODSG)
- ..I ORKMODE="SESSION" D EN^ORKCHK6(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
- ;
- ;set messages into sorting array then into ORKY ORKS("ORK",clinical danger level,oi,msg)=ornum^order check ien^clin danger level^message
- S ORKX="",ORKI=1
- F S ORKX=$O(ORKS("ORK",ORKX)) Q:ORKX="" D
- .S ORKY(ORKI)=ORKS("ORK",ORKX)
- .;S ORKY(ORKI)=$E(ORKS("ORK",ORKX),1,500)
- .;
- .;log debug msgs if parameter is enabled:
- .I $G(ORKLOG)="E" D
- ..S ORKLI=$G(ORKLI)+1
- ..S ^XTMP("ORKLOG",$$NOW^XLFDT,ORKDFN,+$G(ORKOI),ORKMODE,DUZ,ORKLI)=ORKY(ORKI)
- ..S $P(^XTMP("ORKLOG",0),U,3)=$P($G(^XTMP("ORKLOG",0)),U,3)+1
- .;
- .;send moderate and high danger order checks for delayed orders as notifications:
- .I ORKMODE="NOTIF" S DNGR=$P(ORKY(ORKI),U,3) I $G(DNGR)<3 D
- ..S ORKADUZ="",ORNUM=$P(ORKY(ORKI),U)
- ..S:+$G(ORKNDUZ)>0 ORKADUZ(ORKNDUZ)=""
- ..S ORKNMSG="Order check: "_$P(ORKY(ORKI),U,4)
- ..D EN^ORB3(54,ORKDFN,$G(ORNUM),.ORKADUZ,ORKNMSG,"")
- .S ORKI=ORKI+1
- ;
- K ^TMP("ORKA",$J),^TMP("ORR",$J)
- I $G(ORKLOG)="E" D
- .S ORKLI=$G(ORKLI)+1
- .S ^XTMP("ORKLOG",$$NOW^XLFDT,ORKDFN,+$G(ORKOI),ORKMODE,DUZ,ORKLI)="LEAVING ORDER CHECKING"
- .S $P(^XTMP("ORKLOG",0),U,3)=$P($G(^XTMP("ORKLOG",0)),U,3)+1
- D CHKRMT
- Q
- ;
- CHKRMT ;
- N I,ORQFLAG
- S ORQFLAG=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
- Q:$G(ORQFLAG)
- Q:'$$HAVEHDR^ORRDI1
- Q:$$LDPTTVAL^ORRDI2($G(DFN))
- Q:$P($G(^XTMP("ORRDI","PSOO",ORKDFN,0)),U,3)'<0&($P($G(^XTMP("ORRDI","ART",ORKDFN,0)),U,3)'<0)
- I $G(ORKMODE)="ACCEPT"!($G(ORKMODE)="ALLACC") D
- . N IFN
- . S IFN=$O(ORKY(""),-1)+1
- . S ORKY(IFN)="^99^2^Remote Order Checking not available - checks done on local data only"
- . K ^TMP($J,"ORRDI") S ^TMP($J,"ORRDI",ORKDFN)=1
- I $G(ORKMODE)="SESSION" D
- . N I,IFN,ORARR
- . S IFN=$O(ORKY(""),-1)
- . S I=0 F S I=$O(ORKY(I)) Q:'I S ORARR(+ORKY(I))=""
- . 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"
- . K ^TMP($J,"ORRDI") S ^TMP($J,"ORRDI",ORKDFN)=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKCHK 7095 printed Feb 18, 2025@23:57:33 Page 2
- 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
- EN(ORKY,ORKDFN,ORKA,ORKMODE,OROIL,ORDODSG) ;initiate order checking
- +1 ;ORKY: array of returned msgs in format: ornum^orderchk ien^clin danger^msg
- +2 ;ORKDFN: patient dfn
- +3 ;ORKA: array of order information in the format:
- +4 ; orderable item ien|
- +5 ; display group-filler app|
- +6 ; nat'l id^nat'l text^nat'l code sys^local id^local text^local code sys|
- +7 ; effective d/t|
- +8 ; order number|
- +9 ; filler data (LR: specimen ien, PS: meds prev ordered during this session in format med1^med2^...)
- +10 ;ORKMODE: mode/event trigger (DISPLAY,SELECT,ACCEPT,SESSION,ALL,NOTIF,ALLERGY,ALLACC)
- +11 ; PS: meds previously ordered during this session med1^med2^...
- +12 ;OROIL: array containing the order info passed in (oly for ACCEPT mode)
- +13 ;ORDODSG: flag that denotes if dosage checks should be performed
- +14 ; 1 for perform dosage checks
- +15 ; 0 for do not perform dosage checks
- +16 NEW ORKQ,ORKN
- SET ORKQ=0
- SET ORKN=1
- +17 if +$GET(ORKDFN)<1
- SET ORKY(ORKN)="^^^Order Checking Unavailable - invalid patient id"
- SET ORKQ=1
- SET ORKN=ORKN+1
- +18 if '$LENGTH($GET(ORKMODE))
- SET ORKY(ORKN)="^^^Order Checking Unavailable - invalid mode/event"
- SET ORKQ=1
- SET ORKN=ORKN+1
- +19 if $GET(ORKQ)=1
- QUIT
- +20 if +$GET(ORKA)<1
- QUIT
- +21 NEW ORKX,ORKS,DNGR,ORENT,ORKENT,ORKNENT,ORNUM,ORKOFF,ORKTMODE
- +22 NEW ORKADUZ,ORKNDUZ,ORKI,ORKPRIM,ORKNMSG,ORKMSG,ORKLOG,ORKLD,ORKLI,ORKOI
- +23 NEW ORKDG,ORKLPS,ORKPSA,ORKCNT,ORKDGI,ORIVORDR
- +24 ;
- +25 ;save array of orders for use in session processing:
- +26 MERGE ^TMP("ORKA",$JOB)=ORKA
- +27 ;
- +28 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
- +29 ;reliably determined, and many simultaneous outpt locations can occur):
- +30 NEW DFN,ORKLOC
- +31 SET DFN=ORKDFN
- SET VA200=""
- DO OERR^VADPT
- +32 SET ORKLOC=+$GET(^DIC(42,+VAIN(4),44))
- +33 KILL VA200,VAIN
- +34 ;
- +35 ;get user's service/section flag:
- +36 NEW ORKSRV
- +37 SET ORKSRV=$$GET1^DIQ(200,DUZ,29,"I")
- IF +ORKSRV>0
- SET ORKSRV=$PIECE(ORKSRV,U)
- +38 ;
- +39 ;log order check debug messages (or not)
- +40 SET ORKLOG=$$GET^XPAR("DIV^SYS^PKG","ORK DEBUG ENABLE/DISABLE",1,"I")
- +41 IF $GET(ORKLOG)="D"
- KILL ^XTMP("ORKLOG")
- SET ^XTMP("ORKLOG",0)=""
- +42 IF +$PIECE($GET(^XTMP("ORKLOG",0)),U,3)>5000
- KILL ^XTMP("ORKLOG")
- +43 ;
- +44 ;if SESSION mode & pharmacy order occurred in session get unsigned med orders
- +45 IF ORKMODE="SESSION"
- Begin DoDot:1
- +46 NEW I,J
- SET I=1
- SET J=0
- FOR
- SET I=$ORDER(ORKA(I))
- if 'I!(J)
- QUIT
- Begin DoDot:2
- +47 SET ORKDG=$PIECE(ORKA(I),"|",2)
- +48 IF $EXTRACT($GET(ORKDG),1,2)="PS"
- Begin DoDot:3
- +49 SET ORKDGI=0
- SET ORKDGI=$ORDER(^ORD(100.98,"B","PHARMACY",ORKDGI))
- +50 KILL ^TMP("ORR",$JOB)
- +51 DO EN^ORQ1(DFN_";DPT(",ORKDGI,11,"","","",0,0)
- SET J=1
- +52 ;store unsigned med orders in ^TMP("ORR",$J for processing in ORKPS
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +53 ;main processing loop:
- +54 SET (ORKX,ORIVORDR)=""
- FOR
- SET ORKX=$ORDER(ORKA(ORKX))
- if ORKX=""
- QUIT
- Begin DoDot:1
- +55 SET ORKOI=$PIECE(ORKA(ORKX),"|")
- +56 ;
- +57 ;log debug msgs if parameter is enabled:
- +58 IF $GET(ORKLOG)="E"
- Begin DoDot:2
- +59 SET ORKLD=$$NOW^XLFDT
- +60 SET ORKLI=0
- +61 IF +$PIECE($GET(^XTMP("ORKLOG",0)),U,3)<1
- SET $PIECE(^XTMP("ORKLOG",0),U,3)=0
- +62 SET ORKCNT=$PIECE(^XTMP("ORKLOG",0),U,3)+1
- +63 SET ^XTMP("ORKLOG",0)=$$FMADD^XLFDT(ORKLD,3,"","","")_U_ORKLD_U_ORKCNT
- +64 SET ^XTMP("ORKLOG",ORKLD,ORKDFN,+$GET(ORKOI),ORKMODE,DUZ,ORKLI)=ORKA(ORKX)
- End DoDot:2
- +65 ;
- +66 SET ORKDG=$PIECE(ORKA(ORKX),"|",2)
- SET ORKTMODE=""
- +67 SET ORKENT="USR^LOC.`"_+$GET(ORKLOC)_"^SRV.`"_+$GET(ORKSRV)_"^DIV^SYS^PKG"
- +68 if '$LENGTH($GET(ORKDG))
- QUIT
- +69 ;
- +70 ;if pharmacy order and multiple pharmacy orders in session add data node:
- +71 IF $EXTRACT(ORKDG,1,2)="PS"
- IF ($LENGTH($GET(ORKPSA)))
- Begin DoDot:2
- +72 SET $PIECE(ORKA(ORKX),"|",6)=ORKPSA
- End DoDot:2
- +73 ;
- +74 SET ORNUM=$PIECE(ORKA(ORKX),"|",5)
- +75 ; get correct DUZ for notification processing if in NOTIF mode:
- +76 IF ORKMODE="NOTIF"
- Begin DoDot:2
- +77 ;ordering provider
- if +$GET(ORNUM)>0
- SET ORKNDUZ=$$ORDERER^ORQOR2(ORNUM)
- +78 ;prim provider
- if +$GET(ORNUM)<1
- SET ORKNDUZ=$PIECE($$PRIM^ORQPTQ4(ORKDFN),U)
- +79 IF +$GET(ORKNDUZ)>0
- Begin DoDot:3
- +80 SET ORKSRV=$$GET1^DIQ(200,ORKNDUZ,29,"I")
- IF +ORKSRV>0
- SET ORKSRV=$PIECE(ORKSRV,U)
- +81 SET ORKNENT="USR.`"_+ORKNDUZ_"^LOC.`"_+$GET(ORKLOC)_"^SRV.`"_+$GET(ORKSRV)_"^DIV^SYS^PKG"
- End DoDot:3
- +82 if +$GET(ORKNDUZ)<1
- SET ORKNENT="LOC.`"_+$GET(ORKLOC)_"^DIV^SYS^PKG"
- End DoDot:2
- +83 SET ORENT=$SELECT(ORKMODE="NOTIF":ORKNENT,1:ORKENT)
- +84 ;
- +85 ;If the order is a delayed release order (NOTIF) process all nodes.
- +86 ;If it is a renewal, edit or delayed signature order (ALL) process all
- +87 ;modes except SESSION which gets processed just before signature:
- +88 IF ORKMODE="NOTIF"!(ORKMODE="ALL")
- SET ORKTMODE=ORKMODE
- Begin DoDot:2
- +89 ;DISPLAY
- DO EN^ORKCHK3(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
- +90 ;SELECT
- DO EN^ORKCHK4(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORIVORDR,.ORDODSG)
- +91 ;ACCEPT
- DO EN^ORKCHK5(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORDODSG)
- +92 ;SESSION
- IF ORKMODE="NOTIF"
- DO EN^ORKCHK6(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
- +93 SET ORKMODE=ORKTMODE
- End DoDot:2
- +94 ;
- +95 ;Process regular orders/modes:
- +96 IF '$LENGTH($GET(ORKTMODE))
- Begin DoDot:2
- +97 IF ORKMODE="DISPLAY"
- DO EN^ORKCHK3(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
- +98 IF ORKMODE="SELECT"
- DO EN^ORKCHK4(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORIVORDR,.ORDODSG)
- +99 IF ORKMODE="ACCEPT"!(ORKMODE="ALLERGY")!(ORKMODE="ALLACC")
- DO EN^ORKCHK5(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE,.OROIL,.ORDODSG)
- +100 IF ORKMODE="SESSION"
- DO EN^ORKCHK6(.ORKS,ORKDFN,ORKA(ORKX),ORENT,ORKTMODE)
- End DoDot:2
- End DoDot:1
- +101 ;
- +102 ;set messages into sorting array then into ORKY ORKS("ORK",clinical danger level,oi,msg)=ornum^order check ien^clin danger level^message
- +103 SET ORKX=""
- SET ORKI=1
- +104 FOR
- SET ORKX=$ORDER(ORKS("ORK",ORKX))
- if ORKX=""
- QUIT
- Begin DoDot:1
- +105 SET ORKY(ORKI)=ORKS("ORK",ORKX)
- +106 ;S ORKY(ORKI)=$E(ORKS("ORK",ORKX),1,500)
- +107 ;
- +108 ;log debug msgs if parameter is enabled:
- +109 IF $GET(ORKLOG)="E"
- Begin DoDot:2
- +110 SET ORKLI=$GET(ORKLI)+1
- +111 SET ^XTMP("ORKLOG",$$NOW^XLFDT,ORKDFN,+$GET(ORKOI),ORKMODE,DUZ,ORKLI)=ORKY(ORKI)
- +112 SET $PIECE(^XTMP("ORKLOG",0),U,3)=$PIECE($GET(^XTMP("ORKLOG",0)),U,3)+1
- End DoDot:2
- +113 ;
- +114 ;send moderate and high danger order checks for delayed orders as notifications:
- +115 IF ORKMODE="NOTIF"
- SET DNGR=$PIECE(ORKY(ORKI),U,3)
- IF $GET(DNGR)<3
- Begin DoDot:2
- +116 SET ORKADUZ=""
- SET ORNUM=$PIECE(ORKY(ORKI),U)
- +117 if +$GET(ORKNDUZ)>0
- SET ORKADUZ(ORKNDUZ)=""
- +118 SET ORKNMSG="Order check: "_$PIECE(ORKY(ORKI),U,4)
- +119 DO EN^ORB3(54,ORKDFN,$GET(ORNUM),.ORKADUZ,ORKNMSG,"")
- End DoDot:2
- +120 SET ORKI=ORKI+1
- End DoDot:1
- +121 ;
- +122 KILL ^TMP("ORKA",$JOB),^TMP("ORR",$JOB)
- +123 IF $GET(ORKLOG)="E"
- Begin DoDot:1
- +124 SET ORKLI=$GET(ORKLI)+1
- +125 SET ^XTMP("ORKLOG",$$NOW^XLFDT,ORKDFN,+$GET(ORKOI),ORKMODE,DUZ,ORKLI)="LEAVING ORDER CHECKING"
- +126 SET $PIECE(^XTMP("ORKLOG",0),U,3)=$PIECE($GET(^XTMP("ORKLOG",0)),U,3)+1
- End DoDot:1
- +127 DO CHKRMT
- +128 QUIT
- +129 ;
- CHKRMT ;
- +1 NEW I,ORQFLAG
- +2 SET ORQFLAG=1
- +3 SET I=0
- FOR
- SET I=$ORDER(ORKA(I))
- if 'I
- QUIT
- IF $EXTRACT($PIECE(ORKA(I),"|",2),1,2)="PS"!($EXTRACT($PIECE(ORKA(I),"|",2),1,2)="RA")
- SET ORQFLAG=0
- +4 if $GET(ORQFLAG)
- QUIT
- +5 if '$$HAVEHDR^ORRDI1
- QUIT
- +6 if $$LDPTTVAL^ORRDI2($GET(DFN))
- QUIT
- +7 if $PIECE($GET(^XTMP("ORRDI","PSOO",ORKDFN,0)),U,3)'<0&($PIECE($GET(^XTMP("ORRDI","ART",ORKDFN,0)),U,3)'<0)
- QUIT
- +8 IF $GET(ORKMODE)="ACCEPT"!($GET(ORKMODE)="ALLACC")
- Begin DoDot:1
- +9 NEW IFN
- +10 SET IFN=$ORDER(ORKY(""),-1)+1
- +11 SET ORKY(IFN)="^99^2^Remote Order Checking not available - checks done on local data only"
- +12 KILL ^TMP($JOB,"ORRDI")
- SET ^TMP($JOB,"ORRDI",ORKDFN)=1
- End DoDot:1
- +13 IF $GET(ORKMODE)="SESSION"
- Begin DoDot:1
- +14 NEW I,IFN,ORARR
- +15 SET IFN=$ORDER(ORKY(""),-1)
- +16 SET I=0
- FOR
- SET I=$ORDER(ORKY(I))
- if 'I
- QUIT
- SET ORARR(+ORKY(I))=""
- +17 SET I=0
- FOR
- SET I=$ORDER(ORARR(I))
- if 'I
- QUIT
- SET IFN=IFN+1
- SET ORKY(IFN)=I_"^99^2^Remote Order Checking not available - checks done on local data only"
- +18 KILL ^TMP($JOB,"ORRDI")
- SET ^TMP($JOB,"ORRDI",ORKDFN)=1
- End DoDot:1
- +19 QUIT