- TIUCCRHL7P3 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
- ;;1.0;TEXT INTEGRATION UTILITIES;**337,344,349,356,366,371**;Sep 27, 2023;Build 4
- ; Documented API's and Integration Agreements
- ; ----------------------------------------------
- ; IA #3473I GET^GMRCTIU
- ; ICR 2980 call to CMT^GMRCGUIB
- ;
- ;PB - Patch 344 to modify how the note and addendum text is formatted
- ;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult
- ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
- ;PB - Patch 371 removes unused code
- Q
- CONTINUE ;
- S TIUDA=$G(TIUIEN)
- ; get document parameters
- D DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
- I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1) Q
- MAKEADD ;
- ; validate CONSULT title
- ; set appropriate DOCUMENT STATUS from document parameters
- S DUZ=$G(TIU("AUDA")),DUZ(2)=$$GETDIV^TIUHL7U1(DUZ),TIU("DIVISION")=DUZ(2)
- I $P(TIUDPRM(0),U,2)=1 S TIUZ(.05)=3
- I '+$G(TIUZ(.05)),$P(TIUDPRM(0),U,3)>0,$P(TIUDPRM(0),U,3)'>2 S TIUZ(.05)=4
- I '+$G(TIUZ(.05)) S TIUZ(.05)=5
- S TIUZ(.07)=$S(+$G(TIU("EPDT")):TIU("EPDT"),+$G(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
- S TIUZ(1201)=$$NOW^XLFDT
- S TIUZ(1202)=$G(TIU("AUDA"))
- S TIUZ(1204)=$G(TIU("AUDA"))
- S TIUZ(1208)=$G(TIU("CSDA"))
- S TIUZ(1205)=$G(VLOC)
- S TIUZ(1211)=$G(VLOC)
- S TIUZ(1212)=$G(TIU("DIVISION"))
- S TIUZ(1301)=$G(TIU("RFDT"))
- S TIUZ(1302)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA")),TIU("EBDA")=TIUZ(1302)
- S TIUZ(1307)=$G(TIU("DICDT"))
- S TIUZ(1701)=$G(TIU("SUB"))
- ; check if document was found and editable
- ; if not editable, make addendum
- I +$G(TIUDA),'$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") D Q
- . N PERSON,SUCCESS
- . S PERSON=$G(TIU("AUDA"))
- . D MAKEADD^TIUHL7U2(.SUCCESS,TIUDA,.TIUZ,1)
- . ; PB - Patch 349 - add comment for consult factor
- . I '+SUCCESS S MSGTEXT=$P(SUCCESS,U,2),STOP=1 D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
- . Q:$G(STOP)=1
- . N COMMENT,NOTEDT
- . S COMMENT(1)=CFNOTE,NOTEDT=$$NOW^XLFDT,GMRCDA=CONSULTID ; PB - Sep 23 - Patch 356 changed to set GMRCDA to equal CONSULTID instead of VNUM
- . D CMT^GMRCGUIB(GMRCDA,.COMMENT,DUZ,NOTEDT,DUZ) ;icr 2980
- . S $P(^TIU(8925,+SUCCESS,13),U,3)="U",$P(^TIU(8925,+SUCCESS,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- . D SIGNDOC^TIUHL7U1(+SUCCESS) I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+SUCCESS) Q
- . ; does the ack method below work for CCRA?
- ; if editable, make changes to document
- I +$G(TIUDA),$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") D Q
- . N SUCCESS
- . D DELTEXT^TIUPUTPN(TIUDA)
- . S TIUZ("HDR")="1^1" D SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ) K TIUZ("HDR"),TIUZ("TEXT")
- . I '+SUCCESS S MSGTEXT=$P(SUCCESS,U,2),STOP=1 D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
- . Q:$G(STOP)=1
- . D FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
- . I '+SUCCESS S MSGTEXT=$P(SUCCESS,U,2),STOP=1 D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
- . Q:$G(STOP)=1
- . S $P(^TIU(8925,+SUCCESS,13),U,3)="U",$P(^TIU(8925,+SUCCESS,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- . D SIGNDOC^TIUHL7U1(+SUCCESS) I +TIU("EC") ;I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
- I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1) Q
- ; document creation
- N SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1,ORIGSTAT
- S ORIGSTAT=$$GET1^DIQ(123,CONSULTID_",",8,"I") ;ICR 3983 - save the status of the consult before adding the note. PB - Sep 23 - patch 356 changes for lookup by by CONSULTID
- D MAKE^TIUCCRHL7P2(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,$G(TIU("VSTR")))
- I $G(TIUDA)>0 D SIGNDOC^TIUCCRHL7P2(+TIUDA) I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA) Q
- ; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
- I '+TIUDA S MSGTEXT=$P(TIUDA,U,2) D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) Q ;D ERR^TIUCCHL7UT("TIU",1,"0000.00",$P(TIUDA,U,2)),ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- S $P(^TIU(8925,+TIUDA,13),U,3)="U",$P(^TIU(8925,+TIUDA,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- S $P(^TIU(8925,+TIUDA,0),U,7)=$S(+$G(TIU("EPDT")):TIU("EPDT"),+$G(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
- ; update the consult as necessary
- I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") D
- . N TIUSTAT S TIUSTAT=$P($G(^TIU(8925,+TIUDA,0)),U,5)
- . S TIUSTAT="INCOMPLETE"
- D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA)
- D SEND^TIUALRT(+TIUDA)
- D AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
- Q
- MESSAGE(MSGID,VNUM,MSGTEXT) ; Send a MailMan Message with the errors
- N DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J,FLG1,MID
- S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
- S XMSUB="Consult: "_$G(VNUM)_" TIU CCRA Consult Issue from HSRM"
- S MSGTEXT(1)=" "
- S MSGTEXT(2)="Error Processing TIU Note for Consult ID: "_$G(VNUM)_" from HSRM"
- S MSGTEXT(3)="The error is: "_$G(MSGTEXT)
- S MSGTEXT(4)="Date: "_DATE
- S MSGTEXT(5)="Message ID: "_MSGID
- S XMTEXT="MSGTEXT("
- S XMDUZ="TIU CONSULT Transaction Error"
- S XMDUZ=.5
- S XMY("G.TIU HSRM CONSULT HL7 MESSAGES")=""
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCCRHL7P3 5452 printed Feb 19, 2025@00:05:36 Page 2
- TIUCCRHL7P3 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**337,344,349,356,366,371**;Sep 27, 2023;Build 4
- +2 ; Documented API's and Integration Agreements
- +3 ; ----------------------------------------------
- +4 ; IA #3473I GET^GMRCTIU
- +5 ; ICR 2980 call to CMT^GMRCGUIB
- +6 ;
- +7 ;PB - Patch 344 to modify how the note and addendum text is formatted
- +8 ;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult
- +9 ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
- +10 ;PB - Patch 371 removes unused code
- +11 QUIT
- CONTINUE ;
- +1 SET TIUDA=$GET(TIUIEN)
- +2 ; get document parameters
- +3 DO DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
- +4 IF +TIU("EC")
- DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1)
- QUIT
- MAKEADD ;
- +1 ; validate CONSULT title
- +2 ; set appropriate DOCUMENT STATUS from document parameters
- +3 SET DUZ=$GET(TIU("AUDA"))
- SET DUZ(2)=$$GETDIV^TIUHL7U1(DUZ)
- SET TIU("DIVISION")=DUZ(2)
- +4 IF $PIECE(TIUDPRM(0),U,2)=1
- SET TIUZ(.05)=3
- +5 IF '+$GET(TIUZ(.05))
- IF $PIECE(TIUDPRM(0),U,3)>0
- IF $PIECE(TIUDPRM(0),U,3)'>2
- SET TIUZ(.05)=4
- +6 IF '+$GET(TIUZ(.05))
- SET TIUZ(.05)=5
- +7 SET TIUZ(.07)=$SELECT(+$GET(TIU("EPDT")):TIU("EPDT"),+$GET(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
- +8 SET TIUZ(1201)=$$NOW^XLFDT
- +9 SET TIUZ(1202)=$GET(TIU("AUDA"))
- +10 SET TIUZ(1204)=$GET(TIU("AUDA"))
- +11 SET TIUZ(1208)=$GET(TIU("CSDA"))
- +12 SET TIUZ(1205)=$GET(VLOC)
- +13 SET TIUZ(1211)=$GET(VLOC)
- +14 SET TIUZ(1212)=$GET(TIU("DIVISION"))
- +15 SET TIUZ(1301)=$GET(TIU("RFDT"))
- +16 SET TIUZ(1302)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- SET TIU("EBDA")=TIUZ(1302)
- +17 SET TIUZ(1307)=$GET(TIU("DICDT"))
- +18 SET TIUZ(1701)=$GET(TIU("SUB"))
- +19 ; check if document was found and editable
- +20 ; if not editable, make addendum
- +21 IF +$GET(TIUDA)
- IF '$$CANEDIT^TIUHL7U1(TIUDA)
- IF '+TIU("EC")
- Begin DoDot:1
- +22 NEW PERSON,SUCCESS
- +23 SET PERSON=$GET(TIU("AUDA"))
- +24 DO MAKEADD^TIUHL7U2(.SUCCESS,TIUDA,.TIUZ,1)
- +25 ; PB - Patch 349 - add comment for consult factor
- +26 ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
- IF '+SUCCESS
- SET MSGTEXT=$PIECE(SUCCESS,U,2)
- SET STOP=1
- DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
- DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
- +27 if $GET(STOP)=1
- QUIT
- +28 NEW COMMENT,NOTEDT
- +29 ; PB - Sep 23 - Patch 356 changed to set GMRCDA to equal CONSULTID instead of VNUM
- SET COMMENT(1)=CFNOTE
- SET NOTEDT=$$NOW^XLFDT
- SET GMRCDA=CONSULTID
- +30 ;icr 2980
- DO CMT^GMRCGUIB(GMRCDA,.COMMENT,DUZ,NOTEDT,DUZ)
- +31 SET $PIECE(^TIU(8925,+SUCCESS,13),U,3)="U"
- SET $PIECE(^TIU(8925,+SUCCESS,13),U,2)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- +32 DO SIGNDOC^TIUHL7U1(+SUCCESS)
- IF +TIU("EC")
- DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+SUCCESS)
- QUIT
- +33 ; does the ack method below work for CCRA?
- End DoDot:1
- QUIT
- +34 ; if editable, make changes to document
- +35 IF +$GET(TIUDA)
- IF $$CANEDIT^TIUHL7U1(TIUDA)
- IF '+TIU("EC")
- Begin DoDot:1
- +36 NEW SUCCESS
- +37 DO DELTEXT^TIUPUTPN(TIUDA)
- +38 SET TIUZ("HDR")="1^1"
- DO SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ)
- KILL TIUZ("HDR"),TIUZ("TEXT")
- +39 ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
- IF '+SUCCESS
- SET MSGTEXT=$PIECE(SUCCESS,U,2)
- SET STOP=1
- DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
- DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
- +40 if $GET(STOP)=1
- QUIT
- +41 DO FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
- +42 ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
- IF '+SUCCESS
- SET MSGTEXT=$PIECE(SUCCESS,U,2)
- SET STOP=1
- DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
- DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
- +43 if $GET(STOP)=1
- QUIT
- +44 SET $PIECE(^TIU(8925,+SUCCESS,13),U,3)="U"
- SET $PIECE(^TIU(8925,+SUCCESS,13),U,2)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- +45 ;I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
- DO SIGNDOC^TIUHL7U1(+SUCCESS)
- IF +TIU("EC")
- End DoDot:1
- QUIT
- +46 IF +TIU("EC")
- DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1)
- QUIT
- +47 ; document creation
- +48 NEW SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1,ORIGSTAT
- +49 ;ICR 3983 - save the status of the consult before adding the note. PB - Sep 23 - patch 356 changes for lookup by by CONSULTID
- SET ORIGSTAT=$$GET1^DIQ(123,CONSULTID_",",8,"I")
- +50 DO MAKE^TIUCCRHL7P2(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,$GET(TIU("VSTR")))
- +51 IF $GET(TIUDA)>0
- DO SIGNDOC^TIUCCRHL7P2(+TIUDA)
- IF +TIU("EC")
- DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA)
- QUIT
- +52 ; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
- +53 ;D ERR^TIUCCHL7UT("TIU",1,"0000.00",$P(TIUDA,U,2)),ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- IF '+TIUDA
- SET MSGTEXT=$PIECE(TIUDA,U,2)
- DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
- DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
- QUIT
- +54 SET $PIECE(^TIU(8925,+TIUDA,13),U,3)="U"
- SET $PIECE(^TIU(8925,+TIUDA,13),U,2)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- +55 SET $PIECE(^TIU(8925,+TIUDA,0),U,7)=$SELECT(+$GET(TIU("EPDT")):TIU("EPDT"),+$GET(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
- +56 ; update the consult as necessary
- +57 IF $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS")
- Begin DoDot:1
- +58 NEW TIUSTAT
- SET TIUSTAT=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)
- +59 SET TIUSTAT="INCOMPLETE"
- End DoDot:1
- +60 DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA)
- +61 DO SEND^TIUALRT(+TIUDA)
- +62 DO AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
- +63 QUIT
- MESSAGE(MSGID,VNUM,MSGTEXT) ; Send a MailMan Message with the errors
- +1 NEW DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J,FLG1,MID
- +2 SET DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($PIECE(HL("DTM"),"-",1)))
- +3 SET XMSUB="Consult: "_$GET(VNUM)_" TIU CCRA Consult Issue from HSRM"
- +4 SET MSGTEXT(1)=" "
- +5 SET MSGTEXT(2)="Error Processing TIU Note for Consult ID: "_$GET(VNUM)_" from HSRM"
- +6 SET MSGTEXT(3)="The error is: "_$GET(MSGTEXT)
- +7 SET MSGTEXT(4)="Date: "_DATE
- +8 SET MSGTEXT(5)="Message ID: "_MSGID
- +9 SET XMTEXT="MSGTEXT("
- +10 SET XMDUZ="TIU CONSULT Transaction Error"
- +11 SET XMDUZ=.5
- +12 SET XMY("G.TIU HSRM CONSULT HL7 MESSAGES")=""
- +13 DO ^XMD
- +14 QUIT