source: WorldVistAEHR/trunk/r/FUNCTIONAL_INDEPENDENCE-RMIM/RMIMV.m@ 619

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

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1RMIMV ;WPB/CAM Version check - dup check - server option - consult screen
2 ;;1.0;FUNCTIONAL INDEPENDENCE;**4**;Apr 15, 2003
3 ;VERSION WILL BE IN GUI FORMAT - "1.0.0.T4"
4 ;12/01/2004 KAM RMIM*1*4 Modify code to match Consult/Request Tracking
5 ; permission verification for consult completion
6 ;12/27/2004 KAM RMIM*1*4 DBIA #4576 was approved to handle the API call
7 ; to $$VALID^GMRCAU
8RPC(RESULTS,NAME,VERSION) ;Main RPC entry
9 S RESULTS(0)=0
10 D FIND^DIC(19,"",1,"X",NAME,1,,,,"RMIMV")
11 I 'RMIMV("DILIST",0) Q
12 S VAL=RMIMV("DILIST","ID",1,1)
13 S VAL=$P(VAL,"version ",2)
14 I VAL'=VERSION Q
15 S RESULTS(0)=1
16 Q
17DUP(FLAG,RMIMD) ;Check to see if duplicate record
18 S DFN=$P(RMIMD,U),FAC=$P(RMIMD,U,2),IMP=$P(RMIMD,U,3),ADMIT=$P(RMIMD,U,4),ONSET=$P(RMIMD,U,5)
19 S X=ADMIT D ^%DT S ADMIT=Y
20 S X=ONSET D ^%DT S ONSET=Y
21 S FLAG(0)=0
22 F AA=0:0 S AA=$O(^RMIM(783,"DFN",DFN,AA)) Q:AA="" D
23 .S FFAC=$P(^RMIM(783,AA,0),U,6)
24 .S FIMP=$P(^RMIM(783,AA,0),U,8)
25 .S FADM=$P(^RMIM(783,AA,0),U,10)
26 .S FONS=$P(^RMIM(783,AA,0),U,9)
27 .Q:FAC'=FFAC
28 .Q:FIMP'=FIMP
29 .Q:ADMIT'=FADM
30 .Q:ONSET'=FONS
31 .S FLAG(0)=1
32 Q
33CON(ORY,ORPT,ORSDT,OREDT,ORSERV,ORSTATUS) ;Consult list only users service
34 F AA=0:0 S AA=$O(^GMR(123.5,AA)) Q:'AA D
35 .;
36 .;12/06/2004 KAM Added Next Line for RMIM*1*4
37 .I $$VALID^GMRCAU(AA) S SERV(AA)=""
38 .;
39 F AA=0:0 S AA=$O(SERV(AA)) Q:AA="" D
40 .D LIST^ORQQCN(.ORY,ORPT,,,AA,ORSTATUS)
41 .F CC=0:0 S CC=$O(^TMP("ORQQCN",$J,"CS",CC)) Q:CC="" D
42 ..S IEN=$P(^TMP("ORQQCN",$J,"CS",CC,0),U)
43 ..Q:+IEN=0
44 ..S ^TMP("ORQQCN",$J,"AS",IEN,0)=^TMP("ORQQCN",$J,"CS",CC,0)
45 .K ^TMP("ORQQCN",$J,"CS")
46 M ^TMP("ORQQCN",$J,"CS")=^TMP("ORQQCN",$J,"AS")
47 K ^TMP("ORQQCN",$J,"AS")
48 Q
49SER ;Server routine to populate the status and error desc if error status
50 ;Read SSN to get DFN and use DFN xref to find records for this patient
51 S (FAC,IMP,ONSET,ADMIT)=""
52 S (EFAC,EIMP,EONSET,EADMIT)=""
53 S RMIMFG=0
54 S REC=^XMB(3.9,XQMSG,2,2,0)
55 S ERR="",COUNT=0
56 F EE=3:0 S EE=$O(^XMB(3.9,XQMSG,2,EE)) Q:EE=""!(COUNT>3) D
57 .Q:^XMB(3.9,XQMSG,2,EE,0)["NNNN"
58 .W !,^XMB(3.9,XQMSG,2,EE,0)
59 .I ^XMB(3.9,XQMSG,2,EE,0)'="" D
60 ..S COUNT=COUNT+1
61 ..S ERR=ERR_^XMB(3.9,XQMSG,2,EE,0)
62 ;After receiving messages need to code for multiple errors
63 ;Greater then 4 needs a message sent to coordinators
64 I COUNT>3 D
65 .S ERR=" ERROR: MULTIPLE IDENTIFIED - COORDINATOR NEEDS TO REVIEW ALL FIELDS"
66 F AA=30:1 S REC2=$E(REC,AA,132) Q:+REC2
67 S REC3=$P(REC2," ",2)
68 F AA=1:1 S:$E(REC3,1)=" " REC3=$E(REC3,2,80) Q:$E(REC3,1)'=" "
69 S SSN=$E(REC2,1,9) I SSN="" S EMSG="SSN SENT FROM AUSTIN IS NOT A VALID SSN" D SEND Q
70 S DFN="",DFN=$O(^DPT("SSN",SSN,DFN)) W !,DFN
71 I DFN="" S EMSG="SSN SENT FROM AUSTIN IS NOT A VALID SSN" D SEND Q ;Need to send message if could not find ssn
72 S FAC=$P(REC2," ",3),IMP=$P(REC2," ",4)
73 F AA=1:1 S:$E(IMP,1)=" " IMP=$E(IMP,2,10) Q:$E(IMP,1)'=" "
74 S ONSET=$P(REC3," "),ADMIT=$P(REC3," ",2)
75 S X=ONSET D ^%DT Q:Y=-1 S ONSET=Y
76 S X=ADMIT D ^%DT Q:Y=-1 S ADMIT=Y
77 S STA=$P(REC3," ",3)
78 S FLAG=0
79 F AA=0:0 S AA=$O(^RMIM(783,"DFN",DFN,AA)) Q:AA=""!(FLAG=1) D
80 .S FIMP=$P(^RMIM(783,AA,0),"^",8) I FIMP'=IMP S RMIMFG=1,EIMP=IMP,EACK=AA,EMSG="IMP DOES NOT MATCH" Q
81 .S FONSET=$P(^RMIM(783,AA,0),"^",9) I FONSET'=ONSET S RMIMFG=1,EONSET=ONSET,EACK=AA,EMSG="ONSET DOES NOT MATCH" Q
82 .S FADMIT=$P(^RMIM(783,AA,0),"^",10) I FADMIT'=ADMIT S RMIMFG=1,EADMIT=ADMIT,EACK=AA,EMSG="ADMIT DOES NOT MATCH" Q
83 .S FFAC=$P(^RMIM(783,AA,0),"^",6) I FFAC'=FAC S RMIMFG=1,EFAC=FAC,EACK=AA,EMSG="FAC DOES NOT MATCH" Q
84 .I STA["ACK" S STA=0
85 .I STA["ERR" S STA=1
86 .S ^RMIM(783,AA,9)=STA_"^"_ERR S FLAG=1
87 I FLAG=1 Q
88 D SEND
89 Q
90SEND ;Message to coordinators data from Austin did not match RMIM file
91 S X=EONSET D DD^%DT Q:Y=-1 S EONSET=Y
92 S X=EADMIT D DD^%DT Q:Y=-1 S EADMIT=Y
93 S AS="" S:$D(^RMIM(783,EACK,9)) AS=$P(^RMIM(783,EACK,9),U)
94 I AS=0 S EACK="ACK"
95 I AS=1 S EACK="ERR"
96 S TX(1,0)="Please check FSOD in Austin to view FIM transmission."
97 S TX(2,0)="This FIM patient record did not match data transmitted in our file"
98 S TX(3,0)="(783) therefore the Austin Status field could not get updated."
99 S TX(4,0)="If FSOD record looks ok in Austin, then have IRM manually update the"
100 S TX(5,0)="record, which best fits, this description to reflect Austin Status."
101 S TX(6,0)=""
102 S TX(16,0)="SSN: "_SSN
103 S TX(17,0)="FACILITY: "_FAC
104 S TX(18,0)="IMPAIRMENT CODE: "_IMP
105 S TX(19,0)="ADMIT DATE: "_EADMIT
106 S TX(20,0)="ONSET DATE: "_EONSET
107 S TX(21,0)="Austin Status: "_EACK
108 S TX(22,0)=""
109 S TX(23,0)="Below is the data that was returned by FSOD Austin"
110 S TX(24,0)="Message number "_XQMSG
111 S TX(25,0)=^XMB(3.9,XQMSG,2,2,0)
112 S (XMDUN,XMDUZ)="FSOD TRANSMISSION",XMSUB="Unidentified Acknowledgement from Austin"
113 S RMIMMG=$P(^RMIM(783.9,1,0),U,3),RMIMMG=$P(^XMB(3.8,RMIMMG,0),U)
114 S RMIMMG="G."_RMIMMG
115 S XMTEXT="TX(",XMY(RMIMMG)="" D ^XMD
116 Q
117IT ;Resend all records to Austin
118 W !,"You will be setting the cross-ref to transmit all records to Austin"
119 W !,"Are you sure you want to continue?"
120 S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:$D(DIRUT)!(Y=0)
121 S RMIM=0 F S RMIM=$O(^RMIM(783,RMIM)) Q:'RMIM S X=$G(^(RMIM,0)) D
122 .S ^RMIM(783,"ATRAN",1,RMIM)="",$P(X,U,15)=1
123 .S ^RMIM(783,RMIM,0)=X
124 W !,"Cross-ref set to retransmit all records to Austin"
125 Q
Note: See TracBrowser for help on using the repository browser.