MPIFAREQ ;BPCIO/CMC-AUTO ACCEPT REQUESTS NOT PROCEESED ; NOV 16, 2000
;;1.0; MASTER PATIENT INDEX VISTA ;**11**;30 Apr 99
;
; If a request goes unprocessed for more than 14 days, it will
; be processed as if auto-accept was enabled.
;
; This will be a job that will run in the background, nightly
CHK ;
N IEN,RDT,NODE,X,Y,%,NDT,X1,X2,PAT,REQ
K ARRAY
S (REQ,IEN)=0
D NOW^%DTC
S NDT=X
F S IEN=$O(^MPIF(984.9,"AC",3,IEN)) Q:IEN="" D
.S NODE=$G(^MPIF(984.9,IEN,0))
.S RDT=$P(NODE,"^",3),PAT=$P(NODE,"^",4)
.S X1=NDT,X2=RDT
.D ^%DTC
.I X>14 D
..K ARRAY
..D OTHERS(PAT,IEN,.ARRAY)
..I ARRAY(0)'=0 S REQ=0 F S REQ=$O(ARRAY(REQ)) Q:REQ="" D AUTODIS(ARRAY(REQ))
..; ^ automatically disapprove any other requests for this patient that are pending
..D AUTO^MPIFREQ(IEN)
..; ^ auto approve request older than 14 days
K ARRAY
Q
;
OTHERS(PT,ENT,ARR) ;
N IEN,CNT
K ARR
S IEN="",CNT=0
F S IEN=$O(^MPIF(984.9,"C",PT,IEN)) Q:IEN="" D
.I IEN'=ENT,$P($G(^MPIF(984.9,IEN,0)),"^",6)=3 D
..S CNT=CNT+1
..S ARR(IEN)=$P($G(^MPIF(984.9,IEN,0)),"^")
S ARR(0)=CNT
Q
;
AUTODIS(REQNO) ;
N DIE,DA,DR,IEN,NOTES
S DIE="^MPIF(984.9,",IEN=$O(^MPIF(984.9,"B",REQNO,""))
Q:IEN=""
S DA=IEN,NOTES="Multiple Request to Change CMOR, Other Request received 1st"
S DR=".06///5;3.01///Automatic Processing;2.02///TODAY;3.02///"_NOTES
D ^DIE
D EN^MPIFRESS(IEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFAREQ 1418 printed Nov 22, 2024@17:20:59 Page 2
MPIFAREQ ;BPCIO/CMC-AUTO ACCEPT REQUESTS NOT PROCEESED ; NOV 16, 2000
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**11**;30 Apr 99
+2 ;
+3 ; If a request goes unprocessed for more than 14 days, it will
+4 ; be processed as if auto-accept was enabled.
+5 ;
+6 ; This will be a job that will run in the background, nightly
CHK ;
+1 NEW IEN,RDT,NODE,X,Y,%,NDT,X1,X2,PAT,REQ
+2 KILL ARRAY
+3 SET (REQ,IEN)=0
+4 DO NOW^%DTC
+5 SET NDT=X
+6 FOR
SET IEN=$ORDER(^MPIF(984.9,"AC",3,IEN))
if IEN=""
QUIT
Begin DoDot:1
+7 SET NODE=$GET(^MPIF(984.9,IEN,0))
+8 SET RDT=$PIECE(NODE,"^",3)
SET PAT=$PIECE(NODE,"^",4)
+9 SET X1=NDT
SET X2=RDT
+10 DO ^%DTC
+11 IF X>14
Begin DoDot:2
+12 KILL ARRAY
+13 DO OTHERS(PAT,IEN,.ARRAY)
+14 IF ARRAY(0)'=0
SET REQ=0
FOR
SET REQ=$ORDER(ARRAY(REQ))
if REQ=""
QUIT
DO AUTODIS(ARRAY(REQ))
+15 ; ^ automatically disapprove any other requests for this patient that are pending
+16 DO AUTO^MPIFREQ(IEN)
+17 ; ^ auto approve request older than 14 days
End DoDot:2
End DoDot:1
+18 KILL ARRAY
+19 QUIT
+20 ;
OTHERS(PT,ENT,ARR) ;
+1 NEW IEN,CNT
+2 KILL ARR
+3 SET IEN=""
SET CNT=0
+4 FOR
SET IEN=$ORDER(^MPIF(984.9,"C",PT,IEN))
if IEN=""
QUIT
Begin DoDot:1
+5 IF IEN'=ENT
IF $PIECE($GET(^MPIF(984.9,IEN,0)),"^",6)=3
Begin DoDot:2
+6 SET CNT=CNT+1
+7 SET ARR(IEN)=$PIECE($GET(^MPIF(984.9,IEN,0)),"^")
End DoDot:2
End DoDot:1
+8 SET ARR(0)=CNT
+9 QUIT
+10 ;
AUTODIS(REQNO) ;
+1 NEW DIE,DA,DR,IEN,NOTES
+2 SET DIE="^MPIF(984.9,"
SET IEN=$ORDER(^MPIF(984.9,"B",REQNO,""))
+3 if IEN=""
QUIT
+4 SET DA=IEN
SET NOTES="Multiple Request to Change CMOR, Other Request received 1st"
+5 SET DR=".06///5;3.01///Automatic Processing;2.02///TODAY;3.02///"_NOTES
+6 DO ^DIE
+7 DO EN^MPIFRESS(IEN)
+8 QUIT
