Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOF778A.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOF778A.m
r613 r623 1 HLOF778A ;ALB/CJM-HL7 - Saving messages to file 778 (continued) ;07/10/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,134,137**;Oct 13, 1995;Build 21 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; 6 NEW(HLMSTATE) ; 7 ;This function creates a new entry in file 778. 8 ;Input: 9 ; HLMSTATE (required, pass by reference) These subscripts are expected: 10 ; 11 ;Output - the function returns the ien of the newly created record 12 ; 13 N IEN,NODE,ID,STAT 14 S STAT="HLMSTATE(""STATUS"")" 15 S IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP) 16 Q:'IEN 0 17 S HLMSTATE("IEN")=IEN 18 ; 19 D ;build the message header 20 .N HDR 21 .;for incoming messages the header segment should already exist 22 .;for outgoing messages must build the header segment 23 .I HLMSTATE("DIRECTION")="OUT" D Q 24 ..I HLMSTATE("BATCH"),$G(HLMSTATE("ACK TO"))]"" S HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")=HLMSTATE("ACK TO") 25 ..D BUILDHDR^HLOPBLD1(.HLMSTATE,$S(HLMSTATE("BATCH"):"BHS",1:"MSH"),.HDR) 26 ..S HLMSTATE("HDR",1)=HDR(1),HLMSTATE("HDR",2)=HDR(2) 27 ; 28 K ^HLB(IEN) 29 S ID=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID")) 30 S NODE=ID_"^"_HLMSTATE("BODY")_"^"_$G(HLMSTATE("ACK TO"))_"^"_$S(HLMSTATE("DIRECTION")="IN":"I",1:"O")_"^" 31 S $P(NODE,"^",5)=$G(@STAT@("LINK NAME")) 32 S $P(NODE,"^",6)=$G(@STAT@("QUEUE")) 33 S $P(NODE,"^",8)=$G(@STAT@("PORT")) 34 S $P(NODE,"^",20)=$G(@STAT) 35 S $P(NODE,"^",21)=$G(@STAT@("ERROR TEXT")) 36 S $P(NODE,"^",16)=HLMSTATE("DT/TM") 37 ; 38 I HLMSTATE("DIRECTION")="OUT" D 39 .S $P(NODE,"^",10)=$P($G(@STAT@("APP ACK RESPONSE")),"^") 40 .S $P(NODE,"^",11)=$P($G(@STAT@("APP ACK RESPONSE")),"^",2) 41 .S $P(NODE,"^",12)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^") 42 .S $P(NODE,"^",13)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^",2) 43 .S $P(NODE,"^",14)=$P($G(@STAT@("FAILURE RESPONSE")),"^") 44 .S $P(NODE,"^",15)=$P($G(@STAT@("FAILURE RESPONSE")),"^",2) 45 .; 46 .;for outgoing set these x-refs now, for incoming msgs set them later 47 .S ^HLB("B",ID,IEN)="" 48 .S ^HLB("C",HLMSTATE("BODY"),IEN)="" 49 .I ($G(@STAT)="ER") D 50 ..S ^HLB("ERRORS",$S($L($G(HLMSTATE("HDR","RECEIVING APPLICATION"))):HLMSTATE("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),HLMSTATE("DT/TM CREATED"),IEN)="" 51 ..D COUNT^HLOESTAT("OUT",$G(HLMSTATE("HDR","RECEIVING APPLICATION")),$G(HLMSTATE("HDR","SENDING APPLICATION")),$S(HLMSTATE("BATCH"):"BATCH",1:$G(HLMSTATE("HDR","MESSAGE TYPE"))),$G(HLMSTATE("HDR","EVENT"))) 52 .; 53 .;save some space for the ack 54 .S:($G(HLMSTATE("HDR","ACCEPT ACK TYPE"))="AL") ^HLB(IEN,4)="^^^ " 55 I $G(HLMSTATE("STATUS","PURGE")) S $P(NODE,"^",9)=HLMSTATE("STATUS","PURGE"),^HLB("AD","OUT",HLMSTATE("STATUS","PURGE"),HLMSTATE("IEN"))="" 56 S ^HLB(IEN,0)=NODE 57 ; 58 ;store the message header 59 S ^HLB(IEN,1)=HLMSTATE("HDR",1) 60 S ^HLB(IEN,2)=HLMSTATE("HDR",2) 61 ; 62 ;if the msg is an app ack, update the original msg 63 I $G(HLMSTATE("ACK TO","IEN"))]"" D 64 .N ACKTO 65 .M ACKTO=HLMSTATE("ACK TO") 66 .S ACKTO("ACK BY")=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID")) 67 .D ACKTO^HLOF778(.HLMSTATE,.ACKTO) 68 .S HLMSTATE("ACK TO","DONE")=1 ;because the update was already done, otherwise it might be done again 69 ; 70 ;The "SEARCH" x-ref will be created asynchronously 71 S ^HLTMP("PENDING SEARCH X-REF",$J,HLMSTATE("DT/TM CREATED"),IEN)="" 72 ; 73 ;sequence q? 74 I HLMSTATE("DIRECTION")="OUT",$G(@STAT@("SEQUENCE QUEUE"))'="" S ^HLB(IEN,5)=@STAT@("SEQUENCE QUEUE") 75 ; 76 Q IEN 77 ; 78 NEWIEN(DIR,TCP) ; 79 ;This function uses a counter to get the next available ien for file 778. There are 4 different counters, each assigned as range of numbers, selected via the input parameters. It does not create a record. 80 ;Inputs: 81 ; DIR = "IN" or "OUT" (required) 82 ; TCP = 1,0 (optional) 83 ;Output - the function returns the next available ien. Several counters are used: 84 ; 85 ; <"OUT","TCP"> 86 ; <"OUT","NOT TCP"> 87 ; <"IN","TCP"> 88 ; <"IN","NOT TCP"> 89 ; 90 N IEN,COUNTER,INC 91 I DIR="OUT" S INC=$S(+$G(TCP):0,1:100000000000) 92 I DIR="IN" S INC=$S(+$G(TCP):200000000000,1:300000000000) 93 S COUNTER=$NA(^HLC("FILE778",DIR,$S(+$G(TCP):"TCP",1:"NOT TCP"))) 94 AGAIN ; 95 S IEN=$$INC^HLOSITE(COUNTER,1) 96 I IEN>100000000000 D 97 .L +@COUNTER:200 98 .I $T,@COUNTER>100000000000 S @COUNTER=1,IEN=1 99 .L -@COUNTER 100 I IEN>100000000000 G AGAIN 101 Q (IEN+INC) 102 ; 103 TCP() ;checks the link to see if its TCP, return 1 if yes, 0 if no or not defined 104 N IEN,TCP 105 S TCP=1 106 S IEN=$G(HLMSTATE("STATUS","LINK IEN")) 107 I IEN,$P($G(^HLCS(869.1,+$P($G(^HLCS(870,IEN,0)),"^",3),0)),"^")'="TCP" S TCP=0 108 Q TCP 109 ; 110 GETWORK(WORK) ; Used by the Process Manager. 111 ;Are there any messages that need the "SEARCH" x-ref set? 112 ;Inputs: 113 ; WORK (required, pass-by-reference) 114 ; ("DOLLARJ") 115 ; ("NOW") (required by the process manager, pass-by-reference) 116 ; 117 L +^HLTMP("PENDING SEARCH X-REF"):0 118 Q:'$T 0 119 N OLD,DOLLARJ,SUCCESS,NOW 120 S SUCCESS=0 121 S NOW=$$SEC^XLFDT($H) 122 S (OLD,DOLLARJ)=$G(WORK("DOLLARJ")) 123 F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS 124 .N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,"")) 125 .S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1 126 ; 127 I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS 128 .N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,"")) 129 .S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1 130 S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW 131 Q:WORK("DOLLARJ")]"" 1 132 L -^HLTMP("PENDING SEARCH X-REF") 133 Q 0 134 ; 135 DOWORK(WORK) ;Used by the Process Manager 136 ;Sets the "SEARCH" x-ref, running 100 seconds behind when the message record was created. 137 ; 138 N MSGIEN,TIME 139 S TIME=0 140 F S TIME=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME)) Q:'TIME Q:((WORK("NOW")-$$SEC^XLFDT(TIME))<100) D 141 .S MSGIEN=0 142 .F S MSGIEN=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN)) Q:'MSGIEN D 143 ..N MSG 144 ..I $$GETMSG^HLOMSG(MSGIEN,.MSG) D 145 ...Q:'MSG("DT/TM CREATED") 146 ...I MSG("BATCH") D 147 ....N HDR 148 ....F Q:'$$NEXTMSG^HLOMSG(.MSG,.HDR) S MSG("HDR",1)=HDR(1),MSG("HDR",2)=HDR(2) D SET(.MSG) 149 ...E D 150 ....D SET(.MSG) 151 ..K ^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN) 152 L -^HLTMP("PENDING SEARCH X-REF") 153 Q 154 ; 155 SET(MSG) ; 156 ;sets the ^HLB("SEARCH") x-ref 157 ; 158 N APP,FS,CS,IEN 159 I MSG("DIRECTION")'="IN",MSG("DIRECTION")'="OUT" Q 160 S FS=$E(MSG("HDR",1),4) 161 Q:FS="" 162 S CS=$E(MSG("HDR",1),5) 163 S APP=$S(MSG("DIRECTION")="IN":$P($P(MSG("HDR",1),FS,5),CS),1:$P($P(MSG("HDR",1),FS,3),CS)) 164 I APP="" S APP="UNKNOWN" 165 I MSG("BATCH") D 166 .N VALUE 167 .S VALUE=$P(MSG("HDR",2),FS,4) 168 .S MSG("MESSAGE TYPE")=$P(VALUE,CS) 169 .S MSG("EVENT")=$P(VALUE,CS,2) 170 S:MSG("MESSAGE TYPE")="" MSG("MESSAGE TYPE")="<none>" 171 S:MSG("EVENT")="" MSG("EVENT")="<none>" 172 S IEN=MSG("IEN") 173 I MSG("BATCH") S IEN=IEN_"^"_MSG("BATCH","CURRENT MESSAGE") 174 S ^HLB("SEARCH",MSG("DIRECTION"),MSG("DT/TM CREATED"),APP,MSG("MESSAGE TYPE"),MSG("EVENT"),IEN)="" 175 Q 1 HLOF778A ;ALB/CJM-HL7 - Saving messages to file 778 (continued) ;03/07/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,134**;Oct 13, 1995;Build 30 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; 6 NEW(HLMSTATE) ; 7 ;This function creates a new entry in file 778. 8 ;Input: 9 ; HLMSTATE (required, pass by reference) These subscripts are expected: 10 ; 11 ;Output - the function returns the ien of the newly created record 12 ; 13 N IEN,NODE,ID,STAT 14 S STAT="HLMSTATE(""STATUS"")" 15 S IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP) 16 Q:'IEN 0 17 S HLMSTATE("IEN")=IEN 18 ; 19 D ;build the message header 20 .N HDR 21 .;for incoming messages the header segment should already exist 22 .;for outgoing messages must build the header segment 23 .I HLMSTATE("DIRECTION")="OUT" D Q 24 ..I HLMSTATE("BATCH"),$G(HLMSTATE("ACK TO"))]"" S HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")=HLMSTATE("ACK TO") 25 ..D BUILDHDR^HLOPBLD1(.HLMSTATE,$S(HLMSTATE("BATCH"):"BHS",1:"MSH"),.HDR) 26 ..S HLMSTATE("HDR",1)=HDR(1),HLMSTATE("HDR",2)=HDR(2) 27 ; 28 K ^HLB(IEN) 29 S ID=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID")) 30 S NODE=ID_"^"_HLMSTATE("BODY")_"^"_$G(HLMSTATE("ACK TO"))_"^"_$S(HLMSTATE("DIRECTION")="IN":"I",1:"O")_"^" 31 S $P(NODE,"^",5)=$G(@STAT@("LINK NAME")) 32 S $P(NODE,"^",6)=$G(@STAT@("QUEUE")) 33 S $P(NODE,"^",8)=$G(@STAT@("PORT")) 34 S $P(NODE,"^",20)=$G(@STAT) 35 S $P(NODE,"^",21)=$G(@STAT@("ERROR TEXT")) 36 S $P(NODE,"^",16)=HLMSTATE("DT/TM") 37 ; 38 I HLMSTATE("DIRECTION")="OUT" D 39 .S $P(NODE,"^",10)=$P($G(@STAT@("APP ACK RESPONSE")),"^") 40 .S $P(NODE,"^",11)=$P($G(@STAT@("APP ACK RESPONSE")),"^",2) 41 .S $P(NODE,"^",12)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^") 42 .S $P(NODE,"^",13)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^",2) 43 .S $P(NODE,"^",14)=$P($G(@STAT@("FAILURE RESPONSE")),"^") 44 .S $P(NODE,"^",15)=$P($G(@STAT@("FAILURE RESPONSE")),"^",2) 45 .; 46 .;for outgoing set these x-refs now, for incoming msgs set them later 47 .S ^HLB("B",ID,IEN)="" 48 .S ^HLB("C",HLMSTATE("BODY"),IEN)="" 49 .I ($G(@STAT)="SE") D 50 ..S ^HLB("ERRORS","SE",$S($L($G(HLMSTATE("HDR","RECEIVING APPLICATION"))):HLMSTATE("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),HLMSTATE("DT/TM CREATED"),IEN)="" 51 ..D COUNT^HLOESTAT("OUT",$G(HLMSTATE("HDR","RECEIVING APPLICATION")),$G(HLMSTATE("HDR","SENDING APPLICATION")),$S(HLMSTATE("BATCH"):"BATCH",1:$G(HLMSTATE("HDR","MESSAGE TYPE"))),$G(HLMSTATE("HDR","EVENT"))) 52 .; 53 .;save some space for the ack 54 .S:($G(HLMSTATE("HDR","ACCEPT ACK TYPE"))="AL") ^HLB(IEN,4)="^^^ " 55 I $G(HLMSTATE("STATUS","PURGE")) S $P(NODE,"^",9)=HLMSTATE("STATUS","PURGE"),^HLB("AD","OUT",HLMSTATE("STATUS","PURGE"),HLMSTATE("IEN"))="" 56 S ^HLB(IEN,0)=NODE 57 ; 58 ;store the message header 59 S ^HLB(IEN,1)=HLMSTATE("HDR",1) 60 S ^HLB(IEN,2)=HLMSTATE("HDR",2) 61 ; 62 ;if the msg is an app ack, update the original msg 63 I $G(HLMSTATE("ACK TO","IEN"))]"" D 64 .N ACKTO 65 .M ACKTO=HLMSTATE("ACK TO") 66 .S ACKTO("ACK BY")=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID")) 67 .D ACKTO^HLOF778(.HLMSTATE,.ACKTO) 68 .S HLMSTATE("ACK TO","DONE")=1 ;because the update was already done, otherwise it might be done again 69 ; 70 ;The "SEARCH" x-ref will be created asynchronously 71 S ^HLTMP("PENDING SEARCH X-REF",$J,HLMSTATE("DT/TM CREATED"),IEN)="" 72 ; 73 Q IEN 74 ; 75 NEWIEN(DIR,TCP) ; 76 ;This function uses a counter to get the next available ien for file 778. There are 4 different counters, each assigned as range of numbers, selected via the input parameters. It does not create a record. 77 ;Inputs: 78 ; DIR = "IN" or "OUT" (required) 79 ; TCP = 1,0 (optional) 80 ;Output - the function returns the next available ien. Several counters are used: 81 ; 82 ; <"OUT","TCP"> 83 ; <"OUT","NOT TCP"> 84 ; <"IN","TCP"> 85 ; <"IN","NOT TCP"> 86 ; 87 N IEN,COUNTER,INC 88 I DIR="OUT" S INC=$S(+$G(TCP):0,1:100000000000) 89 I DIR="IN" S INC=$S(+$G(TCP):200000000000,1:300000000000) 90 S COUNTER=$NA(^HLC("FILE778",DIR,$S(+$G(TCP):"TCP",1:"NOT TCP"))) 91 AGAIN ; 92 S IEN=$$INC^HLOSITE(COUNTER,1) 93 I IEN>100000000000 D 94 .L +@COUNTER:200 95 .I $T,@COUNTER>100000000000 S @COUNTER=1,IEN=1 96 .L -@COUNTER 97 I IEN>100000000000 G AGAIN 98 Q (IEN+INC) 99 ; 100 TCP() ;checks the link to see if its TCP, return 1 if yes, 0 if no or not defined 101 N IEN,TCP 102 S TCP=1 103 S IEN=$G(HLMSTATE("STATUS","LINK IEN")) 104 I IEN,$P($G(^HLCS(869.1,+$P($G(^HLCS(870,IEN,0)),"^",3),0)),"^")'="TCP" S TCP=0 105 Q TCP 106 ; 107 GETWORK(WORK) ; Used by the Process Manager. 108 ;Are there any messages that need the "SEARCH" x-ref set? 109 ;Inputs: 110 ; WORK (required, pass-by-reference) 111 ; ("DOLLARJ") 112 ; ("NOW") (required by the process manager, pass-by-reference) 113 ; 114 L +^HLTMP("PENDING SEARCH X-REF"):0 115 Q:'$T 0 116 N OLD,DOLLARJ,SUCCESS,NOW 117 S SUCCESS=0 118 S NOW=$$SEC^XLFDT($H) 119 S (OLD,DOLLARJ)=$G(WORK("DOLLARJ")) 120 F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS 121 .N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,"")) 122 .S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1 123 ; 124 I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS 125 .N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,"")) 126 .S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1 127 S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW 128 Q:WORK("DOLLARJ")]"" 1 129 L -^HLTMP("PENDING SEARCH X-REF") 130 Q 0 131 ; 132 DOWORK(WORK) ;Used by the Process Manager 133 ;Sets the "SEARCH" x-ref, running 100 seconds behind when the message record was created. 134 ; 135 N MSGIEN,TIME 136 S TIME=0 137 F S TIME=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME)) Q:'TIME Q:((WORK("NOW")-$$SEC^XLFDT(TIME))<100) D 138 .S MSGIEN=0 139 .F S MSGIEN=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN)) Q:'MSGIEN D 140 ..N MSG 141 ..I $$GETMSG^HLOMSG(MSGIEN,.MSG) D 142 ...Q:'MSG("DT/TM CREATED") 143 ...I MSG("BATCH") D 144 ....N HDR 145 ....F Q:'$$NEXTMSG^HLOMSG(.MSG,.HDR) S MSG("HDR",1)=HDR(1),MSG("HDR",2)=HDR(2) D SET(.MSG) 146 ...E D 147 ....D SET(.MSG) 148 ..K ^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN) 149 L -^HLTMP("PENDING SEARCH X-REF") 150 Q 151 ; 152 SET(MSG) ; 153 ;sets the ^HLB("SEARCH") x-ref 154 ; 155 N APP,FS,CS,IEN 156 I MSG("DIRECTION")'="IN",MSG("DIRECTION")'="OUT" Q 157 S FS=$E(MSG("HDR",1),4) 158 Q:FS="" 159 S CS=$E(MSG("HDR",1),5) 160 S APP=$S(MSG("DIRECTION")="IN":$P($P(MSG("HDR",1),FS,5),CS),1:$P($P(MSG("HDR",1),FS,3),CS)) 161 I APP="" S APP="UNKNOWN" 162 I MSG("BATCH") D 163 .N VALUE 164 .S VALUE=$P(MSG("HDR",2),FS,4) 165 .S MSG("MESSAGE TYPE")=$P(VALUE,CS) 166 .S MSG("EVENT")=$P(VALUE,CS,2) 167 S:MSG("MESSAGE TYPE")="" MSG("MESSAGE TYPE")="<none>" 168 S:MSG("EVENT")="" MSG("EVENT")="<none>" 169 S IEN=MSG("IEN") 170 I MSG("BATCH") S IEN=IEN_"^"_MSG("BATCH","CURRENT MESSAGE") 171 S ^HLB("SEARCH",MSG("DIRECTION"),MSG("DT/TM CREATED"),APP,MSG("MESSAGE TYPE"),MSG("EVENT"),IEN)="" 172 Q
Note:
See TracChangeset
for help on using the changeset viewer.
