- 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 ;
