INHBLD ;DP;12:16 PM 12 Apr 1996;14 Feb 96 08:15
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
W # R "Number of records: ",NUM:$G(DTIME,300)
Q:'NUM K ^UTIL(DUZ),DST,DEST
N ZZ,ZZ1 F ZZ=1:1:6 S ZZ1(ZZ)=$P($T(ZZ1+ZZ),";;",2)
;Build an array of active destinations for this run
W !,"Building array of active background processes",!
F I=20:1:47 D
.Q:'$D(^INRHB("RUN",I))
.S DST=$P(^INTHPC(I,0),U,7) Q:'DST
.W $P(^INTHPC(I,0),U),!
.S DEST(DST)=""
I '$D(DEST) W "No background processes are active. No messages generated!",! Q
S DST="" F ZZ=1:1:NUM D
.;Get next destination from array of active destinations
.D
..S DST=$O(DEST(DST))
..;if DST="", start over
..S DST=$O(DEST(DST))
.S X="NOW",DLAYGO=4001,DIC="^INTHU(",DIC(0)="FL" D ^DICN
.S (INREQIEN,DA)=+Y L +^INTHU(DA) S ^UTIL(DUZ,ZZ)=INREQIEN K A1 D NAME
.;B S $P(^INTHU(0),U,3)=DA
.S DIE="^INTHU(",DR="[INH MESSAGE NEW]" D ^DIE
.S TIM=$$CDATH2F^%ZTFDT($H),MID="CHCS"_INREQIEN
.S ^INTHU("B",TIM,INREQIEN)="",^INTHU("C",MID,INREQIEN)=""
.;Concatenate time (.01 field) and destination to remainder
.S X1=ZZ1(1),X=TIM_U_DST_U_$P(X1,U,3,4)_U_MID_U_$P(X1,6,99)
.;S X1=ZZ1(1),X=TIM_U_$P(X1,U,2,4)_U_MID_U_$P(X1,6,99)
.S ^INTHU(INREQIEN,0)=X,^INTHU(INREQIEN,3,0)=ZZ1(2)
.S X1=ZZ1(3),X=$P(X1,U,1,9)_U_MID_U_$P(X1,U,11,99)
.S ^INTHU(INREQIEN,3,1,0)=X
.S ^INTHU(INREQIEN,3,2,0)=ZZ1(4)
.S ^INTHU(INREQIEN,3,4,0)=ZZ1(6)
.S ^INTHU(INREQIEN,3,3,0)=NAME
.;Queue the message
.;S INDEST=$P(^INTHU(INREQIEN,0),U,2)
.;S INQUE=$P($G(^INRHD(INDEST,0)),U,12)
.;S ^INLHDEST(INDEST,0,$H,INREQIEN)=""
.S ^INLHDEST(DST,0,$H,INREQIEN)=""
.L -^INTHU(INREQIEN)
Q
NAME ;SET LIST OF NAMES
S A=$R(1000) S:'$D(^DPT(A,0)) A=$O(^DPT(A))
Q:'$D(^DPT(A,0))
S A1=^DPT(A,0),A2=$G(^DPT(A,.11))
S X=ZZ1(5),X1=$P(X,U,4),$P(X1,"\",1)=A,N=$P(A1,U)
S NAME=$P(N,",")_"\"_$P($P(N,",",2)," ")_"\"_$P($P(N,",",2)," ",2)_"\\\"
;W !,X,!!,A1,!!,NAME
S $P(X,U,6)=NAME,NAME=X ; W !,X
S ZZ1(5)=X
Q
ZZ1 ;
;;2951220.183743^11019^N^0^CHCS485207^^^^^O^12122^^^^^0^^^56601,67063
;;^^4^4
;;MSH^\|~&^CHCSADT^A0101^^^19951220183700^^ADT\A04^CHCS485207^P^2.2^^^^|CR|
;;EVN^A04^^^|CR|
;;PID^1^^424385\\\A0101^20/567-67-7890^GREEN\CHILD\ONE\\\^^19190505000000^M^^C^\\UNIVERSITY CITY\CALIFORNIA\92122^^^^^S^^^567-67-7890^^^^^^^^4104\USA ACTIVE DUTY ENLISTED\99PAT|CR|
;;PV1^1^O^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^|CR|
;
INHBLD ;DP;12:16 PM 12 Apr 1996;14 Feb 96 08:15
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 WRITE #
READ "Number of records: ",NUM:$GET(DTIME,300)
+4 IF 'NUM
QUIT
KILL ^UTIL(DUZ),DST,DEST
+5 NEW ZZ,ZZ1
FOR ZZ=1:1:6
SET ZZ1(ZZ)=$PIECE($TEXT(ZZ1+ZZ),";;",2)
+6 ;Build an array of active destinations for this run
+7 WRITE !,"Building array of active background processes",!
+8 FOR I=20:1:47
Begin DoDot:1
+9 IF '$DATA(^INRHB("RUN",I))
QUIT
+10 SET DST=$PIECE(^INTHPC(I,0),U,7)
IF 'DST
QUIT
+11 WRITE $PIECE(^INTHPC(I,0),U),!
+12 SET DEST(DST)=""
End DoDot:1
+13 IF '$DATA(DEST)
WRITE "No background processes are active. No messages generated!",!
QUIT
+14 SET DST=""
FOR ZZ=1:1:NUM
Begin DoDot:1
+15 ;Get next destination from array of active destinations
+16 Begin DoDot:2
+17 SET DST=$ORDER(DEST(DST))
+18 ;if DST="", start over
+19 SET DST=$ORDER(DEST(DST))
End DoDot:2
+20 SET X="NOW"
SET DLAYGO=4001
SET DIC="^INTHU("
SET DIC(0)="FL"
DO ^DICN
+21 SET (INREQIEN,DA)=+Y
LOCK +^INTHU(DA)
SET ^UTIL(DUZ,ZZ)=INREQIEN
KILL A1
DO NAME
+22 ;B S $P(^INTHU(0),U,3)=DA
+23 SET DIE="^INTHU("
SET DR="[INH MESSAGE NEW]"
DO ^DIE
+24 SET TIM=$$CDATH2F^%ZTFDT($HOROLOG)
SET MID="CHCS"_INREQIEN
+25 SET ^INTHU("B",TIM,INREQIEN)=""
SET ^INTHU("C",MID,INREQIEN)=""
+26 ;Concatenate time (.01 field) and destination to remainder
+27 SET X1=ZZ1(1)
SET X=TIM_U_DST_U_$PIECE(X1,U,3,4)_U_MID_U_$PIECE(X1,6,99)
+28 ;S X1=ZZ1(1),X=TIM_U_$P(X1,U,2,4)_U_MID_U_$P(X1,6,99)
+29 SET ^INTHU(INREQIEN,0)=X
SET ^INTHU(INREQIEN,3,0)=ZZ1(2)
+30 SET X1=ZZ1(3)
SET X=$PIECE(X1,U,1,9)_U_MID_U_$PIECE(X1,U,11,99)
+31 SET ^INTHU(INREQIEN,3,1,0)=X
+32 SET ^INTHU(INREQIEN,3,2,0)=ZZ1(4)
+33 SET ^INTHU(INREQIEN,3,4,0)=ZZ1(6)
+34 SET ^INTHU(INREQIEN,3,3,0)=NAME
+35 ;Queue the message
+36 ;S INDEST=$P(^INTHU(INREQIEN,0),U,2)
+37 ;S INQUE=$P($G(^INRHD(INDEST,0)),U,12)
+38 ;S ^INLHDEST(INDEST,0,$H,INREQIEN)=""
+39 SET ^INLHDEST(DST,0,$HOROLOG,INREQIEN)=""
+40 LOCK -^INTHU(INREQIEN)
End DoDot:1
+41 QUIT
NAME ;SET LIST OF NAMES
+1 SET A=$RANDOM(1000)
IF '$DATA(^DPT(A,0))
SET A=$ORDER(^DPT(A))
+2 IF '$DATA(^DPT(A,0))
QUIT
+3 SET A1=^DPT(A,0)
SET A2=$GET(^DPT(A,.11))
+4 SET X=ZZ1(5)
SET X1=$PIECE(X,U,4)
SET $PIECE(X1,"\",1)=A
SET N=$PIECE(A1,U)
+5 SET NAME=$PIECE(N,",")_"\"_$PIECE($PIECE(N,",",2)," ")_"\"_$PIECE($PIECE(N,",",2)," ",2)_"\\\"
+6 ;W !,X,!!,A1,!!,NAME
+7 ; W !,X
SET $PIECE(X,U,6)=NAME
SET NAME=X
+8 SET ZZ1(5)=X
+9 QUIT
ZZ1 ;
+1 ;;2951220.183743^11019^N^0^CHCS485207^^^^^O^12122^^^^^0^^^56601,67063
+2 ;;^^4^4
+3 ;;MSH^\|~&^CHCSADT^A0101^^^19951220183700^^ADT\A04^CHCS485207^P^2.2^^^^|CR|
+4 ;;EVN^A04^^^|CR|
+5 ;;PID^1^^424385\\\A0101^20/567-67-7890^GREEN\CHILD\ONE\\\^^19190505000000^M^^C^\\UNIVERSITY CITY\CALIFORNIA\92122^^^^^S^^^567-67-7890^^^^^^^^4104\USA ACTIVE DUTY ENLISTED\99PAT|CR|
+6 ;;PV1^1^O^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^|CR|
+7 ;
