Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMIMV

RMIMV.m

Go to the documentation of this file. 
  1. RMIMV ;WPB/CAM Version check - dup check - server option - consult screen
  1.  ;;1.0;FUNCTIONAL INDEPENDENCE;**4**;Apr 15, 2003
  1.  ;VERSION WILL BE IN GUI FORMAT - "1.0.0.T4"
  1.  ;12/01/2004 KAM RMIM*1*4 Modify code to match Consult/Request Tracking
  1.  ;               permission verification for consult completion 
  1.  ;12/27/2004 KAM RMIM*1*4 DBIA #4576 was approved to handle the API call 
  1.  ;               to $$VALID^GMRCAU
  1. RPC(RESULTS,NAME,VERSION) ;Main RPC entry
  1.  S RESULTS(0)=0
  1.  D FIND^DIC(19,"",1,"X",NAME,1,,,,"RMIMV")
  1.  I 'RMIMV("DILIST",0) Q
  1.  S VAL=RMIMV("DILIST","ID",1,1)
  1.  S VAL=$P(VAL,"version ",2)
  1.  I VAL'=VERSION Q
  1.  S RESULTS(0)=1
  1.  Q
  1. DUP(FLAG,RMIMD) ;Check to see if duplicate record
  1.  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)
  1.  S X=ADMIT D ^%DT S ADMIT=Y
  1.  S X=ONSET D ^%DT S ONSET=Y
  1.  S FLAG(0)=0
  1.  F AA=0:0 S AA=$O(^RMIM(783,"DFN",DFN,AA)) Q:AA=""  D
  1.  .S FFAC=$P(^RMIM(783,AA,0),U,6)
  1.  .S FIMP=$P(^RMIM(783,AA,0),U,8)
  1.  .S FADM=$P(^RMIM(783,AA,0),U,10)
  1.  .S FONS=$P(^RMIM(783,AA,0),U,9)
  1.  .Q:FAC'=FFAC 
  1.  .Q:FIMP'=FIMP
  1.  .Q:ADMIT'=FADM
  1.  .Q:ONSET'=FONS
  1.  .S FLAG(0)=1
  1.  Q
  1. CON(ORY,ORPT,ORSDT,OREDT,ORSERV,ORSTATUS) ;Consult list only users service
  1.  F AA=0:0 S AA=$O(^GMR(123.5,AA)) Q:'AA  D
  1.  .;
  1.  .;12/06/2004 KAM Added Next Line for RMIM*1*4
  1.  .I $$VALID^GMRCAU(AA) S SERV(AA)=""
  1.  .;
  1.  F AA=0:0 S AA=$O(SERV(AA)) Q:AA=""  D
  1.  .D LIST^ORQQCN(.ORY,ORPT,,,AA,ORSTATUS)
  1.  .F CC=0:0 S CC=$O(^TMP("ORQQCN",$J,"CS",CC)) Q:CC=""  D
  1.  ..S IEN=$P(^TMP("ORQQCN",$J,"CS",CC,0),U)
  1.  ..Q:+IEN=0
  1.  ..S ^TMP("ORQQCN",$J,"AS",IEN,0)=^TMP("ORQQCN",$J,"CS",CC,0)
  1.  .K ^TMP("ORQQCN",$J,"CS")
  1.  M ^TMP("ORQQCN",$J,"CS")=^TMP("ORQQCN",$J,"AS")
  1.  K ^TMP("ORQQCN",$J,"AS")
  1.  Q
  1. SER ;Server routine to populate the status and error desc if error status
  1.  ;Read SSN to get DFN and use DFN xref to find records for this patient
  1.  S (FAC,IMP,ONSET,ADMIT)=""
  1.  S (EFAC,EIMP,EONSET,EADMIT)=""
  1.  S RMIMFG=0
  1.  S REC=^XMB(3.9,XQMSG,2,2,0)
  1.  S ERR="",COUNT=0
  1.  F EE=3:0 S EE=$O(^XMB(3.9,XQMSG,2,EE)) Q:EE=""!(COUNT>3)  D
  1.  .Q:^XMB(3.9,XQMSG,2,EE,0)["NNNN"
  1.  .W !,^XMB(3.9,XQMSG,2,EE,0)
  1.  .I ^XMB(3.9,XQMSG,2,EE,0)'="" D
  1.  ..S COUNT=COUNT+1
  1.  ..S ERR=ERR_^XMB(3.9,XQMSG,2,EE,0)
  1.  ;After receiving messages need to code for multiple errors
  1.  ;Greater then 4 needs a message sent to coordinators
  1.  I COUNT>3 D
  1.  .S ERR="  ERROR: MULTIPLE IDENTIFIED - COORDINATOR NEEDS TO REVIEW ALL FIELDS"
  1.  F AA=30:1 S REC2=$E(REC,AA,132) Q:+REC2
  1.  S REC3=$P(REC2,"    ",2)
  1.  F AA=1:1 S:$E(REC3,1)=" " REC3=$E(REC3,2,80) Q:$E(REC3,1)'=" "
  1.  S SSN=$E(REC2,1,9) I SSN="" S EMSG="SSN SENT FROM AUSTIN IS NOT A VALID SSN" D SEND Q
  1.  S DFN="",DFN=$O(^DPT("SSN",SSN,DFN)) W !,DFN
  1.  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
  1.  S FAC=$P(REC2,"  ",3),IMP=$P(REC2,"  ",4)
  1.  F AA=1:1 S:$E(IMP,1)=" " IMP=$E(IMP,2,10) Q:$E(IMP,1)'=" "
  1.  S ONSET=$P(REC3,"  "),ADMIT=$P(REC3,"  ",2)
  1.  S X=ONSET D ^%DT Q:Y=-1  S ONSET=Y
  1.  S X=ADMIT D ^%DT Q:Y=-1  S ADMIT=Y
  1.  S STA=$P(REC3,"  ",3)
  1.  S FLAG=0
  1.  F AA=0:0 S AA=$O(^RMIM(783,"DFN",DFN,AA)) Q:AA=""!(FLAG=1)  D
  1.  .S FIMP=$P(^RMIM(783,AA,0),"^",8) I FIMP'=IMP S RMIMFG=1,EIMP=IMP,EACK=AA,EMSG="IMP DOES NOT MATCH" Q
  1.  .S FONSET=$P(^RMIM(783,AA,0),"^",9) I FONSET'=ONSET S RMIMFG=1,EONSET=ONSET,EACK=AA,EMSG="ONSET DOES NOT MATCH" Q
  1.  .S FADMIT=$P(^RMIM(783,AA,0),"^",10) I FADMIT'=ADMIT S RMIMFG=1,EADMIT=ADMIT,EACK=AA,EMSG="ADMIT DOES NOT MATCH" Q
  1.  .S FFAC=$P(^RMIM(783,AA,0),"^",6) I FFAC'=FAC S RMIMFG=1,EFAC=FAC,EACK=AA,EMSG="FAC DOES NOT MATCH" Q
  1.  .I STA["ACK" S STA=0
  1.  .I STA["ERR" S STA=1
  1.  .S ^RMIM(783,AA,9)=STA_"^"_ERR S FLAG=1
  1.  I FLAG=1 Q
  1.  D SEND
  1.  Q
  1. SEND ;Message to coordinators data from Austin did not match RMIM file
  1.  S X=EONSET D DD^%DT Q:Y=-1  S EONSET=Y
  1.  S X=EADMIT D DD^%DT Q:Y=-1  S EADMIT=Y
  1.  S AS="" S:$D(^RMIM(783,EACK,9)) AS=$P(^RMIM(783,EACK,9),U)
  1.  I AS=0 S EACK="ACK"
  1.  I AS=1 S EACK="ERR"
  1.  S TX(1,0)="Please check FSOD in Austin to view FIM transmission."
  1.  S TX(2,0)="This FIM patient record did not match data transmitted in our file"
  1.  S TX(3,0)="(783) therefore the Austin Status field could not get updated."
  1.  S TX(4,0)="If FSOD record looks ok in Austin, then have IRM manually update the"
  1.  S TX(5,0)="record, which best fits, this description to reflect Austin Status."
  1.  S TX(6,0)=""
  1.  S TX(16,0)="SSN: "_SSN
  1.  S TX(17,0)="FACILITY: "_FAC
  1.  S TX(18,0)="IMPAIRMENT CODE: "_IMP
  1.  S TX(19,0)="ADMIT DATE: "_EADMIT
  1.  S TX(20,0)="ONSET DATE: "_EONSET
  1.  S TX(21,0)="Austin Status:  "_EACK
  1.  S TX(22,0)=""
  1.  S TX(23,0)="Below is the data that was returned by FSOD Austin"
  1.  S TX(24,0)="Message number "_XQMSG
  1.  S TX(25,0)=^XMB(3.9,XQMSG,2,2,0)
  1.  S (XMDUN,XMDUZ)="FSOD TRANSMISSION",XMSUB="Unidentified Acknowledgement from Austin"
  1.  S RMIMMG=$P(^RMIM(783.9,1,0),U,3),RMIMMG=$P(^XMB(3.8,RMIMMG,0),U)
  1.  S RMIMMG="G."_RMIMMG
  1.  S XMTEXT="TX(",XMY(RMIMMG)="" D ^XMD
  1.  Q
  1. IT ;Resend all records to Austin
  1.  W !,"You will be setting the cross-ref to transmit all records to Austin"
  1.  W !,"Are you sure you want to continue?"
  1.  S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:$D(DIRUT)!(Y=0)
  1.  S RMIM=0 F  S RMIM=$O(^RMIM(783,RMIM)) Q:'RMIM  S X=$G(^(RMIM,0)) D
  1.  .S ^RMIM(783,"ATRAN",1,RMIM)="",$P(X,U,15)=1
  1.  .S ^RMIM(783,RMIM,0)=X
  1.  W !,"Cross-ref set to retransmit all records to Austin"
  1.  Q