1 | MPIFAREQ ;BPCIO/CMC-AUTO ACCEPT REQUESTS NOT PROCEESED ; NOV 16, 2000
|
---|
2 | ;;1.0; MASTER PATIENT INDEX VISTA ;**11**;30 Apr 99
|
---|
3 | ;
|
---|
4 | ; If a request goes unprocessed for more than 14 days, it will
|
---|
5 | ; be processed as if auto-accept was enabled.
|
---|
6 | ;
|
---|
7 | ; This will be a job that will run in the background, nightly
|
---|
8 | CHK ;
|
---|
9 | N IEN,RDT,NODE,X,Y,%,NDT,X1,X2,PAT,REQ
|
---|
10 | K ARRAY
|
---|
11 | S (REQ,IEN)=0
|
---|
12 | D NOW^%DTC
|
---|
13 | S NDT=X
|
---|
14 | F S IEN=$O(^MPIF(984.9,"AC",3,IEN)) Q:IEN="" D
|
---|
15 | .S NODE=$G(^MPIF(984.9,IEN,0))
|
---|
16 | .S RDT=$P(NODE,"^",3),PAT=$P(NODE,"^",4)
|
---|
17 | .S X1=NDT,X2=RDT
|
---|
18 | .D ^%DTC
|
---|
19 | .I X>14 D
|
---|
20 | ..K ARRAY
|
---|
21 | ..D OTHERS(PAT,IEN,.ARRAY)
|
---|
22 | ..I ARRAY(0)'=0 S REQ=0 F S REQ=$O(ARRAY(REQ)) Q:REQ="" D AUTODIS(ARRAY(REQ))
|
---|
23 | ..; ^ automatically disapprove any other requests for this patient that are pending
|
---|
24 | ..D AUTO^MPIFREQ(IEN)
|
---|
25 | ..; ^ auto approve request older than 14 days
|
---|
26 | K ARRAY
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | OTHERS(PT,ENT,ARR) ;
|
---|
30 | N IEN,CNT
|
---|
31 | K ARR
|
---|
32 | S IEN="",CNT=0
|
---|
33 | F S IEN=$O(^MPIF(984.9,"C",PT,IEN)) Q:IEN="" D
|
---|
34 | .I IEN'=ENT,$P($G(^MPIF(984.9,IEN,0)),"^",6)=3 D
|
---|
35 | ..S CNT=CNT+1
|
---|
36 | ..S ARR(IEN)=$P($G(^MPIF(984.9,IEN,0)),"^")
|
---|
37 | S ARR(0)=CNT
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | AUTODIS(REQNO) ;
|
---|
41 | N DIE,DA,DR,IEN,NOTES
|
---|
42 | S DIE="^MPIF(984.9,",IEN=$O(^MPIF(984.9,"B",REQNO,""))
|
---|
43 | Q:IEN=""
|
---|
44 | S DA=IEN,NOTES="Multiple Request to Change CMOR, Other Request received 1st"
|
---|
45 | S DR=".06///5;3.01///Automatic Processing;2.02///TODAY;3.02///"_NOTES
|
---|
46 | D ^DIE
|
---|
47 | D EN^MPIFRESS(IEN)
|
---|
48 | Q
|
---|