- TIUHL7P3 ; SLC/AJB - TIUHL7 Msg Processing; March 23, 2005
- ;;1.0;TEXT INTEGRATION UTILITIES;**200**;Jun 20, 1997
- Q
- CONTINUE ;
- ;
- ; DOCUMENT TITLE & VISIT LIMITATION
- I '+$$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!'+($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)")) D TIUVISIT^TIUSRVA(.TIUTMP,TIU("TDA"),$G(DFN),$G(TIU("VSTR"))) I +TIUTMP D
- . S TIUDA=+$$EXIST^TIUEDI3(+$G(DFN),+TIU("TDA"),$G(TIU("VSTR")),0,+TIU("AUDA")) I '+TIUDA D ERR^TIUHL7U1("TXA",16,"0000.00",TIU("TITLE")_" already exists for this visit; only one record of this type is allowed per visit.")
- ;
- ; get document parameters
- D DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
- ;
- ; verify upload support for SURGICAL REPORT titles
- I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"SURGICAL REPORTS") D
- . I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)")) Q
- . D ERR^TIUHL7U1("TXA",16,"0000.00","This SURGICAL REPORT ["_TIU("TITLE")_"] title is not a supported upload title.")
- ;
- ; send APPLICATION REJECT if any data element verification failed
- I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- ;
- ; validate and process OPERATION REPORTS or PROCEDURE REPORTS
- I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)")) D Q
- . N SUCCESS,TIUD0,TIUDA,TIUDAD,TIUSR0,TIUSRCN,TIUOPDT,TIUSTAT
- . S TIUSRCN=+$G(TIU("SRCN")),TIUOPDT=+$P($G(TIU("EPDT")),"."),TIUDA=""
- . I '+TIUSRCN,'+TIUOPDT D ERR^TIUHL7U1("TXA",12,"0000.000","HL7 message missing SURGICAL CASE # and OPERATION DATE.")
- . I '+TIUSRCN,+TIUOPDT S TIUSRCN=$$FINDCASE^TIUPUTS($G(DFN),TIUOPDT) I '+TIUSRCN D ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find a SURGICAL CASE # using the EPISODE BEGIN DATE ["_$$FMTE^XLFDT(TIUOPDT)_"].")
- . I +TIUSRCN,$D(^SRF(TIUSRCN,"TIU")) S TIUDA=$$GETSDA^TIUPUTS(TIUSRCN) I '+TIUDA D ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find "_TIU("TITLE")_" document stub for SURGICAL CASE #"_TIUSRCN_".")
- . I +TIUSRCN'>0 D ERR^TIUHL7U1("TXA",12,"0000.000","SURGICAL CASE # cannot be determined.")
- . I +TIUDA'>0 D ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find "_TIU("TITLE")_" document stub for SURGICAL CASE #"_TIUSRCN_".")
- . I '+TIU("EC") D
- . . S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUSR0=$G(^SRF(TIUSRCN,0))
- . . I '+TIUOPDT S TIU("EPDT")=$P($P(TIUSR0,U,9),"."),TIUOPDT=TIU("EPDT")
- . . I +TIUSR0'=$G(DFN) D ERR^TIUHL7U1("TXA",12,"0000.000","PATIENT mismatch between HL7 message ["_$$GET1^DIQ(2,$G(DFN),.01)_"] and SURGICAL CASE #"_TIUSRCN_" ["_$$GET1^DIQ(2,+TIUSR0,.01)_"].")
- . . I +$P(TIUD0,U,2)'=$G(DFN) D ERR^TIUHL7U1("TXA",12,"0000.000","PATIENT mismatch between HL7 message ["_$$GET1^DIQ(2,$G(DFN),.01)_"] and "_TIU("TITLE")_" stub ["_$$GET1^DIQ(2,+$P(TIUD0,U,2),.01)_"].")
- . . I TIUOPDT'=$P($P(TIUSR0,U,9),".") D ERR^TIUHL7U1("TXA",12,"0000.000","OPERATION DATE mismatch between HL7 message ["_$$FMTE^XLFDT(TIUOPDT)_"] and SURGICAL CASE #"_TIUSRCN_" ["_$$FMTE^XLFDT($P($P(TIUSR0,U,9),"."))_"].") Q
- . . I +TIU("EC") Q
- . . I +$G(TIUDA),'$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") G MAKEADD
- . . S TIUZ("HDR")="1^1" D SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ)
- . . I '+$G(SUCCESS) D ERR^TIUHL7U1("OBX",1,"0000.00","DOCUMENT TEXT failed to update.")
- . I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- . D FOLLOWUP^TIUPUTS(+TIUDA)
- . S $P(^TIU(8925,+TIUDA,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- . D SIGNDOC^TIUHL7U1(+TIUDA) I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- . D ACK^TIUHL7U1("AA",TIUNAME,+TIUDA)
- ;
- MAKEADD ;
- ; validate CONSULT title
- I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") D
- . I '+$G(TIU("CNCN")) D ERR^TIUHL7U1("TXA",12,"0000.00","HL7 message missing CONSULT #.") Q
- . I '$$CPPAT^GMRCCP(TIU("CNCN"),$G(DFN)) D ERR^TIUHL7U1("TXA",12,"0000.00","PATIENT NAME ["_TIU("PTNAME")_"] mismatch between HL7 message and CONSULT ["_$$GET1^DIQ(123,TIU("CNCN"),.02)_"].") Q
- . S TIUZ(1405)=TIU("CNCN")_";GMR(123,"
- ;
- I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- ;
- ; set data fields
- ; 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(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)
- . I '+SUCCESS D ERR^TIUHL7U1("TIU",1,"0000.000",$P(SUCCESS,U,2))
- . I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- . 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^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
- . D ACK^TIUHL7U1("AA",TIUNAME,SUCCESS),SEND^TIUALRT(SUCCESS),SENDADD^TIUALRT(+TIUDA)
- ;
- ; 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 D ERR^TIUHL7U1("TIU",1,"0000.000",$P(SUCCESS,U,2))
- . D FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
- . I '+SUCCESS D ERR^TIUHL7U1("TIU",1,"0000.000",$P(SUCCESS,U,2))
- . I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- . 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^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
- . D ACK^TIUHL7U1("AA",TIUNAME,TIUDA),SEND^TIUALRT(TIUDA) Q
- ;
- I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
- ;
- ; document creation
- N SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1
- D MAKE^TIUSRVP(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,TIU("VSTR"))
- ;
- ; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
- I '+TIUDA D ERR^TIUHL7U1("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)
- ;
- ; process signature/co-signature
- D SIGNDOC^TIUHL7U1(+TIUDA) I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,+TIUDA) Q
- ;
- ; 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=$S(TIUSTAT>6:"COMPLETED",1:"INCOMPLETE")
- . D GET^GMRCTIU(TIU("CNCN"),+TIUDA,TIUSTAT,TIU("AUDA"))
- ;
- D ACK^TIUHL7U1("AA",TIUNAME,+TIUDA)
- D SEND^TIUALRT(+TIUDA)
- D AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUHL7P3 7282 printed Jan 18, 2025@03:42:50 Page 2
- TIUHL7P3 ; SLC/AJB - TIUHL7 Msg Processing; March 23, 2005
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**200**;Jun 20, 1997
- +2 QUIT
- CONTINUE ;
- +1 ;
- +2 ; DOCUMENT TITLE & VISIT LIMITATION
- +3 IF '+$$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!'+($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)"))
- DO TIUVISIT^TIUSRVA(.TIUTMP,TIU("TDA"),$GET(DFN),$GET(TIU("VSTR")))
- IF +TIUTMP
- Begin DoDot:1
- +4 SET TIUDA=+$$EXIST^TIUEDI3(+$GET(DFN),+TIU("TDA"),$GET(TIU("VSTR")),0,+TIU("AUDA"))
- IF '+TIUDA
- DO ERR^TIUHL7U1("TXA",16,"0000.00",TIU("TITLE")_" already exists for this visit; only one record of this type is allowed per visit.")
- End DoDot:1
- +5 ;
- +6 ; get document parameters
- +7 DO DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
- +8 ;
- +9 ; verify upload support for SURGICAL REPORT titles
- +10 IF $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"SURGICAL REPORTS")
- Begin DoDot:1
- +11 IF $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)"))
- QUIT
- +12 DO ERR^TIUHL7U1("TXA",16,"0000.00","This SURGICAL REPORT ["_TIU("TITLE")_"] title is not a supported upload title.")
- End DoDot:1
- +13 ;
- +14 ; send APPLICATION REJECT if any data element verification failed
- +15 IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +16 ;
- +17 ; validate and process OPERATION REPORTS or PROCEDURE REPORTS
- +18 IF $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)"))
- Begin DoDot:1
- +19 NEW SUCCESS,TIUD0,TIUDA,TIUDAD,TIUSR0,TIUSRCN,TIUOPDT,TIUSTAT
- +20 SET TIUSRCN=+$GET(TIU("SRCN"))
- SET TIUOPDT=+$PIECE($GET(TIU("EPDT")),".")
- SET TIUDA=""
- +21 IF '+TIUSRCN
- IF '+TIUOPDT
- DO ERR^TIUHL7U1("TXA",12,"0000.000","HL7 message missing SURGICAL CASE # and OPERATION DATE.")
- +22 IF '+TIUSRCN
- IF +TIUOPDT
- SET TIUSRCN=$$FINDCASE^TIUPUTS($GET(DFN),TIUOPDT)
- IF '+TIUSRCN
- DO ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find a SURGICAL CASE # using the EPISODE BEGIN DATE ["_$$FMTE^XLFDT(TIUOPDT)_"].")
- +23 IF +TIUSRCN
- IF $DATA(^SRF(TIUSRCN,"TIU"))
- SET TIUDA=$$GETSDA^TIUPUTS(TIUSRCN)
- IF '+TIUDA
- DO ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find "_TIU("TITLE")_" document stub for SURGICAL CASE #"_TIUSRCN_".")
- +24 IF +TIUSRCN'>0
- DO ERR^TIUHL7U1("TXA",12,"0000.000","SURGICAL CASE # cannot be determined.")
- +25 IF +TIUDA'>0
- DO ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find "_TIU("TITLE")_" document stub for SURGICAL CASE #"_TIUSRCN_".")
- +26 IF '+TIU("EC")
- Begin DoDot:2
- +27 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
- SET TIUSR0=$GET(^SRF(TIUSRCN,0))
- +28 IF '+TIUOPDT
- SET TIU("EPDT")=$PIECE($PIECE(TIUSR0,U,9),".")
- SET TIUOPDT=TIU("EPDT")
- +29 IF +TIUSR0'=$GET(DFN)
- DO ERR^TIUHL7U1("TXA",12,"0000.000","PATIENT mismatch between HL7 message ["_$$GET1^DIQ(2,$GET(DFN),.01)_"] and SURGICAL CASE #"_TIUSRCN_" ["_$$GET1^DIQ(2,+TIUSR0,.01)_"].")
- +30 IF +$PIECE(TIUD0,U,2)'=$GET(DFN)
- DO ERR^TIUHL7U1("TXA",12,"0000.000","PATIENT mismatch between HL7 message ["_$$GET1^DIQ(2,$GET(DFN),.01)_"] and "_TIU("TITLE")_" stub ["_$$GET1^DIQ(2,+$PIECE(TIUD0,U,2),.01)_"].")
- +31 IF TIUOPDT'=$PIECE($PIECE(TIUSR0,U,9),".")
- DO ERR^TIUHL7U1("TXA",12,"0000.000","OPERATION DATE mismatch between HL7 message ["_$$FMTE^XLFDT(TIUOPDT)_"] and SURGICAL CASE #"_TIUSRCN_" ["_$$FMTE^XLFDT($PIECE($PIECE(TIUSR0,U,9),"."))_"].")
- QUIT
- +32 IF +TIU("EC")
- QUIT
- +33 IF +$GET(TIUDA)
- IF '$$CANEDIT^TIUHL7U1(TIUDA)
- IF '+TIU("EC")
- GOTO MAKEADD
- +34 SET TIUZ("HDR")="1^1"
- DO SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ)
- +35 IF '+$GET(SUCCESS)
- DO ERR^TIUHL7U1("OBX",1,"0000.00","DOCUMENT TEXT failed to update.")
- End DoDot:2
- +36 IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +37 DO FOLLOWUP^TIUPUTS(+TIUDA)
- +38 SET $PIECE(^TIU(8925,+TIUDA,13),U,2)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- +39 DO SIGNDOC^TIUHL7U1(+TIUDA)
- IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +40 DO ACK^TIUHL7U1("AA",TIUNAME,+TIUDA)
- End DoDot:1
- QUIT
- +41 ;
- MAKEADD ;
- +1 ; validate CONSULT title
- +2 IF $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS")
- Begin DoDot:1
- +3 IF '+$GET(TIU("CNCN"))
- DO ERR^TIUHL7U1("TXA",12,"0000.00","HL7 message missing CONSULT #.")
- QUIT
- +4 IF '$$CPPAT^GMRCCP(TIU("CNCN"),$GET(DFN))
- DO ERR^TIUHL7U1("TXA",12,"0000.00","PATIENT NAME ["_TIU("PTNAME")_"] mismatch between HL7 message and CONSULT ["_$$GET1^DIQ(123,TIU("CNCN"),.02)_"].")
- QUIT
- +5 SET TIUZ(1405)=TIU("CNCN")_";GMR(123,"
- End DoDot:1
- +6 ;
- +7 IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +8 ;
- +9 ; set data fields
- +10 ; set appropriate DOCUMENT STATUS from document parameters
- +11 SET DUZ=$GET(TIU("AUDA"))
- SET DUZ(2)=$$GETDIV^TIUHL7U1(DUZ)
- SET TIU("DIVISION")=DUZ(2)
- +12 IF $PIECE(TIUDPRM(0),U,2)=1
- SET TIUZ(.05)=3
- +13 IF '+$GET(TIUZ(.05))
- IF $PIECE(TIUDPRM(0),U,3)>0
- IF $PIECE(TIUDPRM(0),U,3)'>2
- SET TIUZ(.05)=4
- +14 IF '+$GET(TIUZ(.05))
- SET TIUZ(.05)=5
- +15 ;
- +16 SET TIUZ(.07)=$SELECT(+$GET(TIU("EPDT")):TIU("EPDT"),+$GET(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
- +17 SET TIUZ(1201)=$$NOW^XLFDT
- +18 SET TIUZ(1202)=$GET(TIU("AUDA"))
- +19 SET TIUZ(1204)=$GET(TIU("AUDA"))
- +20 SET TIUZ(1208)=$GET(TIU("CSDA"))
- +21 SET TIUZ(1212)=$GET(TIU("DIVISION"))
- +22 SET TIUZ(1301)=$GET(TIU("RFDT"))
- +23 SET TIUZ(1302)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
- SET TIU("EBDA")=TIUZ(1302)
- +24 SET TIUZ(1307)=$GET(TIU("DICDT"))
- +25 SET TIUZ(1701)=$GET(TIU("SUB"))
- +26 ;
- +27 ; check if document was found and editable
- +28 ; if not editable, make addendum
- +29 IF +$GET(TIUDA)
- IF '$$CANEDIT^TIUHL7U1(TIUDA)
- IF '+TIU("EC")
- Begin DoDot:1
- +30 NEW PERSON,SUCCESS
- +31 SET PERSON=$GET(TIU("AUDA"))
- +32 DO MAKEADD^TIUHL7U2(.SUCCESS,TIUDA,.TIUZ,1)
- +33 IF '+SUCCESS
- DO ERR^TIUHL7U1("TIU",1,"0000.000",$PIECE(SUCCESS,U,2))
- +34 IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +35 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"))
- +36 DO SIGNDOC^TIUHL7U1(+SUCCESS)
- IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,+SUCCESS)
- QUIT
- +37 DO ACK^TIUHL7U1("AA",TIUNAME,SUCCESS)
- DO SEND^TIUALRT(SUCCESS)
- DO SENDADD^TIUALRT(+TIUDA)
- End DoDot:1
- QUIT
- +38 ;
- +39 ; if editable, make changes to document
- +40 IF +$GET(TIUDA)
- IF $$CANEDIT^TIUHL7U1(TIUDA)
- IF '+TIU("EC")
- Begin DoDot:1
- +41 NEW SUCCESS
- +42 DO DELTEXT^TIUPUTPN(TIUDA)
- +43 SET TIUZ("HDR")="1^1"
- DO SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ)
- KILL TIUZ("HDR"),TIUZ("TEXT")
- +44 IF '+SUCCESS
- DO ERR^TIUHL7U1("TIU",1,"0000.000",$PIECE(SUCCESS,U,2))
- +45 DO FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
- +46 IF '+SUCCESS
- DO ERR^TIUHL7U1("TIU",1,"0000.000",$PIECE(SUCCESS,U,2))
- +47 IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +48 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"))
- +49 DO SIGNDOC^TIUHL7U1(+SUCCESS)
- IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,+SUCCESS)
- QUIT
- +50 DO ACK^TIUHL7U1("AA",TIUNAME,TIUDA)
- DO SEND^TIUALRT(TIUDA)
- QUIT
- End DoDot:1
- QUIT
- +51 ;
- +52 IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +53 ;
- +54 ; document creation
- +55 NEW SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1
- +56 DO MAKE^TIUSRVP(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,TIU("VSTR"))
- +57 ;
- +58 ; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
- +59 IF '+TIUDA
- DO ERR^TIUHL7U1("TIU",1,"0000.00",$PIECE(TIUDA,U,2))
- DO ACK^TIUHL7U1("AR",TIUNAME,-1)
- QUIT
- +60 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"))
- +61 SET $PIECE(^TIU(8925,+TIUDA,0),U,7)=$SELECT(+$GET(TIU("EPDT")):TIU("EPDT"),+$GET(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
- +62 ;
- +63 ; process signature/co-signature
- +64 DO SIGNDOC^TIUHL7U1(+TIUDA)
- IF +TIU("EC")
- DO ACK^TIUHL7U1("AR",TIUNAME,+TIUDA)
- QUIT
- +65 ;
- +66 ; update the consult as necessary
- +67 IF $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS")
- Begin DoDot:1
- +68 NEW TIUSTAT
- SET TIUSTAT=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)
- +69 SET TIUSTAT=$SELECT(TIUSTAT>6:"COMPLETED",1:"INCOMPLETE")
- +70 DO GET^GMRCTIU(TIU("CNCN"),+TIUDA,TIUSTAT,TIU("AUDA"))
- End DoDot:1
- +71 ;
- +72 DO ACK^TIUHL7U1("AA",TIUNAME,+TIUDA)
- +73 DO SEND^TIUALRT(+TIUDA)
- +74 DO AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
- +75 ;
- +76 QUIT