Changeset 623 for WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- Location:
- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV
- Files:
-
- 13 edited
-
MHV7B0.m (modified) (1 diff)
-
MHV7B1.m (modified) (1 diff)
-
MHV7B1B.m (modified) (1 diff)
-
MHV7B2.m (modified) (1 diff)
-
MHV7R1.m (modified) (1 diff)
-
MHV7R2.m (modified) (1 diff)
-
MHV7T.m (modified) (1 diff)
-
MHV7U.m (modified) (1 diff)
-
MHVRQI.m (modified) (1 diff)
-
MHVU1.m (modified) (1 diff)
-
MHVUL2.m (modified) (1 diff)
-
MHVXRX.m (modified) (1 diff)
-
MHVXRXR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B0.m
r613 r623 1 MHV7B0 ;WAS/GPM - HL7 MESSAGE BUILDER FOR MFN^Z01 ; 1/21/08 5:18pm 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 MFNZ01(MSGROOT,ADM,ERR,DATAROOT,LEN,HL) ;Build MFN^Z01 6 ; 7 ; Input: 8 ; MSGROOT - (required) Global root of message 9 ; ADM - (required) Array of administrative data 10 ; ERR - (Not used) For compatibility with MHV7T 11 ; DATAROOT - (Not used) For compatibility with MHV7T 12 ; HL - (required) Array of HL package variables 13 ; 14 ; Output: 15 ; MFN^Z01 message in MSGROOT 16 ; MSH,MFI,MFE,ZHV 17 ; LEN - Length of formatted message 18 ; 19 N CNT 20 D LOG^MHVUL2("MFN-Z01 BUILDER","BEGIN","S","TRACE") 21 K @MSGROOT 22 S CNT=1,@MSGROOT@(CNT)=$$MFI(.HL),LEN=$L(@MSGROOT@(CNT)) 23 S CNT=CNT+1,@MSGROOT@(CNT)=$$MFE(.ADM,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 24 S CNT=CNT+1,@MSGROOT@(CNT)=$$ZHV(.ADM,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 25 D LOG^MHVUL2("MFN-Z01 BUILDER","END","S","TRACE") 26 Q 27 ; 28 MFI(HL) ;build MFI segment 29 N MFI 30 S MFI(0)="MFI" 31 S MFI(1,1,1)="MHV" 32 S MFI(3)="UPD" 33 S MFI(6)="NE" 34 Q $$BLDSEG^MHV7U(.MFI,.HL) 35 ; 36 MFE(ADM,HL) ;build MFE segment 37 N MFE 38 S MFE(0)="MFE" 39 S MFE(1)="MUP" 40 S MFE(4)=$G(ADM("SITE NUMBER")) 41 S MFE(5)="CE" 42 Q $$BLDSEG^MHV7U(.MFE,.HL) 43 ; 44 ZHV(ADM,HL) ;build ZHV segment 45 N ZHV 46 S ZHV(0)="ZHV" 47 S ZHV(1,1,1)=$G(ADM("SITE NUMBER")) 48 S ZHV(1,1,2)=$$ESCAPE^MHV7U($G(ADM("SITE NAME")),.HL) 49 S ZHV(2)=$G(ADM("DOMAIN")) 50 S ZHV(3)=$G(ADM("IP ADDRESS")) 51 S ZHV(4)=$G(ADM("HL7 LISTENER PORT")) 52 S ZHV(5)=$G(ADM("RPC BROKER PORT")) 53 S ZHV(6,1,1)=$G(ADM("VERSION")) 54 S ZHV(7)=$$ESCAPE^MHV7U($G(ADM("PATCH NUMBER")),.HL) 55 S ZHV(8)=$G(ADM("SYSTEM TYPE")) 56 Q $$BLDSEG^MHV7U(.ZHV,.HL) 57 ; 1 MHV7B0 ;WAS/GPM - HL7 MESSAGE BUILDER FOR MFN^Z01 ; [8/22/05 6:21pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 MFNZ01(MSGROOT,ADM,ERR,DATAROOT,HL) ;Build MFN^Z01 6 ; 7 ; Input: 8 ; MSGROOT - (required) Global root of message 9 ; ADM - (required) Array of administrative data 10 ; ERR - (Not used) For compatibility with MHV7T 11 ; DATAROOT - (Not used) For compatibility with MHV7T 12 ; HL - (required) Array of HL package variables 13 ; Output: 14 ; MFN^Z01 message in MSGROOT 15 ; MSH,MFI,MFE,ZHV 16 ; 17 N CNT 18 S CNT=0 19 K @MSGROOT 20 S CNT=CNT+1,@MSGROOT@(CNT)=$$MFI(.HL) 21 S CNT=CNT+1,@MSGROOT@(CNT)=$$MFE(.ADM,.HL) 22 S CNT=CNT+1,@MSGROOT@(CNT)=$$ZHV(.ADM,.HL) 23 Q 24 ; 25 MFI(HL) ;build MFI segment 26 N MFI 27 S MFI(0)="MFI" 28 S MFI(1,1,1)="MHV" 29 S MFI(3)="UPD" 30 S MFI(6)="NE" 31 Q $$BLDSEG^MHV7U(.MFI,.HL) 32 ; 33 MFE(ADM,HL) ;build MFE segment 34 N MFE 35 S MFE(0)="MFE" 36 S MFE(1)="MUP" 37 S MFE(4)=$G(ADM("SITE NUMBER")) 38 S MFE(5)="CE" 39 Q $$BLDSEG^MHV7U(.MFE,.HL) 40 ; 41 ZHV(ADM,HL) ;build ZHV segment 42 N ZHV 43 S ZHV(0)="ZHV" 44 S ZHV(1,1,1)=$G(ADM("SITE NUMBER")) 45 S ZHV(1,1,2)=$$ESCAPE^MHV7U($G(ADM("SITE NAME")),.HL) 46 S ZHV(2)=$G(ADM("DOMAIN")) 47 S ZHV(3)=$G(ADM("IP ADDRESS")) 48 S ZHV(4)=$G(ADM("HL7 LISTENER PORT")) 49 S ZHV(5)=$G(ADM("RPC BROKER PORT")) 50 S ZHV(6,1,1)=$G(ADM("VERSION")) 51 S ZHV(7)=$$ESCAPE^MHV7U($G(ADM("PATCH NUMBER")),.HL) 52 S ZHV(8)=$G(ADM("SYSTEM TYPE")) 53 Q $$BLDSEG^MHV7U(.ZHV,.HL) 54 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m
r613 r623 1 MHV7B1 ;WAS/GPM - HL7 message builder RTB^K13 ; [1/7/08 10:45pm] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 RTBK13(MSGROOT,QRY,ERR,DATAROOT,LEN,HL) ; Build query response 8 ; 9 ; Populates the array pointed to by MSGROOT with an RTB^K13 query 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK/Data or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, hit counts, and query information are used to 13 ; build the segments. 14 ; An error number in ERR^4 indicates a NAK is needed. 15 ; DATAROOT being null indicates a dataless ACK (testing purposes). 16 ; Multiple types of RDF/RDT are supported based on the type of 17 ; data in the response. The appropriate domain specific builder is 18 ; called based on QRY("BUILDER"). Note that this is a different 19 ; routine than the XMT("BUILDER"). 20 ; 21 ; Input: 22 ; MSGROOT - Global root of message 23 ; QRY - Query parameters 24 ; QRY("BUILDER") - Domain specific builder routine 25 ; QRY("MID") - original message control ID 26 ; ERR - Caret delimited error string 27 ; segment^sequence^field^code^ACK type^error text 28 ; DATAROOT - Global root of data array 29 ; HL - HL7 package array variable 30 ; 31 ; Output: RTB^K13 message in MSGROOT 32 ; LEN - Length of formatted message 33 ; 34 N CNT,RDT,HIT,EXTIME 35 D LOG^MHVUL2("RTB-K13 BUILDER","BEGIN","S","TRACE") 36 ; 37 S HIT=0,EXTIME="" 38 I DATAROOT'="" D 39 . S HIT=+$P($G(@DATAROOT),"^",1) 40 . S EXTIME=$P($G(@DATAROOT),"^",2) 41 . Q 42 S HIT=HIT_"^"_HIT_"^0" 43 ; 44 K @MSGROOT 45 S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7BUS($G(QRY("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) 46 I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 47 S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^MHV7BUS(.QRY,ERR,HIT,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 48 S CNT=CNT+1,@MSGROOT@(CNT)=$$QPD^MHV7BUS(.QRY,EXTIME,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 49 I '$P(ERR,"^",4) D 50 . D @("RDF^"_QRY("BUILDER")_"(MSGROOT,.CNT,.LEN,.HL)") 51 . Q:DATAROOT="" 52 . Q:HIT<1 53 . D @("RDT^"_QRY("BUILDER")_"(MSGROOT,DATAROOT,.CNT,.LEN,.HL)") 54 . Q 55 ; 56 D LOG^MHVUL2("RTB-K13 BUILDER","END","S","TRACE") 57 Q 58 ; 1 MHV7B1 ;WAS/GPM - HL7 message builder RTB^K13 ; [8/22/05 6:18pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 RTBK13(MSGROOT,QRY,ERR,DATAROOT,HL) ; Build query response 8 ; 9 ; Populates the array pointed to by MSGROOT with an RTB^K13 query 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK/Data or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, hit counts, and query information are user to 13 ; buld the segments. 14 ; An error number in ERR^4 indicates a NAK is needed. 15 ; DATAROOT being null indicates a dataless ACK (testing purposes). 16 ; Multiple types of RDF/RDT are supported based on the type of 17 ; data in the response, indicated by QRY("TYPE"). 18 ; 19 ; Input: 20 ; MSGROOT - Global root of message 21 ; QRY - Query parameters 22 ; QRY("TYPE") - Request type number 23 ; QRY("MID") - original message control ID 24 ; ERR - Caret delimited error string 25 ; segment^sequence^field^code^ACK type^error text 26 ; DATAROOT - Global root of data array 27 ; HL - HL7 package array variable 28 ; 29 ; Output: RTB^K13 message in MSGROOT 30 ; 31 N CNT,RDT,HIT 32 S HIT="" 33 I DATAROOT'="" S HIT=$G(@DATAROOT) 34 I HIT="" S HIT=0 35 S HIT=HIT_"^"_HIT_"^0" 36 K @MSGROOT 37 S CNT=1,@MSGROOT@(CNT)=$$MSA($G(QRY("MID")),ERR,.HL) 38 I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR(ERR,.HL) 39 S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK(.QRY,ERR,HIT,.HL) 40 S CNT=CNT+1,@MSGROOT@(CNT)=$$QPD(.QRY,.HL) 41 Q:$P(ERR,"^",4) 42 S CNT=CNT+1,@MSGROOT@(CNT)=$$RDF(QRY("TYPE"),.HL) 43 Q:DATAROOT="" 44 Q:@DATAROOT<1 45 D RDT(MSGROOT,QRY("TYPE"),DATAROOT,.CNT,.HL) 46 Q 47 ; 48 MSA(MID,ERROR,HL) ;build MSA segment 49 N MSA,ACK 50 S ACK=$P(ERROR,"^",5) 51 I ACK="" S ACK="AA" 52 S MSA(0)="MSA" 53 S MSA(1)=ACK ;ACK code 54 S MSA(2)=MID ;message control ID 55 S MSA(3)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text message 56 Q $$BLDSEG^MHV7U(.MSA,.HL) 57 ; 58 ERR(ERROR,HL) ;build ERR segment 59 N ERR 60 S ERR(0)="ERR" 61 S ERR(1,1,1)=$P(ERROR,"^",1) ;segment 62 S ERR(1,1,2)=$P(ERROR,"^",2) ;sequence 63 S ERR(1,1,3)=$P(ERROR,"^",3) ;field 64 S ERR(1,1,4,1)=$P(ERROR,"^",4) ;code 65 S ERR(1,1,4,2)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text 66 Q $$BLDSEG^MHV7U(.ERR,.HL) 67 ; 68 QAK(QRY,ERROR,HIT,HL) ;build QAK segment 69 N QAK,STATUS 70 S STATUS=$P(ERROR,"^",5) 71 I STATUS="" S STATUS="OK" 72 I STATUS="OK",HIT<1 S STATUS="NF" 73 S QAK(0)="QAK" 74 S QAK(1)=QRY("QPD",2) ;query tag 75 S QAK(2)=STATUS ;query response status 76 M QAK(3)=QRY("QPD",1) ;message query name 77 S QAK(4)=$P(HIT,"^",1) ;hit count total 78 S QAK(5)=$P(HIT,"^",2) ;hits this payload 79 S QAK(6)=$P(HIT,"^",3) ;hits remaining 80 Q $$BLDSEG^MHV7U(.QAK,.HL) 81 ; 82 QPD(QRY,HL) ;build QPD segment 83 N QPD 84 M QPD=QRY("QPD") 85 S QPD(0)="QPD" 86 S QPD(7)=$G(QRY("ICN")) ;ICN 87 S QPD(8)=$G(QRY("DFN")) ;DFN 88 Q $$BLDSEG^MHV7U(.QPD,.HL) 89 ; 90 RDF(REQTYPE,HL) ; build RDF segment 91 N RTN 92 S RTN=$$RTN(REQTYPE) 93 Q:RTN="" "RDF" 94 Q @("$$RDF^"_RTN_"(.HL)") 95 ; 96 RDT(MSGROOT,REQTYPE,DATAROOT,CNT,HL) ; Build RDT segments 97 N RTN 98 S RTN=$$RTN(REQTYPE) 99 Q:RTN="" 100 D @("RDT^"_RTN_"(MSGROOT,DATAROOT,.CNT,.HL)") 101 Q 102 ; 103 RTN(REQTYPE) ; 104 N RDEF 105 S RDEF(3)="MHV7B1B" 106 S RDEF(21)="MHV7B1B" 107 Q $G(RDEF(REQTYPE)) 108 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1B.m
r613 r623 1 MHV7B1B ;WAS/GPM - HL7 message builder RTB^K13 Rx Profile ; 10/13/05 7:52pm [12/24/07 5:39pm] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 RDF(MSGROOT,CNT,LEN,HL) ; Build RDF segment for Rx Profile data 8 ; 9 ; Input: 10 ; MSGROOT - Root of array holding the message 11 ; CNT - Current message line counter 12 ; LEN - Current message length 13 ; HL - HL7 package array variable 14 ; 15 ; Output: 16 ; - Populated message array 17 ; - Updated LEN and CNT 18 ; 19 N RDF 20 S RDF(0)="RDF" 21 S RDF(1)=20 22 S RDF(2,1,1)="Prescription Number",RDF(2,1,2)="ST",RDF(2,1,3)=20 23 S RDF(2,2,1)="IEN",RDF(2,2,2)="NM",RDF(2,2,3)=30 24 S RDF(2,3,1)="Drug Name",RDF(2,3,2)="ST",RDF(2,3,3)=40 25 S RDF(2,4,1)="Issue Date/Time",RDF(2,4,2)="TS",RDF(2,4,3)=26 26 S RDF(2,5,1)="Last Fill Date",RDF(2,5,2)="TS",RDF(2,5,3)=26 27 S RDF(2,6,1)="Release Date/Time",RDF(2,6,2)="TS",RDF(2,6,3)=26 28 S RDF(2,7,1)="Expiration or Cancel Date",RDF(2,7,2)="TS",RDF(2,7,3)=26 29 S RDF(2,8,1)="Status",RDF(2,8,2)="ST",RDF(2,8,3)=25 30 S RDF(2,9,1)="Quantity",RDF(2,9,2)="NM",RDF(2,9,3)=11 31 S RDF(2,10,1)="Days Supply",RDF(2,10,2)="NM",RDF(2,10,3)=3 32 S RDF(2,11,1)="Number of Refills",RDF(2,11,2)="NM",RDF(2,11,3)=3 33 S RDF(2,12,1)="Provider",RDF(2,12,2)="XCN",RDF(2,12,3)=150 34 S RDF(2,13,1)="Placer Order Number",RDF(2,13,2)="ST",RDF(2,13,3)=30 35 S RDF(2,14,1)="Mail/Window",RDF(2,14,2)="ST",RDF(2,14,3)=1 36 S RDF(2,15,1)="Division",RDF(2,15,2)="NM",RDF(2,15,3)=3 37 S RDF(2,16,1)="Division Name",RDF(2,16,2)="ST",RDF(2,16,3)=20 38 S RDF(2,17,1)="MHV Request Status",RDF(2,17,2)="NM",RDF(2,17,3)=3 39 S RDF(2,18,1)="MHV Request Status Date",RDF(2,18,2)="TS",RDF(2,18,3)=26 40 S RDF(2,19,1)="Remarks",RDF(2,19,2)="ST",RDF(2,19,3)=75 41 S RDF(2,20,1)="SIG",RDF(2,20,2)="TX",RDF(2,20,3)=1024 42 ; 43 S CNT=CNT+1 44 S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDF,.HL) 45 S LEN=LEN+$L(@MSGROOT@(CNT)) 46 Q 47 ; 48 RDT(MSGROOT,DATAROOT,CNT,LEN,HL) ; Build RDT segments for Rx Profile data 49 ; 50 ; Walks data in DATAROOT to populate MSGROOT with RDT segments 51 ; sequentially numbered starting at CNT 52 ; 53 ; Integration Agreements: 54 ; 10103 : FMTHL7^XLFDT 55 ; 3065 : HLNAME^XLFNAME 56 ; 57 ; Input: 58 ; MSGROOT - Root of array holding the message 59 ; DATAROOT - Root of array to hold extract data 60 ; CNT - Current message line counter 61 ; LEN - Current message length 62 ; HL - HL7 package array variable 63 ; 64 ; Output: 65 ; - Populated message array 66 ; - Updated LEN and CNT 67 ; 68 N I,RX,RX0,RXP,RXN,RXD,RDT,SIG,SEG,PIEN,NAME,WPLEN 69 D LOG^MHVUL2("MHV7B1B","BEGIN RDT","S","TRACE") 70 F I=1:1 Q:'$D(@DATAROOT@(I)) D 71 . S RX=@DATAROOT@(I) 72 . S RX0=@DATAROOT@(I,0) 73 . S RXP=@DATAROOT@(I,"P") 74 . S PIEN=+RXP 75 . S RXN=@DATAROOT@(I,"RXN") 76 . S RXD=@DATAROOT@(I,"DIV") 77 . K SIG M SIG=@DATAROOT@(I,"SIG") 78 . S RDT(0)="RDT" 79 . S RDT(1)=$P(RX,"^") ;Rx Number 80 . S RDT(2)=$P(RXN,"^",9) ;Rx IEN 81 . S RDT(3)=$$ESCAPE^MHV7U($P(RX,"^",2),.HL) ;Drug Name 82 . S RDT(4)=$$FMTHL7^XLFDT($P(RX0,"^",5)) ;Issue Date/Time 83 . S RDT(5)=$$FMTHL7^XLFDT($P(RX0,"^",12)) ;Last Fill Date 84 . S RDT(6)=$$FMTHL7^XLFDT($P(RXN,"^",2)) ;Release Date/Time 85 . S RDT(7)=$$FMTHL7^XLFDT($P(RX0,"^",3)) ;Expiration/Cancel Date 86 . S RDT(8)=$$ESCAPE^MHV7U($P(RX0,"^",6),.HL) ;Status 87 . S RDT(9)=$P(RX0,"^",8) ;Quantity 88 . S RDT(10)=$P(RX0,"^",7) ;Days Supply 89 . S RDT(11)=$P(RX0,"^",4) ;Number of Refills 90 . I PIEN D 91 .. D FMTNAME2^MHV7BU(PIEN,200,.NAME,.HL,"XCN") 92 .. M RDT(12,1)=NAME 93 .. S RDT(12,1,1)=PIEN ;Provider IEN 94 .. Q 95 . S RDT(13)=$$ESCAPE^MHV7U($P(RX0,"^",11),.HL) ;Placer Order Number 96 . S RDT(14)=$P(RXN,"^",3) ;Mail/Window 97 . S RDT(15)=$P(RXD,"^") ;Division 98 . S RDT(16)=$$ESCAPE^MHV7U($P(RXD,"^",2),.HL) ;Division Name 99 . S RDT(17)=$P(RX,"^",3) ;MHV status 100 . S RDT(18)=$$FMTHL7^XLFDT($P(RX,"^",4)) ;MHV status date 101 . S RDT(19)=$$ESCAPE^MHV7U($P(RXN,"^",4),.HL) ;Remarks 102 . S CNT=CNT+1 103 . S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDT,.HL) 104 . S LEN=LEN+$L(@MSGROOT@(CNT)) 105 . Q:'SIG(0) 106 . K SEG,WPLEN 107 . D BLDWP^MHV7U(.SIG,.SEG,1024,0,.WPLEN,.HL) 108 . M @MSGROOT@(CNT)=SEG 109 . S LEN=LEN+WPLEN 110 . Q 111 D LOG^MHVUL2("MHV7B1B","END RDT","S","TRACE") 112 Q 113 ; 1 MHV7B1B ;WAS/GPM - HL7 message builder RTB^K13 Rx Profile ; [8/22/05 11:45pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 RDF(HL) ; Build RDF segment for Rx Profile data 8 N RDF 9 S RDF(0)="RDF" 10 S RDF(1)=20 11 S RDF(2,1,1)="Prescription Number",RDF(2,1,2)="ST",RDF(2,1,3)=20 12 S RDF(2,2,1)="IEN",RDF(2,2,2)="NM",RDF(2,2,3)=30 13 S RDF(2,3,1)="Drug Name",RDF(2,3,2)="ST",RDF(2,3,3)=40 14 S RDF(2,4,1)="Issue Date/Time",RDF(2,4,2)="TS",RDF(2,4,3)=26 15 S RDF(2,5,1)="Last Fill Date",RDF(2,5,2)="TS",RDF(2,5,3)=26 16 S RDF(2,6,1)="Release Date/Time",RDF(2,6,2)="TS",RDF(2,6,3)=26 17 S RDF(2,7,1)="Expiration or Cancel Date",RDF(2,7,2)="TS",RDF(2,7,3)=26 18 S RDF(2,8,1)="Status",RDF(2,8,2)="ST",RDF(2,8,3)=25 19 S RDF(2,9,1)="Quantity",RDF(2,9,2)="NM",RDF(2,9,3)=11 20 S RDF(2,10,1)="Days Supply",RDF(2,10,2)="NM",RDF(2,10,3)=3 21 S RDF(2,11,1)="Number of Refills",RDF(2,11,2)="NM",RDF(2,11,3)=3 22 S RDF(2,12,1)="Provider",RDF(2,12,2)="XCN",RDF(2,12,3)=150 23 S RDF(2,13,1)="Placer Order Number",RDF(2,13,2)="ST",RDF(2,13,3)=30 24 S RDF(2,14,1)="Mail/Window",RDF(2,14,2)="ST",RDF(2,14,3)=1 25 S RDF(2,15,1)="Division",RDF(2,15,2)="NM",RDF(2,15,3)=3 26 S RDF(2,16,1)="Division Name",RDF(2,16,2)="ST",RDF(2,16,3)=20 27 S RDF(2,17,1)="MHV Request Status",RDF(2,17,2)="NM",RDF(2,17,3)=3 28 S RDF(2,18,1)="MHV Request Status Date",RDF(2,18,2)="TS",RDF(2,18,3)=26 29 S RDF(2,19,1)="Remarks",RDF(2,19,2)="ST",RDF(2,19,3)=75 30 S RDF(2,20,1)="SIG",RDF(2,20,2)="TX",RDF(2,20,3)=1024 31 Q $$BLDSEG^MHV7U(.RDF,.HL) 32 ; 33 RDT(MSGROOT,DATAROOT,CNT,HL) ; Build RDT segments for Rx Profile data 34 ; 35 ; Walks data in DATAROOT to popoulate MSGROOT with RDT segments 36 ; sequentially numbered starting at CNT 37 ; 38 ; Integration Agreements: 39 ; 3065 : $$HLNAME^XLFNAME 40 ; 41 ; Input: 42 ; MSGROOT - Root of array holding the message 43 ; DATAROOT - Root of array to hold extract data 44 ; CNT - Current message line counter 45 ; HL - HL7 package array variable 46 ; 47 ; Output: 48 ; - Populated message array 49 ; 50 N I,RX,RX0,RXP,RXN,RXD,RDT,SIG,SEG,PIEN,NAME 51 F I=1:1 Q:'$D(@DATAROOT@(I)) D 52 . S RX=@DATAROOT@(I) 53 . S RX0=@DATAROOT@(I,0) 54 . S RXP=@DATAROOT@(I,"P") 55 . S PIEN=+RXP 56 . S RXN=@DATAROOT@(I,"RXN") 57 . S RXD=@DATAROOT@(I,"DIV") 58 . K SIG M SIG=@DATAROOT@(I,"SIG") 59 . S RDT(0)="RDT" 60 . S RDT(1)=$P(RX,"^") ;Rx Number 61 . S RDT(2)=$P(RXN,"^",9) ;Rx IEN 62 . S RDT(3)=$$ESCAPE^MHV7U($P(RX,"^",2),.HL) ;Drug Name 63 . S RDT(4)=$$FMTHL7^XLFDT($P(RX0,"^",5)) ;Issue Date/Time 64 . S RDT(5)=$$FMTHL7^XLFDT($P(RX0,"^",12)) ;Last Fill Date 65 . S RDT(6)=$$FMTHL7^XLFDT($P(RXN,"^",2)) ;Release Date/Time 66 . S RDT(7)=$$FMTHL7^XLFDT($P(RX0,"^",3)) ;Expiration/Cancel Date 67 . S RDT(8)=$$ESCAPE^MHV7U($P(RX0,"^",6),.HL) ;Status 68 . S RDT(9)=$P(RX0,"^",8) ;Quantity 69 . S RDT(10)=$P(RX0,"^",7) ;Days Supply 70 . S RDT(11)=$P(RX0,"^",4) ;Number of Refills 71 . I PIEN D 72 .. S RDT(12,1,1)=PIEN ;Provider IEN 73 .. S NAME("FILE")=200,NAME("FIELD")=.01,NAME("IENS")=PIEN_"," 74 .. S NAME=$$HLNAME^XLFNAME(.NAME,"","^") 75 .. S RDT(12,1,2)=$$ESCAPE^MHV7U($P(NAME,"^"),.HL) ;family 76 .. S RDT(12,1,3)=$$ESCAPE^MHV7U($P(NAME,"^",2),.HL) ;given 77 .. S RDT(12,1,4)=$$ESCAPE^MHV7U($P(NAME,"^",3),.HL) ;middle 78 .. S RDT(12,1,5)=$$ESCAPE^MHV7U($P(NAME,"^",4),.HL) ;suffix 79 .. S RDT(12,1,6)=$$ESCAPE^MHV7U($P(NAME,"^",5),.HL) ;prefix 80 .. S RDT(12,1,7)=$$ESCAPE^MHV7U($P(NAME,"^",6),.HL) ;degree 81 .. Q 82 . S RDT(13)=$$ESCAPE^MHV7U($P(RX0,"^",11),.HL) ;Placer Order Number 83 . S RDT(14)=$P(RXN,"^",3) ;Mail/Window 84 . S RDT(15)=$P(RXD,"^") ;Division 85 . S RDT(16)=$$ESCAPE^MHV7U($P(RXD,"^",2),.HL) ;Division Name 86 . S RDT(17)=$P(RX,"^",3) ;MHV status 87 . S RDT(18)=$$FMTHL7^XLFDT($P(RX,"^",4)) ;MHV status date 88 . S RDT(19)=$$ESCAPE^MHV7U($P(RXN,"^",4),.HL) ;Remarks 89 . S CNT=CNT+1 90 . S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDT,.HL) 91 . Q:'SIG(0) 92 . K SEG 93 . D BLDWPSEG^MHV7U(.SIG,.SEG,1024,.HL) 94 . M @MSGROOT@(CNT)=SEG 95 . Q 96 Q 97 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m
r613 r623 1 MHV7B2 ;WAS/GPM - HL7 message builder ORP^O10 ; [12/24/07 5:43pm] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 ORPO10(MSGROOT,REQ,ERR,DATAROOT,LEN,HL) ; Build refill request response 8 ; 9 ; Populates the array pointed to by MSGROOT with an ORP^O10 order 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, and request parameters are used to build the 13 ; segments. An error number in ERR^4 indicates a NAK is needed. 14 ; 15 ; Integration Agreements: 16 ; 3065 : $$HLNAME^XLFNAME 17 ; 10112 : $$SITE^VASITE 18 ; 19 ; Input: 20 ; MSGROOT - Global root of message 21 ; REQ - Query parameters 22 ; REQ("TYPE") - Request type number 23 ; REQ("MID") - original message control ID 24 ; ERR - Caret delimited error string 25 ; segment^sequence^field^code^ACK type^error text 26 ; DATAROOT - Global root of data array 27 ; HL - HL7 package array variable 28 ; 29 ; Output: ORP^O10 message in MSGROOT 30 ; LEN - Length of formatted message 31 ; 32 N CNT,HIT,I 33 D LOG^MHVUL2("ORP-O10 BUILDER","BEGIN","S","TRACE") 34 ; 35 K @MSGROOT 36 S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7BUS($G(REQ("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) 37 I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 38 S CNT=CNT+1,@MSGROOT@(CNT)=$$PID^MHV7BUS(.REQ,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 39 ; 40 I '$P(ERR,"^",4),DATAROOT'="" D 41 . F I=1:1 Q:'$D(@DATAROOT@(I)) D 42 .. S CNT=CNT+1,@MSGROOT@(CNT)=$$ORC(@DATAROOT@(I),.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 43 .. S CNT=CNT+1,@MSGROOT@(CNT)=$$RXE(@DATAROOT@(I),.HL),LEN=LEN+$L(@MSGROOT@(CNT)) 44 .. Q 45 . Q 46 ; 47 D LOG^MHVUL2("ORP-O10 BUILDER","END","S","TRACE") 48 Q 49 ; 50 ORC(DATA,HL) ;build ORC segment 51 N ORC,STATUS,CONTROL 52 S STATUS=$P(DATA,"^",2) 53 S CONTROL=$S(STATUS=1:"OK",1:"UA") 54 S ORC(0)="ORC" 55 S ORC(1)=CONTROL ;order control 56 S ORC(2)=$P(DATA,"^",3) ;placer order number 57 S ORC(3)=$P(DATA,"^",3) ;filler order number 58 Q $$BLDSEG^MHV7U(.ORC,.HL) 59 ; 60 RXE(DATA,HL) ;build RXE segment 61 N RXE,STATUS,CONTROL 62 S STATUS=$P(DATA,"^",2) 63 S CONTROL=$S(STATUS=1:"OK",1:"UA") 64 S RXE(0)="RXE" 65 S RXE(1,1,1,1)=1 ;order quantity 66 S RXE(1,1,4,1)=$P(DATA,"^",4) ;order start time 67 S RXE(2,1,1)=CONTROL ;give code identifier 68 S RXE(2,1,2)=STATUS ;give code text 69 S RXE(2,1,3)="HL70119" ;give code system 70 S RXE(3)=1 ;give amount 71 S RXE(5)="1 refill unit" ;give units 72 ;S RXE(7)="" ;division number 73 S RXE(15)=$P(DATA,"^",1) ;prescription number 74 Q $$BLDSEG^MHV7U(.RXE,.HL) 75 ; 1 MHV7B2 ;WAS/GPM - HL7 message builder ORP^O10 ; [8/22/05 11:47pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 ORPO10(MSGROOT,REQ,ERR,DATAROOT,HL) ; Build refill request response 8 ; 9 ; Populates the array pointed to by MSGROOT with an ORP^O10 order 10 ; response message by calling the appropriate segment builders based 11 ; on the type of response ACK or NAK. Extracted data pointed to 12 ; by DATAROOT, errors, and request parameters are used to build the 13 ; segments. An error number in ERR^4 indicates a NAK is needed. 14 ; 15 ; Integration Agreements: 16 ; 3065 : $$HLNAME^XLFNAME 17 ; 10112 : $$SITE^VASITE 18 ; 19 ; Input: 20 ; MSGROOT - Global root of message 21 ; REQ - Query parameters 22 ; REQ("TYPE") - Request type number 23 ; REQ("MID") - original message control ID 24 ; ERR - Caret delimited error string 25 ; segment^sequence^field^code^ACK type^error text 26 ; DATAROOT - Global root of data array 27 ; HL - HL7 package array variable 28 ; 29 ; Output: ORP^O10 message in MSGROOT 30 ; 31 N CNT,RDT,HIT,I 32 K @MSGROOT 33 S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7B1($G(REQ("MID")),ERR,.HL) 34 I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$ERR^MHV7B1(ERR,.HL) 35 Q:$P(ERR,"^",4) 36 S CNT=CNT+1,@MSGROOT@(CNT)=$$PID(.REQ,.HL) 37 F I=1:1 Q:'$D(@DATAROOT@(I)) D 38 . S CNT=CNT+1,@MSGROOT@(CNT)=$$ORC(@DATAROOT@(I),.HL) 39 . S CNT=CNT+1,@MSGROOT@(CNT)=$$RXE(@DATAROOT@(I),.HL) 40 . Q 41 Q 42 ; 43 PID(REQ,HL) ; 44 N PID,NAME,STATION,IDCNT 45 S STATION=$P($$SITE^VASITE,"^",3) 46 S PID(0)="PID" 47 S IDCNT=0 48 I REQ("ICN")'="" D 49 . S IDCNT=IDCNT+1 50 . S PID(3,IDCNT,1)=REQ("ICN") ;Patient ID - ICN 51 . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID 52 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type 53 . S PID(3,IDCNT,5)="NI" ;Patient ID type 54 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility 55 . S PID(3,IDCNT,6,2)=STATION ;Station number 56 . S PID(3,IDCNT,6,3)="L" ;facility ID type 57 . Q 58 ; 59 I REQ("DFN")'="" D 60 . S IDCNT=IDCNT+1 61 . S PID(3,IDCNT,1)=REQ("DFN") ;Patient ID - DFN 62 . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID 63 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type 64 . S PID(3,IDCNT,5)="PI" ;Patient ID type 65 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility 66 . S PID(3,IDCNT,6,2)=STATION ;Station number 67 . S PID(3,IDCNT,6,3)="L" ;facility ID type 68 . Q 69 ; 70 I REQ("SSN")'="" D 71 . S IDCNT=IDCNT+1 72 . S PID(3,IDCNT,1)=REQ("SSN") ;Patient ID - SSN 73 . S PID(3,IDCNT,4,1)="USSSA" ;assigning authority ID 74 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type 75 . S PID(3,IDCNT,5)="SS" ;Patient ID type 76 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility 77 . S PID(3,IDCNT,6,2)="200MH" ;Station number 78 . S PID(3,IDCNT,6,3)="L" ;facility ID type 79 . Q 80 ; 81 S NAME("FILE")=2,NAME("FIELD")=.01,NAME("IENS")=REQ("DFN")_"," 82 S NAME=$$NAMEFMT^XLFNAME(.NAME) 83 S PID(5,1,1)=$$ESCAPE^MHV7U($P(NAME,"^"),.HL) ;family 84 S PID(5,1,2)=$$ESCAPE^MHV7U($P(NAME,"^",2),.HL) ;given 85 S PID(5,1,3)=$$ESCAPE^MHV7U($P(NAME,"^",3),.HL) ;middle 86 S PID(5,1,4)=$$ESCAPE^MHV7U($P(NAME,"^",4),.HL) ;suffix 87 ; 88 Q $$BLDSEG^MHV7U(.PID,.HL) 89 ; 90 ORC(DATA,HL) ;build ORC segment 91 N ORC,STATUS,CONTROL 92 S STATUS=$P(DATA,"^",2) 93 S CONTROL=$S(STATUS=1:"OK",1:"UA") 94 S ORC(0)="ORC" 95 S ORC(1)=CONTROL ;order control 96 S ORC(2)=$P(DATA,"^",3) ;placer order number 97 S ORC(3)=$P(DATA,"^",3) ;filler order number 98 Q $$BLDSEG^MHV7U(.ORC,.HL) 99 ; 100 RXE(DATA,HL) ;build RXE segment 101 N RXE,STATUS,CONTROL 102 S STATUS=$P(DATA,"^",2) 103 S CONTROL=$S(STATUS=1:"OK",1:"UA") 104 S RXE(0)="RXE" 105 S RXE(1,1,1,1)=1 ;order quantity 106 S RXE(1,1,4,1)=$P(DATA,"^",4) ;order start time 107 S RXE(2,1,1)=CONTROL ;give code identifier 108 S RXE(2,1,2)=STATUS ;give code text 109 S RXE(2,1,3)="HL70119" ;give code system 110 S RXE(3)=1 ;give amount 111 S RXE(5)="1 refill unit" ;give units 112 ;S RXE(7)="" ;division number 113 S RXE(15)=$P(DATA,"^",1) ;prescription number 114 Q $$BLDSEG^MHV7U(.RXE,.HL) 115 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R1.m
r613 r623 1 MHV7R1 ;WAS/GPM - HL7 RECEIVER FOR QBP QUERIES ; [12/31/07 3:11pm] 2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 QBPQ13 ;Process QBP^Q13 messages from the MHV QBP-Q13 Subscriber protocol 8 ; 9 QBPQ11 ;Process QBP^Q11 messages from the MHV QBP-Q11 Subscriber protocol 10 ; 11 ; This routine and subroutines assume that all VistA HL7 environment 12 ; variables are properly initialized and will produce a fatal error 13 ; if they are missing. 14 ; 15 ; The message will be checked to see if it is a valid query. 16 ; If not a negative acknowledgement will be sent. If the query is an 17 ; immediate mode or synchronous query, the realtime request manager 18 ; is called to handle the query. This means the query will be 19 ; processed and a response generated immediately. 20 ; In the future deferred mode queries may be filed in a database for 21 ; later processing, or transmission. 22 ; 23 ; Input: 24 ; HL7 environment variables 25 ; 26 ; Output: 27 ; Processed query or negative acknowledgement 28 ; If handled real-time the query response is generated 29 ; 30 N MSGROOT,QRY,XMT,ERR,RNAME 31 S (QRY,XMT,ERR)="" 32 ; Inbound query messages are small enough to be held in a local. 33 ; The following lines commented out support use of global and are 34 ; left in case use a global becomes necessary. 35 ;S MSGROOT="^TMP(""MHV7"",$J)" 36 ;K @MSGROOT 37 S MSGROOT="MHV7MSG" 38 N MHV7MSG 39 D LOADXMT^MHV7U(.XMT) ;Load inbound message information 40 ; 41 S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER" 42 D LOG^MHVUL2(RNAME,"BEGIN","S","TRACE") 43 ; 44 D LOADMSG^MHV7U(MSGROOT) 45 D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG") 46 ; 47 D PARSEMSG^MHV7U(MSGROOT,.HL) 48 D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG") 49 ; 50 I '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR) D Q 51 . D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR") 52 . D XMIT^MHV7T(.QRY,.XMT,ERR,"",.HL) 53 D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE") 54 ; 55 ; Immediate Mode 56 ; Deferred mode queries are not supported at this time 57 D REALTIME^MHVRQI(.QRY,.XMT,.HL) 58 ; 59 D LOG^MHVUL2(RNAME,"END","S","TRACE") 60 D RESET^MHVUL2 ;Clean up TMP used by logging 61 ;K @MSGROOT 62 ; 63 Q 64 ; 65 VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message 66 ; 67 ; Messages handled: QBP^Q13 68 ; QBP^Q11 69 ; 70 ; QBP query messages must contain PID, QPD and RCP segments 71 ; RXE segments are processed on Q13 prescription queries 72 ; Any additional segments are ignored 73 ; 74 ; The following sequences are required 75 ; PID(3) - Patient ID 76 ; PID(5)* - Patient Name 77 ; QPD(1)* - Message Query Name 78 ; QPD(2)* - Query Tag 79 ; QPD(3) - Request ID 80 ; QPD(4) - Subject Area 81 ; RCP(1) - Query Priority 82 ; * required by HL7 standard but not used by MHV 83 ; 84 ; The following sequences are optional 85 ; QPD(5) - From Date 86 ; QPD(6) - To Date 87 ; RCP(2) - Quantity Limited 88 ; 89 ; Input: 90 ; MSGROOT - Root of array holding message 91 ; XMT - Transmission parameters 92 ; 93 ; Output: 94 ; QRY - Query Array 95 ; XMT - Transmission parameters 96 ; ERR - segment^sequence^field^code^ACK type^error text 97 ; 98 N MSH,PID,RDF,RXE,QPD,RCP,REQID,REQTYPE,FROMDT,TODT,PRI,QTAG,QNAME,SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT 99 K QRY,ERR 100 S ERR="" 101 ; 102 ; Set up basics for responding to message. 103 ;----------------------------------------- 104 S QRY("MID")=XMT("MID") ;Message ID 105 S QRY("QPD")="" 106 ; 107 ; Validate message is a well-formed QBP query message. 108 ;----------------------------------------------------------- 109 ; Must have MSH first, followed by QPD,PID,RXE,RDF,RCP in any order 110 ; RXE is processed on Q13 prescriptions queries 111 ; RDF is not required 112 ; Any other segments are ignored. 113 ; 114 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) 115 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 116 ; 117 S CNT=2,OCNT=0 118 F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 119 . S SEGTYPE=$G(@MSGROOT@(CNT,0)) 120 . I SEGTYPE="PID" M PID=@MSGROOT@(CNT),QRY("PID")=PID Q 121 . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q 122 . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q 123 . I SEGTYPE="RCP" M RCP=@MSGROOT@(CNT) Q 124 . I SEGTYPE="RXE" S OCNT=OCNT+1 M RXE(OCNT)=@MSGROOT@(CNT) Q 125 . Q 126 ; 127 I '$D(PID) S ERR="PID^1^^100^AE^Missing PID segment" Q 0 128 I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0 129 I '$D(RCP) S ERR="RCP^1^^100^AE^Missing RCP segment" Q 0 130 ; 131 ; Validate required fields and query parameters 132 ;------------------------------------------------------ 133 S QTAG=$G(QPD(2)) ;Query Tag 134 S REQID=$G(QPD(3)) ;Request ID 135 S REQTYPE=$G(QPD(4)) ;Request Type 136 S FROMDT=$G(QPD(5)) ;From Date 137 S TODT=$G(QPD(6)) ;To Date 138 S PRI=$G(RCP(1)) ;Query Priority 139 S QTY=$G(RCP(2,1,1)) ;Quantity Limited 140 S UNIT=$G(RCP(2,1,2)) ;Quantity units 141 ; 142 I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0 143 M QNAME=QPD(1) ;Message Query Name 144 ; 145 I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0 146 ; 147 I REQID="" S ERR="QPD^1^3^101^AE^Missing Request ID" Q 0 148 S QRY("REQID")=REQID 149 ; 150 I REQTYPE="" S ERR="QPD^1^4^101^AE^Missing Request Type" Q 0 151 I '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR) S ERR="QPD^1^4^"_ERR Q 0 152 ; 153 I '$$VALIDDT^MHV7RU(.FROMDT) S ERR="QPD^1^5^102^AE^Invalid From Date" Q 0 154 S QRY("FROM")=FROMDT 155 I '$$VALIDDT^MHV7RU(.TODT) S ERR="QPD^1^6^102^AE^Invalid To Date" Q 0 156 I TODT'="",TODT<FROMDT S ERR="QPD^1^6^102^AE^To Date precedes From Date" Q 0 157 S QRY("TO")=TODT 158 ; 159 I '$$VALIDPID^MHV7RUS(.PID,.QRY,.ERR) Q 0 160 ; 161 I PRI="" S ERR="RCP^1^1^101^AE^Missing Query Priority" Q 0 162 I ",D,I,"'[(","_PRI_",") S ERR="RCP^1^1^102^AE^Invalid Query Priority" Q 0 163 S QRY("PRI")=PRI 164 ; 165 I QTY'?0.N S ERR="RCP^1^2^102^AE^Invalid Quantity" Q 0 166 S QRY("QTY")=+QTY 167 S XMT("MAX SIZE")=+QTY 168 ; 169 I QTY,UNIT'="CH" S ERR="RCP^1^2^102^AE^Invalid Units" Q 0 170 ; 171 ; Setup prescription list (if passed) 172 ;------------------------------------ 173 F CNT=1:1 Q:'$D(RXE(CNT)) D Q:ERR'="" 174 . S RXNUM=$G(RXE(CNT,15)) 175 . I RXNUM="" S ERR="RXE^"_CNT_"^15^101^AE^Missing Prescription#" Q 176 . I RXNUM'?1.N0.A S ERR="RXE^"_CNT_"^15^102^AE^Invalid Prescription#" Q 177 . S QRY("RXLIST",RXNUM)="" 178 . Q 179 Q:ERR'="" 0 180 ; 181 Q 1 182 ; 1 MHV7R1 ;WAS/GPM - HL7 RECEIVER FOR QBP^Q13 ; [5/24/06 10:19am] 2 ;;1.0;My HealtheVet;**1**;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 QBPQ13 ;Process QBP^Q13 messages from the MHV QBP-Q13 Subscriber protocol 6 ; 7 ; This routine and subroutines assume that all VistA HL7 environment 8 ; variables are properly initialized and will produce a fatal error 9 ; if they are missing. 10 ; 11 ; The message will be checked to see if it is a valid QBP^Q13 query. 12 ; If not a negative acknowledgement will be sent. If the query is an 13 ; immediate mode or synchronous query, the realtime request manager 14 ; is called to handle the query. 15 ; In the future deferred mode queries may be filed in a database for 16 ; later processing, or transmission. 17 ; 18 ; Integration Agreements: 19 ; 10103 : $$HL7TFM^XLFDT 20 ; 21 ; Input: 22 ; HL7 environment variables 23 ; 24 ; Output: 25 ; Processed query or negative acknowledgement 26 ; 27 N MSGROOT,QRY,XMT,ERR 28 S (QRY,XMT,ERR)="" 29 ;S MSGROOT="^TMP(""MHV7"",$J)" 30 S MSGROOT="MHV7MSG" 31 N MHV7MSG 32 D LOG^MHV7U("QBP-Q13 RECEIVER","","S",1) 33 ; 34 D LOADMSG^MHV7U(MSGROOT) 35 D LOG^MHV7U("LOAD",MSGROOT,"I",0) 36 ; 37 D PARSEMSG^MHV7U(MSGROOT,.HL) 38 ;D LOG^MHV7U("PARSE",MSGROOT,"I",0) 39 ; 40 I '$$VALIDQ13(MSGROOT,.QRY,.XMT,.ERR) D Q 41 . D LOG^MHV7U("MSG CHECK","INVALID^"_ERR,"S",0) 42 . D XMIT^MHV7T(.QRY,.XMT,ERR,"",.HL) 43 D LOG^MHV7U("MSG CHECK","VALID","S",0) 44 ; 45 ; Immediate Mode 46 ; Only real time synchronous calls are supported at this time. 47 I QRY("PRI")="I" D REALTIME^MHVRQI(.QRY,.XMT,.HL) 48 K ^TMP("MHV7LOG",$J) 49 ; 50 Q 51 ; 52 VALIDQ13(MSG,QRY,XMT,ERR) ;Parse and Validate message 53 ; 54 ; QBP^Q13 messages must contain QPD and RCP segments 55 ; RDF segments are optional but not processed 56 ; The following sequences are required 57 ; PID(3) - Patient ID 58 ; QPD(3) - Request ID 59 ; QPD(4) - Subject Area 60 ; RCP(1) - priority 61 ; The following sequences are optional 62 ; QPD(5) - From Date 63 ; QPD(6) - To Date 64 ; QPD(7) - ICN 65 ; QPD(8) - DFN 66 ; 67 ; ERR = segment^sequence^field^code^ACK type^error text 68 ; 69 N MSH,PID,RDF,RXE,QPD,RCP,REQID,ICN,REQTYPE,FROMDT,TODT,DFN,PRI,REQTIEN,REQT0,QTAG,QNAME,SEGTYPE,CNT,SSN,FAMILY,GIVEN,MIDDLE,SUFFIX,SEGTYPE,CNT,OCNT,RXNUM,I,ID,TYPE 70 S ERR="" 71 K QRY,XMT 72 ; 73 ;Set response control defaults 74 S XMT("PROTOCOL")="MHV RTB-K13 Event Driver" ;Response protocol 75 S XMT("BUILDER")="RTBK13^MHV7B1" ;Response builder 76 S XMT("MODE")="D" ;Response mode 77 I $G(HL("APAT"))="" S XMT("MODE")="I" ;Immediate mode 78 S XMT("HLMTIENS")=HLMTIENS ;Message IEN 79 S QRY("MID")="" ;Message ID 80 S QRY("QPD")="" ;QPD segment 81 ; 82 ; 83 ;Validate message is a well formed QBP^Q13 message 84 ; 85 ;Must have MSH first, followed by QPD,PID,RXE,RDF,RCP in any order 86 ;RDF is not required, any other segments are ignored 87 ; 88 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) S QRY("MID")=$G(MSH(9)) 89 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 90 S CNT=2,OCNT=0 91 F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 92 . S SEGTYPE=$G(@MSGROOT@(CNT,0)) 93 . I SEGTYPE="PID" M PID=@MSGROOT@(CNT),QRY("PID")=PID Q 94 . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q 95 . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q 96 . I SEGTYPE="RCP" M RCP=@MSGROOT@(CNT) Q 97 . I SEGTYPE="RXE" S OCNT=OCNT+1 M RXE(OCNT)=@MSGROOT@(CNT) Q 98 . Q 99 ; 100 I '$D(PID) S ERR="PID^1^^100^AE^Missing PID segment" Q 0 101 I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0 102 I '$D(RCP) S ERR="RCP^1^^100^AE^Missing RCP segment" Q 0 103 ; 104 ; 105 ;Validate required fields and query parameters 106 ; 107 S ICN="",DFN="",SSN="" 108 F I=1:1:3 Q:'$D(PID(3,I)) D Q:ERR'="" 109 . S ID=$G(PID(3,I,1)) 110 . S TYPE=$G(PID(3,I,5)) 111 . I ID="" S ERR="PID^1^3^101^AE^Missing Patient ID" Q 112 . I TYPE="" S ERR="PID^1^3^101^AE^Missing Patient ID Type" Q 113 . I TYPE="NI" S ICN=ID 114 . I TYPE="PI" S DFN=ID 115 . I TYPE="SS" S SSN=ID 116 . Q 117 Q:ERR'="" 0 118 ; 119 S FAMILY=$G(PID(5,1,1)) 120 S GIVEN=$G(PID(5,1,2)) 121 S MIDDLE=$G(PID(5,1,3)) 122 S SUFFIX=$G(PID(5,1,4)) 123 ; 124 ; ID is validated from PID only, 125 ; May want to add fallback to use ID supplied in QPD 126 I '$$VALIDID^MHV7R2(.ICN,.DFN,.SSN,.ERR) S ERR="PID^1^3^"_ERR Q 0 127 ; 128 ; *** May need to add validation of name - compare against system 129 ;I FAMILY="" S ERR="PID^1^5^101^AE^Missing Patient Family Name" Q 0 130 ;I GIVEN="" S ERR="PID^1^5^101^AE^Missing Patient Given Name" Q 0 131 ; 132 ; 133 S QTAG=$G(QPD(2)) ;Query Tag 134 S REQID=$G(QPD(3)) ;Request ID 135 S REQTYPE=$G(QPD(4)) ;Request Type 136 S FROMDT=$G(QPD(5)) ;From Date 137 S TODT=$G(QPD(6)) ;To Date 138 ; Do not use ICN or DFN from QPD, get from PID 139 ;I ICN="" S ICN=$G(QPD(7)) ;ICN 140 ;I DFN="" S DFN=$G(QPD(8)) ;DFN 141 S PRI=$G(RCP(1)) ;Query Priority 142 ; 143 I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0 144 M QNAME=QPD(1) ;Message Query Name 145 ; 146 I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0 147 ; 148 I REQID="" S ERR="QPD^1^3^101^AE^Missing Request ID" Q 0 149 ; 150 I REQTYPE="" S ERR="QPD^1^4^101^AE^Missing Request Type" Q 0 151 S REQTIEN=$O(^MHV(2275.3,"D",REQTYPE,0)) 152 I 'REQTIEN S ERR="QPD^1^4^103^AE^Request Type Not Found" Q 0 153 S REQT0=$G(^MHV(2275.3,REQTIEN,0)) 154 S REQTYPE=$P(REQT0,"^",2) 155 ; 156 I FROMDT'="" D Q:ERR'="" 0 157 . I FROMDT'?8.16N S ERR="QPD^1^5^102^AE^Invalid From Date" Q 158 . ;***Check into Time Zone issue between MHV server and site 159 . S FROMDT=$$HL7TFM^XLFDT(FROMDT)\1 160 . I FROMDT'?7N S ERR="QPD^1^5^102^AE^Invalid From Date" Q 161 . Q 162 ; 163 I TODT'="" D Q:ERR'="" 0 164 . I TODT'?8.16N S ERR="QPD^1^6^102^AE^Invalid To Date" Q 165 . ;***Check into Time Zone issue between MHV server and site 166 . S TODT=$$HL7TFM^XLFDT(TODT)\1 167 . I TODT'?7N S ERR="QPD^1^6^102^AE^Invalid To Date" Q 168 . Q 169 ; 170 I TODT'="",TODT<FROMDT S ERR="QPD^1^6^102^AE^To Date precedes From Date" Q 0 171 ; 172 I PRI="" S ERR="RCP^1^1^101^AE^Missing Query Priority" Q 0 173 I "D|I"'[PRI S ERR="RCP^1^1^102^AE^Invalid Query Priority" Q 0 174 ; 175 F CNT=1:1 Q:'$D(RXE(CNT)) D 176 . S RXNUM=$G(RXE(CNT,15)) 177 . Q:RXNUM<1 178 . S QRY("RXLIST",RXNUM)="" 179 . Q 180 ; 181 S QRY("REQID")=REQID ;Request ID 182 S QRY("ICN")=ICN ;ICN 183 S QRY("TYPE")=REQTYPE ;Request Data Type 184 S QRY("FROM")=FROMDT ;From Date 185 S QRY("TO")=TODT ;To Date 186 S QRY("DFN")=DFN ;DFN 187 S QRY("SSN")=SSN ;SSN 188 S QRY("PRI")=PRI ;Priority 189 ; 190 S QRY("BLOCKED")=$P(REQT0,"^",3) 191 S QRY("REALTIME")=$P(REQT0,"^",4) 192 S QRY("EXECUTE")=$TR($P(REQT0,"^",5),"~","^") 193 ; 194 Q 1 195 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R2.m
r613 r623 1 MHV7R2 ;WAS/GPM - HL7 RECEIVER FOR OMP^O09 ; [12/31/07 10:38am] 2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 OMPO09 ;Process OMP^O09 messages from the MHV OMP^O09 Subscriber protocol 6 ; 7 ; This routine and subroutines assume that all VistA HL7 environment 8 ; variables are properly initialized and will produce a fatal error 9 ; if they are missing. 10 ; 11 ; The message will be checked to see if it is a valid OMP^O09 order 12 ; message. If not, a negative acknowledgement will be sent. The 13 ; realtime request manager is called to handle all order messages. 14 ; This means the order will be processed and a response generated 15 ; immediately whether the message is synchronous or asynchronous. 16 ; 17 ; Input: 18 ; HL7 environment variables 19 ; 20 ; Output: 21 ; Processed query or negative acknowledgement 22 ; 23 N MSGROOT,REQ,XMT,ERR 24 S (REQ,XMT,ERR)="" 25 ; Inbound order messages are small enough to be held in a local. 26 ; The following lines commented out support use of global and are 27 ; left in case use a global becomes necessary. 28 ;S MSGROOT="^TMP(""MHV7"",$J)" 29 ;K @MSGROOT 30 S MSGROOT="MHV7MSG" 31 N MHV7MSG 32 D LOADXMT^MHV7U(.XMT) ;Load inbound message information 33 D LOG^MHVUL2("OMP-O09 RECEIVER","BEGIN","S","TRACE") 34 ; 35 D LOADMSG^MHV7U(MSGROOT) 36 D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG") 37 ; 38 D PARSEMSG^MHV7U(MSGROOT,.HL) 39 D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG") 40 ; 41 I '$$VALIDMSG(MSGROOT,.REQ,.XMT,.ERR) D Q 42 . D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR") 43 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL) 44 D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE") 45 ; 46 D REALTIME^MHVRQI(.REQ,.XMT,.HL) 47 ; 48 D LOG^MHVUL2("OMP-O09 RECEIVER","END","S","TRACE") 49 D RESET^MHVUL2 ;Clean up TMP used by logging 50 ;K @MSGROOT 51 ; 52 Q 53 ; 54 VALIDMSG(MSGROOT,REQ,XMT,ERR) ;Validate message 55 ; 56 ; OMP^O09 messages must contain PID, ORC, and RXE segments 57 ; 58 ; The following sequences are required 59 ; PID(3) - ICN/DFN 60 ; ORC(2) - Placer Order Number 61 ; RXE(1).4- Order Start Time 62 ; RXE(15) - Prescription Number 63 ; 64 ; The following sequences are optional 65 ; 66 ; ERR = segment^sequence^field^code^ACK type^error text 67 ; 68 ; Input: 69 ; MSGROOT - Root of array holding message 70 ; XMT - Transmission parameters 71 ; 72 ; Output: 73 ; REQ - Request Array 74 ; XMT - Transmission parameters 75 ; ERR - segment^sequence^field^code^ACK type^error text 76 ; 77 N MSH,PID,ORC,RXE,CNT,REQTYPE,I,ORDERCTL,PORDERN,ORDERQTY,GIVEID,GIVESYS,GIVEAMT,GIVEUNT,ORDERTM,RXNUM 78 K REQ,ERR 79 S ERR="" 80 ; 81 ; Set up message ID for responding to message. 82 ;--------------------------------------------- 83 S REQ("MID")=XMT("MID") ;Message ID 84 ; 85 ; Validate message is a well-formed OMP^O09 message 86 ;----------------------------------------------------------- 87 ; Must have MSH first followed by PID, then one or more ORC/RXE pairs 88 ; 89 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) 90 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 91 ; 92 I $G(@MSGROOT@(2,0))="PID" M PID=@MSGROOT@(2),REQ("PID")=PID 93 E S ERR="PID^1^^100^AE^Missing PID segment" Q 0 94 ; 95 S CNT=3 96 F Q:'$D(@MSGROOT@(CNT)) D Q:ERR'="" 97 . I $G(@MSGROOT@(CNT,0))="ORC" M ORC(CNT\2)=@MSGROOT@(CNT) 98 . E S ERR="ORC^1^^100^AE^Missing ORC segment" Q 99 . I $G(@MSGROOT@(CNT+1,0))="RXE" M RXE(CNT\2)=@MSGROOT@(CNT+1) 100 . E S ERR="RXE^1^^100^AE^Missing RXE segment" Q 101 . S CNT=CNT+2 102 . Q 103 Q:ERR'="" 0 104 ; 105 I '$D(ORC) S ERR="ORC^1^^100^AE^Missing ORC segment" Q 0 106 I '$D(RXE) S ERR="RXE^1^^100^AE^Missing RXE segment" Q 0 107 ; 108 ; 109 ; Validate required fields and refill request parameters 110 ;----------------------------------------------------------- 111 ; 112 I '$$VALIDPID^MHV7RUS(.PID,.REQ,.ERR) Q 0 113 ; 114 F I=1:1 Q:'$D(ORC(I)) D Q:ERR'="" 115 . S ORDERCTL=$G(ORC(I,1)) 116 . S PORDERN=$G(ORC(I,2)) 117 . I ORDERCTL="" S ERR="ORC^"_I_"^2^101^AE^Missing Order Control" Q 118 . I PORDERN="" S ERR="ORC^"_I_"^2^101^AE^Missing Placer Order#" Q 119 . ; 120 . S ORDERQTY=$G(RXE(I,1,1,1)) 121 . S ORDERTM=$G(RXE(I,1,1,4)) 122 . S GIVEID=$G(RXE(I,2,1,1)) 123 . S GIVESYS=$G(RXE(I,2,1,3)) 124 . S GIVEAMT=$G(RXE(I,3)) 125 . S GIVEUNT=$G(RXE(I,5)) 126 . S RXNUM=$G(RXE(I,15)) 127 . I ORDERQTY="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Quantity" Q 128 . I ORDERTM="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Start Time" Q 129 . I GIVEID="" S ERR="RXE^"_I_"^2^101^AE^Missign Give Code ID" Q 130 . I GIVESYS="" S ERR="RXE^"_I_"^2^101^AE^Missing Give Code System" Q 131 . I GIVEAMT="" S ERR="RXE^"_I_"^3^101^AE^Missing Give Amount" Q 132 . I GIVEUNT="" S ERR="RXE^"_I_"^5^101^AE^Missing Give Units" Q 133 . I RXNUM="" S ERR="RXE^"_I_"^15^101^AE^Missing Prescription#" Q 134 . I RXNUM'?1N.N0.1A S ERR="RXE^"_I_"^15^102^AE^Invalid Prescription#" Q 135 . S REQ("RX",I)=RXNUM_"^"_PORDERN_"^"_ORDERTM 136 . Q 137 Q:ERR'="" 0 138 ; 139 I '$$VALRTYPE^MHV7RU("RxRefill",.REQ,.ERR) S ERR="MSH^1^9^"_ERR Q 0 140 ; 141 Q 1 142 ; 1 MHV7R2 ;WAS/GPM - HL7 RECEIVER FOR OMP^O09 ; [5/24/06 10:20am] 2 ;;1.0;My HealtheVet;**1**;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 OMPO09 ;Process OMP^O09 messages from the MHV OMP^O09 Subscriber protocol 6 ; 7 ; This routine and subroutines assume that all VistA HL7 environment 8 ; variables are properly initialized and will produce a fatal error 9 ; if they are missing. 10 ; 11 ; The message will be checked to see if it is a valid OMP^O09 order 12 ; message. If not, a negative acknowledgement will be sent. If the ; order message is real time or synchronous, the realtime request 13 ; manager is called to handle it. 14 ; 15 ; Input: 16 ; HL7 environment variables 17 ; 18 ; Output: 19 ; Processed query or negative acknowledgement 20 ; 21 N MSGROOT,REQ,XMT,ERR 22 S (REQ,XMT,ERR)="" 23 S MSGROOT="^TMP(""MHV7"",$J)" 24 D LOG^MHV7U("OMP-O09 RECEIVER","","S",1) 25 ; 26 D LOADMSG^MHV7U(MSGROOT) 27 D LOG^MHV7U("LOAD",MSGROOT,"I",0) 28 ; 29 D PARSEMSG^MHV7U(MSGROOT,.HL) 30 ;D LOG^MHV7U("PARSE",MSGROOT,"I",0) 31 ; 32 I '$$VALIDO09(MSGROOT,.REQ,.XMT,.ERR) D Q 33 . D LOG^MHV7U("MSG CHECK","INVALID^"_ERR,"S",0) 34 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL) 35 D LOG^MHV7U("MSG CHECK","VALID","S",0) 36 ; 37 ; Immediate Mode 38 ; Only real time synchronous calls are supported at this time. 39 I REQ("PRI")="I" D REALTIME^MHVRQI(.REQ,.XMT,.HL) 40 K ^TMP("MHV7LOG",$J) 41 ; 42 Q 43 ; 44 VALIDO09(MSGROOT,REQ,XMT,ERR) ;Parse and Validate message 45 ; 46 ; OMP^O09 messages must contain PID, ORC, and RXE segments 47 ; The following sequences are required 48 ; PID(3) - ICN/DFN 49 ; ORC(2) - Placer Order Number 50 ; RXE(1).4- Order Start Time 51 ; RXE(15) - Prescription Number 52 ; The following sequences are optional 53 ; 54 ; ERR = segment^sequence^field^code^ACK type^error text 55 ; 56 N MSH,PID,ORC,RXE,CNT,ICN,SSN,REQTYPE,DFN,PRI,REQTIEN,REQT0,TYPE,ID,I,ORDERCTL,PORDERN,ORDERQTY,GIVEID,GIVESYS,GIVEAMT,GIVEUNT,ORDERTM,RXNUM,FAMILY,GIVEN,MIDDLE,SUFFIX 57 S ERR="" 58 K REQ,XMT 59 ; 60 ;Set response control defaults 61 S XMT("PROTOCOL")="MHV ORP-O10 Event Driver" ;Response protocol 62 S XMT("BUILDER")="ORPO10^MHV7B2" ;Response builder 63 S XMT("MODE")="D" ;Response mode 64 I $G(HL("APAT"))="" S XMT("MODE")="I" ;Immediate mode 65 S XMT("HLMTIENS")=HLMTIENS ;Message IEN 66 S REQ("MID")="" ;Message ID 67 ; 68 ;Validate message is a well-formed OMP^O09 message 69 ;Must have MSH first followed by PID, then one or more ORC/RXE pairs 70 I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) S REQ("MID")=$G(MSH(9)) 71 E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 72 I $G(@MSGROOT@(2,0))="PID" M PID=@MSGROOT@(2),REQ("PID")=PID 73 E S ERR="PID^1^^100^AE^Missing PID segment" Q 0 74 S CNT=3 75 F Q:'$D(@MSGROOT@(CNT)) D Q:ERR'="" 76 . I $G(@MSGROOT@(CNT,0))="ORC" M ORC(CNT\2)=@MSGROOT@(CNT) 77 . E S ERR="ORC^1^^100^AE^Missing ORC segment" Q 78 . I $G(@MSGROOT@(CNT+1,0))="RXE" M RXE(CNT\2)=@MSGROOT@(CNT+1) 79 . E S ERR="RXE^1^^100^AE^Missing RXE segment" Q 80 . S CNT=CNT+2 81 . Q 82 Q:ERR'="" 0 83 I '$D(ORC) S ERR="ORC^1^^100^AE^Missing ORC segment" Q 0 84 I '$D(RXE) S ERR="RXE^1^^100^AE^Missing RXE segment" Q 0 85 ; 86 ; 87 ;Validate required fields and refill request parameters 88 ; 89 S ICN="",DFN="",SSN="" 90 F I=1:1:3 Q:'$D(PID(3,I)) D Q:ERR'="" 91 . S ID=$G(PID(3,I,1)) 92 . S TYPE=$G(PID(3,I,5)) 93 . I ID="" S ERR="PID^1^3^101^AE^Missing Patient ID" Q 94 . I TYPE="" S ERR="PID^1^3^101^AE^Missing Patient ID Type" Q 95 . I TYPE="NI" S ICN=ID 96 . I TYPE="PI" S DFN=ID 97 . I TYPE="SS" S SSN=ID 98 . Q 99 Q:ERR'="" 0 100 ; 101 S FAMILY=$G(PID(5,1,1)) 102 S GIVEN=$G(PID(5,1,2)) 103 S MIDDLE=$G(PID(5,1,3)) 104 S SUFFIX=$G(PID(5,1,4)) 105 ; 106 I '$$VALIDID(.ICN,.DFN,.SSN,.ERR) S ERR="PID^1^3^"_ERR Q 0 107 ; 108 ; *** May need to add validation of name - compare against system 109 ;I FAMILY="" S ERR="PID^1^5^101^AE^Missing Patient Family Name" Q 0 110 ;I GIVEN="" S ERR="PID^1^5^101^AE^Missing Patient Given Name" Q 0 111 ; 112 F I=1:1 Q:'$D(ORC(I)) D Q:ERR'="" 113 . S ORDERCTL=$G(ORC(I,1)) 114 . S PORDERN=$G(ORC(I,2)) 115 . I ORDERCTL="" S ERR="ORC^"_I_"^2^101^AE^Missing Order Control" Q 116 . I PORDERN="" S ERR="ORC^"_I_"^2^101^AE^Missing Placer Order#" Q 117 . ; 118 . S ORDERQTY=$G(RXE(I,1,1,1)) 119 . S ORDERTM=$G(RXE(I,1,1,4)) 120 . S GIVEID=$G(RXE(I,2,1,1)) 121 . S GIVESYS=$G(RXE(I,2,1,3)) 122 . S GIVEAMT=$G(RXE(I,3)) 123 . S GIVEUNT=$G(RXE(I,5)) 124 . S RXNUM=$G(RXE(I,15)) 125 . I ORDERQTY="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Quantity" Q 126 . I ORDERTM="" S ERR="RXE^"_I_"^1^101^AE^Missing Order Start Time" Q 127 . I GIVEID="" S ERR="RXE^"_I_"^2^101^AE^Missign Give Code ID" Q 128 . I GIVESYS="" S ERR="RXE^"_I_"^2^101^AE^Missing Give Code System" Q 129 . I GIVEAMT="" S ERR="RXE^"_I_"^3^101^AE^Missing Give Amount" Q 130 . I GIVEUNT="" S ERR="RXE^"_I_"^5^101^AE^Missing Give Units" Q 131 . I RXNUM="" S ERR="RXE^"_I_"^15^101^AE^Missing Prescription#" Q 132 . I RXNUM'?1N.N0.1A S ERR="RXE^"_I_"^15^102^AE^Invalid Prescription#" Q 133 . S REQ("RX",I)=RXNUM_"^"_PORDERN_"^"_ORDERTM 134 . Q 135 Q:ERR'="" 0 136 ; 137 S PRI=XMT("MODE") 138 S REQTYPE="RxRefill" 139 S REQTIEN=$O(^MHV(2275.3,"D",REQTYPE,0)) 140 I 'REQTIEN S ERR="MSH^1^9^103^AE^Request Type Not Found" Q 0 141 S REQT0=$G(^MHV(2275.3,REQTIEN,0)) 142 S REQTYPE=$P(REQT0,"^",2) 143 ; 144 S REQ("ICN")=ICN ;ICN 145 S REQ("DFN")=DFN ;DFN 146 S REQ("SSN")=SSN ;SSN 147 S REQ("TYPE")=REQTYPE ;Request Data Type 148 S REQ("PRI")=PRI ;Priority 149 ; 150 S REQ("BLOCKED")=$P(REQT0,"^",3) 151 S REQ("REALTIME")=$P(REQT0,"^",4) 152 S REQ("EXECUTE")=$TR($P(REQT0,"^",5),"~","^") 153 ; 154 Q 1 155 ; 156 VALIDID(ICN,DFN,SSN,ERR) ;Validate patient identifiers 157 ; Will accept ICN, SSN, or DFN, but must have at least one. 158 ; Only validate one, in order of preference: ICN, SSN, DFN. 159 ; 160 ; Integration Agreements: 161 ; 2701 : $$GETDFN^MPIF001, $$GETICN^MPIF001 162 ; 10035 : Direct reference of ^DPT(DFN,0);9 163 ; and reference of ^DPT("SSN") x-ref 164 ; 165 N XSSN,XDFN 166 S ERR="" 167 I ICN="",SSN="",DFN="" S ERR="101^AE^Missing Patient ID" Q 0 168 ;I ICN="" S ERR="101^AE^Missing ICN" Q 0 169 ; 170 I ICN'="" D Q:ERR'="" 0 Q 1 171 . S ICN=$P(ICN,"V") 172 . I ICN'?9.10N S ERR="102^AE^Invalid ICN" Q 173 . S XDFN=$$GETDFN^MPIF001(ICN) 174 . I XDFN<1 S ERR="204^AR^Patient Not Found" Q 175 . S XSSN=$P($G(^DPT(XDFN,0)),"^",9) 176 . I SSN'="" D Q:ERR'="" 177 .. I SSN'?9N S ERR="102^AE^Invalid SSN" Q 178 .. I SSN'=XSSN S ERR="204^AE^Patient SSN Mismatch" Q 179 . I DFN'="",DFN'=XDFN S ERR="204^AE^Patient DFN Mismatch" Q 180 . S DFN=XDFN,SSN=XSSN 181 . Q 182 ; 183 I SSN'="" D Q:ERR'="" 0 Q 1 184 . I SSN'?9N S ERR="102^AE^Invalid SSN" Q 185 . S XDFN=$O(^DPT("SSN",SSN,"")) 186 . I XDFN<1 S ERR="204^AR^Patient Not Found" Q 187 . S ICN=+$$GETICN^MPIF001(DFN) 188 . I ICN<1 S ICN="" 189 . I DFN'="",DFN'=XDFN S ERR="204^AE^Patient DFN Mismatch" Q 190 . S DFN=XDFN 191 . Q 192 ; 193 I DFN'="" D Q:ERR'="" 0 Q 1 194 . I DFN'?1N.N S ERR="102^AE^Invalid DFN" Q 195 . I DFN<1 S ERR="102^AE^Invalid DFN" Q 196 . I '$D(^DPT(DFN,0)) S ERR="204^AR^Patient Not Found" Q 197 . S ICN=+$$GETICN^MPIF001(DFN) 198 . I ICN<1 S ICN="" 199 . S SSN=$P($G(^DPT(DFN,0)),"^",9) 200 . Q 201 ; 202 S ERR="101^AE^Missing Patient ID" Q 0 203 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7T.m
r613 r623 1 MHV7T ;WAS/GPM - HL7 TRANSMITTER ; 10/25/05 4:10pm [12/24/07 9:45pm] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 XMIT(REQ,XMT,ERR,DATAROOT,HL) ;Build and Transmit HL7 message 8 ; Builds and sends the desired HL7 message based on the mode and 9 ; builder passed in XMT. If the builder requires other information 10 ; to build the message, it can be passed as additional subscripts of 11 ; XMT or REQ. REQ is used for request or query related parameters, 12 ; XMT for transmission and control related parameters. 13 ; 14 ; The message builder sent in XMT("BUILDER") is called to build the 15 ; desired message. 16 ; 17 ; A synchronous response is indicated by XMT("MODE") of S, and sent 18 ; on the current interface as an original mode acknowledgement. 19 ; 20 ; An asynchronous response is indicated by XMT("MODE") of A, and 21 ; sent on the interface associated with XMT("PROTOCOL") as an 22 ; enhanced mode application acknowledgement. Large messages can be 23 ; sent as a bolus (series of messages without batch formatting) by 24 ; specifying an XMT("MAX SIZE"). 25 ; 26 ; A message may be initiated by using the asynchronous mode settings 27 ; Synchronous messages cannot be initiated with this API. 28 ; 29 ; Integration Agreements: 30 ; 2161 : INIT^HLFNC2 31 ; 2164 : GENERATE^HLMA 32 ; 2165 : GENACK^HLMA1 33 ; 34 ; Input: 35 ; REQ - Request parameters and Message ID of original message 36 ; XMT - Transmission parameters 37 ; XMT("MODE") - Mode of the transmission 38 ; XMT("PROTOCOL") - Protocol for deferred transmissions 39 ; XMT("BUILDER") - Name/tag of message builder routine 40 ; XMT("HLMTIENS") - Original message IEN - Immediate mode 41 ; XMT("MAX SIZE") - Maximum message size (asynch only) 42 ; ERR - Caret delimited error string 43 ; segment^sequence^field^code^ACK type^error text 44 ; DATAROOT - Global root of data array 45 ; HL - HL7 package array variable 46 ; 47 ; Output: HL7 Message Transmitted 48 ; 49 N MSGROOT,HLRSLT,HLP,MSGLEN 50 D LOG^MHVUL2("TRANSMIT","BEGIN","S","TRACE") 51 I XMT("MODE")="A" D ;Asynchronous mode 52 . D LOG^MHVUL2("TRANSMIT","ASYNCHRONOUS","S","TRACE") 53 . K HL 54 . D INIT^HLFNC2(XMT("PROTOCOL"),.HL) 55 . I $G(HL) S ERR=HL D LOG^MHVUL2("PROTOCOL INIT FAILURE",ERR,"S","ERROR") Q 56 . D LOG^MHVUL2("PROTOCOL INIT","DONE "_XMT("MODE"),"S","DEBUG") 57 . S MSGROOT="^TMP(""HLS"",$J)" 58 . D @(XMT("BUILDER")_"(MSGROOT,.REQ,ERR,DATAROOT,.MSGLEN,.HL)") 59 . D LOG^MHVUL2("BUILD "_$P(XMT("BUILDER"),"^"),MSGROOT,"I","DEBUG") 60 . I MSGLEN<XMT("MAX SIZE")!'XMT("MAX SIZE") D Q 61 . . D GENERATE^HLMA(XMT("PROTOCOL"),"GM",1,.HLRSLT,"",.HLP) 62 . . K @MSGROOT 63 . . D LOG^MHVUL2("TRANSMIT "_$P(XMT("BUILDER"),"^"),.HLRSLT,"M","DEBUG") 64 . . Q 65 . D BOLUS^MHV7TB(MSGROOT,.XMT,.HL) 66 . Q 67 ; 68 I XMT("MODE")="S" D ;Synchronous mode 69 . D LOG^MHVUL2("TRANSMIT","SYNCHRONOUS","S",0) 70 . S MSGROOT="^TMP(""HLA"",$J)" 71 . D @(XMT("BUILDER")_"(MSGROOT,.REQ,ERR,DATAROOT,.MSGLEN,.HL)") 72 . D LOG^MHVUL2("BUILD "_$P(XMT("BUILDER"),"^"),MSGROOT,"I","DEBUG") 73 . D GENACK^HLMA1(HL("EID"),XMT("HLMTIENS"),HL("EIDS"),"GM",1,.HLRSLT) 74 . K @MSGROOT 75 . D LOG^MHVUL2("TRANSMIT "_$P(XMT("BUILDER"),"^"),.HLRSLT,"M","DEBUG") 76 . Q 77 D LOG^MHVUL2("TRANSMIT","END","S","TRACE") 78 Q 79 ; 80 EMAIL(REQ,XMT,ERR,DATAROOT,HL) ;Build and Transmit HL7 message 81 ; Builds and sends the desired HL7 message via email. 82 ; This will only be used until the MHV server can establish normal 83 ; HL7 receivers. 84 ; 85 ; If the builder requires other information to build the message, it 86 ; can be passed as additional subscripts of XMT or REQ. REQ is used 87 ; for request or query related parameters, XMT for transmission and 88 ; control related parameters. 89 ; 90 ; The message builder sent in XMT("BUILDER") is called to build the 91 ; desired message. 92 ; 93 ; Integration Agreements: 94 ; 2161 : INIT^HLFNC2 95 ; MSH^HLFNC2 96 ; 10070 : ^XMD 97 ; 98 ; Input: 99 ; REQ - Request parameters and Message ID of original message 100 ; XMT - Transmission parameters 101 ; XMT("PROTOCOL") - Protocol for deferred transmissions 102 ; XMT("BUILDER") - Name/tag of message builder routine 103 ; XMT("SAF") - Sending Facility 104 ; XMT("EMAIL") - Email Address to use 105 ; ERR - Caret delimited error string 106 ; segment^sequence^field^code^ACK type^error text 107 ; DATAROOT - Global root of data array 108 ; HL - HL7 package array variable 109 ; 110 ; Output: HL7 Message Transmitted 111 ; 112 N MSGROOT,MID,MSH,CNT,MSGLEN 113 N TEXT,XMDUN,XMDUZ,XMTEXT,XMROU,XMSTRIP,XMSUB,XMY,XMZ,XMDF,XMMG 114 D LOG^MHVUL2("TRANSMIT","EMAIL","S","TRACE") 115 K HL 116 D INIT^HLFNC2(XMT("PROTOCOL"),.HL) 117 I $G(HL) S ERR=HL D LOG^MHVUL2("PROTOCOL INIT FAIL",ERR,"S","ERROR") Q 118 D LOG^MHVUL2("PROTOCOL INIT","DONE EMAIL","S","DEBUG") 119 S MSGROOT="^TMP(""MHV7TEM"",$J)" 120 D @(XMT("BUILDER")_"(MSGROOT,.REQ,ERR,DATAROOT,.MSGLEN,.HL)") 121 D LOG^MHVUL2("BUILD "_$P(XMT("BUILDER"),"^"),MSGROOT,"I","DEBUG") 122 S MID=+$H_"-"_$P($H,",",2) 123 S HL("SAF")=XMT("SAF") 124 D MSH^HLFNC2(.HL,MID,.MSH) 125 S XMDF="",(XMDUN,XMDUZ)="My HealtheVet Package" 126 S XMY(XMT("EMAIL"))="" 127 S XMSUB=XMT("SAF")_" MHV PACKAGE MESSAGE" 128 S XMTEXT="TEXT(" 129 S TEXT(1)=MSH 130 F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) S TEXT(CNT+1)=@MSGROOT@(CNT) 131 D ^XMD 132 K @MSGROOT 133 I $D(XMMG) D LOG^MHVUL2("EMAIL TRANSMIT","FAILURE: "_XMMG,"S","ERROR") Q 134 D LOG^MHVUL2("EMAIL TRANSMIT","SUCCESS: "_XMZ,"S","TRACE") 135 Q 1 MHV7T ;WAS/GPM - HL7 TRANSMITTER ; [8/22/05 11:54pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 XMIT(REQ,XMT,ERR,DATAROOT,HL) ;Build and Transmit HL7 message 8 ; Builds and sends the desired HL7 message based on the mode and 9 ; builder passed in XMT. If the builder requires other information 10 ; to build the message, it can be passed as additional subscripts of 11 ; XMT or REQ. REQ is used for request or query related parameters, 12 ; XMT for transmission and control related parameters. 13 ; 14 ; The message builder sent in XMT("BUILDER") is called to build the 15 ; desired message. 16 ; 17 ; An immediate mode response is indicated by XMT("MODE") of I, and 18 ; sent on the current interface as an original mode acknowledgement. 19 ; 20 ; A deferred mode response is indicated by XMT("MODE") of D, and 21 ; sent on the interface associated with XMT("PROTOCOL") as an 22 ; enhanced mode application acknowledgement. 23 ; 24 ; A message may be initiated by using the deferred mode settings. 25 ; Synchronous messages cannot be initiate with this API. 26 ; 27 ; Integration Agreements: 28 ; 2161 : INIT^HLFNC2 29 ; 2164 : GENERATE^HLMA 30 ; 2165 : GENACK^HLMA1 31 ; 32 ; Input: 33 ; REQ - Request parameters and Message ID of original message 34 ; XMT - Transmission parameters 35 ; XMT("MODE") - Priority or mode of the transmission 36 ; XMT("PROTOCOL") - Protocol for deferred transmissions 37 ; XMT("BUILDER") - Name/tag of message builder routine 38 ; XMT("HLMTIENS") - Original message IEN - Immediate mode 39 ; ERR - Caret delimited error string 40 ; segment^sequence^field^code^ACK type^error text 41 ; DATAROOT - Global root of data array 42 ; HL - HL7 package array variable 43 ; 44 ; Output: HL7 Message Transmitted 45 ; 46 N MSGROOT,HLRSLT,HLP 47 I XMT("MODE")="D" D ;Deferred mode 48 . D LOG^MHV7U("TRANSMIT","DEFERRED MODE","S",0) 49 . K HL 50 . D INIT^HLFNC2(XMT("PROTOCOL"),.HL) 51 . I $G(HL) S ERR=HL D LOG^MHV7U("PROTOCOL INIT FAIL",ERR,"S",0) Q 52 . D LOG^MHV7U("PROTOCOL INIT","DONE "_XMT("MODE"),"S",0) 53 . S MSGROOT="^TMP(""HLS"",$J)" 54 . D @(XMT("BUILDER")_"(MSGROOT,.REQ,ERR,DATAROOT,.HL)") 55 . D LOG^MHV7U("BUILD "_$P(XMT("BUILDER"),"^"),MSGROOT,"I",0) 56 . D GENERATE^HLMA(XMT("PROTOCOL"),"GM",1,.HLRSLT,"",.HLP) 57 . K @MSGROOT 58 . D LOG^MHV7U("TRANSMIT "_$P(XMT("BUILDER"),"^"),.HLRSLT,"M",0) 59 . Q 60 ; 61 I XMT("MODE")="I" D ;Immediate mode 62 . D LOG^MHV7U("TRANSMIT","IMMEDIATE MODE","S",0) 63 . S MSGROOT="^TMP(""HLA"",$J)" 64 . D @(XMT("BUILDER")_"(MSGROOT,.REQ,ERR,DATAROOT,.HL)") 65 . D LOG^MHV7U("BUILD "_$P(XMT("BUILDER"),"^"),MSGROOT,"I",0) 66 . D GENACK^HLMA1(HL("EID"),XMT("HLMTIENS"),HL("EIDS"),"GM",1,.HLRSLT) 67 . K @MSGROOT 68 . D LOG^MHV7U("TRANSMIT "_$P(XMT("BUILDER"),"^"),.HLRSLT,"M",0) 69 . Q 70 D LOG^MHV7U("TRANSMIT","COMPLETE","S",0) 71 Q 72 ; 73 EMAIL(REQ,XMT,ERR,DATAROOT,HL) ;Build and Transmit HL7 message 74 ; Builds and sends the desired HL7 message via email. 75 ; This will only be used until the MHV server can establish normal 76 ; HL7 receivers. 77 ; 78 ; If the builder requires other information to build the message, it 79 ; can be passed as additional subscripts of XMT or REQ. REQ is used 80 ; for request or query related parameters, XMT for transmission and 81 ; control related parameters. 82 ; 83 ; The message builder sent in XMT("BUILDER") is called to build the 84 ; desired message. 85 ; 86 ; Integration Agreements: 87 ; 2161 : INIT^HLFNC2, MSH^HLFNC2 88 ; 10070 : ^XMD 89 ; 90 ; Input: 91 ; REQ - Request parameters and Message ID of original message 92 ; XMT - Transmission parameters 93 ; XMT("PROTOCOL") - Protocol for deferred transmissions 94 ; XMT("BUILDER") - Name/tag of message builder routine 95 ; XMT("SAF") - Sending Facility 96 ; XMT("EMAIL") - Email Address to use 97 ; ERR - Caret delimited error string 98 ; segment^sequence^field^code^ACK type^error text 99 ; DATAROOT - Global root of data array 100 ; HL - HL7 package array variable 101 ; 102 ; Output: HL7 Message Transmitted 103 ; 104 N MSGROOT,MID,MSH,CNT 105 N TEXT,XMDUN,XMDUZ,XMTEXT,XMROU,XMSTRIP,XMSUB,XMY,XMZ,XMDF,XMMG 106 D LOG^MHV7U("TRANSMIT","EMAIL","S",0) 107 K HL 108 D INIT^HLFNC2(XMT("PROTOCOL"),.HL) 109 I $G(HL) S ERR=HL D LOG^MHV7U("PROTOCOL INIT FAIL",ERR,"S",0) Q 110 D LOG^MHV7U("PROTOCOL INIT","DONE EMAIL","S",0) 111 S MSGROOT="^TMP(""MHV7TEM"",$J)" 112 D @(XMT("BUILDER")_"(MSGROOT,.REQ,ERR,DATAROOT,.HL)") 113 D LOG^MHV7U("BUILD "_$P(XMT("BUILDER"),"^"),MSGROOT,"I",0) 114 S MID=+$H_"-"_$P($H,",",2) 115 S HL("SAF")=XMT("SAF") 116 D MSH^HLFNC2(.HL,MID,.MSH) 117 S XMDF="",(XMDUN,XMDUZ)="My HealtheVet Package" 118 S XMY(XMT("EMAIL"))="" 119 S XMSUB=XMT("SAF")_" MHV PACKAGE MESSAGE" 120 S XMTEXT="TEXT(" 121 S TEXT(1)=MSH 122 F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) S TEXT(CNT+1)=@MSGROOT@(CNT) 123 D ^XMD 124 K @MSGROOT 125 I $D(XMMG) D LOG^MHV7U("EMAIL TRANSMIT","FAILURE: "_XMMG,"S",0) Q 126 D LOG^MHV7U("EMAIL TRANSMIT","SUCCESS: "_XMZ,"S",0) 127 Q -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7U.m
r613 r623 1 MHV7U ;WAS/GPM - HL7 UTILITIES ; [1/7/08 10:21pm] 2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;This routine contains generic utilities used when building 6 ;or processing HL7 messages. 7 ; 8 Q ;Direct entry not supported 9 ; 10 LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing 11 ; 12 ;This subroutine assumes that all VistA HL7 environment variables are 13 ;properly initialized and will produce a fatal error if they aren't. 14 ; 15 N CNT,SEG 16 K @MSGROOT 17 F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D 18 . S CNT=0 19 . S @MSGROOT@(SEG,CNT)=HLNODE 20 . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) 21 Q 22 ; 23 LOADXMT(XMT) ;Set HL dependent XMT values 24 ; 25 ; The HL array and variables are expected to be defined. If not, 26 ; message processing will fail. These references should not be 27 ; wrapped in $G, as null values will simply postpone the failure to 28 ; a point that will be harder to diagnose. Except HL("APAT") which 29 ; is not defined on synchronous calls. 30 ; Also assumes MHV RESPONSE MAP file is setup for every protocol 31 ; pair defined by MHV package. 32 ; 33 ; Integration Agreements: 34 ; 1373 : Reference to PROTOCOL file #101 35 ; 36 N SUBPROT,RESPIEN,RESP0 37 S XMT("MID")=HL("MID") ;Message ID 38 S XMT("MODE")="A" ;Response mode 39 I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode 40 S XMT("HLMTIENS")=HLMTIENS ;Message IEN 41 S XMT("MESSAGE TYPE")=HL("MTN") ;Message type 42 S XMT("EVENT TYPE")=HL("ETN") ;Event type 43 S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters 44 S XMT("MAX SIZE")=0 ;Default size unlimited 45 ; 46 ; Map response protocol and builder 47 S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") 48 S RESPIEN=$O(^MHV(2275.4,"B",SUBPROT,0)) 49 S RESP0=$G(^MHV(2275.4,RESPIEN,0)) 50 S XMT("PROTOCOL")=$P(RESP0,"^",2) ;Response Protocol 51 S XMT("BUILDER")=$TR($P(RESP0,"^",3),"~","^") ;Response Builder 52 S XMT("BREAK SEGMENT")=$P(RESP0,"^",4) ;Boundary Segment 53 Q 54 ; 55 DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol 56 ; 57 ; Integration Agreements: 58 ; 2161 : INIT^HLFNC2 59 ; 60 N HL 61 Q:PROTOCOL="" "" 62 D INIT^HLFNC2(PROTOCOL,.HL) 63 Q $G(HL("FS"))_$G(HL("ECH")) 64 ; 65 PARSEMSG(MSGROOT,HL) ; Message Parser 66 ; Does not handle segments that span nodes 67 ; Does not handle extremely long segments (uses a local) 68 ; Does not handle long fields (segment parser doesn't) 69 ; 70 N SEG,CNT,DATA,MSG 71 F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D 72 . D PARSESEG(SEG(0),.DATA,.HL) 73 . K @MSGROOT@(CNT) 74 . I DATA(0)'="" M @MSGROOT@(CNT)=DATA 75 . Q:'$D(SEG(1)) 76 . ;Add handler for segments that span nodes here. 77 . Q 78 Q 79 ; 80 PARSESEG(SEG,DATA,HL) ;Generic segment parser 81 ;This procedure parses a single HL7 segment and builds an array 82 ;subscripted by the field number containing the data for that field. 83 ; Does not handle segments that span nodes 84 ; 85 ; Input: 86 ; SEG - HL7 segment to parse 87 ; HL - HL7 environment array 88 ; 89 ; Output: 90 ; Function value - field data array [SUB1:field, SUB2:repetition, 91 ; SUB3:component, SUB4:sub-component] 92 ; 93 N CMP ;component subscript 94 N CMPVAL ;component value 95 N FLD ;field subscript 96 N FLDVAL ;field value 97 N REP ;repetition subscript 98 N REPVAL ;repetition value 99 N SUB ;sub-component subscript 100 N SUBVAL ;sub-component value 101 N FS ;field separator 102 N CS ;component separator 103 N RS ;repetition separator 104 N SS ;sub-component separator 105 ; 106 K DATA 107 S FS=HL("FS") 108 S CS=$E(HL("ECH")) 109 S RS=$E(HL("ECH"),2) 110 S SS=$E(HL("ECH"),4) 111 ; 112 S DATA(0)=$P(SEG,FS) 113 S SEG=$P(SEG,FS,2,9999) 114 F FLD=1:1:$L(SEG,FS) D 115 . S FLDVAL=$P(SEG,FS,FLD) 116 . F REP=1:1:$L(FLDVAL,RS) D 117 . . S REPVAL=$P(FLDVAL,RS,REP) 118 . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D 119 . . . S CMPVAL=$P(REPVAL,CS,CMP) 120 . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D 121 . . . . S SUBVAL=$P(CMPVAL,SS,SUB) 122 . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL 123 . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL 124 . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL 125 . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL 126 Q 127 ; 128 BLDSEG(DATA,HL) ;generic segment builder 129 ; 130 ; Input: 131 ; DATA - field data array [SUB1:field, SUB2:repetition, 132 ; SUB3:component, SUB4:sub-component] 133 ; HL - HL7 environment array 134 ; 135 ; Output: 136 ; Function Value - Formatted HL7 segment on success, "" on failure 137 ; 138 N CMP ;component subscript 139 N CMPVAL ;component value 140 N FLD ;field subscript 141 N FLDVAL ;field value 142 N REP ;repetition subscript 143 N REPVAL ;repetition value 144 N SUB ;sub-component subscript 145 N SUBVAL ;sub-component value 146 N FS ;field separator 147 N CS ;component separator 148 N RS ;repetition separator 149 N ES ;escape character 150 N SS ;sub-component separator 151 N SEG,SEP 152 ; 153 S FS=HL("FS") 154 S CS=$E(HL("ECH")) 155 S RS=$E(HL("ECH"),2) 156 S ES=$E(HL("ECH"),3) 157 S SS=$E(HL("ECH"),4) 158 ; 159 S SEG=$G(DATA(0)) 160 F FLD=1:1:$O(DATA(""),-1) D 161 . S FLDVAL=$G(DATA(FLD)),SEP=FS 162 . S SEG=SEG_SEP_FLDVAL 163 . F REP=1:1:$O(DATA(FLD,""),-1) D 164 . . S REPVAL=$G(DATA(FLD,REP)) 165 . . S SEP=$S(REP=1:"",1:RS) 166 . . S SEG=SEG_SEP_REPVAL 167 . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D 168 . . . S CMPVAL=$G(DATA(FLD,REP,CMP)) 169 . . . S SEP=$S(CMP=1:"",1:CS) 170 . . . S SEG=SEG_SEP_CMPVAL 171 . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D 172 . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB)) 173 . . . . S SEP=$S(SUB=1:"",1:SS) 174 . . . . S SEG=SEG_SEP_SUBVAL 175 Q SEG 176 ; 177 BLDWP(WP,SEG,MAXLEN,FORMAT,FMTLEN,HL) ; 178 ;Builds segment nodes to add word processing fields to a segment 179 N CNT,LINE,LAST,FS,RS,LENGTH,I 180 I MAXLEN<1 S MAXLEN=99999999999999999 181 S FS=HL("FS") ;field separator 182 S RS=$E(HL("ECH"),2) ;repeat separator 183 S CNT=$O(SEG(""),-1)+1 184 S SEG(CNT)=FS 185 S FMTLEN=0 186 S LENGTH=0 187 ; 188 S I=0 189 F S I=$O(WP(I)) Q:'I D Q:LENGTH'<MAXLEN 190 . I $D(WP(I,0)) S LINE=$G(WP(I,0)) ;conventional WP field 191 . E S LINE=$G(WP(I)) 192 . S LENGTH=LENGTH+$L(LINE) 193 . I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN)) 194 . S LINE=$$ESCAPE(LINE,.HL) 195 . S LAST=$E(LINE,$L(LINE)) 196 . ;first line 197 . I SEG(CNT)=FS S SEG(CNT)=FS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT)) Q 198 . S CNT=CNT+1 199 . S SEG(CNT)=RS_LINE,FMTLEN=FMTLEN+$L(SEG(CNT)) 200 . Q:'FORMAT 201 . ;attempt to keep sentences together 202 . I $E(LINE)=" "!(LAST=" ") S SEG(CNT)=LINE,FMTLEN=FMTLEN+$L(LINE) 203 . Q 204 Q 205 ; 206 ESCAPE(VAL,HL) ;Escape any special characters 207 ; *** Does not handle long strings of special characters *** 208 ; 209 ; Input: 210 ; VAL - value to escape 211 ; HL - HL7 environment array 212 ; 213 ; Output: 214 ; VAL - passed by reference 215 ; 216 N FS ;field separator 217 N CS ;component separator 218 N RS ;repetition separator 219 N ES ;escape character 220 N SS ;sub-component separator 221 N L,STR,I 222 ; 223 S FS=HL("FS") 224 S CS=$E(HL("ECH")) 225 S RS=$E(HL("ECH"),2) 226 S ES=$E(HL("ECH"),3) 227 S SS=$E(HL("ECH"),4) 228 ; 229 I VAL[ES D 230 . S L=$L(VAL,ES),STR="" 231 . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I) 232 . S VAL=STR 233 I VAL[FS D 234 . S L=$L(VAL,FS),STR="" 235 . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I) 236 . S VAL=STR 237 I VAL[RS D 238 . S L=$L(VAL,RS),STR="" 239 . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I) 240 . S VAL=STR 241 I VAL[CS D 242 . S L=$L(VAL,CS),STR="" 243 . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I) 244 . S VAL=STR 245 I VAL[SS D 246 . S L=$L(VAL,SS),STR="" 247 . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I) 248 . S VAL=STR 249 Q VAL 250 ; 251 UNESC(VAL,HL) ;Reconstitute any escaped characters 252 ; 253 ; Input: 254 ; VAL - Value to reconstitute 255 ; HL - HL7 environment array 256 ; 257 ; Output: 258 ; VAL - passed by reference 259 ; 260 N FS ;field separator 261 N CS ;component separator 262 N RS ;repetition separator 263 N ES ;escape character 264 N SS ;sub-component separator 265 N L,STR,I,FESC,CESC,RESC,EESC,SESC 266 ; 267 S FS=HL("FS") 268 S CS=$E(HL("ECH")) 269 S RS=$E(HL("ECH"),2) 270 S ES=$E(HL("ECH"),3) 271 S SS=$E(HL("ECH"),4) 272 S FESC=ES_"F"_ES 273 S CESC=ES_"S"_ES 274 S RESC=ES_"R"_ES 275 S EESC=ES_"E"_ES 276 S SESC=ES_"T"_ES 277 ; 278 I VAL'[ES Q VAL 279 I VAL[FESC D 280 . S L=$L(VAL,FESC),STR="" 281 . F I=1:1:L S $P(STR,FS,I)=$P(VAL,FESC,I) 282 . S VAL=STR 283 I VAL[CESC D 284 . S L=$L(VAL,CESC),STR="" 285 . F I=1:1:L S $P(STR,CS,I)=$P(VAL,CESC,I) 286 . S VAL=STR 287 I VAL[RESC D 288 . S L=$L(VAL,RESC),STR="" 289 . F I=1:1:L S $P(STR,RS,I)=$P(VAL,RESC,I) 290 . S VAL=STR 291 I VAL[SESC D 292 . S L=$L(VAL,SESC),STR="" 293 . F I=1:1:L S $P(STR,SS,I)=$P(VAL,SESC,I) 294 . S VAL=STR 295 I VAL[EESC D 296 . S L=$L(VAL,EESC),STR="" 297 . F I=1:1:L S $P(STR,ES,I)=$P(VAL,EESC,I) 298 . S VAL=STR 299 Q VAL 300 ; 1 MHV7U ;WAS/GPM - HL7 UTILITIES ; [4/19/06 12:41pm] 2 ;;1.0;My HealtheVet;**1**;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;This routine contains generic utilities used when building 6 ;or processing HL7 messages. 7 ; 8 Q ;Direct entry not supported 9 ; 10 LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing 11 ; 12 ;This subroutine assumes that all VistA HL7 environment variables are 13 ;properly initialized and will produce a fatal error if they aren't. 14 ; 15 N CNT,SEG 16 K @MSGROOT 17 F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D 18 . S CNT=0 19 . S @MSGROOT@(SEG,CNT)=HLNODE 20 . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) 21 Q 22 ; 23 PARSEMSG(MSGROOT,HL) ; Message Parser 24 ; Does not handle segments that span nodes 25 ; Does not handle extremely long segments (uses a local) 26 ; Does not handle long fields (segment parser doesn't) 27 ; 28 N SEG,CNT,DATA,MSG 29 F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D 30 . D PARSESEG(SEG(0),.DATA,.HL) 31 . K @MSGROOT@(CNT) 32 . I DATA(0)'="" M @MSGROOT@(CNT)=DATA 33 . Q:'$D(SEG(1)) 34 . ;Add handler for segments that span nodes here. 35 . Q 36 Q 37 ; 38 LOG(NAME,DATA,TYPE,NEW) ;Log to MHV application log 39 ; 40 ; Input: 41 ; NAME - Name to identify log line 42 ; DATA - Value,Tree, or Name of structure to put in log 43 ; TYPE - Type of log entry 44 ; S:Set Single Value 45 ; M:Merge Tree 46 ; I:Indirect Merge @ 47 ; NEW - Flag to create new log entry 48 ; 49 ; Output: 50 ; Updates log 51 ; 52 ; ^XTMP("MHV7LOG",0) - Head of log file 53 ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on 54 ; ^XTMP("MHV7LOG",2) - contains the log 55 ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry 56 ; 57 ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM) 58 ; 59 ;Quit if logging is not turned on 60 Q:'$G(^XTMP("MHV7LOG",1)) 61 N DTM,CNT 62 ; 63 Q:'$D(DATA) 64 Q:$G(TYPE)="" 65 Q:$G(NAME)="" 66 S NAME=$TR(NAME,"^","-") 67 ; 68 ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node 69 I '$G(^TMP("MHV7LOG",$J)) S NEW=1 70 ; 71 I $G(NEW) D 72 . S DTM=-$$NOW^XLFDT() 73 . K ^XTMP("MHV7LOG",2,DTM,$J) 74 . S ^TMP("MHV7LOG",$J)=DTM 75 . S CNT=1 76 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT 77 . D AUTOPRG 78 . Q 79 E D 80 . S DTM=^TMP("MHV7LOG",$J) 81 . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1 82 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT 83 . Q 84 ; 85 I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q 86 I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q 87 I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q 88 ; 89 Q 90 ; 91 AUTOPRG ; 92 Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE")) 93 N DT,DAYS,RESULT 94 ; Purge only once per day 95 S DT=$$DT^XLFDT 96 Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT 97 ; 98 S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS")) 99 I DAYS<1 S DAYS=7 100 ;*** Consider tasking the purge 101 D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1)) 102 S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT 103 Q 104 ; 105 TRIMSPC(STR) ;Trim leading and trailing spaces from a text string 106 ; 107 ; Input: 108 ; STR - Text string 109 ; 110 ; Output: 111 ; Function Value - Input text string with leading and trailing 112 ; spaces removed 113 ; 114 N SPACE,POS,LEN 115 S SPACE=$C(32) 116 S LEN=$L(STR) 117 S POS=1 118 F Q:$E(STR,POS)'=SPACE!(POS>LEN) S POS=POS+1 119 S STR=$E(STR,POS,LEN) 120 S POS=$L(STR) 121 F Q:$E(STR,POS)'=SPACE!(POS<1) S POS=POS-1 122 S STR=$E(STR,1,POS) 123 Q STR 124 ; 125 PARSESEG(SEG,DATA,HL) ;Generic segment parser 126 ;This procedure parses a single HL7 segment and builds an array 127 ;subscripted by the field number containing the data for that field. 128 ; Does not handle segments that span nodes 129 ; 130 ; Input: 131 ; SEG - HL7 segment to parse 132 ; HL - HL7 environment array 133 ; 134 ; Output: 135 ; Function value - field data array [SUB1:field, SUB2:repetition, 136 ; SUB3:component, SUB4:sub-component] 137 ; 138 N CMP ;component subscript 139 N CMPVAL ;component value 140 N FLD ;field subscript 141 N FLDVAL ;field value 142 N REP ;repetition subscript 143 N REPVAL ;repetition value 144 N SUB ;sub-component subscript 145 N SUBVAL ;sub-component value 146 N FS ;field separator 147 N CS ;component separator 148 N RS ;repetition separator 149 N SS ;sub-component separator 150 ; 151 K DATA 152 S FS=HL("FS") 153 S CS=$E(HL("ECH")) 154 S RS=$E(HL("ECH"),2) 155 S SS=$E(HL("ECH"),4) 156 ; 157 S DATA(0)=$P(SEG,FS) 158 S SEG=$P(SEG,FS,2,9999) 159 F FLD=1:1:$L(SEG,FS) D 160 . S FLDVAL=$P(SEG,FS,FLD) 161 . F REP=1:1:$L(FLDVAL,RS) D 162 . . S REPVAL=$P(FLDVAL,RS,REP) 163 . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D 164 . . . S CMPVAL=$P(REPVAL,CS,CMP) 165 . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D 166 . . . . S SUBVAL=$P(CMPVAL,SS,SUB) 167 . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL 168 . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL 169 . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL 170 . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL 171 Q 172 ; 173 BLDSEG(DATA,HL) ;generic segment builder 174 ; 175 ; Input: 176 ; DATA - field data array [SUB1:field, SUB2:repetition, 177 ; SUB3:component, SUB4:sub-component] 178 ; HL - HL7 environment array 179 ; 180 ; Output: 181 ; Function Value - Formatted HL7 segment on success, "" on failure 182 ; 183 N CMP ;component subscript 184 N CMPVAL ;component value 185 N FLD ;field subscript 186 N FLDVAL ;field value 187 N REP ;repetition subscript 188 N REPVAL ;repetition value 189 N SUB ;sub-component subscript 190 N SUBVAL ;sub-component value 191 N FS ;field separator 192 N CS ;component separator 193 N RS ;repetition separator 194 N ES ;escape character 195 N SS ;sub-component separator 196 N SEG,SEP 197 ; 198 S FS=HL("FS") 199 S CS=$E(HL("ECH")) 200 S RS=$E(HL("ECH"),2) 201 S ES=$E(HL("ECH"),3) 202 S SS=$E(HL("ECH"),4) 203 ; 204 S SEG=$G(DATA(0)) 205 F FLD=1:1:$O(DATA(""),-1) D 206 . S FLDVAL=$G(DATA(FLD)),SEP=FS 207 . S SEG=SEG_SEP_FLDVAL 208 . F REP=1:1:$O(DATA(FLD,""),-1) D 209 . . S REPVAL=$G(DATA(FLD,REP)) 210 . . S SEP=$S(REP=1:"",1:RS) 211 . . S SEG=SEG_SEP_REPVAL 212 . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D 213 . . . S CMPVAL=$G(DATA(FLD,REP,CMP)) 214 . . . S SEP=$S(CMP=1:"",1:CS) 215 . . . S SEG=SEG_SEP_CMPVAL 216 . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D 217 . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB)) 218 . . . . S SEP=$S(SUB=1:"",1:SS) 219 . . . . S SEG=SEG_SEP_SUBVAL 220 Q SEG 221 ; 222 BLDWPSEG(WP,SEG,MAXLEN,HL) ; 223 ;Builds segment nodes to add word processing fields to a segment 224 N CNT,LINE,LAST,FS,RS,LENGTH 225 I MAXLEN<1 S MAXLEN=999999999999 226 S FS=HL("FS") ;field separator 227 S RS=$E(HL("ECH"),2) ;repeat separator 228 S CNT=$O(SEG(""),-1)+1 229 S LINE=$O(WP(0)) 230 S LENGTH=$L(LINE) 231 S SEG(CNT)="" 232 S SEG(CNT)=FS_$$ESCAPE($G(WP(LINE,0)),.HL) 233 F S LINE=$O(WP(LINE)) Q:LINE="" D Q:LENGTH'<MAXLEN 234 . S LENGTH=LENGTH+$L(LINE) 235 . I LENGTH'<MAXLEN S LINE=$E(LINE,1,$L(LINE)-(LENGTH-MAXLEN)) 236 . S LAST=$E(SEG(CNT),$L(SEG(CNT))) 237 . S CNT=CNT+1 238 . S SEG(CNT)=$$ESCAPE($G(WP(LINE,0)),.HL) 239 . I $E(SEG(CNT))'=" ",LAST'=" " S SEG(CNT)=RS_SEG(CNT) 240 . Q 241 Q 242 ; 243 ADD(VAL,SEP,SEG) ;append a value onto segment 244 ; 245 ; Input: 246 ; VAL - value to append 247 ; SEP - HL7 separator 248 ; 249 ; Output: 250 ; SEG - segment passed by reference 251 ; 252 S SEP=$G(SEP) 253 S VAL=$G(VAL) 254 ; Escape VAL?? 255 ; If exceed 512 characters don't add 256 S SEG=SEG_SEP_VAL 257 Q 258 ; 259 ESCAPE(VAL,HL) ;Escape any special characters 260 ; *** Does not handle long strings of special characters *** 261 ; 262 ; Input: 263 ; VAL - value to escape 264 ; HL - HL7 environment array 265 ; 266 ; Output: 267 ; VAL - passed by reference 268 ; 269 N FS ;field separator 270 N CS ;component separator 271 N RS ;repetition separator 272 N ES ;escape character 273 N SS ;sub-component separator 274 N L,STR,I 275 ; 276 S FS=HL("FS") 277 S CS=$E(HL("ECH")) 278 S RS=$E(HL("ECH"),2) 279 S ES=$E(HL("ECH"),3) 280 S SS=$E(HL("ECH"),4) 281 ; 282 I VAL[ES D 283 . S L=$L(VAL,ES),STR="" 284 . F I=1:1:L S $P(STR,ES_"E"_ES,I)=$P(VAL,ES,I) 285 . S VAL=STR 286 I VAL[FS D 287 . S L=$L(VAL,FS),STR="" 288 . F I=1:1:L S $P(STR,ES_"F"_ES,I)=$P(VAL,FS,I) 289 . S VAL=STR 290 I VAL[RS D 291 . S L=$L(VAL,RS),STR="" 292 . F I=1:1:L S $P(STR,ES_"R"_ES,I)=$P(VAL,RS,I) 293 . S VAL=STR 294 I VAL[CS D 295 . S L=$L(VAL,CS),STR="" 296 . F I=1:1:L S $P(STR,ES_"S"_ES,I)=$P(VAL,CS,I) 297 . S VAL=STR 298 I VAL[SS D 299 . S L=$L(VAL,SS),STR="" 300 . F I=1:1:L S $P(STR,ES_"T"_ES,I)=$P(VAL,SS,I) 301 . S VAL=STR 302 Q VAL 303 ; 304 UNESC(VAL,HL) ;Reconstitute any escaped characters 305 ; 306 ; Input: 307 ; VAL - Value to reconstitute 308 ; HL - HL7 environment array 309 ; 310 ; Output: 311 ; VAL - passed by reference 312 ; 313 N FS ;field separator 314 N CS ;component separator 315 N RS ;repetition separator 316 N ES ;escape character 317 N SS ;sub-component separator 318 N L,STR,I,FESC,CESC,RESC,EESC,SESC 319 ; 320 S FS=HL("FS") 321 S CS=$E(HL("ECH")) 322 S RS=$E(HL("ECH"),2) 323 S ES=$E(HL("ECH"),3) 324 S SS=$E(HL("ECH"),4) 325 S FESC=ES_"F"_ES 326 S CESC=ES_"S"_ES 327 S RESC=ES_"R"_ES 328 S EESC=ES_"E"_ES 329 S SESC=ES_"T"_ES 330 ; 331 I VAL'[ES Q VAL 332 I VAL[FESC D 333 . S L=$L(VAL,FESC),STR="" 334 . F I=1:1:L S $P(STR,FS,I)=$P(VAL,FESC,I) 335 . S VAL=STR 336 I VAL[CESC D 337 . S L=$L(VAL,CESC),STR="" 338 . F I=1:1:L S $P(STR,CS,I)=$P(VAL,CESC,I) 339 . S VAL=STR 340 I VAL[RESC D 341 . S L=$L(VAL,RESC),STR="" 342 . F I=1:1:L S $P(STR,RS,I)=$P(VAL,RESC,I) 343 . S VAL=STR 344 I VAL[SESC D 345 . S L=$L(VAL,SESC),STR="" 346 . F I=1:1:L S $P(STR,SS,I)=$P(VAL,SESC,I) 347 . S VAL=STR 348 I VAL[EESC D 349 . S L=$L(VAL,EESC),STR="" 350 . F I=1:1:L S $P(STR,ES,I)=$P(VAL,EESC,I) 351 . S VAL=STR 352 Q VAL 353 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVRQI.m
r613 r623 1 MHVRQI ;WAS/GPM - Request Manager Immediate Mode ; 7/28/05 11:49pm [12/14/06 11:38am] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; 6 REALTIME(REQ,XMT,HL) ; Manage immediate mode / real time requests 7 ; 8 ; Triage, execute/extract and respond to real time requests and 9 ; queries. If the request is rejected (blocked, or doesn't support 10 ; real time access), send a negative acknowledgement, otherwise call 11 ; the execute/extraction routine. If there are no errors transmit 12 ; the results, send a negative acknowledgement if there are errors. 13 ; 14 ; Input: 15 ; REQ - Parsed query and query parameters 16 ; XMT - Transmission parameters 17 ; HL - HL7 package array variable 18 ; 19 ; Output: 20 ; Extract information and respond to query 21 ; 22 N ERR,DATAROOT,MHVDATA 23 S DATAROOT="^TMP(""MHVEXTRACT"","_$J_","_REQ("TYPE")_")" 24 S ERR="" 25 ; 26 D LOG^MHVUL2("REQUEST MGR - IMMEDIATE","BEGIN","S","TRACE") 27 ; 28 I $$REJECT(.REQ,.ERR) D Q 29 . D LOG^MHVUL2("REQUEST CHECK","REJECT^"_ERR,"S","ERROR") 30 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL) 31 D LOG^MHVUL2("REQUEST CHECK","PROCESS","S","TRACE") 32 ; 33 I '$$EXECUTE(.REQ,.ERR,.DATAROOT) D Q 34 . D LOG^MHVUL2("REQUEST EXECUTE","ERROR^"_ERR,"S","ERROR") 35 . D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL) 36 D LOG^MHVUL2("REQUEST EXECUTE","COMPLETE","S","TRACE") 37 ; 38 D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL) 39 K @DATAROOT 40 ; 41 D LOG^MHVUL2("REQUEST MGR - IMMEDIATE","END","S","TRACE") 42 ; 43 Q 44 ; 45 REJECT(REQ,ERR) ;Check to see if request can be processed 46 S ERR="" 47 I REQ("BLOCKED") D Q 1 48 . S ERR="^207^AR^Request Type Blocked by Site" 49 . I $D(REQ("QPD")) S ERR="QPD^1^4"_ERR Q ;QBP query flag the QPD 50 . I $D(REQ("QRD")) S ERR="QRD^1^10"_ERR Q ;old style query flag QRD 51 . S ERR="MSH^1^9"_ERR ;not a query flag MSH 52 . Q 53 I 'REQ("REALTIME") D Q 1 54 . S ERR="^207^AR^Real Time Calls Not Supported By Request Type" 55 . I $D(REQ("QPD")) S ERR="RCP^1^1"_ERR Q ;QBP query flag RCP 56 . I $D(REQ("QRD")) S ERR="QRD^1^3"_ERR Q ;old style query flag QRD 57 . S ERR="MSH^1^9"_ERR ;not a query flag MSH 58 . Q 59 Q 0 60 ; 61 EXECUTE(REQ,ERR,DATAROOT) ;Execute action or extraction 62 ;Calls the execute routine for this request type 63 ;For queries this is the extraction routine 64 ;Parameters can be passed on REQ 65 ;Errors are passed on ERR 66 ; 67 ; DATAROOT is passed by reference because extractors are permitted 68 ; to change the root referenced. This allows on the fly use of 69 ; local variables and globals produced by calls to other packages. 70 ; Care must be given when using locals because they cannot be NEWed. 71 ; MHVDATA is NEWed above, and can be safely used. 72 ; The KILL in the main loop above will clean up. 73 ; 74 S ERR="" 75 D @(REQ("EXECUTE")_"(.REQ,.ERR,.DATAROOT)") 76 I ERR D Q 0 77 . S ERR="^207^AR^"_$P(ERR,"^",2) 78 . I $D(REQ("QPD")) S ERR="QPD^1^4"_ERR Q ;QBP query flag the QPD 79 . I $D(REQ("QRD")) S ERR="QRD^1^10"_ERR Q ;old style query flag QRD 80 . S ERR="MSH^1^9"_ERR ;not a query flag MSH 81 . Q 82 Q 1 83 ; 1 MHVRQI ;WAS/GPM - Request Manager Immediate Mode ; [8/22/05 6:19pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; 6 REALTIME(REQ,XMT,HL) ; Manage real time requests 7 ; 8 ; It is assumed no ROI logging or checking is needed for real time 9 ; request. 10 ; 11 ; Triage, execute/extract and respond to real time requests and 12 ; queries. If the request is rejected (blocked, or doesn't support 13 ; real time access), send a negative acknowledgement, otherwise call 14 ; the execute/extraction routine. If there are no errors transmit 15 ; the results, send a negative acknowledgement if there are errors. 16 ; 17 ; Input: 18 ; REQ - Parsed query and query paramters 19 ; XMT - Transmission parameters 20 ; HL - HL7 package array variable 21 ; 22 ; Output: 23 ; Extract information and respond to query 24 ; 25 N ERR,DATAROOT 26 S DATAROOT="^TMP(""MHVEXTRACT"",$J,"_REQ("TYPE")_")" 27 S ERR="" 28 ; 29 D LOG^MHV7U("REAL TIME","BEGIN","S",0) 30 ; 31 I $$REJECT(.REQ,.ERR) D Q 32 . D LOG^MHV7U("REQUEST CHECK","REJECT^"_ERR,"S",0) 33 . D XMIT^MHV7T(.REQ,.XMT,ERR,"",.HL) 34 D LOG^MHV7U("REQUEST CHECK","PROCESS","S",0) 35 ; 36 I '$$EXECUTE(.REQ,.ERR,DATAROOT) D Q 37 . D LOG^MHV7U("EXECUTE","ERROR^"_ERR,"S",0) 38 . D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL) 39 D LOG^MHV7U("EXECUTE","COMPLETE","S",0) 40 ; 41 D XMIT^MHV7T(.REQ,.XMT,ERR,DATAROOT,.HL) 42 K @DATAROOT 43 ; 44 D LOG^MHV7U("REAL TIME","END","S",0) 45 ; 46 Q 47 ; 48 REJECT(REQ,ERR) ;Check to see if request can be processed 49 S ERR="" 50 I REQ("BLOCKED") D Q 1 51 . S ERR="^207^AR^Request Type Blocked by Site" 52 . I $D(REQ("QPD")) S ERR="QPD^1^5"_ERR ;Its a query flag the QPD 53 . E S ERR="MSH^1^9"_ERR 54 . Q 55 I 'REQ("REALTIME") D Q 1 56 . S ERR="^207^AR^Real Time Calls Not Supported By Request Type" 57 . I $D(REQ("QPD")) S ERR="RCP^1^1"_ERR ;Its a query flag the RCP 58 . E S ERR="MSH^1^9"_ERR 59 . Q 60 Q 0 61 ; 62 EXECUTE(REQ,ERR,DATAROOT) ;Execute action or extraction 63 ;Calls the execute routine for this request type 64 ;For queries this is the extraction routine 65 ;Parameters can be passed on REQ 66 ;Errors are passed on ERR 67 ;DATAROOT is the name holding the data, can be local or global 68 S ERR="" 69 D @(REQ("EXECUTE")_"(.REQ,.ERR,DATAROOT)") 70 I ERR D Q 0 71 . S ERR="^207^AR^"_$P(ERR,"^",2) 72 . I $D(REQ("QPD")) S ERR="QPD^1^5"_ERR ;Its a query flag the QPD 73 . E S ERR="MSH^1^9"_ERR 74 . Q 75 Q 1 76 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVU1.m
r613 r623 1 MHVU1 ;WAS/GPM - UTILITIES ; 7/25/05 3:48pm [12/13/07 12:06am] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 NOTIFY(ADM) ; Notify MHV server of patch installation, and configuration data 8 ; Sends the current version and last patch installed for the 9 ; My HealtheVet package. This is called by post install routines to 10 ; notify the MHV server of patch installation. 11 ; Configuration data passed in ADM will also be sent. 12 ; 13 ; Input: 14 ; ADM - Array of administrative data 15 ; SITE NUMBER - From Institution file 16 ; SITE NAME - Descriptive Site Name 17 ; DOMAIN - System Domain Name 18 ; SYSTEM TYPE - Production or Test 19 ; VERSION - MHV version 20 ; PATCH NUMBER - Last MHV patch loaded 21 ; RPC BROKER PORT - Broker port MHV Server should use 22 ; IP ADDRESS - System IP address 23 ; HL7 LISTENER PORT - For HL7 listener 24 ; 25 ; Output: 26 ; MFN^Z01 Message is sent to the MHV server 27 ; 28 ; 29 N XMT 30 D LOG^MHVUL2("MFN-Z01 UPDATE","BEGIN","S","TRACE") 31 D LOG^MHVUL2("ADM",.ADM,"M","TRACE") 32 S XMT("BUILDER")="MFNZ01^MHV7B0" 33 S XMT("PROTOCOL")="MHV MFN-Z01 Event Driver" 34 S XMT("MODE")="A" 35 D XMIT^MHV7T(.ADM,.XMT,"","","") 36 ; 37 ; code to use Email transmitter 38 ;S XMT("SAF")=ADM("SITE NUMBER") 39 ;S XMT("EMAIL")="VHAMHVSITECOMMCONFIG@MED.VA.GOV" 40 ;D EMAIL^MHV7T(.ADM,.XMT,"","","") 41 ; 42 D LOG^MHVUL2("MFN-Z01 UPDATE","END","S","TRACE") 43 ; 44 Q 45 ; 46 SETADM(ADM) ; Set up ADM array of site information 47 ; 48 ; Integration Agreements: 49 ; 10141 : $$LAST^XPDUTL,$$VERSION^XPDUTL 50 ; 3552 : $$PARAM^HLCS2 51 ; 4440 : $$PROD^XUPROD 52 ; 53 ; Input: None 54 ; 55 ; Output: 56 ; ADM - Array of administrative data 57 ; SITE NUMBER - From Institution file 58 ; SITE NAME - Descriptive Site Name 59 ; DOMAIN - System Domain Name 60 ; SYSTEM TYPE - Production or Test 61 ; VERSION - MHV version 62 ; PATCH NUMBER - Last MHV patch loaded 63 ; RPC BROKER PORT - Broker port MHV Server should use 64 ; IP ADDRESS - System IP address 65 ; HL7 LISTENER PORT - For HL7 listener 66 ; 67 N PARAM,VERSION,PATCH 68 S PARAM=$$PARAM^HLCS2 69 S VERSION=$$VERSION^XPDUTL("My HealtheVet") 70 S PATCH=$P($$LAST^XPDUTL("My HealtheVet",.VERSION),"^") 71 I PATCH<1 S PATCH="" 72 ; 73 S ADM("SITE NUMBER")=$P(PARAM,"^",6) 74 S ADM("SITE NAME")=$P(PARAM,"^",5) 75 S ADM("DOMAIN")=$P(PARAM,"^",2) 76 S ADM("SYSTEM TYPE")=$S($$PROD^XUPROD(1):"P",1:"T") 77 S ADM("VERSION")=VERSION 78 S ADM("PATCH NUMBER")=PATCH 79 S ADM("RPC BROKER PORT")="" 80 S ADM("IP ADDRESS")="" 81 S ADM("HL7 LISTENER PORT")=5000 82 Q 83 ; 1 MHVU1 ;WAS/GPM - MHV UTILITIES ; [8/22/05 6:20pm] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 NOTIFY(ADM) ; Notify MHV server of patch installation, and configuration data 8 ; Sends the current version and last patch installed for the 9 ; My HealtheVet package. This is called by post install routines to 10 ; notify the MHV server of patch installation. 11 ; Configuration data passed in ADM will also be sent. 12 ; 13 ; Input: 14 ; ADM - Array of administrative data 15 ; SITE NUMBER - From Institution file 16 ; SITE NAME - Descriptive Site Name 17 ; DOMAIN - System Domain Name 18 ; SYSTEM TYPE - Production or Test 19 ; VERSION - MHV version 20 ; PATCH NUMBER - Last MHV patch loaded 21 ; RPC BROKER PORT - Broker port MHV Server should use 22 ; IP ADDRESS - System IP address 23 ; HL7 LISTENER PORT - For HL7 listener 24 ; 25 ; Output: 26 ; MFN^Z01 Message is sent to the MHV server 27 ; 28 ; 29 N XMT 30 D LOG^MHV7U("ADM",.ADM,"M",1) 31 S XMT("BUILDER")="MFNZ01^MHV7B0" 32 S XMT("PROTOCOL")="MHV MFN-Z01 Event Driver" 33 ; Use email transmitter for now 34 S XMT("SAF")=ADM("SITE NUMBER") 35 S XMT("EMAIL")="VHAMHVSITECOMMCONFIG@MED.VA.GOV" 36 D EMAIL^MHV7T(.ADM,.XMT,"","","") 37 Q 38 ; 39 SETADM(ADM) ; Set up ADM array of site information 40 ; 41 ; Integration Agreements: 42 ; 10141 : $$LAST^XPDUTL,$$VERSION^XPDUTL 43 ; 3552 : $$PARAM^HLCS2 44 ; 4440 : $$PROD^XUPROD 45 ; 46 ; Input: None 47 ; 48 ; Output: 49 ; ADM - Array of administrative data 50 ; SITE NUMBER - From Institution file 51 ; SITE NAME - Descriptive Site Name 52 ; DOMAIN - System Domain Name 53 ; SYSTEM TYPE - Production or Test 54 ; VERSION - MHV version 55 ; PATCH NUMBER - Last MHV patch loaded 56 ; RPC BROKER PORT - Broker port MHV Server should use 57 ; IP ADDRESS - System IP address 58 ; HL7 LISTENER PORT - For HL7 listener 59 ; 60 N PARAM,VERSION,PATCH 61 S PARAM=$$PARAM^HLCS2 62 S VERSION=$$VERSION^XPDUTL("My HealtheVet") 63 S PATCH=$P($$LAST^XPDUTL("My HealtheVet",.VERSION),"^") 64 I PATCH<1 S PATCH="" 65 ; 66 S ADM("SITE NUMBER")=$P(PARAM,"^",6) 67 S ADM("SITE NAME")=$P(PARAM,"^",5) 68 S ADM("DOMAIN")=$P(PARAM,"^",2) 69 S ADM("SYSTEM TYPE")=$S($$PROD^XUPROD(1):"P",1:"T") 70 S ADM("VERSION")=VERSION 71 S ADM("PATCH NUMBER")=PATCH 72 S ADM("RPC BROKER PORT")="" 73 S ADM("IP ADDRESS")="" 74 S ADM("HL7 LISTENER PORT")=5000 75 Q 76 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVUL2.m
r613 r623 1 MHVUL2 ;WAS/GPM - MHV UTILITIES - LOGGING ; 3/2/06 5:38pm [9/22/06 3:51pm] 2 ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 LOG(NAME,DATA,TYPE,LEVEL) ;Log to MHV application log 8 ; 9 ; Input: 10 ; NAME - Name to identify log entry 11 ; DATA - Value,Tree, or Name of structure to put in log 12 ; TYPE - Type of log entry 13 ; S:Set Single Value 14 ; M:Merge Tree 15 ; I:Indirect Merge @ 16 ; LEVEL - Level of log entry - ERROR,TRACE,NAMED,DEBUG 17 ; 18 ; Output: 19 ; Adds entry to log 20 ; 21 ; ^XTMP("MHV7LOG",0) - Head of log file 22 ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on 23 ; ^XTMP("MHV7LOG",1,"LEVEL") - logging level 24 ; ^XTMP("MHV7LOG",1,"LEVEL",LEVEL) = rank 25 ; ^XTMP("MHV7LOG",1,"NAMES",) - names to log caret delimited string 26 ; ^XTMP("MHV7LOG",1,"NAMES",NAME) - name to log 27 ; ^XTMP("MHV7LOG",2) - contains the log 28 ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry 29 ; 30 ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM) 31 ; 32 ;Quit if logging is not turned on 33 Q:'$G(^XTMP("MHV7LOG",1)) 34 N DTM,CNT,LOGLEVEL 35 ; 36 Q:'$D(DATA) 37 Q:$G(TYPE)="" 38 Q:$G(NAME)="" 39 S NAME=$TR(NAME,"^","-") 40 ; 41 ;If LEVEL is null or unknown default to DEBUG 42 I $G(LEVEL)="" S LEVEL="DEBUG" 43 I '$D(^XTMP("MHV7LOG",1,"LEVEL",LEVEL)) S LEVEL="DEBUG" 44 ; 45 ;Log entries at or lower than the current logging level set 46 ;Levels are ranked as follows: 47 ; ^XTMP("MHV7LOG",1,"LEVEL","ERROR")=1 48 ; ^XTMP("MHV7LOG",1,"LEVEL","TRACE")=2 49 ; ^XTMP("MHV7LOG",1,"LEVEL","NAMED")=3 50 ; ^XTMP("MHV7LOG",1,"LEVEL","DEBUG")=4 51 ;Named is like a filtered version of debug. 52 ;Additional levels may be added, and ranks changed without affecting 53 ;the LOG api. Inserting a level between Named and Debug will require 54 ;a change to the conditional below. 55 S LOGLEVEL=$G(^XTMP("MHV7LOG",1,"LEVEL")) 56 I LOGLEVEL="" S LOGLEVEL="TRACE" 57 I $G(^XTMP("MHV7LOG",1,"LEVEL",LEVEL))>$G(^XTMP("MHV7LOG",1,"LEVEL",LOGLEVEL)) Q:LOGLEVEL'="NAMED" Q:'$D(^XTMP("MHV7LOG",1,"NAMES",NAME)) 58 ; 59 ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node 60 I '$G(^TMP("MHV7LOG",$J)) D 61 . S DTM=-$$NOW^XLFDT() 62 . K ^XTMP("MHV7LOG",2,DTM,$J) 63 . S ^TMP("MHV7LOG",$J)=DTM 64 . S CNT=1 65 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT 66 . D AUTOPRG 67 . Q 68 E D 69 . S DTM=^TMP("MHV7LOG",$J) 70 . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1 71 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT 72 . Q 73 ; 74 I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q 75 I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q 76 I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q 77 ; 78 Q 79 ; 80 RESET ; Initialize or clear session pointer into log 81 K ^TMP("MHV7LOG",$J) 82 Q 83 ; 84 AUTOPRG ; 85 Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE")) 86 N DT,DAYS,RESULT 87 ; Purge only once per day 88 S DT=$$DT^XLFDT 89 Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT 90 ; 91 S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS")) 92 I DAYS<1 S DAYS=7 93 ; 94 D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1)) 95 S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT 96 Q 97 ; 98 LOGBROWS ; Browser view of Log 99 N LOG,CNT,DTM,JOB,NUM,NAME,DIR,DIRUT,X,Y 100 K ^TMP("MHV LOG SUMMARY",$J) 101 K ^TMP("MHV LOG DETAIL",$J) 102 K ^TMP("MHV LOG BROWSE",$J) 103 K ^TMP("MHV LOG BROWSE DETAIL",$J) 104 D LOGSUM^MHVUL1(.LOG) 105 S CNT=$P(@LOG,"^",2) 106 I CNT<1 D Q 107 . W !!,?12,"LOG IS EMPTY" 108 . K DIR,DIRUT,X,Y 109 . S DIR(0)="E" 110 . D ^DIR 111 . Q 112 F I=1:1:CNT D 113 . S DTM=$P(@LOG@(I),"^") 114 . S JOB=$P(@LOG@(I),"^",2) 115 . S NUM=$P(@LOG@(I),"^",3) 116 . S NAME=$E($P(@LOG@(I),"^",4)_$J("",20),1,20) 117 . S ^TMP("MHV LOG BROWSE",$J,I)="$.%$CREF$^TMP(""MHV LOG BROWSE DETAIL"",$J,"_I_")$CREF$^"_NAME_"$.%"_$J($$FMTE^XLFDT(-DTM),22)_$J(JOB,13)_" "_NUM 118 . S ^TMP("MHV LOG BROWSE DETAIL",$J,I)="$XC$^D LOGBDET^MHVUL2("_I_","_DTM_","_JOB_")$XC$^"_NAME_" "_$$FMTE^XLFDT(-DTM)_" "_JOB 119 . Q 120 D LOGBTITL 121 S TITLE="Log Entry Timestamp Job Number Items" 122 D BROWSE^DDBR("^TMP(""MHV LOG BROWSE"",$J)","NA",TITLE_$J("",80-$L(TITLE)),"","",3,24) 123 K ^TMP("MHV LOG SUMMARY",$J) 124 K ^TMP("MHV LOG DETAIL",$J) 125 K ^TMP("MHV LOG BROWSE",$J) 126 K ^TMP("MHV LOG BROWSE DETAIL",$J) 127 Q 128 ; 129 LOGBTITL ; Build Titles for Browser 130 N TITLE,INFO,TLOG,TPRG,TAUT,TLEN 131 D LOGINFO^MHVUL1(.INFO) 132 S TLOG="Logging: "_$S(INFO("STATE"):"",1:"OFF") 133 I INFO("STATE") S TLOG=TLOG_INFO("LEVEL") 134 S TAUT="Auto Purge: "_$S(INFO("AUTOPURGE"):"",1:"OFF") 135 I INFO("AUTOPURGE") S TAUT=TAUT_+INFO("DAYS")_" days" 136 S TPRG="Delete: "_$$FMTE^XLFDT(INFO("DELETE")) 137 ; 138 S TITLE="MHV APPLICATION LOG" 139 S TLEN=$L(TITLE) 140 W @IOF,$J(TITLE,TLEN\2+40)_$J(TPRG,40-(TLEN\2)) 141 S TITLE=$J(TLOG_" ",15)_$J(TAUT,63) 142 W !,TITLE 143 Q 144 ; 145 LOGBDET(NODE,DTM,JOB) ; Build document from entry for Browser 146 N I,CNT,LINE,ENTRY 147 D LOGDET^MHVUL1(.ENTRY,DTM,JOB) 148 S I=0 149 S CNT=0 150 F S I=$O(@ENTRY@(I)) Q:I="" D 151 . S LINE=@ENTRY@(I) 152 . S CNT=CNT+1 153 . S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$E(LINE,1,80) 154 . S LINE=$E(LINE,81,999999) 155 . F Q:LINE="" D 156 .. S CNT=CNT+1 157 .. S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$J("",9)_$E(LINE,1,71) 158 .. S LINE=$E(LINE,72,999999) 159 .. Q 160 . Q 161 Q 162 ; 1 MHVUL2 ;WAS/GPM - MHV UTILITIES - LOGGING ; 3/2/06 5:38pm [4/19/06 2:30pm] 2 ;;1.0;My HealtheVet;**1**;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 LOG(NAME,DATA,TYPE,LEVEL) ;Log to MHV application log 8 ; 9 ; Input: 10 ; NAME - Name to identify log entry 11 ; DATA - Value,Tree, or Name of structure to put in log 12 ; TYPE - Type of log entry 13 ; S:Set Single Value 14 ; M:Merge Tree 15 ; I:Indirect Merge @ 16 ; LEVEL - Level of log entry - ERROR,TRACE,NAMED,DEBUG 17 ; 18 ; Output: 19 ; Adds entry to log 20 ; 21 ; ^XTMP("MHV7LOG",0) - Head of log file 22 ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on 23 ; ^XTMP("MHV7LOG",1,"LEVEL") - logging level 24 ; ^XTMP("MHV7LOG",1,"LEVEL",LEVEL) = rank 25 ; ^XTMP("MHV7LOG",1,"NAMES",) - names to log caret delimited string 26 ; ^XTMP("MHV7LOG",1,"NAMES",NAME) - name to log 27 ; ^XTMP("MHV7LOG",2) - contains the log 28 ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry 29 ; 30 ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM) 31 ; 32 ;Quit if logging is not turned on 33 Q:'$G(^XTMP("MHV7LOG",1)) 34 N DTM,CNT,LOGLEVEL 35 ; 36 Q:'$D(DATA) 37 Q:$G(TYPE)="" 38 Q:$G(NAME)="" 39 S NAME=$TR(NAME,"^","-") 40 ; 41 ;If LEVEL is null or unknown default to DEBUG 42 I $G(LEVEL)="" S LEVEL="DEBUG" 43 I '$D(^XTMP("MHV7LOG",1,"LEVEL",LEVEL)) S LEVEL="DEBUG" 44 ; 45 ;Log entries at or lower than the current logging level set 46 ;Levels are ranked as follows: 47 ; ^XTMP("MHV7LOG",1,"LEVEL","ERROR")=1 48 ; ^XTMP("MHV7LOG",1,"LEVEL","TRACE")=2 49 ; ^XTMP("MHV7LOG",1,"LEVEL","NAMED")=3 50 ; ^XTMP("MHV7LOG",1,"LEVEL","DEBUG")=4 51 ;Named is like a filtered version of debug. 52 ;Additional levels may be added, and ranks changed without affecting 53 ;the LOG api. Inserting a level between Named and Debug will require 54 ;a change to the conditional below. 55 S LOGLEVEL=$G(^XTMP("MHV7LOG",1,"LEVEL")) 56 I LOGLEVEL="" S LOGLEVEL="TRACE" 57 I $G(^XTMP("MHV7LOG",1,"LEVEL",LEVEL))>$G(^XTMP("MHV7LOG",1,"LEVEL",LOGLEVEL)) Q:LOGLEVEL'="NAMED" Q:'$D(^XTMP("MHV7LOG",1,"NAMES",NAME)) 58 ; 59 ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node 60 I '$G(^TMP("MHV7LOG",$J)) D 61 . S DTM=-$$NOW^XLFDT() 62 . K ^XTMP("MHV7LOG",2,DTM,$J) 63 . S ^TMP("MHV7LOG",$J)=DTM 64 . S CNT=1 65 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT 66 . D AUTOPRG 67 . Q 68 E D 69 . S DTM=^TMP("MHV7LOG",$J) 70 . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1 71 . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT 72 . Q 73 ; 74 I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q 75 I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q 76 I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q 77 ; 78 Q 79 ; 80 AUTOPRG ; 81 Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE")) 82 N DT,DAYS,RESULT 83 ; Purge only once per day 84 S DT=$$DT^XLFDT 85 Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT 86 ; 87 S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS")) 88 I DAYS<1 S DAYS=7 89 ; 90 D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1)) 91 S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT 92 Q 93 ; 94 LOGBROWS ; Browser view of Log 95 N LOG,CNT,DTM,JOB,NUM,NAME,DIR,DIRUT,X,Y 96 K ^TMP("MHV LOG SUMMARY",$J) 97 K ^TMP("MHV LOG DETAIL",$J) 98 K ^TMP("MHV LOG BROWSE",$J) 99 K ^TMP("MHV LOG BROWSE DETAIL",$J) 100 D LOGSUM^MHVUL1(.LOG) 101 S CNT=$P(@LOG,"^",2) 102 I CNT<1 D Q 103 . W !!,?12,"LOG IS EMPTY" 104 . K DIR,DIRUT,X,Y 105 . S DIR(0)="E" 106 . D ^DIR 107 . Q 108 F I=1:1:CNT D 109 . S DTM=$P(@LOG@(I),"^") 110 . S JOB=$P(@LOG@(I),"^",2) 111 . S NUM=$P(@LOG@(I),"^",3) 112 . S NAME=$E($P(@LOG@(I),"^",4)_$J("",20),1,20) 113 . S ^TMP("MHV LOG BROWSE",$J,I)="$.%$CREF$^TMP(""MHV LOG BROWSE DETAIL"",$J,"_I_")$CREF$^"_NAME_"$.%"_$J($$FMTE^XLFDT(-DTM),22)_$J(JOB,13)_" "_NUM 114 . S ^TMP("MHV LOG BROWSE DETAIL",$J,I)="$XC$^D LOGBDET^MHVUL2("_I_","_DTM_","_JOB_")$XC$^"_NAME_" "_$$FMTE^XLFDT(-DTM)_" "_JOB 115 . Q 116 D LOGBTITL 117 S TITLE="Log Entry Timestamp Job Number Items" 118 D BROWSE^DDBR("^TMP(""MHV LOG BROWSE"",$J)","NA",TITLE_$J("",80-$L(TITLE)),"","",3,24) 119 K ^TMP("MHV LOG SUMMARY",$J) 120 K ^TMP("MHV LOG DETAIL",$J) 121 K ^TMP("MHV LOG BROWSE",$J) 122 K ^TMP("MHV LOG BROWSE DETAIL",$J) 123 Q 124 ; 125 LOGBTITL ; Build Titles for Browser 126 N TITLE,INFO,TLOG,TPRG,TAUT,TLEN 127 D LOGINFO^MHVUL1(.INFO) 128 S TLOG="Logging: "_$S(INFO("STATE"):"",1:"OFF") 129 I INFO("STATE") S TLOG=TLOG_INFO("LEVEL") 130 S TAUT="Auto Purge: "_$S(INFO("AUTOPURGE"):"",1:"OFF") 131 I INFO("AUTOPURGE") S TAUT=TAUT_+INFO("DAYS")_" days" 132 S TPRG="Delete: "_$$FMTE^XLFDT(INFO("DELETE")) 133 ; 134 S TITLE="MHV APPLICATION LOG" 135 S TLEN=$L(TITLE) 136 W @IOF,$J(TITLE,TLEN\2+40)_$J(TPRG,40-(TLEN\2)) 137 S TITLE=$J(TLOG_" ",15)_$J(TAUT,63) 138 W !,TITLE 139 Q 140 ; 141 LOGBDET(NODE,DTM,JOB) ; Build document from entry for Browser 142 N I,CNT,LINE,ENTRY 143 D LOGDET^MHVUL1(.ENTRY,DTM,JOB) 144 S I=0 145 S CNT=0 146 F S I=$O(@ENTRY@(I)) Q:I="" D 147 . S LINE=@ENTRY@(I) 148 . S CNT=CNT+1 149 . S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$E(LINE,1,80) 150 . S LINE=$E(LINE,81,999999) 151 . F Q:LINE="" D 152 .. S CNT=CNT+1 153 .. S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$J("",9)_$E(LINE,1,71) 154 .. S LINE=$E(LINE,72,999999) 155 .. Q 156 . Q 157 Q 158 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRX.m
r613 r623 1 MHVXRX ;WAS/GPM - Prescription extract ; [12/14/06 11:38am] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 PROFILE(QRY,ERR,DATAROOT) ; Entry point to get prescription profile 8 ; Retrieves requested prescription data and returns it in DATAROOT 9 ; Retrieves all prescriptions with an active status 10 ; 11 ; Integration Agreements: 12 ; 3768 : AP2^PSOPRA,AP5^PSOPRA 13 ; 4687 : EN^PSOMHV1 14 ; 15 ; Input: 16 ; QRY - Query array 17 ; QRY(DFN) - (required) Pointer to PATIENT (#2) file 18 ; DATAROOT - Root of array to hold extract data 19 ; 20 ; Output: 21 ; DATAROOT - Populated data array, includes # of hits 22 ; ERR - Errors during extraction 23 ; 24 N U,DT,HIT,DFN,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX 25 ; 26 D LOG^MHVUL2("MHVXRX PROFILE","BEGIN","S","TRACE") 27 S U="^",DT=$$DT^XLFDT 28 S ERR=0,HIT=0 29 K @DATAROOT 30 K ^TMP("PSO",$J) 31 S DFN=$G(QRY("DFN")) 32 S FROM=DT 33 S TO="" 34 ; 35 D EN^PSOMHV1(DFN,FROM,TO) 36 ; 37 S STA="",INDEX="" 38 F STA="ACT","SUS" F S INDEX=$O(^TMP("PSO",$J,STA,INDEX)) Q:INDEX="" D SET 39 ; 40 K ^TMP("PSO",$J) 41 S @DATAROOT=HIT 42 D LOG^MHVUL2("MHVXRX PROFILE",HIT_" HITS","S","TRACE") 43 D LOG^MHVUL2("MHVXRX PROFILE","END","S","TRACE") 44 Q 45 ; 46 EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract prescription data 47 ; Retrieves requested prescription data and returns it in DATAROOT 48 ; Retrieves all prescriptions of all statuses in given date range 49 ; Statuses of deleted are filtered by the pharmacy API. 50 ; 51 ; Integration Agreements: 52 ; 3768 : AP2^PSOPRA,AP5^PSOPRA 53 ; 4687 : EN3^PSOMHV1 54 ; 55 ; Input: 56 ; QRY - Query array 57 ; QRY(DFN) - (required) Pointer to PATIENT (#2) file 58 ; QRY(FROM) - Date to start from 59 ; QRY(TO) - Date to go to 60 ; DATAROOT - Root of array to hold extract data 61 ; 62 ; Output: 63 ; DATAROOT - Populated data array, includes # of hits 64 ; ERR - Errors during extraction 65 ; 66 N U,DT,HIT,DFN,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX 67 ; 68 D LOG^MHVUL2("MHVXRX EXTRACT","BEGIN","S","TRACE") 69 S U="^",DT=$$DT^XLFDT 70 S ERR=0,HIT=0 71 K @DATAROOT 72 K ^TMP("PS",$J) 73 S DFN=$G(QRY("DFN")) 74 S FROM=$G(QRY("FROM")) 75 S TO=$G(QRY("TO")) 76 ; 77 I FROM="" S FROM=2000101 ;01/01/1900 78 ; 79 ; The EN3^PSOMHV1 call uses RX IEN instead of DRUG as a 80 ; subscript in ^TMP("PSO",$J). This was a late breaking change to 81 ; PSOMHV1 to support historical extracts. 82 D EN3^PSOMHV1(DFN,FROM,TO) 83 ; 84 S STA="",INDEX="" 85 F S STA=$O(^TMP("PSO",$J,STA)) Q:STA="" I STA'="PEN" F S INDEX=$O(^TMP("PSO",$J,STA,INDEX)) Q:INDEX="" D SET 86 ; 87 K ^TMP("PSO",$J) 88 S @DATAROOT=HIT 89 D LOG^MHVUL2("MHVXRX EXTRACT",HIT_" HITS","S","TRACE") 90 D LOG^MHVUL2("MHVXRX EXTRACT","END","S","TRACE") 91 Q 92 ; 93 SET ; 94 ;INDEX will be RXIEN if called from EXTRACT 95 ;INDEX will be drug name if called from PROFILE 96 S RXN=$P($G(^TMP("PSO",$J,STA,INDEX,"RXN",0)),"^") 97 I RXN="" Q 98 I $D(QRY("RXLIST")) Q:'$D(QRY("RXLIST",RXN)) 99 S MHVSTAT=$$AP2^PSOPRA(DFN,RXN) 100 S MHVDATE=$P(MHVSTAT,"^",2) 101 S MHVSTAT=$P(MHVSTAT,"^",1) 102 I MHVSTAT>0 I $$AP5^PSOPRA(DFN,RXN) ;Clear RXN from queue 103 S DRUG=$P($G(^TMP("PSO",$J,STA,INDEX,0)),"^",1) ;Drug Name 104 S HIT=HIT+1 105 S @DATAROOT@(HIT)=RXN_U_DRUG_U_MHVSTAT_U_MHVDATE 106 S @DATAROOT@(HIT,0)=$G(^TMP("PSO",$J,STA,INDEX,0)) 107 S @DATAROOT@(HIT,"P")=$G(^TMP("PSO",$J,STA,INDEX,"P",0)) 108 S @DATAROOT@(HIT,"RXN")=$G(^TMP("PSO",$J,STA,INDEX,"RXN",0)) 109 S @DATAROOT@(HIT,"DIV")=$G(^TMP("PSO",$J,STA,INDEX,"DIV",0)) 110 I '$D(^TMP("PSO",$J,STA,INDEX,"SIG")) S @DATAROOT@(HIT,"SIG",0)=0 111 E M @DATAROOT@(HIT,"SIG")=^TMP("PSO",$J,STA,INDEX,"SIG") 112 Q 113 ; 1 MHVXRX ;WAS/GPM - Prescription extract ; [8/23/05 12:33am] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 PROFILE(QRY,ERR,DATAROOT) ; Entry point to get prescription profile 8 ; Retrieves requested prescripton data and returns it in DATAROOT 9 ; Retrieves all prescriptions with an active status 10 ; 11 ; Integration Agreements: 12 ; 3768 : AP2^PSOPRA,AP5^PSOPRA 13 ; 4687 : EN^PSOMHV1 14 ; 15 ; Input: 16 ; QRY - Query array 17 ; QRY(DFN) - (required) Pointer to PATIENT (#2) file 18 ; DATAROOT - Root of array to hold extract data 19 ; 20 ; Output: 21 ; DATAROOT - Populated data array, includes # of hits 22 ; ERR - Errors during extraction 23 ; 24 N U,DT,HIT,DFN,PRI,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX 25 ; 26 D LOG^MHV7U("MHVXRX Profile","BEGIN","S",0) 27 S U="^",DT=$$DT^XLFDT 28 S ERR=0,HIT=0 29 K @DATAROOT 30 K ^TMP("PSO",$J) 31 S DFN=$G(QRY("DFN")) 32 S PRI=$G(QRY("PRI")) 33 S FROM=DT 34 S TO="" 35 ; 36 D EN^PSOMHV1(DFN,FROM,TO) 37 ; 38 S STA="",INDEX="" 39 F STA="ACT","SUS" F S INDEX=$O(^TMP("PSO",$J,STA,INDEX)) Q:INDEX="" D SET 40 ; 41 K ^TMP("PSO",$J) 42 S @DATAROOT=HIT 43 D LOG^MHV7U("MHVXRX Profile HITS=",HIT,"S",0) 44 D LOG^MHV7U("MHVXRX Profile","END","S",0) 45 Q 46 ; 47 EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract prescription data 48 ; Retrieves requested prescripton data and returns it in DATAROOT 49 ; Retrieves all prescriptions of all statuses in given date range 50 ; Statuses of deleted are filtered by the pharmacy API. 51 ; 52 ; Integration Agreements: 53 ; 3768 : AP2^PSOPRA,AP5^PSOPRA 54 ; 4687 : EN3^PSOMHV1 55 ; 56 ; Input: 57 ; QRY - Query array 58 ; QRY(DFN) - (required) Pointer to PATIENT (#2) file 59 ; QRY(FROM) - Date to start from 60 ; QRY(TO) - Date to go to 61 ; DATAROOT - Root of array to hold extract data 62 ; 63 ; Output: 64 ; DATAROOT - Populated data array, includes # of hits 65 ; ERR - Errors during extraction 66 ; 67 N U,DT,HIT,DFN,PRI,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX 68 ; 69 D LOG^MHV7U("MHVXRX Extract","BEGIN","S",0) 70 S U="^",DT=$$DT^XLFDT 71 S ERR=0,HIT=0 72 K @DATAROOT 73 K ^TMP("PS",$J) 74 S DFN=$G(QRY("DFN")) 75 S PRI=$G(QRY("PRI")) 76 S FROM=$G(QRY("FROM")) 77 S TO=$G(QRY("TO")) 78 ; 79 I FROM="" S FROM=2000101 ;01/01/1900 80 ; 81 ; The EN3^PSOMHV1 call uses RX IEN instead of DRUG as a 82 ; subscript in ^TMP("PSO",$J). This was a late breaking change to 83 ; PSOMHV1 to support historical extracts. 84 D EN3^PSOMHV1(DFN,FROM,TO) 85 ; 86 S STA="",INDEX="" 87 F S STA=$O(^TMP("PSO",$J,STA)) Q:STA="" I STA'="PEN" F S INDEX=$O(^TMP("PSO",$J,STA,INDEX)) Q:INDEX="" D SET 88 ; 89 K ^TMP("PSO",$J) 90 S @DATAROOT=HIT 91 D LOG^MHV7U("MHVXRX Extract HITS=",HIT,"S",0) 92 D LOG^MHV7U("MHVXRX Extract","END","S",0) 93 Q 94 ; 95 SET ; 96 ;INDEX will be RXIEN if called from EXTRACT 97 ;INDEX will be drug name if called from PROFILE 98 S RXN=$P($G(^TMP("PSO",$J,STA,INDEX,"RXN",0)),"^") 99 I RXN="" Q 100 I $D(QRY("RXLIST")) Q:'$D(QRY("RXLIST",RXN)) 101 S MHVSTAT=$$AP2^PSOPRA(DFN,RXN) 102 S MHVDATE=$P(MHVSTAT,"^",2) 103 S MHVSTAT=$P(MHVSTAT,"^",1) 104 I MHVSTAT>0 I $$AP5^PSOPRA(DFN,RXN) ;Clear RXN from queue 105 S DRUG=$P($G(^TMP("PSO",$J,STA,INDEX,0)),"^",1) ;Drug Name 106 S HIT=HIT+1 107 S @DATAROOT@(HIT)=RXN_U_DRUG_U_MHVSTAT_U_MHVDATE 108 S @DATAROOT@(HIT,0)=$G(^TMP("PSO",$J,STA,INDEX,0)) 109 S @DATAROOT@(HIT,"P")=$G(^TMP("PSO",$J,STA,INDEX,"P",0)) 110 S @DATAROOT@(HIT,"RXN")=$G(^TMP("PSO",$J,STA,INDEX,"RXN",0)) 111 S @DATAROOT@(HIT,"DIV")=$G(^TMP("PSO",$J,STA,INDEX,"DIV",0)) 112 I '$D(^TMP("PSO",$J,STA,INDEX,"SIG")) S @DATAROOT@(HIT,"SIG",0)=0 113 E M @DATAROOT@(HIT,"SIG")=^TMP("PSO",$J,STA,INDEX,"SIG") 114 Q 115 ; -
WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRXR.m
r613 r623 1 MHVXRXR ;WAS/GPM - Prescription refill request ; [12/12/07 11:38pm] 2 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 REQUEST(QRY,ERR,DATAROOT) ; Entry point to request refills 8 ; Walks list of prescriptions calling a pharmacy api AP1^PSOPRA to 9 ; add the prescription to the internet refill request queue in the 10 ; PRESCRIPTION REFILL REQUEST file #52.43. The status of the api 11 ; call is returned in DATAROOT. 12 ; 13 ; Integration Agreements: 14 ; 3768 : AP1^PSOPRA 15 ; 16 ; Input: 17 ; QRY - Query array 18 ; QRY(DFN) - (required) Pointer to PATIENT (#2) file 19 ; DATAROOT - Root of array to hold extract data 20 ; 21 ; Output: 22 ; DATAROOT - Populated data array, includes # of hits 23 ; ERR - Errors during extraction 24 ; 25 N CNT,RX,PORDERN,ORDERTM,STATUS,DIV,DFN,U 26 ; 27 D LOG^MHVUL2("MHVXRXR","BEGIN","S","TRACE") 28 S U="^" 29 S ERR=0 30 K @DATAROOT 31 S DFN=$G(QRY("DFN")) 32 ; 33 F CNT=1:1 Q:'$D(QRY("RX",CNT)) D 34 . S RX=$G(QRY("RX",CNT)) 35 . S PORDERN=$P(RX,"^",2) 36 . S ORDERTM=$P(RX,"^",3) 37 . S RX=$P(RX,"^") 38 . S STATUS=$$AP1^PSOPRA(DFN,RX) 39 . S @DATAROOT@(CNT)=RX_U_STATUS_U_PORDERN_U_ORDERTM 40 . Q 41 ; 42 S @DATAROOT=CNT-1 43 D LOG^MHVUL2("MHVXRXR","END","S","TRACE") 44 Q 1 MHVXRXR ;WAS/GPM - Prescription refill request ; [8/23/05 12:34am] 2 ;;1.0;My HealtheVet;;Aug 23, 2005 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 REQUEST(QRY,ERR,DATAROOT) ; Entry point to extract appointment data 8 ; Retrieves requested appointment data and returns it in DATAROOT 9 ; 10 ; Integration Agreements: 11 ; 3768 : AP1^PSOPRA 12 ; 13 ; Input: 14 ; QRY - Query array 15 ; QRY(DFN) - (required) Pointer to PATIENT (#2) file 16 ; DATAROOT - Root of array to hold extract data 17 ; 18 ; Output: 19 ; DATAROOT - Populated data array, includes # of hits 20 ; ERR - Errors during extraction 21 ; 22 N CNT,RX,PORDERN,ORDERTM,STATUS,DIV,DFN,U 23 ; 24 D LOG^MHV7U("MHVXRXR","BEGIN","S",0) 25 S U="^" 26 S ERR=0 27 K @DATAROOT 28 S DFN=$G(QRY("DFN")) 29 ; 30 F CNT=1:1 Q:'$D(QRY("RX",CNT)) D 31 . S RX=$G(QRY("RX",CNT)) 32 . S PORDERN=$P(RX,"^",2) 33 . S ORDERTM=$P(RX,"^",3) 34 . S RX=$P(RX,"^") 35 . S STATUS=$$AP1^PSOPRA(DFN,RX) 36 . S @DATAROOT@(CNT)=RX_U_STATUS_U_PORDERN_U_ORDERTM 37 . Q 38 ; 39 S @DATAROOT=CNT-1 40 D LOG^MHV7U("MHVXRXR","END","S",0) 41 Q
Note:
See TracChangeset
for help on using the changeset viewer.
