source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFREV.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1MPIFREV ;BHM/RGY-Review CMOR request ;FEB 26, 1998
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**6,11**;30 Apr 99
3 ;
4 ; Integration Agreements Utilized:
5 ;
6 ; EXC^RGHLLOG IA #2796
7 ; START^RGHLLOG IA #2796
8 ; STOP^RGHLLOG IA #2796
9 ;
10EN ;
11 ; Entry point for option MPIF REVIEW REQUEST. This option allows the
12 ; user to review CMOR Change requests and approve or deny them
13 ; No input or output variables.
14 N DIC
15ASK S DIC="^MPIF(984.9,",DIC("A")="Select CMOR request to review: "
16 S DIC(0)="QEAM",DIC("S")="I $D(^MPIF(984.9,""AC"",3,Y))"
17 D ^DIC Q:+Y<0
18 D EN1(+Y)
19 G ASK
20EN1(REQ,MSTOP) ;Review a CMOR request
21 N DFN,PHONE,RESULT,RES1,DIE,DA,DR,ENT,DIC,FR,BY,TO,FLDS,L,DIR,DUTOUT,X,Y,ERR,ER
22 S MSTOP=0,ER=0
23 I $P($G(^MPIF(984.9,+REQ,0)),"^",6)'=3 W !,"*** Request is not pending review ***" Q
24 N PAT S PAT=$P($G(^MPIF(984.9,+REQ,0)),"^",4)
25 ;checking for other requests pending for this patient
26 K ARRAY
27 D OTHERS^MPIFAREQ(PAT,+REQ,.ARRAY)
28 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
29 S L=0,ENT=+REQ,DIC="^MPIF(984.9,",FR=+REQ,TO=+REQ,BY="@NUMBER",FLDS="[MPIF REQUEST VIEW]",IOP="HOME" D EN1^DIP
30APP S DIR("A")="Select Review Action ("_$S($P(^MPIF(984.9,+REQ,0),"^",4)]"":"APPROVE/",1:"")_"DISAPPROVE, OR '^' to Exit)? "
31 S DIR(0)="SAO^"_$S($P(^MPIF(984.9,+REQ,0),"^",4)]"":"A:APPROVE;",1:"")_"D:DISAPPROVE"
32 N DIRUT,DTOUT
33 D ^DIR K DIR
34 I $D(DIRUT) S:X="^"!$D(DTOUT) MSTOP=1 W " ... No Action!" Q
35 S (RESULT,RES1)=Y
36 S PHONE=$P($G(^MPIF(984.9,+$O(^MPIF(984.9,"AE",DUZ,""),-1),2)),"^",3)
37 S DIE="^MPIF(984.9,",DR="[MPIF REVIEW RESULT]",DA=+REQ D ^DIE
38 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
39 W !!," Processing.....",!
40 S DFN=$P($G(^MPIF(984.9,+REQ,0)),"^",4)
41 I $E(RESULT)="A" D
42 .S ERR=$$CHANGE^MPIF001(DFN,+$P($G(^MPIF(984.9,+REQ,0)),"^",7))
43 .;log exception if problem with updating CMOR
44 .I +ERR<0 D Q
45 ..D START^RGHLLOG()
46 ..D EXC^RGHLLOG(220,"Unable to change CMOR for Change CMOR Request for patient DFN= "_DFN_" Request # "_+REQ,DFN)
47 ..D STOP^RGHLLOG(),RESET2^MPIFREQ(+REQ)
48 ..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.",!!
49 .I +ERR>0 D BROAD^MPIFCMOR(+REQ,.ER)
50 I +ER=0 D EN^MPIFRESS(+REQ)
51 I +ER=-1 W !!," Problem during Broadcast - "_$P(ER,"^",2) Q
52 N ENT
53 I ARRAY(0)'=0&($E(RES1)="A") D
54 .S ENT=0
55 .W !,"Have others to Disapprove -- automatically"
56 .F S ENT=$O(ARRAY(ENT)) Q:ENT="" D AUTODIS^MPIFAREQ(ARRAY(ENT))
57 W !!," ... Done!",!!
58 Q
59 ;
60BATCH ;Approve in batch mode
61 NEW CSITE,DIR,DIRUT,IOP,MSTOP,IEN,PIEN
62 I $O(^MPIF(984.9,"AC",3,0))="" W !!,"*** No request to approve ***",! Q
63 S MSTOP=0,CSITE=0
64 S DIR("A")="Do you want to approve by SITE",DIR(0)="Y"
65 D ^DIR K DIR
66 Q:$D(DIRUT)
67 S IEN=0,PIEN=0
68 W !
69 I Y=0 D Q
70 .F S IEN=$O(^MPIF(984.9,"AC",3,IEN)) Q:'IEN S IOP=ION D EN1(IEN,.MSTOP) Q:MSTOP
71 .Q
72SITE 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
73 I $O(^MPIF(984.9,"AS",CSITE,3,0))="" W !!,"*** No requests to approve for this site ***",! G SITE
74 W !
75 S MSTOP=0
76 F S PIEN=$O(^MPIF(984.9,"AS",CSITE,3,PIEN)) Q:'PIEN D
77 .S IOP=ION
78 .D EN1(PIEN,.MSTOP)
79 .Q:MSTOP=1
80 Q
Note: See TracBrowser for help on using the repository browser.