ORQOAUIA ;EPIP/RTW - DAILY TASK RETRIEVE ASSOCIATED ORDER FOR A QUICK ORDER ; 12/29/17 10:03am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**441**;Dec 17, 1997;Build 52
;ICR# Type Description
;----- ---- -------------------------------------
;2053 Sup FILE^DIE
;10103 Sup $$FMTE^XLFDT
Q ;No direct entry
START ; ENTRY POINT
N ORDAT,ORDAT2,ORDATORD,ORDTQUIC,ORDFN,ORDFNPLS,ORFND,ORI,ORJ,ORJJ,ORJO,ORK,ORKK,ORKK0,ORDITEM,ORQOIFN,ORREPLCD,ORSTOP,ORX,ORX0,ORD1
S ORDAT=$$FMADD^XLFDT(DT,-30) ; PROCESS RECORDS UP TO 30 DAYS OLD
I '$D(ZTQUEUED) W !,"Audit#",?10,"Order",?20,"Comment"
F S ORDAT=$O(^OR(100.95,"B",ORDAT)) Q:+ORDAT'>0 S ORI=0 F S ORI=$O(^OR(100.95,"B",ORDAT,ORI)) Q:+ORI'>0 D
. S ORX0=^OR(100.95,ORI,0),ORQOIFN=$P(ORX0,U,4)
. Q:$P(ORX0,U,8)>0 ;Quit if entry already has a ORDER NUMBER.
. Q:ORQOIFN="" ;NO QUICK ORDER RECORDED
. ;S ORD1=$O(^ORD(101.41,ORQOIFN,6,"D",4,0))
. S ORDFN=$P(ORX0,U,3),ORDFNPLS=ORDFN_";DPT("
. S (ORDAT2,ORSTOP)=0 F S ORDAT2=$O(^OR(100,"ACT",ORDFNPLS,ORDAT2)) Q:+ORDAT2'>0!(ORSTOP) S ORJJ=0 F S ORJJ=$O(^OR(100,"ACT",ORDFNPLS,ORDAT2,ORJJ)) Q:+ORJJ'>0 D
.. S ORJ=0 F S ORJ=$O(^OR(100,"ACT",ORDFNPLS,ORDAT2,ORJJ,ORJ)) Q:+ORJ'>0!(ORSTOP) D
... S ORDATORD=$P(^OR(100,ORJ,0),"^",7)+.000099 ;DATE/TIME ORDER ENTERED
... S ORDTQUIC=$P(^OR(100.95,ORI,0),"^",1) ;DATE/TIM OFAUDIT RECORD
... S ORREPLCD=$P($G(^OR(100,ORJ,3)),U,5) ;REPLACED ORDER number if any.
... S ORJO=ORJ D SCAN I 'ORFND,ORREPLCD>0 S ORJO=ORREPLCD D SCAN
Q
SCAN ;
;LOOK FOR AUDIT IFN IN COMMENTS, STORE IFN OF ORDER IN AUDIT FILE
N DA,DIC,DIE,DLAYGO,DR
S ORFND=0
;
I $D(^OR(100,ORJO,8,0)) S ORK=0 F S ORK=$O(^OR(100,ORJO,8,ORK)) Q:+ORK'>0 D
. I $D(^OR(100,ORJO,8,ORK,.1,0)) S ORKK=0 F S ORKK=$O(^OR(100,ORJO,8,ORK,.1,ORKK)) Q:ORKK'>0 D
. . S ORKK0=^OR(100,ORJO,8,ORK,.1,ORKK,0) I ORKK0["** Pharmacy Confirmation",ORKK0[ORI S ORSTOP=1,DA=ORI,DR="7///"_ORJO,DIE="^OR(100.95,",DLAYGO=100.95,DIC(0)="L" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQOAUIA 1986 printed Nov 22, 2024@17:43:10 Page 2
ORQOAUIA ;EPIP/RTW - DAILY TASK RETRIEVE ASSOCIATED ORDER FOR A QUICK ORDER ; 12/29/17 10:03am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**441**;Dec 17, 1997;Build 52
+2 ;ICR# Type Description
+3 ;----- ---- -------------------------------------
+4 ;2053 Sup FILE^DIE
+5 ;10103 Sup $$FMTE^XLFDT
+6 ;No direct entry
QUIT
START ; ENTRY POINT
+1 NEW ORDAT,ORDAT2,ORDATORD,ORDTQUIC,ORDFN,ORDFNPLS,ORFND,ORI,ORJ,ORJJ,ORJO,ORK,ORKK,ORKK0,ORDITEM,ORQOIFN,ORREPLCD,ORSTOP,ORX,ORX0,ORD1
+2 ; PROCESS RECORDS UP TO 30 DAYS OLD
SET ORDAT=$$FMADD^XLFDT(DT,-30)
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Audit#",?10,"Order",?20,"Comment"
+4 FOR
SET ORDAT=$ORDER(^OR(100.95,"B",ORDAT))
if +ORDAT'>0
QUIT
SET ORI=0
FOR
SET ORI=$ORDER(^OR(100.95,"B",ORDAT,ORI))
if +ORI'>0
QUIT
Begin DoDot:1
+5 SET ORX0=^OR(100.95,ORI,0)
SET ORQOIFN=$PIECE(ORX0,U,4)
+6 ;Quit if entry already has a ORDER NUMBER.
if $PIECE(ORX0,U,8)>0
QUIT
+7 ;NO QUICK ORDER RECORDED
if ORQOIFN=""
QUIT
+8 ;S ORD1=$O(^ORD(101.41,ORQOIFN,6,"D",4,0))
+9 SET ORDFN=$PIECE(ORX0,U,3)
SET ORDFNPLS=ORDFN_";DPT("
+10 SET (ORDAT2,ORSTOP)=0
FOR
SET ORDAT2=$ORDER(^OR(100,"ACT",ORDFNPLS,ORDAT2))
if +ORDAT2'>0!(ORSTOP)
QUIT
SET ORJJ=0
FOR
SET ORJJ=$ORDER(^OR(100,"ACT",ORDFNPLS,ORDAT2,ORJJ))
if +ORJJ'>0
QUIT
Begin DoDot:2
+11 SET ORJ=0
FOR
SET ORJ=$ORDER(^OR(100,"ACT",ORDFNPLS,ORDAT2,ORJJ,ORJ))
if +ORJ'>0!(ORSTOP)
QUIT
Begin DoDot:3
+12 ;DATE/TIME ORDER ENTERED
SET ORDATORD=$PIECE(^OR(100,ORJ,0),"^",7)+.000099
+13 ;DATE/TIM OFAUDIT RECORD
SET ORDTQUIC=$PIECE(^OR(100.95,ORI,0),"^",1)
+14 ;REPLACED ORDER number if any.
SET ORREPLCD=$PIECE($GET(^OR(100,ORJ,3)),U,5)
+15 SET ORJO=ORJ
DO SCAN
IF 'ORFND
IF ORREPLCD>0
SET ORJO=ORREPLCD
DO SCAN
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
SCAN ;
+1 ;LOOK FOR AUDIT IFN IN COMMENTS, STORE IFN OF ORDER IN AUDIT FILE
+2 NEW DA,DIC,DIE,DLAYGO,DR
+3 SET ORFND=0
+4 ;
+5 IF $DATA(^OR(100,ORJO,8,0))
SET ORK=0
FOR
SET ORK=$ORDER(^OR(100,ORJO,8,ORK))
if +ORK'>0
QUIT
Begin DoDot:1
+6 IF $DATA(^OR(100,ORJO,8,ORK,.1,0))
SET ORKK=0
FOR
SET ORKK=$ORDER(^OR(100,ORJO,8,ORK,.1,ORKK))
if ORKK'>0
QUIT
Begin DoDot:2
+7 SET ORKK0=^OR(100,ORJO,8,ORK,.1,ORKK,0)
IF ORKK0["** Pharmacy Confirmation"
IF ORKK0[ORI
SET ORSTOP=1
SET DA=ORI
SET DR="7///"_ORJO
SET DIE="^OR(100.95,"
SET DLAYGO=100.95
SET DIC(0)="L"
DO ^DIE
End DoDot:2
End DoDot:1
+8 QUIT
