1 | ORWORR1 ; SLC/JLI - Utilities for Retrieve Orders for Broker ; 4/3/08 7:47am
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,243**;Dec 17, 1997;Build 242
|
---|
3 | ;Called from ORWORR
|
---|
4 | GET1 ;
|
---|
5 | S TOT=^TMP("ORR",$J,ORLIST,"TOT") K ^TMP("ORR",$J,ORLIST,"TOT")
|
---|
6 | S I=.1 F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:'I S IFN=^(I) D
|
---|
7 | . I $G(ORRECIP)&&($G(FILTER)=12&&($$FLAGRULE(+IFN))) K ^TMP("ORR",$J,ORLIST,I) S TOT=TOT-1 Q
|
---|
8 | . I ORWTS,(+$P($G(^OR(100,+IFN,0)),U,13)'=ORWTS) K ^TMP("ORR",$J,ORLIST,I) S TOT=TOT-1 Q
|
---|
9 | . S PTEVTID=$P($G(^OR(100,+IFN,0)),U,17)
|
---|
10 | . S:PTEVTID>0 EVTNAME=$$NAME^OREVNTX(PTEVTID)
|
---|
11 | . S ^TMP("ORR",$J,ORLIST,I)=IFN_U_$P($G(^OR(100,+IFN,0)),U,11)_U_$P($G(^(8,+$P(IFN,";",2),0)),U)_U_PTEVTID_U_EVTNAME
|
---|
12 | S TXTVW=$S(MULT:0,FILTER=2:2,1:1) D:FILTER=2 ORYD^ORDD100
|
---|
13 | S ^TMP("ORR",$J,ORLIST,.1)=TOT_U_TXTVW_U_$G(ORYD,0)
|
---|
14 | S REF=$NA(^TMP("ORR",$J,ORLIST))
|
---|
15 | Q
|
---|
16 | GET2 ; For AUTO DC/Event Release Orders
|
---|
17 | N JDND,JDIX,JDCNT,DCSPLIT
|
---|
18 | S JDCNT=1,DCSPLIT=0
|
---|
19 | S TOT=^TMP("ORR",$J,ORLIST,"TOT") K ^TMP("ORR",$J,ORLIST,"TOT")
|
---|
20 | F JDND="RL","DC" D
|
---|
21 | . S I=.1 F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:'I D
|
---|
22 | . . I '$D(^TMP("ORR",$J,ORLIST,I,JDND)) Q
|
---|
23 | . . S JDIX=0 F S JDIX=$O(^TMP("ORR",$J,ORLIST,I,JDND,JDIX)) Q:'JDIX S IFN=^(JDIX) D
|
---|
24 | . . . I 'DCSPLIT,(JDND="DC") D
|
---|
25 | . . . . S ^TMP("ORRJD",$J,JDCNT)="DC START"
|
---|
26 | . . . . S DCSPLIT=1,JDCNT=JDCNT+1,TOT=TOT+1
|
---|
27 | . . . I ORWTS,(+$P($G(^OR(100,+IFN,0)),U,13)'=ORWTS) S TOT=TOT-1 Q
|
---|
28 | . . . S PTEVTID=$P($G(^OR(100,+IFN,0)),U,17)
|
---|
29 | . . . S:PTEVTID>0 EVTNAME=$$NAME^OREVNTX(PTEVTID)
|
---|
30 | . . . S ^TMP("ORRJD",$J,JDCNT)=IFN_U_$P($G(^OR(100,+IFN,0)),U,11)_U_$P($G(^(8,+$P(IFN,";",2),0)),U)_U_PTEVTID_U_EVTNAME
|
---|
31 | . . . S JDCNT=JDCNT+1
|
---|
32 | S TXTVW=$S(MULT:0,FILTER=2:2,1:1) D:FILTER=2 ORYD^ORDD100
|
---|
33 | S ^TMP("ORRJD",$J,.1)=TOT_U_TXTVW_U_$G(ORYD,0)
|
---|
34 | S REF=$NA(^TMP("ORRJD",$J))
|
---|
35 | Q
|
---|
36 | FLAGRULE(ORNUM,USR) ;
|
---|
37 | ;returns 0 if we should keep ORNUM in the list
|
---|
38 | ;returns 1 if we should remove ORNUM from the list
|
---|
39 | ;determines based on whether the user USR should see these flagged orders
|
---|
40 | ; based on presence in file 100 NODE 8 FIELD 39 and
|
---|
41 | ; based on whether the user should have gotten the flag due to provider recipients
|
---|
42 | N ORI,ORRET,ORQUIT,I,LST,ORDFN
|
---|
43 | I '$G(USR) S USR=DUZ
|
---|
44 | S ORRET=1,ORQUIT=0
|
---|
45 | S ORI=0 F S ORI=$O(^OR(100,ORNUM,8,ORI)) Q:'ORI D
|
---|
46 | .I '$P($G(^OR(100,ORNUM,8,ORI,3)),U,6)&($P($G(^OR(100,ORNUM,8,ORI,3)),U,9)) S LST($P($G(^OR(100,ORNUM,8,ORI,3)),U,9))=""
|
---|
47 | S ORDFN=+$P($G(^OR(100,ORNUM,0)),U,2)
|
---|
48 | D START^ORBPRCHK(.LST,ORNUM,6,ORDFN)
|
---|
49 | ;add ordering provider
|
---|
50 | N ORDPROV
|
---|
51 | S ORDPROV=$$ORDERER^ORQOR2(ORNUM)
|
---|
52 | I $G(ORDPROV) S LST(ORDPROV)=""
|
---|
53 | D ADDSURR(.LST)
|
---|
54 | I $D(LST(USR)) S ORRET=0
|
---|
55 | Q ORRET
|
---|
56 | ADDSURR(LST) ;TAKE LIST OF USERS AND ADD SURROGATES TO THE LIST
|
---|
57 | N I
|
---|
58 | S I=0 F S I=$O(LST(I)) Q:'I S LST($$CURRSURO^XQALSURO(I))=""
|
---|
59 | Q
|
---|