MPIFAREQ.m

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 ---MPIFAREQ   1418     printed  Apr 23, 2025@18:25:18                                                                                                                                                                                                    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