SRHLU.m

SRHLU ;B'HAM ISC/DLR - Surgery HL7 Utility routine ; [ 05/06/98   7:14 AM ]

 ;;3.0; Surgery ;**41**;24 Jun 93

 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

DNAME(NAME) ;identifies an incoming CN data type to a record in file 200

 N X,CNT

 I '$D(NAME)!(($P(NAME,HLCOMP)="")&($P(NAME,HLCOMP,2="")!$P(NAME,HLCOMP,3=""))) S HLERR="Invalid Name." Q ""

 I NAME="" Q ""

 I $P(NAME,HLCOMP)'="" S NAME=$O(^VA(200,"SSN",$P(NAME,HLCOMP),0))

 E  S X="",CNT=0 S NAME=$$FMNAME^HLFNC($P(NAME,HLCOMP,2,3)) F  S X=$O(^VA(200,"B",NAME,X)) Q:'X  S CNT=CNT+1 S NAME=$S(CNT=1:X,CNT>1:"")

 Q NAME

HNAME(IEN) ;converts an file 200 internal entry number into an HL7 CN data type

 I IEN="" Q ""

 I '$D(^VA(200,IEN,0)) W !,"Not a valid entry in file 200." Q ""

 Q $P(^VA(200,IEN,1),U,9)_HLCOMP_$P($P(^VA(200,IEN,0),U),",")_HLCOMP_$P($P(^VA(200,IEN,0),U),",",2)

SETDSC(HL,DSC,SRHL) ;Create discrepancy ^XTMP global

 N SRMID S SRMID=HL("MID")

 I '$D(^XTMP("SRHLERR^"_SRMID_"^"_HL("DTM"),0)) S ^XTMP("SRHLERR^"_SRMID_"^"_HL("DTM"),0)=$$FMADD^XLFDT(DT,3)_"^"_HL("DTM")_"^Surgery Interface Error Log."

 S ^XTMP("SRHLERR^"_SRMID_"^"_HL("DTM"),SRHL("E"))=DSC

 S SRHL("E")=SRHL("E")+1

 Q

DSCPANCY(HL) ;Discrepancy message builder

 N SRMID S SRMID=HL("MID")

 S XMSUB="HL7 Message #"_SRMID_" contains Surgery application discrepancies."

 S XMY("G.SRHL DISCREPANCY")=""

 S XMTEXT="^XTMP(""SRHLERR^""_SRMID_""^""_HL(""DTM""),"

 D ^XMD K XMTEXT,XMY,XMSUB

 Q

DIV() ; return division associated with default institution

 N SITE,SRDIV S SRDIV="",SITE=$P($G(^XMB(1,1,"XUS")),"^",17) I SITE S SRDIV=$O(^SRO(133,"B",SITE,0)) I SRDIV S SRDIV=$O(^SRO(133,0))

 Q SRDIV

V() ;check HL7 package compatibility level 

 N SRDIV,SR15 S SR15="",SRDIV=$$DIV S:SRDIV SR15=$P($G(^SRO(133,SRDIV,0)),"^",20)

 Q SR15

CHNG ; entry to update VisA HL7 compatibility level

 N SR15,SRDIV,SRY

 S SRDIV=$$DIV I 'SRDIV W !!,?5,"Default institution must be defined as a Surgery site in the SURGERY",!,?5,"SITE PARAMETERS file (#133) before this parameter can be updated.",!! Q

 S SR15=$P($G(^SRO(133,SRDIV,0)),"^",20)

 W !!,"This option may be used to edit the site parameter that determines which",!,"Surgery HL7 interface will be used, the interface compatible with VISTA HL7",!,"V. 1.6 or the older one compatible with VISTA HL7 V. 1.5."

 W !!,"If applications communicating with the Surgery HL7 interface must use the",!,"interface designed for HL7 V. 1.5, enter YES.  Otherwise, enter NO or leave",!,"this field blank.",!

 K DA,DIE,DR S DA=SRDIV,DIE=133,DR="34T" D ^DIE K DA,DIE,DR

 Q

SRHLU     ;B'HAM ISC/DLR - Surgery HL7 Utility routine ; [ 05/06/98   7:14 AM ]

 +1       ;;3.0; Surgery ;**41**;24 Jun 93

 +2       ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

