MDCPHL7C ; HINES OIFO/BJ - CP Outbound message record maintenance routine.;26 OCT 2011
;;1.0;CLINICAL PROCEDURES;**23**;OCT 26, 2011;Build 281
;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine uses the following IAs:
; #325 - ADM^VADPT2 Registration (controlled,subscription)
; #417 - $P(^DA(40.8,DA,0),U,7) Registration (controlled,subscription)
;
SNDA08 ;
; Called via ScriptRunner
; P2(0) - DFN of patient
; P2(1) - ID of Protocol Subscriber from file 704.006 to use
;
N IEN,EVENT,WARD,DIV,BED,DFN
;
D NEWDOC^MDCLIO("RESULTS","SENDA08")
D XMLHDR^MDCLIO("RECORD")
I +$G(P2(0))<1 D G SNDA08A
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","PATIENT UNDEFINED")
S DFN=P2(0)
; Yes, I know we're just checking to see if there's anything in the protocol field.
; At this point, though, it isn't worth doing a pattern match on the protocol sent in.
I $G(P2(1))="" D G SNDA08A
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","PROTOCOL UNDEFINED")
; First, sanity checks.
S IEN=$$FIND1^DIC(704.006,"","KO",P2(1))
I +IEN<1 D G SNDA08A
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","UNABLE TO FIND PROTOCOL SUBSCRIBER WITH REQUESTED ID")
S EVENT=$$GET1^DIQ(704.006,IEN_",",".05")
I EVENT'="A08" D G SNDA08A
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","SPECIFIED PROTOCOL DOES NOT SUPPORT A08 MESSAGES")
;
; Okay: at this point, we have a valid protocol and a (presumably) valid patient.
; Now to send the message.
;
;
D ADD^MDCPVDEF(DFN,"","","","ADT","A08",,IEN)
; FIXME: Need to get IEN of new entry in 704.005 and check actual status.
D XMLDATA^MDCLIO("STATUS","1")
D XMLDATA^MDCLIO("MESSAGE","SUCCESS")
SNDA08A ;
D XMLFTR^MDCLIO("RECORD")
D ENDDOC^MDCLIO("RESULTS")
Q
;
CANRESND ;
; Called via ScriptRunner
; P2(0) - DFN of patient
;
D NEWDOC^MDCLIO("RESULTS","CAN RESEND ADT")
D XMLHDR^MDCLIO("RECORD")
N LSTSNTDT,DFN,LSTSNTID
S DFN=P2(0)
; Is this an inpatient? If not, we're not sending an anything other than an A08.
;
D ADM^VADPT2 I +$G(VADMVT)=0 D G CANRSND1
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","PATIENT NOT ADMITTED")
;
S LSTSNTDT=+$O(^MDC(704.005,"LSTMSG",DFN,9999999),-1)
I LSTSNTDT<1 D G CANRSND1
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","NO PREVIOUS MESSAGE")
;
;
N EVENT S EVENT=$O(^MDC(704.005,"LSTMSG",DFN,LSTSNTDT,""))
S LSTSNTID=+$O(^MDC(704.005,"LSTMSG",DFN,LSTSNTDT,EVENT,0))
I LSTSNTID<0 D G CANRSND1
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","INVALID MESSAGE ID")
;
; We now have a valid DFN and message ID. Send the info back to Delphiland so the appropriate menu options can be enabled.
;
D XMLDATA^MDCLIO("STATUS","1")
D XMLDATA^MDCLIO("MESSAGE",LSTSNTID)
;
CANRSND1 ;
D XMLFTR^MDCLIO("RECORD")
D ENDDOC^MDCLIO("RESULTS")
Q
;
DORESND ;
; Called via ScriptRunner
;
; P2(0) - IEN of message to resend.
;
D NEWDOC^MDCLIO("RESULTS","RESEND ADT MESSAGE")
D XMLHDR^MDCLIO("RECORD")
S IEN=$G(P2(0))
I IEN="" D G DORESND1
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","INVALID IEN")
;
N EVENT,STATUS
S EVENT=$$GET1^DIQ(704.005,IEN_",",".07")
I "A01A02A03A11A12A12"'[$G(EVENT) D G DORESND1
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","INVALID MESSAGE STATUS "_EVENT_" FOR MESSAGE "_IEN)
;
I $$QUE^MDCPMESQ(IEN,EVENT,.STATUS) D
. D XMLDATA^MDCLIO("STATUS","1")
. D XMLDATA^MDCLIO("MESSAGE","SUCCESS")
E D
. D XMLDATA^MDCLIO("STATUS","-1")
. D XMLDATA^MDCLIO("MESSAGE","ERROR REQUEING MESSAGE "_IEN_": "_STATUS)
;
DORESND1 ;
D XMLFTR^MDCLIO("RECORD")
D ENDDOC^MDCLIO("RESULTS")
Q
;
GETA08DV ;
; Called via ScriptRunner
;
; No incoming params.
;
N X,DIV,INST S X=0
K @RESULTS
D NEWDOC^MDCLIO("RESULTS","GET A08 DEVICES")
D XMLHDR^MDCLIO("DEVICES")
F S X=$O(^MDC(704.006,"INSTA08","A08",X)) Q:X="" D
. S DIV=$P($G(^MDC(704.006,X,0)),U,2)
. S INST=$P($G(^DG(40.8,DIV,0)),U,7)
. I INST=DUZ(2) D
.. D XMLHDR^MDCLIO("RECORD")
.. D XMLDATA^MDCLIO("DEVICE",X)
.. D XMLDATA^MDCLIO("NAME",$P($G(^MDC(704.006,X,0)),U,7))
.. D XMLDATA^MDCLIO("ID",$P($G(^MDC(704.006,X,0)),U,6))
.. D XMLFTR^MDCLIO("RECORD")
D XMLFTR^MDCLIO("DEVICES")
D ENDDOC^MDCLIO("RESULTS")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCPHL7C 4528 printed Nov 22, 2024@16:52:40 Page 2
MDCPHL7C ; HINES OIFO/BJ - CP Outbound message record maintenance routine.;26 OCT 2011
+1 ;;1.0;CLINICAL PROCEDURES;**23**;OCT 26, 2011;Build 281
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine uses the following IAs:
+5 ; #325 - ADM^VADPT2 Registration (controlled,subscription)
+6 ; #417 - $P(^DA(40.8,DA,0),U,7) Registration (controlled,subscription)
+7 ;
SNDA08 ;
+1 ; Called via ScriptRunner
+2 ; P2(0) - DFN of patient
+3 ; P2(1) - ID of Protocol Subscriber from file 704.006 to use
+4 ;
+5 NEW IEN,EVENT,WARD,DIV,BED,DFN
+6 ;
+7 DO NEWDOC^MDCLIO("RESULTS","SENDA08")
+8 DO XMLHDR^MDCLIO("RECORD")
+9 IF +$GET(P2(0))<1
Begin DoDot:1
+10 DO XMLDATA^MDCLIO("STATUS","-1")
+11 DO XMLDATA^MDCLIO("MESSAGE","PATIENT UNDEFINED")
End DoDot:1
GOTO SNDA08A
+12 SET DFN=P2(0)
+13 ; Yes, I know we're just checking to see if there's anything in the protocol field.
+14 ; At this point, though, it isn't worth doing a pattern match on the protocol sent in.
+15 IF $GET(P2(1))=""
Begin DoDot:1
+16 DO XMLDATA^MDCLIO("STATUS","-1")
+17 DO XMLDATA^MDCLIO("MESSAGE","PROTOCOL UNDEFINED")
End DoDot:1
GOTO SNDA08A
+18 ; First, sanity checks.
+19 SET IEN=$$FIND1^DIC(704.006,"","KO",P2(1))
+20 IF +IEN<1
Begin DoDot:1
+21 DO XMLDATA^MDCLIO("STATUS","-1")
+22 DO XMLDATA^MDCLIO("MESSAGE","UNABLE TO FIND PROTOCOL SUBSCRIBER WITH REQUESTED ID")
End DoDot:1
GOTO SNDA08A
+23 SET EVENT=$$GET1^DIQ(704.006,IEN_",",".05")
+24 IF EVENT'="A08"
Begin DoDot:1
+25 DO XMLDATA^MDCLIO("STATUS","-1")
+26 DO XMLDATA^MDCLIO("MESSAGE","SPECIFIED PROTOCOL DOES NOT SUPPORT A08 MESSAGES")
End DoDot:1
GOTO SNDA08A
+27 ;
+28 ; Okay: at this point, we have a valid protocol and a (presumably) valid patient.
+29 ; Now to send the message.
+30 ;
+31 ;
+32 DO ADD^MDCPVDEF(DFN,"","","","ADT","A08",,IEN)
+33 ; FIXME: Need to get IEN of new entry in 704.005 and check actual status.
+34 DO XMLDATA^MDCLIO("STATUS","1")
+35 DO XMLDATA^MDCLIO("MESSAGE","SUCCESS")
SNDA08A ;
+1 DO XMLFTR^MDCLIO("RECORD")
+2 DO ENDDOC^MDCLIO("RESULTS")
+3 QUIT
+4 ;
CANRESND ;
+1 ; Called via ScriptRunner
+2 ; P2(0) - DFN of patient
+3 ;
+4 DO NEWDOC^MDCLIO("RESULTS","CAN RESEND ADT")
+5 DO XMLHDR^MDCLIO("RECORD")
+6 NEW LSTSNTDT,DFN,LSTSNTID
+7 SET DFN=P2(0)
+8 ; Is this an inpatient? If not, we're not sending an anything other than an A08.
+9 ;
+10 DO ADM^VADPT2
IF +$GET(VADMVT)=0
Begin DoDot:1
+11 DO XMLDATA^MDCLIO("STATUS","-1")
+12 DO XMLDATA^MDCLIO("MESSAGE","PATIENT NOT ADMITTED")
End DoDot:1
GOTO CANRSND1
+13 ;
+14 SET LSTSNTDT=+$ORDER(^MDC(704.005,"LSTMSG",DFN,9999999),-1)
+15 IF LSTSNTDT<1
Begin DoDot:1
+16 DO XMLDATA^MDCLIO("STATUS","-1")
+17 DO XMLDATA^MDCLIO("MESSAGE","NO PREVIOUS MESSAGE")
End DoDot:1
GOTO CANRSND1
+18 ;
+19 ;
+20 NEW EVENT
SET EVENT=$ORDER(^MDC(704.005,"LSTMSG",DFN,LSTSNTDT,""))
+21 SET LSTSNTID=+$ORDER(^MDC(704.005,"LSTMSG",DFN,LSTSNTDT,EVENT,0))
+22 IF LSTSNTID<0
Begin DoDot:1
+23 DO XMLDATA^MDCLIO("STATUS","-1")
+24 DO XMLDATA^MDCLIO("MESSAGE","INVALID MESSAGE ID")
End DoDot:1
GOTO CANRSND1
+25 ;
+26 ; We now have a valid DFN and message ID. Send the info back to Delphiland so the appropriate menu options can be enabled.
+27 ;
+28 DO XMLDATA^MDCLIO("STATUS","1")
+29 DO XMLDATA^MDCLIO("MESSAGE",LSTSNTID)
+30 ;
CANRSND1 ;
+1 DO XMLFTR^MDCLIO("RECORD")
+2 DO ENDDOC^MDCLIO("RESULTS")
+3 QUIT
+4 ;
DORESND ;
+1 ; Called via ScriptRunner
+2 ;
+3 ; P2(0) - IEN of message to resend.
+4 ;
+5 DO NEWDOC^MDCLIO("RESULTS","RESEND ADT MESSAGE")
+6 DO XMLHDR^MDCLIO("RECORD")
+7 SET IEN=$GET(P2(0))
+8 IF IEN=""
Begin DoDot:1
+9 DO XMLDATA^MDCLIO("STATUS","-1")
+10 DO XMLDATA^MDCLIO("MESSAGE","INVALID IEN")
End DoDot:1
GOTO DORESND1
+11 ;
+12 NEW EVENT,STATUS
+13 SET EVENT=$$GET1^DIQ(704.005,IEN_",",".07")
+14 IF "A01A02A03A11A12A12"'[$GET(EVENT)
Begin DoDot:1
+15 DO XMLDATA^MDCLIO("STATUS","-1")
+16 DO XMLDATA^MDCLIO("MESSAGE","INVALID MESSAGE STATUS "_EVENT_" FOR MESSAGE "_IEN)
End DoDot:1
GOTO DORESND1
+17 ;
+18 IF $$QUE^MDCPMESQ(IEN,EVENT,.STATUS)
Begin DoDot:1
+19 DO XMLDATA^MDCLIO("STATUS","1")
+20 DO XMLDATA^MDCLIO("MESSAGE","SUCCESS")
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 DO XMLDATA^MDCLIO("STATUS","-1")
+23 DO XMLDATA^MDCLIO("MESSAGE","ERROR REQUEING MESSAGE "_IEN_": "_STATUS)
End DoDot:1
+24 ;
DORESND1 ;
+1 DO XMLFTR^MDCLIO("RECORD")
+2 DO ENDDOC^MDCLIO("RESULTS")
+3 QUIT
+4 ;
GETA08DV ;
+1 ; Called via ScriptRunner
+2 ;
+3 ; No incoming params.
+4 ;
+5 NEW X,DIV,INST
SET X=0
+6 KILL @RESULTS
+7 DO NEWDOC^MDCLIO("RESULTS","GET A08 DEVICES")
+8 DO XMLHDR^MDCLIO("DEVICES")
+9 FOR
SET X=$ORDER(^MDC(704.006,"INSTA08","A08",X))
if X=""
QUIT
Begin DoDot:1
+10 SET DIV=$PIECE($GET(^MDC(704.006,X,0)),U,2)
+11 SET INST=$PIECE($GET(^DG(40.8,DIV,0)),U,7)
+12 IF INST=DUZ(2)
Begin DoDot:2
+13 DO XMLHDR^MDCLIO("RECORD")
+14 DO XMLDATA^MDCLIO("DEVICE",X)
+15 DO XMLDATA^MDCLIO("NAME",$PIECE($GET(^MDC(704.006,X,0)),U,7))
+16 DO XMLDATA^MDCLIO("ID",$PIECE($GET(^MDC(704.006,X,0)),U,6))
+17 DO XMLFTR^MDCLIO("RECORD")
End DoDot:2
End DoDot:1
+18 DO XMLFTR^MDCLIO("DEVICES")
+19 DO ENDDOC^MDCLIO("RESULTS")
+20 QUIT
