Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOF778.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/HLOF778.m
r613 r623 1 HLOF778 ;ALB/CJM-HL7 - Saving messages to file 778 ;07/10/20072 ;;1.6;HEALTH LEVEL SEVEN;**126,134,137**;Oct 13, 1995;Build 21 3 4 5 6 SAVEMSG(HLMSTATE) 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 NEXTMSG(HLMSTATE,MSG) 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 ACKTO(HLMSTATE,ACKTO) 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 I (STATUS="ER"),'SKIP D145 146 .S APP=HLMSTATE("HDR","RECEIVING APPLICATION")147 148 .S ^HLB("ERRORS",APP,$$NOW^XLFDT,ACKTO("IEN"))=""149 150 151 1 HLOF778 ;ALB/CJM-HL7 - Saving messages to file 778 ;03/15/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 SAVEMSG(HLMSTATE) ; 7 ;If a record has not yet been created in file 778, then it will be created. Will file any segments into 777 not yet stored. For batch messages, will store the MSH segments in 778 as the individual messages are stored in 777. 8 ;Input: 9 ; HLMSTATE (pass by reference) - contains information about the message 10 ; These subscripts must be defined: 11 ; ("BATCH")=1 if batch, 0 otherwise 12 ; ("BATCH","BTS")=BTS segment if end of batch reached 13 ; ("BODY")=ien file 777 if stored 14 ; ("DIRECTION")=<"IN" or "OUT"> 15 ; ("IEN")=ien,file 778 if stored 16 ; ("UNSTORED LINES") - count of lines to be stored. The lines are at the a lower subscript level <msg>,<segment>,<line>=<line to be stored> 17 ; ("UNSTORED MSH") For batch messages, set to 1 if there are MSH in cache. Cached MSH at ("UNSTORED MSH",<subfile ien>,<1 & 2>) 18 ; 19 ;Output: 20 ; Function - returns the ien of the msg (file 778) 21 ; HLMSTATE 22 ; ("BODY") - set to ien, file 777 if newly created 23 ; ("IEN") - set to ien, file 778 if newly created 24 ; ("UNSTORED LINES")-set to 0 as this function will store them 25 ; ("UNSTORED MSH")- set to 0 as this function will store it 26 ; 27 ; 28 I '$D(HLMSTATE("DT/TM")) S HLMSTATE("DT/TM")=$S(HLMSTATE("DIRECTION")="IN":$$NOW^XLFDT,1:"") 29 ; 30 ;insure that 777 entry created & all segments stored 31 I ('HLMSTATE("BODY"))!($G(HLMSTATE("UNSTORED LINES")))!($L($G(HLMSTATE("BATCH","BTS")))),'$$SAVEMSG^HLOF777(.HLMSTATE) Q 0 32 ; 33 ;insure 778 entry created 34 I 'HLMSTATE("IEN") Q:'$$NEW^HLOF778A(.HLMSTATE) 0 35 ; 36 ;for batch messages, store MSH segments in 778 37 I HLMSTATE("BATCH") D 38 .N IEN S IEN=HLMSTATE("IEN") 39 .; 40 .;incoming messages cache the MSH segments in memory 41 .I HLMSTATE("DIRECTION")="IN",HLMSTATE("UNSTORED MSH") D 42 ..N ORDER S ORDER=0 43 ..F S ORDER=$O(HLMSTATE("UNSTORED MSH",ORDER)) Q:'ORDER D 44 ...N FS,MSGID 45 ...S FS=$E(HLMSTATE("UNSTORED MSH",ORDER,1),4) 46 ...S MSGID=$P(HLMSTATE("UNSTORED MSH",ORDER,2),FS,5) 47 ...S ^HLB(IEN,3,ORDER,0)=ORDER_"^"_MSGID_"^"_$G(HLMSTATE("BATCH","ACK TO",ORDER)) 48 ...S ^HLB(IEN,3,ORDER,1)=HLMSTATE("UNSTORED MSH",ORDER,1) 49 ...S ^HLB(IEN,3,ORDER,2)=HLMSTATE("UNSTORED MSH",ORDER,2) 50 ...S ^HLB(IEN,3,"B",ORDER,ORDER)="" 51 ...I MSGID]"" S ^HLB("AE",MSGID,IEN_"^"_ORDER)="" ;whole file index for individual message id 52 ..K HLMSTATE("UNSTORED MSH") S HLMSTATE("UNSTORED MSH")=0 53 .; 54 .; 55 .I HLMSTATE("DIRECTION")="OUT" D 56 ..;must build the MSH segments! 57 ..N HDR,FS,MSG,CS 58 ..S FS=HLMSTATE("HDR","FIELD SEPARATOR") 59 ..S CS=$E(HLMSTATE("HDR","ENCODING CHARACTERS"),1) 60 ..S HLMSTATE("HDR","MESSAGE TYPE")=" " 61 ..S HLMSTATE("HDR","EVENT")=" " 62 ..D BUILDHDR^HLOPBLD1(.HLMSTATE,"MSH",.HDR) 63 ..S HLMSTATE("BATCH","CURRENT MESSAGE")=$O(^HLB(HLMSTATE("IEN"),3,"B",";"),-1) 64 ..F Q:'$$NEXTMSG(.HLMSTATE,.MSG) D 65 ...N MSGID,CUR 66 ...S CUR=HLMSTATE("BATCH","CURRENT MESSAGE") 67 ...S MSGID=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_CUR 68 ...S $P(HDR(2),FS,4)=MSG("MESSAGE TYPE")_CS_MSG("EVENT") 69 ...S $P(HDR(2),FS,5)=MSGID 70 ...S ^HLB(IEN,3,CUR,0)=CUR_"^"_MSGID_"^"_$G(HLMSTATE("BATCH","ACK TO",CUR)) 71 ...S ^HLB(IEN,3,CUR,1)=HDR(1) 72 ...S ^HLB(IEN,3,CUR,2)=HDR(2) 73 ...S ^HLB(IEN,3,"B",CUR,CUR)="" 74 ...S ^HLB("AE",MSGID,IEN_"^"_CUR)="" ;whole file index for individual message id 75 ..; 76 .;if the messages are application acks, then update the original message 77 .N SUBIEN S SUBIEN=0 78 .F S SUBIEN=$O(HLMSTATE("BATCH","ACK TO",SUBIEN)) Q:'SUBIEN I $G(HLMSTATE("BATCH","ACK TO",SUBIEN,"IEN"))]"" D 79 ..N ACKTO 80 ..M ACKTO=HLMSTATE("BATCH","ACK TO",SUBIEN) 81 ..; 82 ..;for outgoing msgs, we just created the msgid, for incoming msgs we already had it 83 ..S:HLMSTATE("DIRECTION")="OUT" ACKTO("ACK BY")=HLMSTATE("HDR","BATCH CONTROL ID")_"-"_SUBIEN 84 ..; 85 ..D ACKTO(.HLMSTATE,.ACKTO) 86 .K HLMSTATE("BATCH","ACK TO") 87 ; 88 ;if the msg is an app ack, update the original if not done already 89 I $G(HLMSTATE("ACK TO","IEN"))]"",'$G(HLMSTATE("ACK TO","DONE")) D 90 .N ACKTO 91 .M ACKTO=HLMSTATE("ACK TO") 92 .S ACKTO("ACK BY")=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID")) 93 .D ACKTO(.HLMSTATE,.ACKTO) 94 .S HLMSTATE("ACK TO","DONE")=1 ;so the update isn't done again 95 ; 96 Q HLMSTATE("IEN") 97 ; 98 NEXTMSG(HLMSTATE,MSG) ; 99 ;Traverses file 777 to return the next message in the batch - as 100 ;indicated by HLMSTATE("BATCH","CURRENT MESSAGE") Set to 0 to start, 101 ;returns 0 when there are no more messages 102 ; 103 ;Input: HLMSTATE (pass by reference,required) 104 ;Output: 105 ; HLMSTATE 106 ; ("BATCH","CURRENT MESSAGE") 107 ; MSG -pass by reference: 108 ; ("EVENT") 109 ; ("MESSAGE TYPE") 110 ; 111 ; 112 N SUBIEN,NODE 113 K MSG 114 Q:'$G(HLMSTATE("BODY")) 0 115 S SUBIEN=$O(^HLA(HLMSTATE("BODY"),2,HLMSTATE("BATCH","CURRENT MESSAGE"))) 116 Q:'SUBIEN 0 117 S NODE=$G(^HLA(HLMSTATE("BODY"),2,SUBIEN,0)) 118 S MSG("MESSAGE TYPE")=$P(NODE,"^",2) 119 S MSG("EVENT")=$P(NODE,"^",3) 120 S HLMSTATE("BATCH","CURRENT MESSAGE")=SUBIEN 121 Q SUBIEN 122 ; 123 ACKTO(HLMSTATE,ACKTO) ;if this is an application ack, update the original message - but do not overlay if already valued 124 ;ACKTO = (msgid of msg being ack'd) 125 ; uses these subscripts ("IEN"=ien^subien),("ACK BY"=msgid of acking msg),("STATUS"=status for the initial msg determined by the ack) 126 ; 127 N STATUS,IEN,SUBIEN,NODE,SKIP 128 S SKIP=0 129 S STATUS=$G(ACKTO("STATUS")) 130 S IEN=+ACKTO("IEN"),SUBIEN=$P(ACKTO("IEN"),"^",2) 131 S NODE=$G(^HLB(IEN,0)) 132 I 'SUBIEN D 133 .;ack is to a message NOT in a batch 134 .I $P(NODE,"^",7)'="",$P(NODE,"^",7)'=ACKTO("ACK BY") S SKIP=1 Q 135 .I STATUS="" S STATUS="SU" 136 .S $P(NODE,"^",7)=ACKTO("ACK BY") 137 .S $P(NODE,"^",20)=STATUS 138 .S $P(NODE,"^",21)=$G(ACKTO("ERROR TEXT")) 139 .S ^HLB(IEN,0)=NODE 140 E D 141 .;ack is to a message that IS in a batch 142 .S $P(^HLB(IEN,3,SUBIEN,0),"^",4)=$G(ACKTO("ACK BY")) 143 .S $P(^HLB(IEN,3,SUBIEN,0),"^",5)=STATUS 144 I (STATUS="AE"),'SKIP D 145 .N APP 146 .S APP=HLMSTATE("HDR","SENDING APPLICATION") 147 .I APP="" S APP="UNKNOWN" 148 .S ^HLB("ERRORS","AE",APP,$$NOW^XLFDT,ACKTO("IEN"))="" 149 .;don't count the error - the app ack was already counted as an error. 150 .D COUNT^HLOESTAT("IN",$G(HLMSTATE("HDR","RECEIVING APPLICATION")),$G(HLMSTATE("HDR","SENDING APPLICATION")),$S(HLMSTATE("BATCH"):"BATCH",1:$G(HLMSTATE("HDR","MESSAGE TYPE"))),$G(HLMSTATE("HDR","EVENT"))) 151 Q
Note:
See TracChangeset
for help on using the changeset viewer.
