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