INSY182 ;slt;19 Aug 1994@090348;compiled gis system data
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
EN F I=1:2 S %ODD=$E($T(EN+I),4,999) Q:%ODD="" S %EVEN=$E($T(EN+(I+1)),4,999) S X="^UTILITY(""INHSYS"","_$J_","_$P(%ODD,",",2,99),@X=%EVEN
;;^UTILITY(562037788,"IS",8,1,66,0)
;;SET OBR27 = @ORQT|CR|
;;^UTILITY(562037788,"IS",8,1,67,0)
;;SET OBR30 = @ORTM|CR|
;;^UTILITY(562037788,"IS",8,1,68,0)
;;SET OBR32 = $E(INSGX("^INTHL7FT(19,3)",@SUPV),1,60)|CR|
;;^UTILITY(562037788,"IS",8,1,69,0)
;;SET OBR33 = $E(INSGX("^INTHL7FT(19,3)",@INTERP),1,60)|CR|
;;^UTILITY(562037788,"IS",8,1,70,0)
;;SET OBR34 = $E(INSGX("^INTHL7FT(19,3)",@TECH),1,60)|CR|
;;^UTILITY(562037788,"IS",8,1,71,0)
;;SET OBR35 = $E(INSGX("^INTHL7FT(19,3)",@TRANSC),1,60)|CR|
;;^UTILITY(562037788,"IS",8,1,72,0)
;;LINE "OBR"^OBR1^$E(OBR2,1,60)^$E(OBR3,1,60)^OBR4^^OBR6^OBR7^^^^^^$E(OBR13,1,300)^OBR14^^OBR16^^^^^^OBR22^^OBR24^OBR25^^$E(OBR27,1,200)^^^$E(OBR30,1,20)^^OBR32^OBR33^OBR34^OBR35|CR|
;;^UTILITY(562037788,"IS",8,1,73,0)
;;ENDWHILE|CR|
;;^UTILITY(562037788,"IS",8,1,74,0)
;;;'OBX' segment|CR|
;;^UTILITY(562037788,"IS",8,1,75,0)
;;^SET INSETID=0|CR|
;;^UTILITY(562037788,"IS",8,1,76,0)
;;WHILE RADIOLOGY REPORTS|CR|
;;^UTILITY(562037788,"IS",8,1,77,0)
;;;'OBX' segment|CR|
;;^UTILITY(562037788,"IS",8,1,78,0)
;;^SET INSETID=0|CR|
;;^UTILITY(562037788,"IS",8,1,79,0)
;;WHILE RADIOLOGY REPORTS|CR|
;;^UTILITY(562037788,"IS",8,1,80,0)
;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
;;^UTILITY(562037788,"IS",8,1,81,0)
;;SET OBX2 = "CE"|CR|
;;^UTILITY(562037788,"IS",8,1,82,0)
;;SET OBX3.1 = $E("C",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,83,0)
;;SET OBX3.2 = $E("RESCODE",1,10)|CR|
;;^UTILITY(562037788,"IS",8,1,84,0)
;;SET OBX3.3 = $E("L",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,85,0)
;;SET OBX5 = $E(INSGX("^INTHL7FT(17,3)",INTERNAL(#8603)_";78.3"),1,10)|CR|
;;^UTILITY(562037788,"IS",8,1,86,0)
;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
;;^UTILITY(562037788,"IS",8,1,87,0)
;;;'OBX' segment|CR|
;;^UTILITY(562037788,"IS",8,1,88,0)
;;^SET INSETID=0|CR|
;;^UTILITY(562037788,"IS",8,1,89,0)
;;WHILE REPORT TEXT|CR|
;;^UTILITY(562037788,"IS",8,1,90,0)
;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
;;^UTILITY(562037788,"IS",8,1,91,0)
;;SET OBX2 = "ST"|CR|
;;^UTILITY(562037788,"IS",8,1,92,0)
;;SET OBX3.1 = $E("R",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,93,0)
;;SET OBX3.2 = $E("REPORT",1,10)|CR|
;;^UTILITY(562037788,"IS",8,1,94,0)
;;SET OBX3.3 = $E("L",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,95,0)
;;SET OBX5 = $E(INSGX("^INTHL7F(297,5)",@NULL),1,300)|CR|
;;^UTILITY(562037788,"IS",8,1,96,0)
;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
;;^UTILITY(562037788,"IS",8,1,97,0)
;;ENDWHILE|CR|
;;^UTILITY(562037788,"IS",8,1,98,0)
;;ENDWHILE|CR|
;;^UTILITY(562037788,"IS",8,1,99,0)
;;;'OBX' segment|CR|
;;^UTILITY(562037788,"IS",8,1,100,0)
;;^SET INSETID=0|CR|
;;^UTILITY(562037788,"IS",8,1,101,0)
;;WHILE AMENDED REPORT|CR|
;;^UTILITY(562037788,"IS",8,1,102,0)
;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
;;^UTILITY(562037788,"IS",8,1,103,0)
;;SET OBX2 = "CE"|CR|
;;^UTILITY(562037788,"IS",8,1,104,0)
;;SET OBX3.1 = $E("C",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,105,0)
;;SET OBX3.2 = $E("RESCODE",1,10)|CR|
;;^UTILITY(562037788,"IS",8,1,106,0)
;;SET OBX3.3 = $E("L",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,107,0)
;;SET OBX5 = $E(INSGX("^INTHL7FT(17,3)",INTERNAL(#4)_";78.3"),1,10)|CR|
;;^UTILITY(562037788,"IS",8,1,108,0)
;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
;;^UTILITY(562037788,"IS",8,1,109,0)
;;;'OBX' segment|CR|
;;^UTILITY(562037788,"IS",8,1,110,0)
;;^SET INSETID=0|CR|
;;^UTILITY(562037788,"IS",8,1,111,0)
;;WHILE AMENDED TEXT|CR|
;;^UTILITY(562037788,"IS",8,1,112,0)
;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
;;^UTILITY(562037788,"IS",8,1,113,0)
;;SET OBX2 = "ST"|CR|
;;^UTILITY(562037788,"IS",8,1,114,0)
;;SET OBX3.1 = $E("R",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,115,0)
;;SET OBX3.2 = $E("REPORT",1,10)|CR|
;;^UTILITY(562037788,"IS",8,1,116,0)
;;SET OBX3.3 = $E("L",1,1)|CR|
;;^UTILITY(562037788,"IS",8,1,117,0)
;;SET OBX5 = $E(INSGX("^INTHL7F(298,5)",@NULL),1,300)|CR|
;;^UTILITY(562037788,"IS",8,1,118,0)
;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
;;^UTILITY(562037788,"IS",8,1,119,0)
;;ENDWHILE|CR|
;;^UTILITY(562037788,"IS",8,1,120,0)
;;ENDWHILE|CR|
;;^UTILITY(562037788,"IS",8,1,121,0)
;;ENDWHILE|CR|
;;^UTILITY(562037788,"IS",8,1,122,0)
;;|CR|
;;^UTILITY(562037788,"IS",8,1,123,0)
;;END:|CR|
;;^UTILITY(562037788,"SGDT",1,0)
;;STRING^ST
;;^UTILITY(562037788,"SGDT",3,0)
;;NUMERIC^NM
;;^UTILITY(562037788,"SGDT",3,2)
;;S:$L(X) X=+X
;;^UTILITY(562037788,"SGDT",3,3)
;;S:$L(X) X=+X
;;^UTILITY(562037788,"SGDT",4,0)
;;DATE^DT
;;^UTILITY(562037788,"SGDT",4,2)
;;I X]"" N Y S Y=$E(X,1,4)-1700_$E(X,5,8) D DD^%DT S X=Y
;;^UTILITY(562037788,"SGDT",4,3)
;;I X]"" S X=$E(X,1,3)+1700_$E(X,4,7)
;;^UTILITY(562037788,"SGDT",6,0)
;;TIME STAMP^TS
;;^UTILITY(562037788,"SGDT",6,2)
;;I X]"" S X=$E(X,1,12) S:$L(X)>8&('$E(X,9,12)) X=$E(X,1,8)_"2400" S X=$E(X,1,4)-1700_$E(X,5,8)_$S($L(X)>8:"."_$E(X,9,14),1:"") N Y S Y=X D DD^%DT S X=Y
;;^UTILITY(562037788,"SGDT",6,3)
;;I X]"" N Y S %DT="ST" D ^%DT S X=$E(Y,1,3)+1700_$E(Y,4,7)_$E($P(Y,".",2)_"000000",1,6)
;;^UTILITY(562037788,"SGDT",7,0)
;;PERSON NAME^PN
;;^UTILITY(562037788,"SGDT",7,2)
;;I X]"" S X=$TR(X,".","") S X=$P(X,"\")_","_$P(X,"\",2)_$S($P(X,"\",3)]"":" "_$P(X,"\",3),1:"")_$S($P(X,"\",4)]"":" "_$P(X,"\",4),1:"")
;;^UTILITY(562037788,"SGDT",7,3)
;;S:X]"" X=$$PN^INHUT(X)
;;^UTILITY(562037788,"SGDT",8,0)
;;TELEPHONE NUMBER^TN
;;^UTILITY(562037788,"SGDT",9,0)
;;ADDRESS^AD
;;^UTILITY(562037788,"SGDT",9,2)
;;I $L(X) S:$P(X,"/",4)="" $P(X,"/",4)="/"
;;^UTILITY(562037788,"SGDT",10,0)
;;CODED ID^ID
;;^UTILITY(562037788,"SGDT",10,50)
;;K:X="" X I $D(X) S X=$P(X,U,2)
;;^UTILITY(562037788,"SGDT",11,0)
;;SET ID^SI
Q
INSY182 ;slt;19 Aug 1994@090348;compiled gis system data
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
EN FOR I=1:2
SET %ODD=$EXTRACT($TEXT(EN+I),4,999)
IF %ODD=""
QUIT
SET %EVEN=$EXTRACT($TEXT(EN+(I+1)),4,999)
SET X="^UTILITY(""INHSYS"","_$JOB_","_$PIECE(%ODD,",",2,99)
SET @X=%EVEN
+1 ;;^UTILITY(562037788,"IS",8,1,66,0)
+2 ;;SET OBR27 = @ORQT|CR|
+3 ;;^UTILITY(562037788,"IS",8,1,67,0)
+4 ;;SET OBR30 = @ORTM|CR|
+5 ;;^UTILITY(562037788,"IS",8,1,68,0)
+6 ;;SET OBR32 = $E(INSGX("^INTHL7FT(19,3)",@SUPV),1,60)|CR|
+7 ;;^UTILITY(562037788,"IS",8,1,69,0)
+8 ;;SET OBR33 = $E(INSGX("^INTHL7FT(19,3)",@INTERP),1,60)|CR|
+9 ;;^UTILITY(562037788,"IS",8,1,70,0)
+10 ;;SET OBR34 = $E(INSGX("^INTHL7FT(19,3)",@TECH),1,60)|CR|
+11 ;;^UTILITY(562037788,"IS",8,1,71,0)
+12 ;;SET OBR35 = $E(INSGX("^INTHL7FT(19,3)",@TRANSC),1,60)|CR|
+13 ;;^UTILITY(562037788,"IS",8,1,72,0)
+14 ;;LINE "OBR"^OBR1^$E(OBR2,1,60)^$E(OBR3,1,60)^OBR4^^OBR6^OBR7^^^^^^$E(OBR13,1,300)^OBR14^^OBR16^^^^^^OBR22^^OBR24^OBR25^^$E(OBR27,1,200)^^^$E(OBR30,1,20)^^OBR32^OBR33^OBR34^OBR35|CR|
+15 ;;^UTILITY(562037788,"IS",8,1,73,0)
+16 ;;ENDWHILE|CR|
+17 ;;^UTILITY(562037788,"IS",8,1,74,0)
+18 ;;;'OBX' segment|CR|
+19 ;;^UTILITY(562037788,"IS",8,1,75,0)
+20 ;;^SET INSETID=0|CR|
+21 ;;^UTILITY(562037788,"IS",8,1,76,0)
+22 ;;WHILE RADIOLOGY REPORTS|CR|
+23 ;;^UTILITY(562037788,"IS",8,1,77,0)
+24 ;;;'OBX' segment|CR|
+25 ;;^UTILITY(562037788,"IS",8,1,78,0)
+26 ;;^SET INSETID=0|CR|
+27 ;;^UTILITY(562037788,"IS",8,1,79,0)
+28 ;;WHILE RADIOLOGY REPORTS|CR|
+29 ;;^UTILITY(562037788,"IS",8,1,80,0)
+30 ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
+31 ;;^UTILITY(562037788,"IS",8,1,81,0)
+32 ;;SET OBX2 = "CE"|CR|
+33 ;;^UTILITY(562037788,"IS",8,1,82,0)
+34 ;;SET OBX3.1 = $E("C",1,1)|CR|
+35 ;;^UTILITY(562037788,"IS",8,1,83,0)
+36 ;;SET OBX3.2 = $E("RESCODE",1,10)|CR|
+37 ;;^UTILITY(562037788,"IS",8,1,84,0)
+38 ;;SET OBX3.3 = $E("L",1,1)|CR|
+39 ;;^UTILITY(562037788,"IS",8,1,85,0)
+40 ;;SET OBX5 = $E(INSGX("^INTHL7FT(17,3)",INTERNAL(#8603)_";78.3"),1,10)|CR|
+41 ;;^UTILITY(562037788,"IS",8,1,86,0)
+42 ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
+43 ;;^UTILITY(562037788,"IS",8,1,87,0)
+44 ;;;'OBX' segment|CR|
+45 ;;^UTILITY(562037788,"IS",8,1,88,0)
+46 ;;^SET INSETID=0|CR|
+47 ;;^UTILITY(562037788,"IS",8,1,89,0)
+48 ;;WHILE REPORT TEXT|CR|
+49 ;;^UTILITY(562037788,"IS",8,1,90,0)
+50 ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
+51 ;;^UTILITY(562037788,"IS",8,1,91,0)
+52 ;;SET OBX2 = "ST"|CR|
+53 ;;^UTILITY(562037788,"IS",8,1,92,0)
+54 ;;SET OBX3.1 = $E("R",1,1)|CR|
+55 ;;^UTILITY(562037788,"IS",8,1,93,0)
+56 ;;SET OBX3.2 = $E("REPORT",1,10)|CR|
+57 ;;^UTILITY(562037788,"IS",8,1,94,0)
+58 ;;SET OBX3.3 = $E("L",1,1)|CR|
+59 ;;^UTILITY(562037788,"IS",8,1,95,0)
+60 ;;SET OBX5 = $E(INSGX("^INTHL7F(297,5)",@NULL),1,300)|CR|
+61 ;;^UTILITY(562037788,"IS",8,1,96,0)
+62 ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
+63 ;;^UTILITY(562037788,"IS",8,1,97,0)
+64 ;;ENDWHILE|CR|
+65 ;;^UTILITY(562037788,"IS",8,1,98,0)
+66 ;;ENDWHILE|CR|
+67 ;;^UTILITY(562037788,"IS",8,1,99,0)
+68 ;;;'OBX' segment|CR|
+69 ;;^UTILITY(562037788,"IS",8,1,100,0)
+70 ;;^SET INSETID=0|CR|
+71 ;;^UTILITY(562037788,"IS",8,1,101,0)
+72 ;;WHILE AMENDED REPORT|CR|
+73 ;;^UTILITY(562037788,"IS",8,1,102,0)
+74 ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
+75 ;;^UTILITY(562037788,"IS",8,1,103,0)
+76 ;;SET OBX2 = "CE"|CR|
+77 ;;^UTILITY(562037788,"IS",8,1,104,0)
+78 ;;SET OBX3.1 = $E("C",1,1)|CR|
+79 ;;^UTILITY(562037788,"IS",8,1,105,0)
+80 ;;SET OBX3.2 = $E("RESCODE",1,10)|CR|
+81 ;;^UTILITY(562037788,"IS",8,1,106,0)
+82 ;;SET OBX3.3 = $E("L",1,1)|CR|
+83 ;;^UTILITY(562037788,"IS",8,1,107,0)
+84 ;;SET OBX5 = $E(INSGX("^INTHL7FT(17,3)",INTERNAL(#4)_";78.3"),1,10)|CR|
+85 ;;^UTILITY(562037788,"IS",8,1,108,0)
+86 ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
+87 ;;^UTILITY(562037788,"IS",8,1,109,0)
+88 ;;;'OBX' segment|CR|
+89 ;;^UTILITY(562037788,"IS",8,1,110,0)
+90 ;;^SET INSETID=0|CR|
+91 ;;^UTILITY(562037788,"IS",8,1,111,0)
+92 ;;WHILE AMENDED TEXT|CR|
+93 ;;^UTILITY(562037788,"IS",8,1,112,0)
+94 ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
+95 ;;^UTILITY(562037788,"IS",8,1,113,0)
+96 ;;SET OBX2 = "ST"|CR|
+97 ;;^UTILITY(562037788,"IS",8,1,114,0)
+98 ;;SET OBX3.1 = $E("R",1,1)|CR|
+99 ;;^UTILITY(562037788,"IS",8,1,115,0)
+100 ;;SET OBX3.2 = $E("REPORT",1,10)|CR|
+101 ;;^UTILITY(562037788,"IS",8,1,116,0)
+102 ;;SET OBX3.3 = $E("L",1,1)|CR|
+103 ;;^UTILITY(562037788,"IS",8,1,117,0)
+104 ;;SET OBX5 = $E(INSGX("^INTHL7F(298,5)",@NULL),1,300)|CR|
+105 ;;^UTILITY(562037788,"IS",8,1,118,0)
+106 ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
+107 ;;^UTILITY(562037788,"IS",8,1,119,0)
+108 ;;ENDWHILE|CR|
+109 ;;^UTILITY(562037788,"IS",8,1,120,0)
+110 ;;ENDWHILE|CR|
+111 ;;^UTILITY(562037788,"IS",8,1,121,0)
+112 ;;ENDWHILE|CR|
+113 ;;^UTILITY(562037788,"IS",8,1,122,0)
+114 ;;|CR|
+115 ;;^UTILITY(562037788,"IS",8,1,123,0)
+116 ;;END:|CR|
+117 ;;^UTILITY(562037788,"SGDT",1,0)
+118 ;;STRING^ST
+119 ;;^UTILITY(562037788,"SGDT",3,0)
+120 ;;NUMERIC^NM
+121 ;;^UTILITY(562037788,"SGDT",3,2)
+122 ;;S:$L(X) X=+X
+123 ;;^UTILITY(562037788,"SGDT",3,3)
+124 ;;S:$L(X) X=+X
+125 ;;^UTILITY(562037788,"SGDT",4,0)
+126 ;;DATE^DT
+127 ;;^UTILITY(562037788,"SGDT",4,2)
+128 ;;I X]"" N Y S Y=$E(X,1,4)-1700_$E(X,5,8) D DD^%DT S X=Y
+129 ;;^UTILITY(562037788,"SGDT",4,3)
+130 ;;I X]"" S X=$E(X,1,3)+1700_$E(X,4,7)
+131 ;;^UTILITY(562037788,"SGDT",6,0)
+132 ;;TIME STAMP^TS
+133 ;;^UTILITY(562037788,"SGDT",6,2)
+134 ;;I X]"" S X=$E(X,1,12) S:$L(X)>8&('$E(X,9,12)) X=$E(X,1,8)_"2400" S X=$E(X,1,4)-1700_$E(X,5,8)_$S($L(X)>8:"."_$E(X,9,14),1:"") N Y S Y=X D DD^%DT S X=Y
+135 ;;^UTILITY(562037788,"SGDT",6,3)
+136 ;;I X]"" N Y S %DT="ST" D ^%DT S X=$E(Y,1,3)+1700_$E(Y,4,7)_$E($P(Y,".",2)_"000000",1,6)
+137 ;;^UTILITY(562037788,"SGDT",7,0)
+138 ;;PERSON NAME^PN
+139 ;;^UTILITY(562037788,"SGDT",7,2)
+140 ;;I X]"" S X=$TR(X,".","") S X=$P(X,"\")_","_$P(X,"\",2)_$S($P(X,"\",3)]"":" "_$P(X,"\",3),1:"")_$S($P(X,"\",4)]"":" "_$P(X,"\",4),1:"")
+141 ;;^UTILITY(562037788,"SGDT",7,3)
+142 ;;S:X]"" X=$$PN^INHUT(X)
+143 ;;^UTILITY(562037788,"SGDT",8,0)
+144 ;;TELEPHONE NUMBER^TN
+145 ;;^UTILITY(562037788,"SGDT",9,0)
+146 ;;ADDRESS^AD
+147 ;;^UTILITY(562037788,"SGDT",9,2)
+148 ;;I $L(X) S:$P(X,"/",4)="" $P(X,"/",4)="/"
+149 ;;^UTILITY(562037788,"SGDT",10,0)
+150 ;;CODED ID^ID
+151 ;;^UTILITY(562037788,"SGDT",10,50)
+152 ;;K:X="" X I $D(X) S X=$P(X,U,2)
+153 ;;^UTILITY(562037788,"SGDT",11,0)
+154 ;;SET ID^SI
+155 QUIT
