Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INSY182

INSY182.m

Go to the documentation of this file. 
  1. INSY182 ;slt;19 Aug 1994@090348;compiled gis system data
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  Q
  1.  ;
  1. 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
  1.  ;;^UTILITY(562037788,"IS",8,1,66,0)
  1.  ;;SET OBR27 = @ORQT|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,67,0)
  1.  ;;SET OBR30 = @ORTM|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,68,0)
  1.  ;;SET OBR32 = $E(INSGX("^INTHL7FT(19,3)",@SUPV),1,60)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,69,0)
  1.  ;;SET OBR33 = $E(INSGX("^INTHL7FT(19,3)",@INTERP),1,60)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,70,0)
  1.  ;;SET OBR34 = $E(INSGX("^INTHL7FT(19,3)",@TECH),1,60)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,71,0)
  1.  ;;SET OBR35 = $E(INSGX("^INTHL7FT(19,3)",@TRANSC),1,60)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,72,0)
  1.  ;;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|
  1.  ;;^UTILITY(562037788,"IS",8,1,73,0)
  1.  ;;ENDWHILE|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,74,0)
  1.  ;;;'OBX' segment|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,75,0)
  1.  ;;^SET INSETID=0|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,76,0)
  1.  ;;WHILE RADIOLOGY REPORTS|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,77,0)
  1.  ;;;'OBX' segment|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,78,0)
  1.  ;;^SET INSETID=0|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,79,0)
  1.  ;;WHILE RADIOLOGY REPORTS|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,80,0)
  1.  ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,81,0)
  1.  ;;SET OBX2 = "CE"|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,82,0)
  1.  ;;SET OBX3.1 = $E("C",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,83,0)
  1.  ;;SET OBX3.2 = $E("RESCODE",1,10)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,84,0)
  1.  ;;SET OBX3.3 = $E("L",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,85,0)
  1.  ;;SET OBX5 = $E(INSGX("^INTHL7FT(17,3)",INTERNAL(#8603)_";78.3"),1,10)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,86,0)
  1.  ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,87,0)
  1.  ;;;'OBX' segment|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,88,0)
  1.  ;;^SET INSETID=0|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,89,0)
  1.  ;;WHILE REPORT TEXT|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,90,0)
  1.  ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,91,0)
  1.  ;;SET OBX2 = "ST"|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,92,0)
  1.  ;;SET OBX3.1 = $E("R",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,93,0)
  1.  ;;SET OBX3.2 = $E("REPORT",1,10)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,94,0)
  1.  ;;SET OBX3.3 = $E("L",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,95,0)
  1.  ;;SET OBX5 = $E(INSGX("^INTHL7F(297,5)",@NULL),1,300)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,96,0)
  1.  ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,97,0)
  1.  ;;ENDWHILE|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,98,0)
  1.  ;;ENDWHILE|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,99,0)
  1.  ;;;'OBX' segment|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,100,0)
  1.  ;;^SET INSETID=0|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,101,0)
  1.  ;;WHILE AMENDED REPORT|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,102,0)
  1.  ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,103,0)
  1.  ;;SET OBX2 = "CE"|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,104,0)
  1.  ;;SET OBX3.1 = $E("C",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,105,0)
  1.  ;;SET OBX3.2 = $E("RESCODE",1,10)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,106,0)
  1.  ;;SET OBX3.3 = $E("L",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,107,0)
  1.  ;;SET OBX5 = $E(INSGX("^INTHL7FT(17,3)",INTERNAL(#4)_";78.3"),1,10)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,108,0)
  1.  ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,109,0)
  1.  ;;;'OBX' segment|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,110,0)
  1.  ;;^SET INSETID=0|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,111,0)
  1.  ;;WHILE AMENDED TEXT|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,112,0)
  1.  ;;SET OBX1 = $E(INSGX("^INTHL7FT(11,3)","OBX"),1,4)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,113,0)
  1.  ;;SET OBX2 = "ST"|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,114,0)
  1.  ;;SET OBX3.1 = $E("R",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,115,0)
  1.  ;;SET OBX3.2 = $E("REPORT",1,10)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,116,0)
  1.  ;;SET OBX3.3 = $E("L",1,1)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,117,0)
  1.  ;;SET OBX5 = $E(INSGX("^INTHL7F(298,5)",@NULL),1,300)|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,118,0)
  1.  ;;LINE "OBX"^OBX1^$E(OBX2,1,2)^OBX3.1_SUBDELIM_OBX3.2_SUBDELIM_OBX3.3^^OBX5|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,119,0)
  1.  ;;ENDWHILE|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,120,0)
  1.  ;;ENDWHILE|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,121,0)
  1.  ;;ENDWHILE|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,122,0)
  1.  ;;|CR|
  1.  ;;^UTILITY(562037788,"IS",8,1,123,0)
  1.  ;;END:|CR|
  1.  ;;^UTILITY(562037788,"SGDT",1,0)
  1.  ;;STRING^ST
  1.  ;;^UTILITY(562037788,"SGDT",3,0)
  1.  ;;NUMERIC^NM
  1.  ;;^UTILITY(562037788,"SGDT",3,2)
  1.  ;;S:$L(X) X=+X
  1.  ;;^UTILITY(562037788,"SGDT",3,3)
  1.  ;;S:$L(X) X=+X
  1.  ;;^UTILITY(562037788,"SGDT",4,0)
  1.  ;;DATE^DT
  1.  ;;^UTILITY(562037788,"SGDT",4,2)
  1.  ;;I X]"" N Y S Y=$E(X,1,4)-1700_$E(X,5,8) D DD^%DT S X=Y
  1.  ;;^UTILITY(562037788,"SGDT",4,3)
  1.  ;;I X]"" S X=$E(X,1,3)+1700_$E(X,4,7)
  1.  ;;^UTILITY(562037788,"SGDT",6,0)
  1.  ;;TIME STAMP^TS
  1.  ;;^UTILITY(562037788,"SGDT",6,2)
  1.  ;;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
  1.  ;;^UTILITY(562037788,"SGDT",6,3)
  1.  ;;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)
  1.  ;;^UTILITY(562037788,"SGDT",7,0)
  1.  ;;PERSON NAME^PN
  1.  ;;^UTILITY(562037788,"SGDT",7,2)
  1.  ;;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:"")
  1.  ;;^UTILITY(562037788,"SGDT",7,3)
  1.  ;;S:X]"" X=$$PN^INHUT(X)
  1.  ;;^UTILITY(562037788,"SGDT",8,0)
  1.  ;;TELEPHONE NUMBER^TN
  1.  ;;^UTILITY(562037788,"SGDT",9,0)
  1.  ;;ADDRESS^AD
  1.  ;;^UTILITY(562037788,"SGDT",9,2)
  1.  ;;I $L(X) S:$P(X,"/",4)="" $P(X,"/",4)="/"
  1.  ;;^UTILITY(562037788,"SGDT",10,0)
  1.  ;;CODED ID^ID
  1.  ;;^UTILITY(562037788,"SGDT",10,50)
  1.  ;;K:X="" X I $D(X) S X=$P(X,U,2)
  1.  ;;^UTILITY(562037788,"SGDT",11,0)
  1.  ;;SET ID^SI
  1.  Q