Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUHL7P2.m

    r613 r623  
    1 TIUHL7P2        ; SLC/AJB - TIUHL7 Msg Processing; March 23, 2005
    2         ;;1.0;TEXT INTEGRATION UTILITIES;**200,228**;Jun 20, 1997
    3         Q
    4 CONTINUE        ; data verification
    5         ;
    6         ; DOCUMENT TEXT
    7         D
    8         . N TIUI S TIUTMP=0 F  S TIUTMP=$O(TIUZ("TEXT",TIUTMP)) Q:'TIUTMP  I +$L(TIUZ("TEXT",TIUTMP,0)) S TIUI=1
    9         . I '+$G(TIUI) D ERR^TIUHL7U1("OBX",1,"0000.00","Missing DOCUMENT TEXT.")
    10         ;
    11         ; DOCUMENT TITLE
    12         I +TIU("TDA")'>0 D ERR^TIUHL7U1("TXA",16,"0000.00","Could not resolve the document title "_TIU("TITLE")_".")
    13         I +$$GET1^DIQ(8925.1,TIU("TDA"),.07,"I")'=11 D ERR^TIUHL7U1("TXA",16,"0000.00","The document title "_TIU("TITLE")_" must be ACTIVE before use.")
    14         ;
    15         ; AUTHOR/DICTATOR
    16         D
    17         . I '+$L(TIU("AUNAME")) D ERR^TIUHL7U1("TXA",9,"0000.00","Missing AUTHOR/DICTATOR name from HL7 message.") Q
    18         . I '+$G(TIU("AUDA")),'+$G(TIU("AUSSN")) S TIU("AUDA")=$$LU^TIUHL7U1(200,TIU("AUNAME"),"X") I '+TIU("AUDA") D ERR^TIUHL7U1("TXA",9,"0000.00","AUTHOR/DICTATOR name lookup failed for ["_TIU("AUNAME")_"].") Q
    19         . I '+$G(TIU("AUDA")),+$G(TIU("AUSSN")) S TIU("AUDA")=+$$FIND1^DIC(200,"","X",+$G(TIU("AUSSN")),"SSN") I '+TIU("AUDA") D ERR^TIUHL7U1("TXA",9,"0000.00","SSN ["_TIU("AUSSN")_"] lookup failed for AUTHOR/DICTATOR.") Q
    20         . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(200,TIU("AUDA"),.01),TIU("AUNAME")) D
    21         . . D ERR^TIUHL7U1("TXA",9,"0000.00","AUTHOR/DICTATOR name discrepancy between HL7 message IEN/SSN ["_$$GET1^DIQ(200,TIU("AUDA"),.01)_"]"_" & the HL7 message name ["_TIU("AUNAME")_"].")
    22         ;
    23         ; EXPECTED CO-SIGNER [ignored if AUTHOR/DICTATOR does not require]
    24         I $$REQCOSIG^TIULP($G(TIU("TDA")),,$G(TIU("AUDA")),$G(TIU("RFDT"))) D
    25         . N TIUTMP
    26         . S TIUZ(1506)=1
    27         . I +$L($G(TIU("CSNAME")))!(+$G(TIU("CSDA")))!(+$G(TIU("CSSSN"))) D
    28         . . I '+$L($G(TIU("CSNAME"))) D ERR^TIUHL7U1("TXA",10,"0000.00","Missing EXPECTED COSIGNER name from HL7 message.") Q
    29         . . I '+$G(TIU("CSDA")),'+$G(TIU("CSSSN")) S TIU("CSDA")=$$LU^TIUHL7U1(200,TIU("CSNAME"),"X") I '+TIU("CSDA") D ERR^TIUHL7U1("TXA",10,"0000.000","EXPECTED COSIGNER name lookup failed for ["_TIU("CSNAME")_"].") Q
    30         . . I '+$G(TIU("CSDA")),+$G(TIU("CSSSN")) S TIU("CSDA")=+$$FIND1^DIC(200,"","X",+$G(TIU("CSSSN")),"SSN") I '+TIU("CSDA") D ERR^TIUHL7U1("TXA",10,"0000.00","SSN ["_TIU("CSSSN")_"] lookup failed for EXPECTED COSIGNER.") Q
    31         . . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(200,TIU("CSDA"),.01),TIU("CSNAME")) D
    32         . . . D ERR^TIUHL7U1("TXA",10,"0000.00","EXPECTED COSIGNER name discrepancy between HL7 message IEN/SSN ["_$$GET1^DIQ(200,TIU("CSDA"),.01)_"]"_" & HL7 message name ["_TIU("CSNAME")_"].")
    33         . I '+$G(TIU("CSDA")) D ERR^TIUHL7U1("TXA",10,"0000.000","Unable to resolve EXPECTED COSIGNER; the AUTHOR/DICTATOR ["_TIU("AUNAME")_"] requires COSIGNATURE.")
    34         ;
    35         ; ENTERED BY [optional]
    36         I +$L($G(TIU("EBNAME")))!(+$G(TIU("EBDA")))!(+$G(TIU("EBSSN"))) D
    37         . I '+$L($G(TIU("EBNAME"))) D ERR^TIUHL7U1("TXA",11,"0000.00","Missing ENTERED BY name from HL7 message.") Q
    38         . I '+$G(TIU("EBDA")),'+$G(TIU("EBSSN")) S TIU("EBDA")=$$LU^TIUHL7U1(200,TIU("EBNAME"),"X") I '+TIU("EBDA") D ERR^TIUHL7U1("TXA",11,"0000.000","ENTERED BY name lookup failed for ["_TIU("EBNAME")_"].") Q
    39         . I '+$G(TIU("EBDA")),+$G(TIU("EBSSN")) S TIU("EBDA")=+$$FIND1^DIC(200,"","X",+$G(TIU("EBSSN")),"SSN") I '+TIU("EBDA") D ERR^TIUHL7U1("TXA",11,"0000.00","SSN ["_TIU("EBSSN")_"] lookup failed for ENTERED BY.") Q
    40         . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(200,TIU("EBDA"),.01),TIU("EBNAME")) D
    41         . . D ERR^TIUHL7U1("TXA",11,"0000.00","ENTERED BY name discrepancy between HL7 message IEN/SSN ["_$$GET1^DIQ(200,TIU("EBDA"),.01)_"]"_" & HL7 message name ["_TIU("EBNAME")_"].")
    42         ;
    43         ; EPISODE BEGIN DATE/TIME for DISCHARGE SUMMARIES
    44         I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"DISCHARGE SUMMARIES") D
    45         . I '+$G(TIU("CSDA")) D ERR^TIUHL7U1("TXA",10,"0000.000","DISCHARGE SUMMARIES require an ATTENDING PHYSICIAN (EXPECTED COSIGNER).")
    46         . S TIUZ(1209)=$G(TIU("CSDA"))
    47         . I +TIU("VNUM") D  Q
    48         . . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(9000010,TIU("VNUM"),.05),$S(+$G(DFN):$$GET1^DIQ(2,DFN,.01),1:TIU("PTNAME"))) D
    49         . . . D ERR^TIUHL7U1("PV1",19,"0000.00","HL7 message PATIENT NAME ["_TIU("PTNAME")_"] does not match VISIT PATIENT NAME ["_$$GET1^DIQ(9000010,TIU("VNUM"),.05)_"].") Q
    50         . . S TIU("EPDT")=$$GET1^DIQ(9000010,TIU("VNUM"),.01,"I"),TIU("VSTR")=$$VSTRBLD^TIUSRVP(TIU("VNUM"))
    51         . I '+TIU("EPDT") D ERR^TIUHL7U1("PV1",44,"0000.000",TIU("TITLE")_" requires an EPISODE BEGIN DATE/TIME.") Q
    52         . I '+$$GETADMIT^TIUHL7U1(+$G(DFN),TIU("EPDT")) D ERR^TIUHL7U1("PV1","44","0000.00","Could not resolve ADMISSION DT[TIME] for "_$$FMTE^XLFDT(TIUDT)_".")
    53         ;
    54         ; VISIT information for PROGRESS NOTES
    55         I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROGRESS NOTES") D
    56         . I TIU("VNUM")="NEW" D  Q
    57         . . N TYP
    58         . . I '+TIU("HLOC"),TIU("AVAIL")'="AV" D ERR^TIUHL7U1("PV1",4,"0000.00","Missing/Invalid HOSPITAL LOCATION ('AV' not set); required for NEW visits.") Q
    59         . . I +TIU("EPDT")'>0 S TIU("EPDT")=$$NOW^XLFDT
    60         . . I $L(TIU("EPDT"),".")=1 S TIU("EPDT")=TIU("EPDT")_"."_$P($$NOW^XLFDT,".",2)
    61         . . I +TIU("HLOC") I $$GET1^DIQ(44,TIU("HLOC"),2,"I")="W" S TYP="I"
    62         . . I +TIU("HLOC")'>0 S TIU("HLOC")=""
    63         . . S TIU("VSTR")=TIU("HLOC")_";"_TIU("EPDT")_";"_$S($G(TYP)="I":"I",TIU("AVAIL")="AV":"E",1:"A")
    64         . I +TIU("VNUM") D  Q
    65         . . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(9000010,TIU("VNUM"),.05),$S(+$G(DFN):$$GET1^DIQ(2,DFN,.01),1:TIU("PTNAME"))) D  Q
    66         . . . D ERR^TIUHL7U1("PV1",19,"0000.00","HL7 message PATIENT NAME ["_TIU("PTNAME")_"] does not match VISIT PATIENT NAME ["_$$GET1^DIQ(9000010,TIU("VNUM"),.05)_"].")
    67         . . S TIU("EPDT")=$$GET1^DIQ(9000010,TIU("VNUM"),.01,"I"),TIU("VSTR")=$$VSTRBLD^TIUSRVP(TIU("VNUM"))
    68         . I '+TIU("VNUM") D
    69         . . I +TIU("EPDT") I '+$$GETADMIT^TIUHL7U1(+$G(DFN),TIU("EPDT")),TIU("AVAIL")'="AV" D ERR^TIUHL7U1("PV1","44","0000.00","Could not find a visit for "_$$FMTE^XLFDT(TIU("EPDT"))_".") Q
    70         . . I '+$$GETVISIT^TIUHL7U1(+$G(DFN),TIU("RFDT")),TIU("AVAIL")'="AV" D ERR^TIUHL7U1("PV1","44","0000.00","Could not find a visit for "_$$FMTE^XLFDT(TIU("RFDT"))_".") Q
    71         . . S TIU("VSTR")=TIU("HLOC")_";"_$$NOW^XLFDT_";E"
    72         ;
    73         D CONTINUE^TIUHL7P3
    74         Q
     1TIUHL7P2 ; SLC/AJB - TIUHL7 Msg Processing; March 23, 2005
     2 ;;1.0;TEXT INTEGRATION UTILITIES;**200**;Jun 20, 1997
     3 Q
     4CONTINUE ; data verification
     5 ;
     6 ; DOCUMENT TEXT
     7 D
     8 . N TIUI S TIUTMP=0 F  S TIUTMP=$O(TIUZ("TEXT",TIUTMP)) Q:'TIUTMP  I +$L(TIUZ("TEXT",TIUTMP,0)) S TIUI=1
     9 . I '+$G(TIUI) D ERR^TIUHL7U1("OBX",1,"0000.00","Missing DOCUMENT TEXT.")
     10 ;
     11 ; DOCUMENT TITLE
     12 I +TIU("TDA")'>0 D ERR^TIUHL7U1("TXA",16,"0000.00","Could not resolve the document title "_TIU("TITLE")_".")
     13 I +$$GET1^DIQ(8925.1,TIU("TDA"),.07,"I")'=11 D ERR^TIUHL7U1("TXA",16,"0000.00","The document title "_TIU("TITLE")_" must be ACTIVE before use.")
     14 ;
     15 ; AUTHOR/DICTATOR
     16 D
     17 . I '+$L(TIU("AUNAME")) D ERR^TIUHL7U1("TXA",9,"0000.00","Missing AUTHOR/DICTATOR name from HL7 message.") Q
     18 . I '+$G(TIU("AUDA")),'+$G(TIU("AUSSN")) S TIU("AUDA")=$$LU^TIUHL7U1(200,TIU("AUNAME"),"X") I '+TIU("AUDA") D ERR^TIUHL7U1("TXA",9,"0000.00","AUTHOR/DICTATOR name lookup failed for ["_TIU("AUNAME")_"].") Q
     19 . I '+$G(TIU("AUDA")),+$G(TIU("AUSSN")) S TIU("AUDA")=+$$FIND1^DIC(200,"","X",+$G(TIU("AUSSN")),"SSN") I '+TIU("AUDA") D ERR^TIUHL7U1("TXA",9,"0000.00","SSN ["_TIU("AUSSN")_"] lookup failed for AUTHOR/DICTATOR.") Q
     20 . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(200,TIU("AUDA"),.01),TIU("AUNAME")) D
     21 . . D ERR^TIUHL7U1("TXA",9,"0000.00","AUTHOR/DICTATOR name discrepancy between HL7 message IEN/SSN ["_$$GET1^DIQ(200,TIU("AUDA"),.01)_"]"_" & the HL7 message name ["_TIU("AUNAME")_"].")
     22 ;
     23 ; EXPECTED CO-SIGNER [ignored if AUTHOR/DICTATOR does not require]
     24 I $$REQCOSIG^TIULP($G(TIU("TDA")),,$G(TIU("AUDA")),$G(TIU("RFDT"))) D
     25 . N TIUTMP
     26 . S TIUZ(1506)=1
     27 . I +$L($G(TIU("CSNAME")))!(+$G(TIU("CSDA")))!(+$G(TIU("CSSSN"))) D
     28 . . I '+$L($G(TIU("CSNAME"))) D ERR^TIUHL7U1("TXA",10,"0000.00","Missing EXPECTED COSIGNER name from HL7 message.") Q
     29 . . I '+$G(TIU("CSDA")),'+$G(TIU("CSSSN")) S TIU("CSDA")=$$LU^TIUHL7U1(200,TIU("CSNAME"),"X") I '+TIU("CSDA") D ERR^TIUHL7U1("TXA",10,"0000.000","EXPECTED COSIGNER name lookup failed for ["_TIU("CSNAME")_"].") Q
     30 . . I '+$G(TIU("CSDA")),+$G(TIU("CSSSN")) S TIU("CSDA")=+$$FIND1^DIC(200,"","X",+$G(TIU("CSSSN")),"SSN") I '+TIU("CSDA") D ERR^TIUHL7U1("TXA",10,"0000.00","SSN ["_TIU("CSSSN")_"] lookup failed for EXPECTED COSIGNER.") Q
     31 . . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(200,TIU("CSDA"),.01),TIU("CSNAME")) D
     32 . . . D ERR^TIUHL7U1("TXA",10,"0000.00","EXPECTED COSIGNER name discrepancy between HL7 message IEN/SSN ["_$$GET1^DIQ(200,TIU("CSDA"),.01)_"]"_" & HL7 message name ["_TIU("CSNAME")_"].")
     33 . I '+$G(TIU("CSDA")) D ERR^TIUHL7U1("TXA",10,"0000.000","Unable to resolve EXPECTED COSIGNER; the AUTHOR/DICTATOR ["_TIU("AUNAME")_"] requires COSIGNATURE.")
     34 ;
     35 ; ENTERED BY [optional]
     36 I +$L($G(TIU("EBNAME")))!(+$G(TIU("EBDA")))!(+$G(TIU("EBSSN"))) D
     37 . I '+$L($G(TIU("EBNAME"))) D ERR^TIUHL7U1("TXA",11,"0000.00","Missing ENTERED BY name from HL7 message.") Q
     38 . I '+$G(TIU("EBDA")),'+$G(TIU("EBSSN")) S TIU("EBDA")=$$LU^TIUHL7U1(200,TIU("EBNAME"),"X") I '+TIU("EBDA") D ERR^TIUHL7U1("TXA",11,"0000.000","ENTERED BY name lookup failed for ["_TIU("EBNAME")_"].") Q
     39 . I '+$G(TIU("EBDA")),+$G(TIU("EBSSN")) S TIU("EBDA")=+$$FIND1^DIC(200,"","X",+$G(TIU("EBSSN")),"SSN") I '+TIU("EBDA") D ERR^TIUHL7U1("TXA",11,"0000.00","SSN ["_TIU("EBSSN")_"] lookup failed for ENTERED BY.") Q
     40 . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(200,TIU("EBDA"),.01),TIU("EBNAME")) D
     41 . . D ERR^TIUHL7U1("TXA",11,"0000.00","ENTERED BY name discrepancy between HL7 message IEN/SSN ["_$$GET1^DIQ(200,TIU("EBDA"),.01)_"]"_" & HL7 message name ["_TIU("EBNAME")_"].")
     42 ;
     43 ; EPISODE BEGIN DATE/TIME for DISCHARGE SUMMARIES
     44 I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"DISCHARGE SUMMARIES") D
     45 . I '+$G(TIU("CSDA")) D ERR^TIUHL7U1("TXA",10,"0000.000","DISCHARGE SUMMARIES require an ATTENDING PHYSICIAN (EXPECTED COSIGNER).")
     46 . S TIUZ(1209)=$G(TIU("CSDA"))
     47 . I +TIU("VNUM") D  Q
     48 . . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(9000010,TIU("VNUM"),.05),$S(+$G(DFN):$$GET1^DIQ(2,DFN,.01),1:TIU("PTNAME"))) D
     49 . . . D ERR^TIUHL7U1("PV1",19,"0000.00","HL7 message PATIENT NAME ["_TIU("PTNAME")_"] does not match VISIT PATIENT NAME ["_$$GET1^DIQ(9000010,TIU("VNUM"),.05)_"].") Q
     50 . . S TIU("EPDT")=$$GET1^DIQ(9000010,TIU("VNUM"),.01,"I"),TIU("VSTR")=$$VSTRBLD^TIUSRVP(TIU("VNUM"))
     51 . I '+TIU("EPDT") D ERR^TIUHL7U1("PV1",44,"0000.000",TIU("TITLE")_" requires an EPISODE BEGIN DATE/TIME.") Q
     52 . I '+$$GETADMIT^TIUHL7U1(+$G(DFN),TIU("EPDT")) D ERR^TIUHL7U1("PV1","44","0000.00","Could not resolve ADMISSION DT[TIME] for "_$$FMTE^XLFDT(TIUDT)_".")
     53 ;
     54 ; VISIT information for PROGRESS NOTES
     55 I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROGRESS NOTES") D
     56 . I TIU("VNUM")="NEW" D  Q
     57 . . N TYP
     58 . . I '+TIU("HLOC"),TIU("AVAIL")'="AV" D ERR^TIUHL7U1("PV1",4,"0000.00","Missing/Invalid HOSPITAL LOCATION ('AV' not set); required for NEW visits.") Q
     59 . . I +TIU("EPDT")'>0 S TIU("EPDT")=$$NOW^XLFDT
     60 . . I $L(TIU("EPDT"),".")=1 S TIU("EPDT")=TIU("EPDT")_"."_$P($$NOW^XLFDT,".",2)
     61 . . I +TIU("HLOC") I $$GET1^DIQ(44,TIU("HLOC"),2,"I")="W" S TYP="I"
     62 . . S TIU("VSTR")=TIU("HLOC")_";"_TIU("EPDT")_";"_$S(+$D(TYP):"I",TIU("AVAIL")="AV":"E",1:"A")
     63 . I +TIU("VNUM") D  Q
     64 . . I '$$COMPARE^TIUHL7U1($$GET1^DIQ(9000010,TIU("VNUM"),.05),$S(+$G(DFN):$$GET1^DIQ(2,DFN,.01),1:TIU("PTNAME"))) D  Q
     65 . . . D ERR^TIUHL7U1("PV1",19,"0000.00","HL7 message PATIENT NAME ["_TIU("PTNAME")_"] does not match VISIT PATIENT NAME ["_$$GET1^DIQ(9000010,TIU("VNUM"),.05)_"].")
     66 . . S TIU("EPDT")=$$GET1^DIQ(9000010,TIU("VNUM"),.01,"I"),TIU("VSTR")=$$VSTRBLD^TIUSRVP(TIU("VNUM"))
     67 . I '+TIU("VNUM") D
     68 . . I +TIU("EPDT") I '+$$GETADMIT^TIUHL7U1(+$G(DFN),TIU("EPDT")),TIU("AVAIL")'="AV" D ERR^TIUHL7U1("PV1","44","0000.00","Could not find a visit for "_$$FMTE^XLFDT(TIU("EPDT"))_".") Q
     69 . . I '+$$GETVISIT^TIUHL7U1(+$G(DFN),TIU("RFDT")),TIU("AVAIL")'="AV" D ERR^TIUHL7U1("PV1","44","0000.00","Could not find a visit for "_$$FMTE^XLFDT(TIU("RFDT"))_".") Q
     70 . . S TIU("VSTR")=TIU("HLOC")_";"_$$NOW^XLFDT_";E"
     71 ;
     72 D CONTINUE^TIUHL7P3
     73 Q
Note: See TracChangeset for help on using the changeset viewer.