MPIFREV ;BHM/RGY-Review CMOR request ;FEB 26, 1998
;;1.0; MASTER PATIENT INDEX VISTA ;**6,11**;30 Apr 99
;
; Integration Agreements Utilized:
;
; EXC^RGHLLOG IA #2796
; START^RGHLLOG IA #2796
; STOP^RGHLLOG IA #2796
;
EN ;
; Entry point for option MPIF REVIEW REQUEST. This option allows the
; user to review CMOR Change requests and approve or deny them
; No input or output variables.
N DIC
ASK S DIC="^MPIF(984.9,",DIC("A")="Select CMOR request to review: "
S DIC(0)="QEAM",DIC("S")="I $D(^MPIF(984.9,""AC"",3,Y))"
D ^DIC Q:+Y<0
D EN1(+Y)
G ASK
EN1(REQ,MSTOP) ;Review a CMOR request
N DFN,PHONE,RESULT,RES1,DIE,DA,DR,ENT,DIC,FR,BY,TO,FLDS,L,DIR,DUTOUT,X,Y,ERR,ER
S MSTOP=0,ER=0
I $P($G(^MPIF(984.9,+REQ,0)),"^",6)'=3 W !,"*** Request is not pending review ***" Q
N PAT S PAT=$P($G(^MPIF(984.9,+REQ,0)),"^",4)
;checking for other requests pending for this patient
K ARRAY
D OTHERS^MPIFAREQ(PAT,+REQ,.ARRAY)
I $G(ARRAY(0))'=0 W !!!,"**** There are other PENDING Requests for this patient. If you approve one the rest will automatically be disapproved. ***" H 5
S L=0,ENT=+REQ,DIC="^MPIF(984.9,",FR=+REQ,TO=+REQ,BY="@NUMBER",FLDS="[MPIF REQUEST VIEW]",IOP="HOME" D EN1^DIP
APP S DIR("A")="Select Review Action ("_$S($P(^MPIF(984.9,+REQ,0),"^",4)]"":"APPROVE/",1:"")_"DISAPPROVE, OR '^' to Exit)? "
S DIR(0)="SAO^"_$S($P(^MPIF(984.9,+REQ,0),"^",4)]"":"A:APPROVE;",1:"")_"D:DISAPPROVE"
N DIRUT,DTOUT
D ^DIR K DIR
I $D(DIRUT) S:X="^"!$D(DTOUT) MSTOP=1 W " ... No Action!" Q
S (RESULT,RES1)=Y
S PHONE=$P($G(^MPIF(984.9,+$O(^MPIF(984.9,"AE",DUZ,""),-1),2)),"^",3)
S DIE="^MPIF(984.9,",DR="[MPIF REVIEW RESULT]",DA=+REQ D ^DIE
I $D(Y)!$D(DTOUT) S:$D(DTOUT) MSTOP=1 S DIE="^MPIF(984.9,",DR="[MPIF REVIEW RESET]",DA=+REQ D ^DIE W " ... No Action!" Q
W !!," Processing.....",!
S DFN=$P($G(^MPIF(984.9,+REQ,0)),"^",4)
I $E(RESULT)="A" D
.S ERR=$$CHANGE^MPIF001(DFN,+$P($G(^MPIF(984.9,+REQ,0)),"^",7))
.;log exception if problem with updating CMOR
.I +ERR<0 D Q
..D START^RGHLLOG()
..D EXC^RGHLLOG(220,"Unable to change CMOR for Change CMOR Request for patient DFN= "_DFN_" Request # "_+REQ,DFN)
..D STOP^RGHLLOG(),RESET2^MPIFREQ(+REQ)
..W !!," Problem Changing CMOR, resetting status to pending approval. May be duplicates in Institution file for new CMOR or Patient file entry was already being edited.",!!
.I +ERR>0 D BROAD^MPIFCMOR(+REQ,.ER)
I +ER=0 D EN^MPIFRESS(+REQ)
I +ER=-1 W !!," Problem during Broadcast - "_$P(ER,"^",2) Q
N ENT
I ARRAY(0)'=0&($E(RES1)="A") D
.S ENT=0
.W !,"Have others to Disapprove -- automatically"
.F S ENT=$O(ARRAY(ENT)) Q:ENT="" D AUTODIS^MPIFAREQ(ARRAY(ENT))
W !!," ... Done!",!!
Q
;
BATCH ;Approve in batch mode
NEW CSITE,DIR,DIRUT,IOP,MSTOP,IEN,PIEN
I $O(^MPIF(984.9,"AC",3,0))="" W !!,"*** No request to approve ***",! Q
S MSTOP=0,CSITE=0
S DIR("A")="Do you want to approve by SITE",DIR(0)="Y"
D ^DIR K DIR
Q:$D(DIRUT)
S IEN=0,PIEN=0
W !
I Y=0 D Q
.F S IEN=$O(^MPIF(984.9,"AC",3,IEN)) Q:'IEN S IOP=ION D EN1(IEN,.MSTOP) Q:MSTOP
.Q
SITE S DIC("A")="Select Site: ",DIC="^DIC(4,",DIC(0)="QEAM",DIC("S")="I $D(^MPIF(984.9,""AS"",Y,3))" D ^DIC Q:Y<0 S CSITE=+Y
I $O(^MPIF(984.9,"AS",CSITE,3,0))="" W !!,"*** No requests to approve for this site ***",! G SITE
W !
S MSTOP=0
F S PIEN=$O(^MPIF(984.9,"AS",CSITE,3,PIEN)) Q:'PIEN D
.S IOP=ION
.D EN1(PIEN,.MSTOP)
.Q:MSTOP=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFREV 3474 printed Nov 22, 2024@17:21:39 Page 2
MPIFREV ;BHM/RGY-Review CMOR request ;FEB 26, 1998
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**6,11**;30 Apr 99
+2 ;
+3 ; Integration Agreements Utilized:
+4 ;
+5 ; EXC^RGHLLOG IA #2796
+6 ; START^RGHLLOG IA #2796
+7 ; STOP^RGHLLOG IA #2796
+8 ;
EN ;
+1 ; Entry point for option MPIF REVIEW REQUEST. This option allows the
+2 ; user to review CMOR Change requests and approve or deny them
+3 ; No input or output variables.
+4 NEW DIC
ASK SET DIC="^MPIF(984.9,"
SET DIC("A")="Select CMOR request to review: "
+1 SET DIC(0)="QEAM"
SET DIC("S")="I $D(^MPIF(984.9,""AC"",3,Y))"
+2 DO ^DIC
if +Y<0
QUIT
+3 DO EN1(+Y)
+4 GOTO ASK
EN1(REQ,MSTOP) ;Review a CMOR request
+1 NEW DFN,PHONE,RESULT,RES1,DIE,DA,DR,ENT,DIC,FR,BY,TO,FLDS,L,DIR,DUTOUT,X,Y,ERR,ER
+2 SET MSTOP=0
SET ER=0
+3 IF $PIECE($GET(^MPIF(984.9,+REQ,0)),"^",6)'=3
WRITE !,"*** Request is not pending review ***"
QUIT
+4 NEW PAT
SET PAT=$PIECE($GET(^MPIF(984.9,+REQ,0)),"^",4)
+5 ;checking for other requests pending for this patient
+6 KILL ARRAY
+7 DO OTHERS^MPIFAREQ(PAT,+REQ,.ARRAY)
+8 IF $GET(ARRAY(0))'=0
WRITE !!!,"**** There are other PENDING Requests for this patient. If you approve one the rest will automatically be disapproved. ***"
HANG 5
+9 SET L=0
SET ENT=+REQ
SET DIC="^MPIF(984.9,"
SET FR=+REQ
SET TO=+REQ
SET BY="@NUMBER"
SET FLDS="[MPIF REQUEST VIEW]"
SET IOP="HOME"
DO EN1^DIP
APP SET DIR("A")="Select Review Action ("_$SELECT($PIECE(^MPIF(984.9,+REQ,0),"^",4)]"":"APPROVE/",1:"")_"DISAPPROVE, OR '^' to Exit)? "
+1 SET DIR(0)="SAO^"_$SELECT($PIECE(^MPIF(984.9,+REQ,0),"^",4)]"":"A:APPROVE;",1:"")_"D:DISAPPROVE"
+2 NEW DIRUT,DTOUT
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
if X="^"!$DATA(DTOUT)
SET MSTOP=1
WRITE " ... No Action!"
QUIT
+5 SET (RESULT,RES1)=Y
+6 SET PHONE=$PIECE($GET(^MPIF(984.9,+$ORDER(^MPIF(984.9,"AE",DUZ,""),-1),2)),"^",3)
+7 SET DIE="^MPIF(984.9,"
SET DR="[MPIF REVIEW RESULT]"
SET DA=+REQ
DO ^DIE
+8 IF $DATA(Y)!$DATA(DTOUT)
if $DATA(DTOUT)
SET MSTOP=1
SET DIE="^MPIF(984.9,"
SET DR="[MPIF REVIEW RESET]"
SET DA=+REQ
DO ^DIE
WRITE " ... No Action!"
QUIT
+9 WRITE !!," Processing.....",!
+10 SET DFN=$PIECE($GET(^MPIF(984.9,+REQ,0)),"^",4)
+11 IF $EXTRACT(RESULT)="A"
Begin DoDot:1
+12 SET ERR=$$CHANGE^MPIF001(DFN,+$PIECE($GET(^MPIF(984.9,+REQ,0)),"^",7))
+13 ;log exception if problem with updating CMOR
+14 IF +ERR<0
Begin DoDot:2
+15 DO START^RGHLLOG()
+16 DO EXC^RGHLLOG(220,"Unable to change CMOR for Change CMOR Request for patient DFN= "_DFN_" Request # "_+REQ,DFN)
+17 DO STOP^RGHLLOG()
DO RESET2^MPIFREQ(+REQ)
+18 WRITE !!," Problem Changing CMOR, resetting status to pending approval. May be duplicates in Institution file for new CMOR or Patient file entry was already being edited.",!!
End DoDot:2
QUIT
+19 IF +ERR>0
DO BROAD^MPIFCMOR(+REQ,.ER)
End DoDot:1
+20 IF +ER=0
DO EN^MPIFRESS(+REQ)
+21 IF +ER=-1
WRITE !!," Problem during Broadcast - "_$PIECE(ER,"^",2)
QUIT
+22 NEW ENT
+23 IF ARRAY(0)'=0&($EXTRACT(RES1)="A")
Begin DoDot:1
+24 SET ENT=0
+25 WRITE !,"Have others to Disapprove -- automatically"
+26 FOR
SET ENT=$ORDER(ARRAY(ENT))
if ENT=""
QUIT
DO AUTODIS^MPIFAREQ(ARRAY(ENT))
End DoDot:1
+27 WRITE !!," ... Done!",!!
+28 QUIT
+29 ;
BATCH ;Approve in batch mode
+1 NEW CSITE,DIR,DIRUT,IOP,MSTOP,IEN,PIEN
+2 IF $ORDER(^MPIF(984.9,"AC",3,0))=""
WRITE !!,"*** No request to approve ***",!
QUIT
+3 SET MSTOP=0
SET CSITE=0
+4 SET DIR("A")="Do you want to approve by SITE"
SET DIR(0)="Y"
+5 DO ^DIR
KILL DIR
+6 if $DATA(DIRUT)
QUIT
+7 SET IEN=0
SET PIEN=0
+8 WRITE !
+9 IF Y=0
Begin DoDot:1
+10 FOR
SET IEN=$ORDER(^MPIF(984.9,"AC",3,IEN))
if 'IEN
QUIT
SET IOP=ION
DO EN1(IEN,.MSTOP)
if MSTOP
QUIT
+11 QUIT
End DoDot:1
QUIT
SITE SET DIC("A")="Select Site: "
SET DIC="^DIC(4,"
SET DIC(0)="QEAM"
SET DIC("S")="I $D(^MPIF(984.9,""AS"",Y,3))"
DO ^DIC
if Y<0
QUIT
SET CSITE=+Y
+1 IF $ORDER(^MPIF(984.9,"AS",CSITE,3,0))=""
WRITE !!,"*** No requests to approve for this site ***",!
GOTO SITE
+2 WRITE !
+3 SET MSTOP=0
+4 FOR
SET PIEN=$ORDER(^MPIF(984.9,"AS",CSITE,3,PIEN))
if 'PIEN
QUIT
Begin DoDot:1
+5 SET IOP=ION
+6 DO EN1(PIEN,.MSTOP)
+7 if MSTOP=1
QUIT
End DoDot:1
+8 QUIT