DNAME(NAME) ;identifies an incoming CN data type to a record in file 200

 +1        NEW X,CNT

 +2        IF '$DATA(NAME)!(($PIECE(NAME,HLCOMP)="")&($PIECE(NAME,HLCOMP,2="")!$PIECE(NAME,HLCOMP,3="")))

               SET HLERR="Invalid Name."

               QUIT ""

 +3        IF NAME=""

               QUIT ""

 +4        IF $PIECE(NAME,HLCOMP)'=""

               SET NAME=$ORDER(^VA(200,"SSN",$PIECE(NAME,HLCOMP),0))

 +5       IF '$TEST

               SET X=""

               SET CNT=0

               SET NAME=$$FMNAME^HLFNC($PIECE(NAME,HLCOMP,2,3))

               FOR 

                   SET X=$ORDER(^VA(200,"B",NAME,X))

                   IF 'X

                       QUIT 

                   SET CNT=CNT+1

                   SET NAME=$SELECT(CNT=1:X,CNT>1:"")

 +6        QUIT NAME

HNAME(IEN) ;converts an file 200 internal entry number into an HL7 CN data type

 +1        IF IEN=""

               QUIT ""

 +2        IF '$DATA(^VA(200,IEN,0))

               WRITE !,"Not a valid entry in file 200."

               QUIT ""

 +3        QUIT $PIECE(^VA(200,IEN,1),U,9)_HLCOMP_$PIECE($PIECE(^VA(200,IEN,0),U),",")_HLCOMP_$PIECE($PIECE(^VA(200,IEN,0),U),",",2)

SETDSC(HL,DSC,SRHL) ;Create discrepancy ^XTMP global

 +1        NEW SRMID

           SET SRMID=HL("MID")

 +2        IF '$DATA(^XTMP("SRHLERR^"_SRMID_"^"_HL("DTM"),0))

               SET ^XTMP("SRHLERR^"_SRMID_"^"_HL("DTM"),0)=$$FMADD^XLFDT(DT,3)_"^"_HL("DTM")_"^Surgery Interface Error Log."

 +3        SET ^XTMP("SRHLERR^"_SRMID_"^"_HL("DTM"),SRHL("E"))=DSC

 +4        SET SRHL("E")=SRHL("E")+1

 +5        QUIT 

DSCPANCY(HL) ;Discrepancy message builder

 +1        NEW SRMID

           SET SRMID=HL("MID")

 +2        SET XMSUB="HL7 Message #"_SRMID_" contains Surgery application discrepancies."

 +3        SET XMY("G.SRHL DISCREPANCY")=""

 +4        SET XMTEXT="^XTMP(""SRHLERR^""_SRMID_""^""_HL(""DTM""),"

 +5        DO ^XMD

           KILL XMTEXT,XMY,XMSUB

 +6        QUIT 

DIV()     ; return division associated with default institution

 +1        NEW SITE,SRDIV

           SET SRDIV=""

           SET SITE=$PIECE($GET(^XMB(1,1,"XUS")),"^",17)

           IF SITE

               SET SRDIV=$ORDER(^SRO(133,"B",SITE,0))

               IF SRDIV

                   SET SRDIV=$ORDER(^SRO(133,0))

 +2        QUIT SRDIV

V()       ;check HL7 package compatibility level 

 +1        NEW SRDIV,SR15

           SET SR15=""

           SET SRDIV=$$DIV

           IF SRDIV

               SET SR15=$PIECE($GET(^SRO(133,SRDIV,0)),"^",20)

 +2        QUIT SR15

CHNG      ; entry to update VisA HL7 compatibility level

 +1        NEW SR15,SRDIV,SRY

 +2        SET SRDIV=$$DIV

           IF 'SRDIV

               WRITE !!,?5,"Default institution must be defined as a Surgery site in the SURGERY",!,?5,"SITE PARAMETERS file (#133) before this parameter can be updated.",!!

               QUIT 

 +3        SET SR15=$PIECE($GET(^SRO(133,SRDIV,0)),"^",20)

 +4        WRITE !!,"This option may be used to edit the site parameter that determines which",!,"Surgery HL7 interface will be used, the interface compatible with VISTA HL7",!,"V. 1.6 or the older one compatible with VISTA HL7 V. 1.5."

 +5        WRITE !!,"If applications communicating with the Surgery HL7 interface must use the",!,"interface designed for HL7 V. 1.5, enter YES.  Otherwise, enter NO or leave",!,"this field blank.",!

 +6        KILL DA,DIE,DR

           SET DA=SRDIV

           SET DIE=133

           SET DR="34T"

           DO ^DIE

           KILL DA,DIE,DR

 +7        QUIT