Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B0.m =================================================================== --- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B0.m (revision 613) +++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B0.m (revision 623) @@ -1,57 +1,54 @@ -MHV7B0 ;WAS/GPM - HL7 MESSAGE BUILDER FOR MFN^Z01 ; 1/21/08 5:18pm - ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 - ;;Per VHA Directive 2004-038, this routine should not be modified. - ; -MFNZ01(MSGROOT,ADM,ERR,DATAROOT,LEN,HL) ;Build MFN^Z01 - ; - ; Input: - ; MSGROOT - (required) Global root of message - ; ADM - (required) Array of administrative data - ; ERR - (Not used) For compatibility with MHV7T - ; DATAROOT - (Not used) For compatibility with MHV7T - ; HL - (required) Array of HL package variables - ; - ; Output: - ; MFN^Z01 message in MSGROOT - ; MSH,MFI,MFE,ZHV - ; LEN - Length of formatted message - ; - N CNT - D LOG^MHVUL2("MFN-Z01 BUILDER","BEGIN","S","TRACE") - K @MSGROOT - S CNT=1,@MSGROOT@(CNT)=$$MFI(.HL),LEN=$L(@MSGROOT@(CNT)) - S CNT=CNT+1,@MSGROOT@(CNT)=$$MFE(.ADM,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - S CNT=CNT+1,@MSGROOT@(CNT)=$$ZHV(.ADM,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - D LOG^MHVUL2("MFN-Z01 BUILDER","END","S","TRACE") - Q - ; -MFI(HL) ;build MFI segment - N MFI - S MFI(0)="MFI" - S MFI(1,1,1)="MHV" - S MFI(3)="UPD" - S MFI(6)="NE" - Q $$BLDSEG^MHV7U(.MFI,.HL) - ; -MFE(ADM,HL) ;build MFE segment - N MFE - S MFE(0)="MFE" - S MFE(1)="MUP" - S MFE(4)=$G(ADM("SITE NUMBER")) - S MFE(5)="CE" - Q $$BLDSEG^MHV7U(.MFE,.HL) - ; -ZHV(ADM,HL) ;build ZHV segment - N ZHV - S ZHV(0)="ZHV" - S ZHV(1,1,1)=$G(ADM("SITE NUMBER")) - S ZHV(1,1,2)=$$ESCAPE^MHV7U($G(ADM("SITE NAME")),.HL) - S ZHV(2)=$G(ADM("DOMAIN")) - S ZHV(3)=$G(ADM("IP ADDRESS")) - S ZHV(4)=$G(ADM("HL7 LISTENER PORT")) - S ZHV(5)=$G(ADM("RPC BROKER PORT")) - S ZHV(6,1,1)=$G(ADM("VERSION")) - S ZHV(7)=$$ESCAPE^MHV7U($G(ADM("PATCH NUMBER")),.HL) - S ZHV(8)=$G(ADM("SYSTEM TYPE")) - Q $$BLDSEG^MHV7U(.ZHV,.HL) - ; +MHV7B0 ;WAS/GPM - HL7 MESSAGE BUILDER FOR MFN^Z01 ; [8/22/05 6:21pm] + ;;1.0;My HealtheVet;;Aug 23, 2005 + ;;Per VHA Directive 2004-038, this routine should not be modified. + ; +MFNZ01(MSGROOT,ADM,ERR,DATAROOT,HL) ;Build MFN^Z01 + ; + ; Input: + ; MSGROOT - (required) Global root of message + ; ADM - (required) Array of administrative data + ; ERR - (Not used) For compatibility with MHV7T + ; DATAROOT - (Not used) For compatibility with MHV7T + ; HL - (required) Array of HL package variables + ; Output: + ; MFN^Z01 message in MSGROOT + ; MSH,MFI,MFE,ZHV + ; + N CNT + S CNT=0 + K @MSGROOT + S CNT=CNT+1,@MSGROOT@(CNT)=$$MFI(.HL) + S CNT=CNT+1,@MSGROOT@(CNT)=$$MFE(.ADM,.HL) + S CNT=CNT+1,@MSGROOT@(CNT)=$$ZHV(.ADM,.HL) + Q + ; +MFI(HL) ;build MFI segment + N MFI + S MFI(0)="MFI" + S MFI(1,1,1)="MHV" + S MFI(3)="UPD" + S MFI(6)="NE" + Q $$BLDSEG^MHV7U(.MFI,.HL) + ; +MFE(ADM,HL) ;build MFE segment + N MFE + S MFE(0)="MFE" + S MFE(1)="MUP" + S MFE(4)=$G(ADM("SITE NUMBER")) + S MFE(5)="CE" + Q $$BLDSEG^MHV7U(.MFE,.HL) + ; +ZHV(ADM,HL) ;build ZHV segment + N ZHV + S ZHV(0)="ZHV" + S ZHV(1,1,1)=$G(ADM("SITE NUMBER")) + S ZHV(1,1,2)=$$ESCAPE^MHV7U($G(ADM("SITE NAME")),.HL) + S ZHV(2)=$G(ADM("DOMAIN")) + S ZHV(3)=$G(ADM("IP ADDRESS")) + S ZHV(4)=$G(ADM("HL7 LISTENER PORT")) + S ZHV(5)=$G(ADM("RPC BROKER PORT")) + S ZHV(6,1,1)=$G(ADM("VERSION")) + S ZHV(7)=$$ESCAPE^MHV7U($G(ADM("PATCH NUMBER")),.HL) + S ZHV(8)=$G(ADM("SYSTEM TYPE")) + Q $$BLDSEG^MHV7U(.ZHV,.HL) + ; Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m =================================================================== --- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m (revision 613) +++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m (revision 623) @@ -1,58 +1,108 @@ -MHV7B1 ;WAS/GPM - HL7 message builder RTB^K13 ; [1/7/08 10:45pm] - ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 - ;;Per VHA Directive 2004-038, this routine should not be modified. - ; - Q - ; -RTBK13(MSGROOT,QRY,ERR,DATAROOT,LEN,HL) ; Build query response - ; - ; Populates the array pointed to by MSGROOT with an RTB^K13 query - ; response message by calling the appropriate segment builders based - ; on the type of response ACK/Data or NAK. Extracted data pointed to - ; by DATAROOT, errors, hit counts, and query information are used to - ; build the segments. - ; An error number in ERR^4 indicates a NAK is needed. - ; DATAROOT being null indicates a dataless ACK (testing purposes). - ; Multiple types of RDF/RDT are supported based on the type of - ; data in the response. The appropriate domain specific builder is - ; called based on QRY("BUILDER"). Note that this is a different - ; routine than the XMT("BUILDER"). - ; - ; Input: - ; MSGROOT - Global root of message - ; QRY - Query parameters - ; QRY("BUILDER") - Domain specific builder routine - ; QRY("MID") - original message control ID - ; ERR - Caret delimited error string - ; segment^sequence^field^code^ACK type^error text - ; DATAROOT - Global root of data array - ; HL - HL7 package array variable - ; - ; Output: RTB^K13 message in MSGROOT - ; LEN - Length of formatted message - ; - N CNT,RDT,HIT,EXTIME - D LOG^MHVUL2("RTB-K13 BUILDER","BEGIN","S","TRACE") - ; - S HIT=0,EXTIME="" - I DATAROOT'="" D - . S HIT=+$P($G(@DATAROOT),"^",1) - . S EXTIME=$P($G(@DATAROOT),"^",2) - . Q - S HIT=HIT_"^"_HIT_"^0" - ; - K @MSGROOT - S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7BUS($G(QRY("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) - I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^MHV7BUS(.QRY,ERR,HIT,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - S CNT=CNT+1,@MSGROOT@(CNT)=$$QPD^MHV7BUS(.QRY,EXTIME,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - I '$P(ERR,"^",4) D - . D @("RDF^"_QRY("BUILDER")_"(MSGROOT,.CNT,.LEN,.HL)") - . Q:DATAROOT="" - . Q:HIT<1 - . D @("RDT^"_QRY("BUILDER")_"(MSGROOT,DATAROOT,.CNT,.LEN,.HL)") - . Q - ; - D LOG^MHVUL2("RTB-K13 BUILDER","END","S","TRACE") - Q - ; +MHV7B1 ;WAS/GPM - HL7 message builder RTB^K13 ; [8/22/05 6:18pm] + ;;1.0;My HealtheVet;;Aug 23, 2005 + ;;Per VHA Directive 2004-038, this routine should not be modified. + ; + Q + ; +RTBK13(MSGROOT,QRY,ERR,DATAROOT,HL) ; Build query response + ; + ; Populates the array pointed to by MSGROOT with an RTB^K13 query + ; response message by calling the appropriate segment builders based + ; on the type of response ACK/Data or NAK. Extracted data pointed to + ; by DATAROOT, errors, hit counts, and query information are user to + ; buld the segments. + ; An error number in ERR^4 indicates a NAK is needed. + ; DATAROOT being null indicates a dataless ACK (testing purposes). + ; Multiple types of RDF/RDT are supported based on the type of + ; data in the response, indicated by QRY("TYPE"). + ; + ; Input: + ; MSGROOT - Global root of message + ; QRY - Query parameters + ; QRY("TYPE") - Request type number + ; QRY("MID") - original message control ID + ; ERR - Caret delimited error string + ; segment^sequence^field^code^ACK type^error text + ; DATAROOT - Global root of data array + ; HL - HL7 package array variable + ; + ; Output: RTB^K13 message in MSGROOT + ; + N CNT,RDT,HIT + S HIT="" + I DATAROOT'="" S HIT=$G(@DATAROOT) + I HIT="" S HIT=0 + S HIT=HIT_"^"_HIT_"^0" + K @MSGROOT + S CNT=1,@MSGROOT@(CNT)=$$MSA($G(QRY("MID")),ERR,.HL) + I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR(ERR,.HL) + S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK(.QRY,ERR,HIT,.HL) + S CNT=CNT+1,@MSGROOT@(CNT)=$$QPD(.QRY,.HL) + Q:$P(ERR,"^",4) + S CNT=CNT+1,@MSGROOT@(CNT)=$$RDF(QRY("TYPE"),.HL) + Q:DATAROOT="" + Q:@DATAROOT<1 + D RDT(MSGROOT,QRY("TYPE"),DATAROOT,.CNT,.HL) + Q + ; +MSA(MID,ERROR,HL) ;build MSA segment + N MSA,ACK + S ACK=$P(ERROR,"^",5) + I ACK="" S ACK="AA" + S MSA(0)="MSA" + S MSA(1)=ACK ;ACK code + S MSA(2)=MID ;message control ID + S MSA(3)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text message + Q $$BLDSEG^MHV7U(.MSA,.HL) + ; +ERR(ERROR,HL) ;build ERR segment + N ERR + S ERR(0)="ERR" + S ERR(1,1,1)=$P(ERROR,"^",1) ;segment + S ERR(1,1,2)=$P(ERROR,"^",2) ;sequence + S ERR(1,1,3)=$P(ERROR,"^",3) ;field + S ERR(1,1,4,1)=$P(ERROR,"^",4) ;code + S ERR(1,1,4,2)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text + Q $$BLDSEG^MHV7U(.ERR,.HL) + ; +QAK(QRY,ERROR,HIT,HL) ;build QAK segment + N QAK,STATUS + S STATUS=$P(ERROR,"^",5) + I STATUS="" S STATUS="OK" + I STATUS="OK",HIT<1 S STATUS="NF" + S QAK(0)="QAK" + S QAK(1)=QRY("QPD",2) ;query tag + S QAK(2)=STATUS ;query response status + M QAK(3)=QRY("QPD",1) ;message query name + S QAK(4)=$P(HIT,"^",1) ;hit count total + S QAK(5)=$P(HIT,"^",2) ;hits this payload + S QAK(6)=$P(HIT,"^",3) ;hits remaining + Q $$BLDSEG^MHV7U(.QAK,.HL) + ; +QPD(QRY,HL) ;build QPD segment + N QPD + M QPD=QRY("QPD") + S QPD(0)="QPD" + S QPD(7)=$G(QRY("ICN")) ;ICN + S QPD(8)=$G(QRY("DFN")) ;DFN + Q $$BLDSEG^MHV7U(.QPD,.HL) + ; +RDF(REQTYPE,HL) ; build RDF segment + N RTN + S RTN=$$RTN(REQTYPE) + Q:RTN="" "RDF" + Q @("$$RDF^"_RTN_"(.HL)") + ; +RDT(MSGROOT,REQTYPE,DATAROOT,CNT,HL) ; Build RDT segments + N RTN + S RTN=$$RTN(REQTYPE) + Q:RTN="" + D @("RDT^"_RTN_"(MSGROOT,DATAROOT,.CNT,.HL)") + Q + ; +RTN(REQTYPE) ; + N RDEF + S RDEF(3)="MHV7B1B" + S RDEF(21)="MHV7B1B" + Q $G(RDEF(REQTYPE)) + ; Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1B.m =================================================================== --- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1B.m (revision 613) +++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1B.m (revision 623) @@ -1,113 +1,97 @@ -MHV7B1B ;WAS/GPM - HL7 message builder RTB^K13 Rx Profile ; 10/13/05 7:52pm [12/24/07 5:39pm] - ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 - ;;Per VHA Directive 2004-038, this routine should not be modified. - ; - Q - ; -RDF(MSGROOT,CNT,LEN,HL) ; Build RDF segment for Rx Profile data - ; - ; Input: - ; MSGROOT - Root of array holding the message - ; CNT - Current message line counter - ; LEN - Current message length - ; HL - HL7 package array variable - ; - ; Output: - ; - Populated message array - ; - Updated LEN and CNT - ; - N RDF - S RDF(0)="RDF" - S RDF(1)=20 - S RDF(2,1,1)="Prescription Number",RDF(2,1,2)="ST",RDF(2,1,3)=20 - S RDF(2,2,1)="IEN",RDF(2,2,2)="NM",RDF(2,2,3)=30 - S RDF(2,3,1)="Drug Name",RDF(2,3,2)="ST",RDF(2,3,3)=40 - S RDF(2,4,1)="Issue Date/Time",RDF(2,4,2)="TS",RDF(2,4,3)=26 - S RDF(2,5,1)="Last Fill Date",RDF(2,5,2)="TS",RDF(2,5,3)=26 - S RDF(2,6,1)="Release Date/Time",RDF(2,6,2)="TS",RDF(2,6,3)=26 - S RDF(2,7,1)="Expiration or Cancel Date",RDF(2,7,2)="TS",RDF(2,7,3)=26 - S RDF(2,8,1)="Status",RDF(2,8,2)="ST",RDF(2,8,3)=25 - S RDF(2,9,1)="Quantity",RDF(2,9,2)="NM",RDF(2,9,3)=11 - S RDF(2,10,1)="Days Supply",RDF(2,10,2)="NM",RDF(2,10,3)=3 - S RDF(2,11,1)="Number of Refills",RDF(2,11,2)="NM",RDF(2,11,3)=3 - S RDF(2,12,1)="Provider",RDF(2,12,2)="XCN",RDF(2,12,3)=150 - S RDF(2,13,1)="Placer Order Number",RDF(2,13,2)="ST",RDF(2,13,3)=30 - S RDF(2,14,1)="Mail/Window",RDF(2,14,2)="ST",RDF(2,14,3)=1 - S RDF(2,15,1)="Division",RDF(2,15,2)="NM",RDF(2,15,3)=3 - S RDF(2,16,1)="Division Name",RDF(2,16,2)="ST",RDF(2,16,3)=20 - S RDF(2,17,1)="MHV Request Status",RDF(2,17,2)="NM",RDF(2,17,3)=3 - S RDF(2,18,1)="MHV Request Status Date",RDF(2,18,2)="TS",RDF(2,18,3)=26 - S RDF(2,19,1)="Remarks",RDF(2,19,2)="ST",RDF(2,19,3)=75 - S RDF(2,20,1)="SIG",RDF(2,20,2)="TX",RDF(2,20,3)=1024 - ; - S CNT=CNT+1 - S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDF,.HL) - S LEN=LEN+$L(@MSGROOT@(CNT)) - Q - ; -RDT(MSGROOT,DATAROOT,CNT,LEN,HL) ; Build RDT segments for Rx Profile data - ; - ; Walks data in DATAROOT to populate MSGROOT with RDT segments - ; sequentially numbered starting at CNT - ; - ; Integration Agreements: - ; 10103 : FMTHL7^XLFDT - ; 3065 : HLNAME^XLFNAME - ; - ; Input: - ; MSGROOT - Root of array holding the message - ; DATAROOT - Root of array to hold extract data - ; CNT - Current message line counter - ; LEN - Current message length - ; HL - HL7 package array variable - ; - ; Output: - ; - Populated message array - ; - Updated LEN and CNT - ; - N I,RX,RX0,RXP,RXN,RXD,RDT,SIG,SEG,PIEN,NAME,WPLEN - D LOG^MHVUL2("MHV7B1B","BEGIN RDT","S","TRACE") - F I=1:1 Q:'$D(@DATAROOT@(I)) D - . S RX=@DATAROOT@(I) - . S RX0=@DATAROOT@(I,0) - . S RXP=@DATAROOT@(I,"P") - . S PIEN=+RXP - . S RXN=@DATAROOT@(I,"RXN") - . S RXD=@DATAROOT@(I,"DIV") - . K SIG M SIG=@DATAROOT@(I,"SIG") - . S RDT(0)="RDT" - . S RDT(1)=$P(RX,"^") ;Rx Number - . S RDT(2)=$P(RXN,"^",9) ;Rx IEN - . S RDT(3)=$$ESCAPE^MHV7U($P(RX,"^",2),.HL) ;Drug Name - . S RDT(4)=$$FMTHL7^XLFDT($P(RX0,"^",5)) ;Issue Date/Time - . S RDT(5)=$$FMTHL7^XLFDT($P(RX0,"^",12)) ;Last Fill Date - . S RDT(6)=$$FMTHL7^XLFDT($P(RXN,"^",2)) ;Release Date/Time - . S RDT(7)=$$FMTHL7^XLFDT($P(RX0,"^",3)) ;Expiration/Cancel Date - . S RDT(8)=$$ESCAPE^MHV7U($P(RX0,"^",6),.HL) ;Status - . S RDT(9)=$P(RX0,"^",8) ;Quantity - . S RDT(10)=$P(RX0,"^",7) ;Days Supply - . S RDT(11)=$P(RX0,"^",4) ;Number of Refills - . I PIEN D - .. D FMTNAME2^MHV7BU(PIEN,200,.NAME,.HL,"XCN") - .. M RDT(12,1)=NAME - .. S RDT(12,1,1)=PIEN ;Provider IEN - .. Q - . S RDT(13)=$$ESCAPE^MHV7U($P(RX0,"^",11),.HL) ;Placer Order Number - . S RDT(14)=$P(RXN,"^",3) ;Mail/Window - . S RDT(15)=$P(RXD,"^") ;Division - . S RDT(16)=$$ESCAPE^MHV7U($P(RXD,"^",2),.HL) ;Division Name - . S RDT(17)=$P(RX,"^",3) ;MHV status - . S RDT(18)=$$FMTHL7^XLFDT($P(RX,"^",4)) ;MHV status date - . S RDT(19)=$$ESCAPE^MHV7U($P(RXN,"^",4),.HL) ;Remarks - . S CNT=CNT+1 - . S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDT,.HL) - . S LEN=LEN+$L(@MSGROOT@(CNT)) - . Q:'SIG(0) - . K SEG,WPLEN - . D BLDWP^MHV7U(.SIG,.SEG,1024,0,.WPLEN,.HL) - . M @MSGROOT@(CNT)=SEG - . S LEN=LEN+WPLEN - . Q - D LOG^MHVUL2("MHV7B1B","END RDT","S","TRACE") - Q - ; +MHV7B1B ;WAS/GPM - HL7 message builder RTB^K13 Rx Profile ; [8/22/05 11:45pm] + ;;1.0;My HealtheVet;;Aug 23, 2005 + ;;Per VHA Directive 2004-038, this routine should not be modified. + ; + Q + ; +RDF(HL) ; Build RDF segment for Rx Profile data + N RDF + S RDF(0)="RDF" + S RDF(1)=20 + S RDF(2,1,1)="Prescription Number",RDF(2,1,2)="ST",RDF(2,1,3)=20 + S RDF(2,2,1)="IEN",RDF(2,2,2)="NM",RDF(2,2,3)=30 + S RDF(2,3,1)="Drug Name",RDF(2,3,2)="ST",RDF(2,3,3)=40 + S RDF(2,4,1)="Issue Date/Time",RDF(2,4,2)="TS",RDF(2,4,3)=26 + S RDF(2,5,1)="Last Fill Date",RDF(2,5,2)="TS",RDF(2,5,3)=26 + S RDF(2,6,1)="Release Date/Time",RDF(2,6,2)="TS",RDF(2,6,3)=26 + S RDF(2,7,1)="Expiration or Cancel Date",RDF(2,7,2)="TS",RDF(2,7,3)=26 + S RDF(2,8,1)="Status",RDF(2,8,2)="ST",RDF(2,8,3)=25 + S RDF(2,9,1)="Quantity",RDF(2,9,2)="NM",RDF(2,9,3)=11 + S RDF(2,10,1)="Days Supply",RDF(2,10,2)="NM",RDF(2,10,3)=3 + S RDF(2,11,1)="Number of Refills",RDF(2,11,2)="NM",RDF(2,11,3)=3 + S RDF(2,12,1)="Provider",RDF(2,12,2)="XCN",RDF(2,12,3)=150 + S RDF(2,13,1)="Placer Order Number",RDF(2,13,2)="ST",RDF(2,13,3)=30 + S RDF(2,14,1)="Mail/Window",RDF(2,14,2)="ST",RDF(2,14,3)=1 + S RDF(2,15,1)="Division",RDF(2,15,2)="NM",RDF(2,15,3)=3 + S RDF(2,16,1)="Division Name",RDF(2,16,2)="ST",RDF(2,16,3)=20 + S RDF(2,17,1)="MHV Request Status",RDF(2,17,2)="NM",RDF(2,17,3)=3 + S RDF(2,18,1)="MHV Request Status Date",RDF(2,18,2)="TS",RDF(2,18,3)=26 + S RDF(2,19,1)="Remarks",RDF(2,19,2)="ST",RDF(2,19,3)=75 + S RDF(2,20,1)="SIG",RDF(2,20,2)="TX",RDF(2,20,3)=1024 + Q $$BLDSEG^MHV7U(.RDF,.HL) + ; +RDT(MSGROOT,DATAROOT,CNT,HL) ; Build RDT segments for Rx Profile data + ; + ; Walks data in DATAROOT to popoulate MSGROOT with RDT segments + ; sequentially numbered starting at CNT + ; + ; Integration Agreements: + ; 3065 : $$HLNAME^XLFNAME + ; + ; Input: + ; MSGROOT - Root of array holding the message + ; DATAROOT - Root of array to hold extract data + ; CNT - Current message line counter + ; HL - HL7 package array variable + ; + ; Output: + ; - Populated message array + ; + N I,RX,RX0,RXP,RXN,RXD,RDT,SIG,SEG,PIEN,NAME + F I=1:1 Q:'$D(@DATAROOT@(I)) D + . S RX=@DATAROOT@(I) + . S RX0=@DATAROOT@(I,0) + . S RXP=@DATAROOT@(I,"P") + . S PIEN=+RXP + . S RXN=@DATAROOT@(I,"RXN") + . S RXD=@DATAROOT@(I,"DIV") + . K SIG M SIG=@DATAROOT@(I,"SIG") + . S RDT(0)="RDT" + . S RDT(1)=$P(RX,"^") ;Rx Number + . S RDT(2)=$P(RXN,"^",9) ;Rx IEN + . S RDT(3)=$$ESCAPE^MHV7U($P(RX,"^",2),.HL) ;Drug Name + . S RDT(4)=$$FMTHL7^XLFDT($P(RX0,"^",5)) ;Issue Date/Time + . S RDT(5)=$$FMTHL7^XLFDT($P(RX0,"^",12)) ;Last Fill Date + . S RDT(6)=$$FMTHL7^XLFDT($P(RXN,"^",2)) ;Release Date/Time + . S RDT(7)=$$FMTHL7^XLFDT($P(RX0,"^",3)) ;Expiration/Cancel Date + . S RDT(8)=$$ESCAPE^MHV7U($P(RX0,"^",6),.HL) ;Status + . S RDT(9)=$P(RX0,"^",8) ;Quantity + . S RDT(10)=$P(RX0,"^",7) ;Days Supply + . S RDT(11)=$P(RX0,"^",4) ;Number of Refills + . I PIEN D + .. S RDT(12,1,1)=PIEN ;Provider IEN + .. S NAME("FILE")=200,NAME("FIELD")=.01,NAME("IENS")=PIEN_"," + .. S NAME=$$HLNAME^XLFNAME(.NAME,"","^") + .. S RDT(12,1,2)=$$ESCAPE^MHV7U($P(NAME,"^"),.HL) ;family + .. S RDT(12,1,3)=$$ESCAPE^MHV7U($P(NAME,"^",2),.HL) ;given + .. S RDT(12,1,4)=$$ESCAPE^MHV7U($P(NAME,"^",3),.HL) ;middle + .. S RDT(12,1,5)=$$ESCAPE^MHV7U($P(NAME,"^",4),.HL) ;suffix + .. S RDT(12,1,6)=$$ESCAPE^MHV7U($P(NAME,"^",5),.HL) ;prefix + .. S RDT(12,1,7)=$$ESCAPE^MHV7U($P(NAME,"^",6),.HL) ;degree + .. Q + . S RDT(13)=$$ESCAPE^MHV7U($P(RX0,"^",11),.HL) ;Placer Order Number + . S RDT(14)=$P(RXN,"^",3) ;Mail/Window + . S RDT(15)=$P(RXD,"^") ;Division + . S RDT(16)=$$ESCAPE^MHV7U($P(RXD,"^",2),.HL) ;Division Name + . S RDT(17)=$P(RX,"^",3) ;MHV status + . S RDT(18)=$$FMTHL7^XLFDT($P(RX,"^",4)) ;MHV status date + . S RDT(19)=$$ESCAPE^MHV7U($P(RXN,"^",4),.HL) ;Remarks + . S CNT=CNT+1 + . S @MSGROOT@(CNT)=$$BLDSEG^MHV7U(.RDT,.HL) + . Q:'SIG(0) + . K SEG + . D BLDWPSEG^MHV7U(.SIG,.SEG,1024,.HL) + . M @MSGROOT@(CNT)=SEG + . Q + Q + ; Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m =================================================================== --- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m (revision 613) +++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m (revision 623) @@ -1,75 +1,115 @@ -MHV7B2 ;WAS/GPM - HL7 message builder ORP^O10 ; [12/24/07 5:43pm] - ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 - ;;Per VHA Directive 2004-038, this routine should not be modified. - ; - Q - ; -ORPO10(MSGROOT,REQ,ERR,DATAROOT,LEN,HL) ; Build refill request response - ; - ; Populates the array pointed to by MSGROOT with an ORP^O10 order - ; response message by calling the appropriate segment builders based - ; on the type of response ACK or NAK. Extracted data pointed to - ; by DATAROOT, errors, and request parameters are used to build the - ; segments. An error number in ERR^4 indicates a NAK is needed. - ; - ; Integration Agreements: - ; 3065 : $$HLNAME^XLFNAME - ; 10112 : $$SITE^VASITE - ; - ; Input: - ; MSGROOT - Global root of message - ; REQ - Query parameters - ; REQ("TYPE") - Request type number - ; REQ("MID") - original message control ID - ; ERR - Caret delimited error string - ; segment^sequence^field^code^ACK type^error text - ; DATAROOT - Global root of data array - ; HL - HL7 package array variable - ; - ; Output: ORP^O10 message in MSGROOT - ; LEN - Length of formatted message - ; - N CNT,HIT,I - D LOG^MHVUL2("ORP-O10 BUILDER","BEGIN","S","TRACE") - ; - K @MSGROOT - S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7BUS($G(REQ("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) - I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - S CNT=CNT+1,@MSGROOT@(CNT)=$$PID^MHV7BUS(.REQ,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - ; - I '$P(ERR,"^",4),DATAROOT'="" D - . F I=1:1 Q:'$D(@DATAROOT@(I)) D - .. S CNT=CNT+1,@MSGROOT@(CNT)=$$ORC(@DATAROOT@(I),.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - .. S CNT=CNT+1,@MSGROOT@(CNT)=$$RXE(@DATAROOT@(I),.HL),LEN=LEN+$L(@MSGROOT@(CNT)) - .. Q - . Q - ; - D LOG^MHVUL2("ORP-O10 BUILDER","END","S","TRACE") - Q - ; -ORC(DATA,HL) ;build ORC segment - N ORC,STATUS,CONTROL - S STATUS=$P(DATA,"^",2) - S CONTROL=$S(STATUS=1:"OK",1:"UA") - S ORC(0)="ORC" - S ORC(1)=CONTROL ;order control - S ORC(2)=$P(DATA,"^",3) ;placer order number - S ORC(3)=$P(DATA,"^",3) ;filler order number - Q $$BLDSEG^MHV7U(.ORC,.HL) - ; -RXE(DATA,HL) ;build RXE segment - N RXE,STATUS,CONTROL - S STATUS=$P(DATA,"^",2) - S CONTROL=$S(STATUS=1:"OK",1:"UA") - S RXE(0)="RXE" - S RXE(1,1,1,1)=1 ;order quantity - S RXE(1,1,4,1)=$P(DATA,"^",4) ;order start time - S RXE(2,1,1)=CONTROL ;give code identifier - S RXE(2,1,2)=STATUS ;give code text - S RXE(2,1,3)="HL70119" ;give code system - S RXE(3)=1 ;give amount - S RXE(5)="1 refill unit" ;give units - ;S RXE(7)="" ;division number - S RXE(15)=$P(DATA,"^",1) ;prescription number - Q $$BLDSEG^MHV7U(.RXE,.HL) - ; +MHV7B2 ;WAS/GPM - HL7 message builder ORP^O10 ; [8/22/05 11:47pm] + ;;1.0;My HealtheVet;;Aug 23, 2005 + ;;Per VHA Directive 2004-038, this routine should not be modified. + ; + Q + ; +ORPO10(MSGROOT,REQ,ERR,DATAROOT,HL) ; Build refill request response + ; + ; Populates the array pointed to by MSGROOT with an ORP^O10 order + ; response message by calling the appropriate segment builders based + ; on the type of response ACK or NAK. Extracted data pointed to + ; by DATAROOT, errors, and request parameters are used to build the + ; segments. An error number in ERR^4 indicates a NAK is needed. + ; + ; Integration Agreements: + ; 3065 : $$HLNAME^XLFNAME + ; 10112 : $$SITE^VASITE + ; + ; Input: + ; MSGROOT - Global root of message + ; REQ - Query parameters + ; REQ("TYPE") - Request type number + ; REQ("MID") - original message control ID + ; ERR - Caret delimited error string + ; segment^sequence^field^code^ACK type^error text + ; DATAROOT - Global root of data array + ; HL - HL7 package array variable + ; + ; Output: ORP^O10 message in MSGROOT + ; + N CNT,RDT,HIT,I + K @MSGROOT + S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7B1($G(REQ("MID")),ERR,.HL) + I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$ERR^MHV7B1(ERR,.HL) + Q:$P(ERR,"^",4) + S CNT=CNT+1,@MSGROOT@(CNT)=$$PID(.REQ,.HL) + F I=1:1 Q:'$D(@DATAROOT@(I)) D + . S CNT=CNT+1,@MSGROOT@(CNT)=$$ORC(@DATAROOT@(I),.HL) + . S CNT=CNT+1,@MSGROOT@(CNT)=$$RXE(@DATAROOT@(I),.HL) + . Q + Q + ; +PID(REQ,HL) ; + N PID,NAME,STATION,IDCNT + S STATION=$P($$SITE^VASITE,"^",3) + S PID(0)="PID" + S IDCNT=0 + I REQ("ICN")'="" D + . S IDCNT=IDCNT+1 + . S PID(3,IDCNT,1)=REQ("ICN") ;Patient ID - ICN + . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID + . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type + . S PID(3,IDCNT,5)="NI" ;Patient ID type + . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility + . S PID(3,IDCNT,6,2)=STATION ;Station number + . S PID(3,IDCNT,6,3)="L" ;facility ID type + . Q + ; + I REQ("DFN")'="" D + . S IDCNT=IDCNT+1 + . S PID(3,IDCNT,1)=REQ("DFN") ;Patient ID - DFN + . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID + . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type + . S PID(3,IDCNT,5)="PI" ;Patient ID type + . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility + . S PID(3,IDCNT,6,2)=STATION ;Station number + . S PID(3,IDCNT,6,3)="L" ;facility ID type + . Q + ; + I REQ("SSN")'="" D + . S IDCNT=IDCNT+1 + . S PID(3,IDCNT,1)=REQ("SSN") ;Patient ID - SSN + . S PID(3,IDCNT,4,1)="USSSA" ;assigning authority ID + . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type + . S PID(3,IDCNT,5)="SS" ;Patient ID type + . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility + . S PID(3,IDCNT,6,2)="200MH" ;Station number + . S PID(3,IDCNT,6,3)="L" ;facility ID type + . Q + ; + S NAME("FILE")=2,NAME("FIELD")=.01,NAME("IENS")=REQ("DFN")_"," + S NAME=$$NAMEFMT^XLFNAME(.NAME) + S PID(5,1,1)=$$ESCAPE^MHV7U($P(NAME,"^"),.HL) ;family + S PID(5,1,2)=$$ESCAPE^MHV7U($P(NAME,"^",2),.HL) ;given + S PID(5,1,3)=$$ESCAPE^MHV7U($P(NAME,"^",3),.HL) ;middle + S PID(5,1,4)=$$ESCAPE^MHV7U($P(NAME,"^",4),.HL) ;suffix + ; + Q $$BLDSEG^MHV7U(.PID,.HL) + ; +ORC(DATA,HL) ;build ORC segment + N ORC,STATUS,CONTROL + S STATUS=$P(DATA,"^",2) + S CONTROL=$S(STATUS=1:"OK",1:"UA") + S ORC(0)="ORC" + S ORC(1)=CONTROL ;order control + S ORC(2)=$P(DATA,"^",3) ;placer order number + S ORC(3)=$P(DATA,"^",3) ;filler order number + Q $$BLDSEG^MHV7U(.ORC,.HL) + ; +RXE(DATA,HL) ;build RXE segment + N RXE,STATUS,CONTROL + S STATUS=$P(DATA,"^",2) + S CONTROL=$S(STATUS=1:"OK",1:"UA") + S RXE(0)="RXE" + S RXE(1,1,1,1)=1 ;order quantity + S RXE(1,1,4,1)=$P(DATA,"^",4) ;order start time + S RXE(2,1,1)=CONTROL ;give code identifier + S RXE(2,1,2)=STATUS ;give code text + S RXE(2,1,3)="HL70119" ;give code system + S RXE(3)=1 ;give amount + S RXE(5)="1 refill unit" ;give units + ;S RXE(7)="" ;division number + S RXE(15)=$P(DATA,"^",1) ;prescription number + Q $$BLDSEG^MHV7U(.RXE,.HL) + ; Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R1.m =================================================================== --- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R1.m (revision 613) +++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7R1.m (revision 623) @@ -1,182 +1,195 @@ -MHV7R1 ;WAS/GPM - HL7 RECEIVER FOR QBP QUERIES ; [12/31/07 3:11pm] - ;;1.0;My HealtheVet;**1,2**;Aug 23, 2005;Build 22 - ;;Per VHA Directive 2004-038, this routine should not be modified. - ; - Q - ; -QBPQ13 ;Process QBP^Q13 messages from the MHV QBP-Q13 Subscriber protocol - ; -QBPQ11 ;Process QBP^Q11 messages from the MHV QBP-Q11 Subscriber protocol - ; - ; This routine and subroutines assume that all VistA HL7 environment - ; variables are properly initialized and will produce a fatal error - ; if they are missing. - ; - ; The message will be checked to see if it is a valid query. - ; If not a negative acknowledgement will be sent. If the query is an - ; immediate mode or synchronous query, the realtime request manager - ; is called to handle the query. This means the query will be - ; processed and a response generated immediately. - ; In the future deferred mode queries may be filed in a database for - ; later processing, or transmission. - ; - ; Input: - ; HL7 environment variables - ; - ; Output: - ; Processed query or negative acknowledgement - ; If handled real-time the query response is generated - ; - N MSGROOT,QRY,XMT,ERR,RNAME - S (QRY,XMT,ERR)="" - ; Inbound query messages are small enough to be held in a local. - ; The following lines commented out support use of global and are - ; left in case use a global becomes necessary. - ;S MSGROOT="^TMP(""MHV7"",$J)" - ;K @MSGROOT - S MSGROOT="MHV7MSG" - N MHV7MSG - D LOADXMT^MHV7U(.XMT) ;Load inbound message information - ; - S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER" - D LOG^MHVUL2(RNAME,"BEGIN","S","TRACE") - ; - D LOADMSG^MHV7U(MSGROOT) - D LOG^MHVUL2("LOAD",MSGROOT,"I","DEBUG") - ; - D PARSEMSG^MHV7U(MSGROOT,.HL) - D LOG^MHVUL2("PARSE",MSGROOT,"I","DEBUG") - ; - I '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR) D Q - . D LOG^MHVUL2("MSG CHECK","INVALID^"_ERR,"S","ERROR") - . D XMIT^MHV7T(.QRY,.XMT,ERR,"",.HL) - D LOG^MHVUL2("MSG CHECK","VALID","S","TRACE") - ; - ; Immediate Mode - ; Deferred mode queries are not supported at this time - D REALTIME^MHVRQI(.QRY,.XMT,.HL) - ; - D LOG^MHVUL2(RNAME,"END","S","TRACE") - D RESET^MHVUL2 ;Clean up TMP used by logging - ;K @MSGROOT - ; - Q - ; -VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message - ; - ; Messages handled: QBP^Q13 - ; QBP^Q11 - ; - ; QBP query messages must contain PID, QPD and RCP segments - ; RXE segments are processed on Q13 prescription queries - ; Any additional segments are ignored - ; - ; The following sequences are required - ; PID(3) - Patient ID - ; PID(5)* - Patient Name - ; QPD(1)* - Message Query Name - ; QPD(2)* - Query Tag - ; QPD(3) - Request ID - ; QPD(4) - Subject Area - ; RCP(1) - Query Priority - ; * required by HL7 standard but not used by MHV - ; - ; The following sequences are optional - ; QPD(5) - From Date - ; QPD(6) - To Date - ; RCP(2) - Quantity Limited - ; - ; Input: - ; MSGROOT - Root of array holding message - ; XMT - Transmission parameters - ; - ; Output: - ; QRY - Query Array - ; XMT - Transmission parameters - ; ERR - segment^sequence^field^code^ACK type^error text - ; - N MSH,PID,RDF,RXE,QPD,RCP,REQID,REQTYPE,FROMDT,TODT,PRI,QTAG,QNAME,SEGTYPE,CNT,OCNT,RXNUM,QTY,UNIT - K QRY,ERR - S ERR="" - ; - ; Set up basics for responding to message. - ;----------------------------------------- - S QRY("MID")=XMT("MID") ;Message ID - S QRY("QPD")="" - ; - ; Validate message is a well-formed QBP query message. - ;----------------------------------------------------------- - ; Must have MSH first, followed by QPD,PID,RXE,RDF,RCP in any order - ; RXE is processed on Q13 prescriptions queries - ; RDF is not required - ; Any other segments are ignored. - ; - I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) - E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 - ; - S CNT=2,OCNT=0 - F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 - . S SEGTYPE=$G(@MSGROOT@(CNT,0)) - . I SEGTYPE="PID" M PID=@MSGROOT@(CNT),QRY("PID")=PID Q - . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q - . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q - . I SEGTYPE="RCP" M RCP=@MSGROOT@(CNT) Q - . I SEGTYPE="RXE" S OCNT=OCNT+1 M RXE(OCNT)=@MSGROOT@(CNT) Q - . Q - ; - I '$D(PID) S ERR="PID^1^^100^AE^Missing PID segment" Q 0 - I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0 - I '$D(RCP) S ERR="RCP^1^^100^AE^Missing RCP segment" Q 0 - ; - ; Validate required fields and query parameters - ;------------------------------------------------------ - S QTAG=$G(QPD(2)) ;Query Tag - S REQID=$G(QPD(3)) ;Request ID - S REQTYPE=$G(QPD(4)) ;Request Type - S FROMDT=$G(QPD(5)) ;From Date - S TODT=$G(QPD(6)) ;To Date - S PRI=$G(RCP(1)) ;Query Priority - S QTY=$G(RCP(2,1,1)) ;Quantity Limited - S UNIT=$G(RCP(2,1,2)) ;Quantity units - ; - I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0 - M QNAME=QPD(1) ;Message Query Name - ; - I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0 - ; - I REQID="" S ERR="QPD^1^3^101^AE^Missing Request ID" Q 0 - S QRY("REQID")=REQID - ; - I REQTYPE="" S ERR="QPD^1^4^101^AE^Missing Request Type" Q 0 - I '$$VALRTYPE^MHV7RU(REQTYPE,.QRY,.ERR) S ERR="QPD^1^4^"_ERR Q 0 - ; - I '$$VALIDDT^MHV7RU(.FROMDT) S ERR="QPD^1^5^102^AE^Invalid From Date" Q 0 - S QRY("FROM")=FROMDT - I '$$VALIDDT^MHV7RU(.TODT) S ERR="QPD^1^6^102^AE^Invalid To Date" Q 0 - I TODT'="",TODT0 D - . S CNT=0 - . S @MSGROOT@(SEG,CNT)=HLNODE - . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) - Q - ; -LOADXMT(XMT) ;Set HL dependent XMT values - ; - ; The HL array and variables are expected to be defined. If not, - ; message processing will fail. These references should not be - ; wrapped in $G, as null values will simply postpone the failure to - ; a point that will be harder to diagnose. Except HL("APAT") which - ; is not defined on synchronous calls. - ; Also assumes MHV RESPONSE MAP file is setup for every protocol - ; pair defined by MHV package. - ; - ; Integration Agreements: - ; 1373 : Reference to PROTOCOL file #101 - ; - N SUBPROT,RESPIEN,RESP0 - S XMT("MID")=HL("MID") ;Message ID - S XMT("MODE")="A" ;Response mode - I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode - S XMT("HLMTIENS")=HLMTIENS ;Message IEN - S XMT("MESSAGE TYPE")=HL("MTN") ;Message type - S XMT("EVENT TYPE")=HL("ETN") ;Event type - S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters - S XMT("MAX SIZE")=0 ;Default size unlimited - ; - ; Map response protocol and builder - S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") - S RESPIEN=$O(^MHV(2275.4,"B",SUBPROT,0)) - S RESP0=$G(^MHV(2275.4,RESPIEN,0)) - S XMT("PROTOCOL")=$P(RESP0,"^",2) ;Response Protocol - S XMT("BUILDER")=$TR($P(RESP0,"^",3),"~","^") ;Response Builder - S XMT("BREAK SEGMENT")=$P(RESP0,"^",4) ;Boundary Segment - Q - ; -DELIM(PROTOCOL) ;Return string of message delimiters based on Protocol - ; - ; Integration Agreements: - ; 2161 : INIT^HLFNC2 - ; - N HL - Q:PROTOCOL="" "" - D INIT^HLFNC2(PROTOCOL,.HL) - Q $G(HL("FS"))_$G(HL("ECH")) - ; -PARSEMSG(MSGROOT,HL) ; Message Parser - ; Does not handle segments that span nodes - ; Does not handle extremely long segments (uses a local) - ; Does not handle long fields (segment parser doesn't) - ; - N SEG,CNT,DATA,MSG - F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D - . D PARSESEG(SEG(0),.DATA,.HL) - . K @MSGROOT@(CNT) - . I DATA(0)'="" M @MSGROOT@(CNT)=DATA - . Q:'$D(SEG(1)) - . ;Add handler for segments that span nodes here. - . Q - Q - ; -PARSESEG(SEG,DATA,HL) ;Generic segment parser - ;This procedure parses a single HL7 segment and builds an array - ;subscripted by the field number containing the data for that field. - ; Does not handle segments that span nodes - ; - ; Input: - ; SEG - HL7 segment to parse - ; HL - HL7 environment array - ; - ; Output: - ; Function value - field data array [SUB1:field, SUB2:repetition, - ; SUB3:component, SUB4:sub-component] - ; - N CMP ;component subscript - N CMPVAL ;component value - N FLD ;field subscript - N FLDVAL ;field value - N REP ;repetition subscript - N REPVAL ;repetition value - N SUB ;sub-component subscript - N SUBVAL ;sub-component value - N FS ;field separator - N CS ;component separator - N RS ;repetition separator - N SS ;sub-component separator - ; - K DATA - S FS=HL("FS") - S CS=$E(HL("ECH")) - S RS=$E(HL("ECH"),2) - S SS=$E(HL("ECH"),4) - ; - S DATA(0)=$P(SEG,FS) - S SEG=$P(SEG,FS,2,9999) - F FLD=1:1:$L(SEG,FS) D - . S FLDVAL=$P(SEG,FS,FLD) - . F REP=1:1:$L(FLDVAL,RS) D - . . S REPVAL=$P(FLDVAL,RS,REP) - . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D - . . . S CMPVAL=$P(REPVAL,CS,CMP) - . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D - . . . . S SUBVAL=$P(CMPVAL,SS,SUB) - . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL - . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL - . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL - . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL - Q - ; -BLDSEG(DATA,HL) ;generic segment builder - ; - ; Input: - ; DATA - field data array [SUB1:field, SUB2:repetition, - ; SUB3:component, SUB4:sub-component] - ; HL - HL7 environment array - ; - ; Output: - ; Function Value - Formatted HL7 segment on success, "" on failure - ; - N CMP ;component subscript - N CMPVAL ;component value - N FLD ;field subscript - N FLDVAL ;field value - N REP ;repetition subscript - N REPVAL ;repetition value - N SUB ;sub-component subscript - N SUBVAL ;sub-component value - N FS ;field separator - N CS ;component separator - N RS ;repetition separator - N ES ;escape character - N SS ;sub-component separator - N SEG,SEP - ; - S FS=HL("FS") - S CS=$E(HL("ECH")) - S RS=$E(HL("ECH"),2) - S ES=$E(HL("ECH"),3) - S SS=$E(HL("ECH"),4) - ; - S SEG=$G(DATA(0)) - F FLD=1:1:$O(DATA(""),-1) D - . S FLDVAL=$G(DATA(FLD)),SEP=FS - . S SEG=SEG_SEP_FLDVAL - . F REP=1:1:$O(DATA(FLD,""),-1) D - . . S REPVAL=$G(DATA(FLD,REP)) - . . S SEP=$S(REP=1:"",1:RS) - . . S SEG=SEG_SEP_REPVAL - . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D - . . . S CMPVAL=$G(DATA(FLD,REP,CMP)) - . . . S SEP=$S(CMP=1:"",1:CS) - . . . S SEG=SEG_SEP_CMPVAL - . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D - . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB)) - . . . . S SEP=$S(SUB=1:"",1:SS) - . . . . S SEG=SEG_SEP_SUBVAL - Q SEG - ; -BLDWP(WP,SEG,MAXLEN,FORMAT,FMTLEN,HL) ; - ;Builds segment nodes to add word processing fields to a segment - N CNT,LINE,LAST,FS,RS,LENGTH,I - I MAXLEN<1 S MAXLEN=99999999999999999 - S FS=HL("FS") ;field separator - S RS=$E(HL("ECH"),2) ;repeat separator - S CNT=$O(SEG(""),-1)+1 - S SEG(CNT)=FS - S FMTLEN=0 - S LENGTH=0 - ; - S I=0 - F S I=$O(WP(I)) Q:'I D Q:LENGTH'0 D + . S CNT=0 + . S @MSGROOT@(SEG,CNT)=HLNODE + . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) + Q + ; +PARSEMSG(MSGROOT,HL) ; Message Parser + ; Does not handle segments that span nodes + ; Does not handle extremely long segments (uses a local) + ; Does not handle long fields (segment parser doesn't) + ; + N SEG,CNT,DATA,MSG + F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D + . D PARSESEG(SEG(0),.DATA,.HL) + . K @MSGROOT@(CNT) + . I DATA(0)'="" M @MSGROOT@(CNT)=DATA + . Q:'$D(SEG(1)) + . ;Add handler for segments that span nodes here. + . Q + Q + ; +LOG(NAME,DATA,TYPE,NEW) ;Log to MHV application log + ; + ; Input: + ; NAME - Name to identify log line + ; DATA - Value,Tree, or Name of structure to put in log + ; TYPE - Type of log entry + ; S:Set Single Value + ; M:Merge Tree + ; I:Indirect Merge @ + ; NEW - Flag to create new log entry + ; + ; Output: + ; Updates log + ; + ; ^XTMP("MHV7LOG",0) - Head of log file + ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on + ; ^XTMP("MHV7LOG",2) - contains the log + ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry + ; + ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM) + ; + ;Quit if logging is not turned on + Q:'$G(^XTMP("MHV7LOG",1)) + N DTM,CNT + ; + Q:'$D(DATA) + Q:$G(TYPE)="" + Q:$G(NAME)="" + S NAME=$TR(NAME,"^","-") + ; + ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node + I '$G(^TMP("MHV7LOG",$J)) S NEW=1 + ; + I $G(NEW) D + . S DTM=-$$NOW^XLFDT() + . K ^XTMP("MHV7LOG",2,DTM,$J) + . S ^TMP("MHV7LOG",$J)=DTM + . S CNT=1 + . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT + . D AUTOPRG + . Q + E D + . S DTM=^TMP("MHV7LOG",$J) + . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1 + . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT + . Q + ; + I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q + I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q + I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q + ; + Q + ; +AUTOPRG ; + Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE")) + N DT,DAYS,RESULT + ; Purge only once per day + S DT=$$DT^XLFDT + Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT + ; + S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS")) + I DAYS<1 S DAYS=7 + ;*** Consider tasking the purge + D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1)) + S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT + Q + ; +TRIMSPC(STR) ;Trim leading and trailing spaces from a text string + ; + ; Input: + ; STR - Text string + ; + ; Output: + ; Function Value - Input text string with leading and trailing + ; spaces removed + ; + N SPACE,POS,LEN + S SPACE=$C(32) + S LEN=$L(STR) + S POS=1 + F Q:$E(STR,POS)'=SPACE!(POS>LEN) S POS=POS+1 + S STR=$E(STR,POS,LEN) + S POS=$L(STR) + F Q:$E(STR,POS)'=SPACE!(POS<1) S POS=POS-1 + S STR=$E(STR,1,POS) + Q STR + ; +PARSESEG(SEG,DATA,HL) ;Generic segment parser + ;This procedure parses a single HL7 segment and builds an array + ;subscripted by the field number containing the data for that field. + ; Does not handle segments that span nodes + ; + ; Input: + ; SEG - HL7 segment to parse + ; HL - HL7 environment array + ; + ; Output: + ; Function value - field data array [SUB1:field, SUB2:repetition, + ; SUB3:component, SUB4:sub-component] + ; + N CMP ;component subscript + N CMPVAL ;component value + N FLD ;field subscript + N FLDVAL ;field value + N REP ;repetition subscript + N REPVAL ;repetition value + N SUB ;sub-component subscript + N SUBVAL ;sub-component value + N FS ;field separator + N CS ;component separator + N RS ;repetition separator + N SS ;sub-component separator + ; + K DATA + S FS=HL("FS") + S CS=$E(HL("ECH")) + S RS=$E(HL("ECH"),2) + S SS=$E(HL("ECH"),4) + ; + S DATA(0)=$P(SEG,FS) + S SEG=$P(SEG,FS,2,9999) + F FLD=1:1:$L(SEG,FS) D + . S FLDVAL=$P(SEG,FS,FLD) + . F REP=1:1:$L(FLDVAL,RS) D + . . S REPVAL=$P(FLDVAL,RS,REP) + . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D + . . . S CMPVAL=$P(REPVAL,CS,CMP) + . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D + . . . . S SUBVAL=$P(CMPVAL,SS,SUB) + . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL + . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL + . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL + . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL + Q + ; +BLDSEG(DATA,HL) ;generic segment builder + ; + ; Input: + ; DATA - field data array [SUB1:field, SUB2:repetition, + ; SUB3:component, SUB4:sub-component] + ; HL - HL7 environment array + ; + ; Output: + ; Function Value - Formatted HL7 segment on success, "" on failure + ; + N CMP ;component subscript + N CMPVAL ;component value + N FLD ;field subscript + N FLDVAL ;field value + N REP ;repetition subscript + N REPVAL ;repetition value + N SUB ;sub-component subscript + N SUBVAL ;sub-component value + N FS ;field separator + N CS ;component separator + N RS ;repetition separator + N ES ;escape character + N SS ;sub-component separator + N SEG,SEP + ; + S FS=HL("FS") + S CS=$E(HL("ECH")) + S RS=$E(HL("ECH"),2) + S ES=$E(HL("ECH"),3) + S SS=$E(HL("ECH"),4) + ; + S SEG=$G(DATA(0)) + F FLD=1:1:$O(DATA(""),-1) D + . S FLDVAL=$G(DATA(FLD)),SEP=FS + . S SEG=SEG_SEP_FLDVAL + . F REP=1:1:$O(DATA(FLD,""),-1) D + . . S REPVAL=$G(DATA(FLD,REP)) + . . S SEP=$S(REP=1:"",1:RS) + . . S SEG=SEG_SEP_REPVAL + . . F CMP=1:1:$O(DATA(FLD,REP,""),-1) D + . . . S CMPVAL=$G(DATA(FLD,REP,CMP)) + . . . S SEP=$S(CMP=1:"",1:CS) + . . . S SEG=SEG_SEP_CMPVAL + . . . F SUB=1:1:$O(DATA(FLD,REP,CMP,""),-1) D + . . . . S SUBVAL=$G(DATA(FLD,REP,CMP,SUB)) + . . . . S SEP=$S(SUB=1:"",1:SS) + . . . . S SEG=SEG_SEP_SUBVAL + Q SEG + ; +BLDWPSEG(WP,SEG,MAXLEN,HL) ; + ;Builds segment nodes to add word processing fields to a segment + N CNT,LINE,LAST,FS,RS,LENGTH + I MAXLEN<1 S MAXLEN=999999999999 + S FS=HL("FS") ;field separator + S RS=$E(HL("ECH"),2) ;repeat separator + S CNT=$O(SEG(""),-1)+1 + S LINE=$O(WP(0)) + S LENGTH=$L(LINE) + S SEG(CNT)="" + S SEG(CNT)=FS_$$ESCAPE($G(WP(LINE,0)),.HL) + F S LINE=$O(WP(LINE)) Q:LINE="" D Q:LENGTH'$G(^XTMP("MHV7LOG",1,"LEVEL",LOGLEVEL)) Q:LOGLEVEL'="NAMED" Q:'$D(^XTMP("MHV7LOG",1,"NAMES",NAME)) - ; - ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node - I '$G(^TMP("MHV7LOG",$J)) D - . S DTM=-$$NOW^XLFDT() - . K ^XTMP("MHV7LOG",2,DTM,$J) - . S ^TMP("MHV7LOG",$J)=DTM - . S CNT=1 - . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT - . D AUTOPRG - . Q - E D - . S DTM=^TMP("MHV7LOG",$J) - . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1 - . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT - . Q - ; - I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q - I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q - I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q - ; - Q - ; -RESET ; Initialize or clear session pointer into log - K ^TMP("MHV7LOG",$J) - Q - ; -AUTOPRG ; - Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE")) - N DT,DAYS,RESULT - ; Purge only once per day - S DT=$$DT^XLFDT - Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT - ; - S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS")) - I DAYS<1 S DAYS=7 - ; - D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1)) - S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT - Q - ; -LOGBROWS ; Browser view of Log - N LOG,CNT,DTM,JOB,NUM,NAME,DIR,DIRUT,X,Y - K ^TMP("MHV LOG SUMMARY",$J) - K ^TMP("MHV LOG DETAIL",$J) - K ^TMP("MHV LOG BROWSE",$J) - K ^TMP("MHV LOG BROWSE DETAIL",$J) - D LOGSUM^MHVUL1(.LOG) - S CNT=$P(@LOG,"^",2) - I CNT<1 D Q - . W !!,?12,"LOG IS EMPTY" - . K DIR,DIRUT,X,Y - . S DIR(0)="E" - . D ^DIR - . Q - F I=1:1:CNT D - . S DTM=$P(@LOG@(I),"^") - . S JOB=$P(@LOG@(I),"^",2) - . S NUM=$P(@LOG@(I),"^",3) - . S NAME=$E($P(@LOG@(I),"^",4)_$J("",20),1,20) - . 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 - . S ^TMP("MHV LOG BROWSE DETAIL",$J,I)="$XC$^D LOGBDET^MHVUL2("_I_","_DTM_","_JOB_")$XC$^"_NAME_" "_$$FMTE^XLFDT(-DTM)_" "_JOB - . Q - D LOGBTITL - S TITLE="Log Entry Timestamp Job Number Items" - D BROWSE^DDBR("^TMP(""MHV LOG BROWSE"",$J)","NA",TITLE_$J("",80-$L(TITLE)),"","",3,24) - K ^TMP("MHV LOG SUMMARY",$J) - K ^TMP("MHV LOG DETAIL",$J) - K ^TMP("MHV LOG BROWSE",$J) - K ^TMP("MHV LOG BROWSE DETAIL",$J) - Q - ; -LOGBTITL ; Build Titles for Browser - N TITLE,INFO,TLOG,TPRG,TAUT,TLEN - D LOGINFO^MHVUL1(.INFO) - S TLOG="Logging: "_$S(INFO("STATE"):"",1:"OFF") - I INFO("STATE") S TLOG=TLOG_INFO("LEVEL") - S TAUT="Auto Purge: "_$S(INFO("AUTOPURGE"):"",1:"OFF") - I INFO("AUTOPURGE") S TAUT=TAUT_+INFO("DAYS")_" days" - S TPRG="Delete: "_$$FMTE^XLFDT(INFO("DELETE")) - ; - S TITLE="MHV APPLICATION LOG" - S TLEN=$L(TITLE) - W @IOF,$J(TITLE,TLEN\2+40)_$J(TPRG,40-(TLEN\2)) - S TITLE=$J(TLOG_" ",15)_$J(TAUT,63) - W !,TITLE - Q - ; -LOGBDET(NODE,DTM,JOB) ; Build document from entry for Browser - N I,CNT,LINE,ENTRY - D LOGDET^MHVUL1(.ENTRY,DTM,JOB) - S I=0 - S CNT=0 - F S I=$O(@ENTRY@(I)) Q:I="" D - . S LINE=@ENTRY@(I) - . S CNT=CNT+1 - . S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$E(LINE,1,80) - . S LINE=$E(LINE,81,999999) - . F Q:LINE="" D - .. S CNT=CNT+1 - .. S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$J("",9)_$E(LINE,1,71) - .. S LINE=$E(LINE,72,999999) - .. Q - . Q - Q - ; +MHVUL2 ;WAS/GPM - MHV UTILITIES - LOGGING ; 3/2/06 5:38pm [4/19/06 2:30pm] + ;;1.0;My HealtheVet;**1**;Aug 23, 2005 + ;;Per VHA Directive 2004-038, this routine should not be modified. + ; + Q + ; +LOG(NAME,DATA,TYPE,LEVEL) ;Log to MHV application log + ; + ; Input: + ; NAME - Name to identify log entry + ; DATA - Value,Tree, or Name of structure to put in log + ; TYPE - Type of log entry + ; S:Set Single Value + ; M:Merge Tree + ; I:Indirect Merge @ + ; LEVEL - Level of log entry - ERROR,TRACE,NAMED,DEBUG + ; + ; Output: + ; Adds entry to log + ; + ; ^XTMP("MHV7LOG",0) - Head of log file + ; ^XTMP("MHV7LOG",1) - if set indicates that logging is on + ; ^XTMP("MHV7LOG",1,"LEVEL") - logging level + ; ^XTMP("MHV7LOG",1,"LEVEL",LEVEL) = rank + ; ^XTMP("MHV7LOG",1,"NAMES",) - names to log caret delimited string + ; ^XTMP("MHV7LOG",1,"NAMES",NAME) - name to log + ; ^XTMP("MHV7LOG",2) - contains the log + ; ^XTMP("MHV7LOG",2,negated FM timestamp,$J,counter,NAME) - log entry + ; + ; ^TMP("MHV7LOG",$J) - Session current log entry (DTM) + ; + ;Quit if logging is not turned on + Q:'$G(^XTMP("MHV7LOG",1)) + N DTM,CNT,LOGLEVEL + ; + Q:'$D(DATA) + Q:$G(TYPE)="" + Q:$G(NAME)="" + S NAME=$TR(NAME,"^","-") + ; + ;If LEVEL is null or unknown default to DEBUG + I $G(LEVEL)="" S LEVEL="DEBUG" + I '$D(^XTMP("MHV7LOG",1,"LEVEL",LEVEL)) S LEVEL="DEBUG" + ; + ;Log entries at or lower than the current logging level set + ;Levels are ranked as follows: + ; ^XTMP("MHV7LOG",1,"LEVEL","ERROR")=1 + ; ^XTMP("MHV7LOG",1,"LEVEL","TRACE")=2 + ; ^XTMP("MHV7LOG",1,"LEVEL","NAMED")=3 + ; ^XTMP("MHV7LOG",1,"LEVEL","DEBUG")=4 + ;Named is like a filtered version of debug. + ;Additional levels may be added, and ranks changed without affecting + ;the LOG api. Inserting a level between Named and Debug will require + ;a change to the conditional below. + S LOGLEVEL=$G(^XTMP("MHV7LOG",1,"LEVEL")) + I LOGLEVEL="" S LOGLEVEL="TRACE" + I $G(^XTMP("MHV7LOG",1,"LEVEL",LEVEL))>$G(^XTMP("MHV7LOG",1,"LEVEL",LOGLEVEL)) Q:LOGLEVEL'="NAMED" Q:'$D(^XTMP("MHV7LOG",1,"NAMES",NAME)) + ; + ; Check ^TMP("MHV7LOG",$J) If no current log node start a new node + I '$G(^TMP("MHV7LOG",$J)) D + . S DTM=-$$NOW^XLFDT() + . K ^XTMP("MHV7LOG",2,DTM,$J) + . S ^TMP("MHV7LOG",$J)=DTM + . S CNT=1 + . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT + . D AUTOPRG + . Q + E D + . S DTM=^TMP("MHV7LOG",$J) + . S CNT=$G(^XTMP("MHV7LOG",2,DTM,$J))+1 + . S ^XTMP("MHV7LOG",2,DTM,$J)=CNT + . Q + ; + I TYPE="S" S ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q + I TYPE="M" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=DATA Q + I TYPE="I" M ^XTMP("MHV7LOG",2,DTM,$J,CNT,NAME)=@DATA Q + ; + Q + ; +AUTOPRG ; + Q:'$G(^XTMP("MHV7LOG",1,"AUTOPURGE")) + N DT,DAYS,RESULT + ; Purge only once per day + S DT=$$DT^XLFDT + Q:$G(^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE"))=DT + ; + S DAYS=$G(^XTMP("MHV7LOG",1,"AUTOPURGE","DAYS")) + I DAYS<1 S DAYS=7 + ; + D LOGPRG^MHVUL1(.RESULT,$$HTFM^XLFDT($H-DAYS,1)) + S ^XTMP("MHV7LOG",1,"AUTOPURGE","PURGE DATE")=DT + Q + ; +LOGBROWS ; Browser view of Log + N LOG,CNT,DTM,JOB,NUM,NAME,DIR,DIRUT,X,Y + K ^TMP("MHV LOG SUMMARY",$J) + K ^TMP("MHV LOG DETAIL",$J) + K ^TMP("MHV LOG BROWSE",$J) + K ^TMP("MHV LOG BROWSE DETAIL",$J) + D LOGSUM^MHVUL1(.LOG) + S CNT=$P(@LOG,"^",2) + I CNT<1 D Q + . W !!,?12,"LOG IS EMPTY" + . K DIR,DIRUT,X,Y + . S DIR(0)="E" + . D ^DIR + . Q + F I=1:1:CNT D + . S DTM=$P(@LOG@(I),"^") + . S JOB=$P(@LOG@(I),"^",2) + . S NUM=$P(@LOG@(I),"^",3) + . S NAME=$E($P(@LOG@(I),"^",4)_$J("",20),1,20) + . 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 + . S ^TMP("MHV LOG BROWSE DETAIL",$J,I)="$XC$^D LOGBDET^MHVUL2("_I_","_DTM_","_JOB_")$XC$^"_NAME_" "_$$FMTE^XLFDT(-DTM)_" "_JOB + . Q + D LOGBTITL + S TITLE="Log Entry Timestamp Job Number Items" + D BROWSE^DDBR("^TMP(""MHV LOG BROWSE"",$J)","NA",TITLE_$J("",80-$L(TITLE)),"","",3,24) + K ^TMP("MHV LOG SUMMARY",$J) + K ^TMP("MHV LOG DETAIL",$J) + K ^TMP("MHV LOG BROWSE",$J) + K ^TMP("MHV LOG BROWSE DETAIL",$J) + Q + ; +LOGBTITL ; Build Titles for Browser + N TITLE,INFO,TLOG,TPRG,TAUT,TLEN + D LOGINFO^MHVUL1(.INFO) + S TLOG="Logging: "_$S(INFO("STATE"):"",1:"OFF") + I INFO("STATE") S TLOG=TLOG_INFO("LEVEL") + S TAUT="Auto Purge: "_$S(INFO("AUTOPURGE"):"",1:"OFF") + I INFO("AUTOPURGE") S TAUT=TAUT_+INFO("DAYS")_" days" + S TPRG="Delete: "_$$FMTE^XLFDT(INFO("DELETE")) + ; + S TITLE="MHV APPLICATION LOG" + S TLEN=$L(TITLE) + W @IOF,$J(TITLE,TLEN\2+40)_$J(TPRG,40-(TLEN\2)) + S TITLE=$J(TLOG_" ",15)_$J(TAUT,63) + W !,TITLE + Q + ; +LOGBDET(NODE,DTM,JOB) ; Build document from entry for Browser + N I,CNT,LINE,ENTRY + D LOGDET^MHVUL1(.ENTRY,DTM,JOB) + S I=0 + S CNT=0 + F S I=$O(@ENTRY@(I)) Q:I="" D + . S LINE=@ENTRY@(I) + . S CNT=CNT+1 + . S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$E(LINE,1,80) + . S LINE=$E(LINE,81,999999) + . F Q:LINE="" D + .. S CNT=CNT+1 + .. S ^TMP("MHV LOG BROWSE DETAIL",$J,NODE,CNT)=$J("",9)_$E(LINE,1,71) + .. S LINE=$E(LINE,72,999999) + .. Q + . Q + Q + ; Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRX.m =================================================================== --- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRX.m (revision 613) +++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRX.m (revision 623) @@ -1,113 +1,115 @@ -MHVXRX ;WAS/GPM - Prescription extract ; [12/14/06 11:38am] - ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 - ;;Per VHA Directive 2004-038, this routine should not be modified. - ; - Q - ; -PROFILE(QRY,ERR,DATAROOT) ; Entry point to get prescription profile - ; Retrieves requested prescription data and returns it in DATAROOT - ; Retrieves all prescriptions with an active status - ; - ; Integration Agreements: - ; 3768 : AP2^PSOPRA,AP5^PSOPRA - ; 4687 : EN^PSOMHV1 - ; - ; Input: - ; QRY - Query array - ; QRY(DFN) - (required) Pointer to PATIENT (#2) file - ; DATAROOT - Root of array to hold extract data - ; - ; Output: - ; DATAROOT - Populated data array, includes # of hits - ; ERR - Errors during extraction - ; - N U,DT,HIT,DFN,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX - ; - D LOG^MHVUL2("MHVXRX PROFILE","BEGIN","S","TRACE") - S U="^",DT=$$DT^XLFDT - S ERR=0,HIT=0 - K @DATAROOT - K ^TMP("PSO",$J) - S DFN=$G(QRY("DFN")) - S FROM=DT - S TO="" - ; - D EN^PSOMHV1(DFN,FROM,TO) - ; - S STA="",INDEX="" - F STA="ACT","SUS" F S INDEX=$O(^TMP("PSO",$J,STA,INDEX)) Q:INDEX="" D SET - ; - K ^TMP("PSO",$J) - S @DATAROOT=HIT - D LOG^MHVUL2("MHVXRX PROFILE",HIT_" HITS","S","TRACE") - D LOG^MHVUL2("MHVXRX PROFILE","END","S","TRACE") - Q - ; -EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract prescription data - ; Retrieves requested prescription data and returns it in DATAROOT - ; Retrieves all prescriptions of all statuses in given date range - ; Statuses of deleted are filtered by the pharmacy API. - ; - ; Integration Agreements: - ; 3768 : AP2^PSOPRA,AP5^PSOPRA - ; 4687 : EN3^PSOMHV1 - ; - ; Input: - ; QRY - Query array - ; QRY(DFN) - (required) Pointer to PATIENT (#2) file - ; QRY(FROM) - Date to start from - ; QRY(TO) - Date to go to - ; DATAROOT - Root of array to hold extract data - ; - ; Output: - ; DATAROOT - Populated data array, includes # of hits - ; ERR - Errors during extraction - ; - N U,DT,HIT,DFN,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX - ; - D LOG^MHVUL2("MHVXRX EXTRACT","BEGIN","S","TRACE") - S U="^",DT=$$DT^XLFDT - S ERR=0,HIT=0 - K @DATAROOT - K ^TMP("PS",$J) - S DFN=$G(QRY("DFN")) - S FROM=$G(QRY("FROM")) - S TO=$G(QRY("TO")) - ; - I FROM="" S FROM=2000101 ;01/01/1900 - ; - ; The EN3^PSOMHV1 call uses RX IEN instead of DRUG as a - ; subscript in ^TMP("PSO",$J). This was a late breaking change to - ; PSOMHV1 to support historical extracts. - D EN3^PSOMHV1(DFN,FROM,TO) - ; - S STA="",INDEX="" - 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 - ; - K ^TMP("PSO",$J) - S @DATAROOT=HIT - D LOG^MHVUL2("MHVXRX EXTRACT",HIT_" HITS","S","TRACE") - D LOG^MHVUL2("MHVXRX EXTRACT","END","S","TRACE") - Q - ; -SET ; - ;INDEX will be RXIEN if called from EXTRACT - ;INDEX will be drug name if called from PROFILE - S RXN=$P($G(^TMP("PSO",$J,STA,INDEX,"RXN",0)),"^") - I RXN="" Q - I $D(QRY("RXLIST")) Q:'$D(QRY("RXLIST",RXN)) - S MHVSTAT=$$AP2^PSOPRA(DFN,RXN) - S MHVDATE=$P(MHVSTAT,"^",2) - S MHVSTAT=$P(MHVSTAT,"^",1) - I MHVSTAT>0 I $$AP5^PSOPRA(DFN,RXN) ;Clear RXN from queue - S DRUG=$P($G(^TMP("PSO",$J,STA,INDEX,0)),"^",1) ;Drug Name - S HIT=HIT+1 - S @DATAROOT@(HIT)=RXN_U_DRUG_U_MHVSTAT_U_MHVDATE - S @DATAROOT@(HIT,0)=$G(^TMP("PSO",$J,STA,INDEX,0)) - S @DATAROOT@(HIT,"P")=$G(^TMP("PSO",$J,STA,INDEX,"P",0)) - S @DATAROOT@(HIT,"RXN")=$G(^TMP("PSO",$J,STA,INDEX,"RXN",0)) - S @DATAROOT@(HIT,"DIV")=$G(^TMP("PSO",$J,STA,INDEX,"DIV",0)) - I '$D(^TMP("PSO",$J,STA,INDEX,"SIG")) S @DATAROOT@(HIT,"SIG",0)=0 - E M @DATAROOT@(HIT,"SIG")=^TMP("PSO",$J,STA,INDEX,"SIG") - Q - ; +MHVXRX ;WAS/GPM - Prescription extract ; [8/23/05 12:33am] + ;;1.0;My HealtheVet;;Aug 23, 2005 + ;;Per VHA Directive 2004-038, this routine should not be modified. + ; + Q + ; +PROFILE(QRY,ERR,DATAROOT) ; Entry point to get prescription profile + ; Retrieves requested prescripton data and returns it in DATAROOT + ; Retrieves all prescriptions with an active status + ; + ; Integration Agreements: + ; 3768 : AP2^PSOPRA,AP5^PSOPRA + ; 4687 : EN^PSOMHV1 + ; + ; Input: + ; QRY - Query array + ; QRY(DFN) - (required) Pointer to PATIENT (#2) file + ; DATAROOT - Root of array to hold extract data + ; + ; Output: + ; DATAROOT - Populated data array, includes # of hits + ; ERR - Errors during extraction + ; + N U,DT,HIT,DFN,PRI,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX + ; + D LOG^MHV7U("MHVXRX Profile","BEGIN","S",0) + S U="^",DT=$$DT^XLFDT + S ERR=0,HIT=0 + K @DATAROOT + K ^TMP("PSO",$J) + S DFN=$G(QRY("DFN")) + S PRI=$G(QRY("PRI")) + S FROM=DT + S TO="" + ; + D EN^PSOMHV1(DFN,FROM,TO) + ; + S STA="",INDEX="" + F STA="ACT","SUS" F S INDEX=$O(^TMP("PSO",$J,STA,INDEX)) Q:INDEX="" D SET + ; + K ^TMP("PSO",$J) + S @DATAROOT=HIT + D LOG^MHV7U("MHVXRX Profile HITS=",HIT,"S",0) + D LOG^MHV7U("MHVXRX Profile","END","S",0) + Q + ; +EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract prescription data + ; Retrieves requested prescripton data and returns it in DATAROOT + ; Retrieves all prescriptions of all statuses in given date range + ; Statuses of deleted are filtered by the pharmacy API. + ; + ; Integration Agreements: + ; 3768 : AP2^PSOPRA,AP5^PSOPRA + ; 4687 : EN3^PSOMHV1 + ; + ; Input: + ; QRY - Query array + ; QRY(DFN) - (required) Pointer to PATIENT (#2) file + ; QRY(FROM) - Date to start from + ; QRY(TO) - Date to go to + ; DATAROOT - Root of array to hold extract data + ; + ; Output: + ; DATAROOT - Populated data array, includes # of hits + ; ERR - Errors during extraction + ; + N U,DT,HIT,DFN,PRI,FROM,TO,STA,DRUG,DIV,MHVSTAT,RXN,MHVDATE,INDEX + ; + D LOG^MHV7U("MHVXRX Extract","BEGIN","S",0) + S U="^",DT=$$DT^XLFDT + S ERR=0,HIT=0 + K @DATAROOT + K ^TMP("PS",$J) + S DFN=$G(QRY("DFN")) + S PRI=$G(QRY("PRI")) + S FROM=$G(QRY("FROM")) + S TO=$G(QRY("TO")) + ; + I FROM="" S FROM=2000101 ;01/01/1900 + ; + ; The EN3^PSOMHV1 call uses RX IEN instead of DRUG as a + ; subscript in ^TMP("PSO",$J). This was a late breaking change to + ; PSOMHV1 to support historical extracts. + D EN3^PSOMHV1(DFN,FROM,TO) + ; + S STA="",INDEX="" + 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 + ; + K ^TMP("PSO",$J) + S @DATAROOT=HIT + D LOG^MHV7U("MHVXRX Extract HITS=",HIT,"S",0) + D LOG^MHV7U("MHVXRX Extract","END","S",0) + Q + ; +SET ; + ;INDEX will be RXIEN if called from EXTRACT + ;INDEX will be drug name if called from PROFILE + S RXN=$P($G(^TMP("PSO",$J,STA,INDEX,"RXN",0)),"^") + I RXN="" Q + I $D(QRY("RXLIST")) Q:'$D(QRY("RXLIST",RXN)) + S MHVSTAT=$$AP2^PSOPRA(DFN,RXN) + S MHVDATE=$P(MHVSTAT,"^",2) + S MHVSTAT=$P(MHVSTAT,"^",1) + I MHVSTAT>0 I $$AP5^PSOPRA(DFN,RXN) ;Clear RXN from queue + S DRUG=$P($G(^TMP("PSO",$J,STA,INDEX,0)),"^",1) ;Drug Name + S HIT=HIT+1 + S @DATAROOT@(HIT)=RXN_U_DRUG_U_MHVSTAT_U_MHVDATE + S @DATAROOT@(HIT,0)=$G(^TMP("PSO",$J,STA,INDEX,0)) + S @DATAROOT@(HIT,"P")=$G(^TMP("PSO",$J,STA,INDEX,"P",0)) + S @DATAROOT@(HIT,"RXN")=$G(^TMP("PSO",$J,STA,INDEX,"RXN",0)) + S @DATAROOT@(HIT,"DIV")=$G(^TMP("PSO",$J,STA,INDEX,"DIV",0)) + I '$D(^TMP("PSO",$J,STA,INDEX,"SIG")) S @DATAROOT@(HIT,"SIG",0)=0 + E M @DATAROOT@(HIT,"SIG")=^TMP("PSO",$J,STA,INDEX,"SIG") + Q + ; Index: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRXR.m =================================================================== --- WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRXR.m (revision 613) +++ WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHVXRXR.m (revision 623) @@ -1,44 +1,41 @@ -MHVXRXR ;WAS/GPM - Prescription refill request ; [12/12/07 11:38pm] - ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22 - ;;Per VHA Directive 2004-038, this routine should not be modified. - ; - Q - ; -REQUEST(QRY,ERR,DATAROOT) ; Entry point to request refills - ; Walks list of prescriptions calling a pharmacy api AP1^PSOPRA to - ; add the prescription to the internet refill request queue in the - ; PRESCRIPTION REFILL REQUEST file #52.43. The status of the api - ; call is returned in DATAROOT. - ; - ; Integration Agreements: - ; 3768 : AP1^PSOPRA - ; - ; Input: - ; QRY - Query array - ; QRY(DFN) - (required) Pointer to PATIENT (#2) file - ; DATAROOT - Root of array to hold extract data - ; - ; Output: - ; DATAROOT - Populated data array, includes # of hits - ; ERR - Errors during extraction - ; - N CNT,RX,PORDERN,ORDERTM,STATUS,DIV,DFN,U - ; - D LOG^MHVUL2("MHVXRXR","BEGIN","S","TRACE") - S U="^" - S ERR=0 - K @DATAROOT - S DFN=$G(QRY("DFN")) - ; - F CNT=1:1 Q:'$D(QRY("RX",CNT)) D - . S RX=$G(QRY("RX",CNT)) - . S PORDERN=$P(RX,"^",2) - . S ORDERTM=$P(RX,"^",3) - . S RX=$P(RX,"^") - . S STATUS=$$AP1^PSOPRA(DFN,RX) - . S @DATAROOT@(CNT)=RX_U_STATUS_U_PORDERN_U_ORDERTM - . Q - ; - S @DATAROOT=CNT-1 - D LOG^MHVUL2("MHVXRXR","END","S","TRACE") - Q +MHVXRXR ;WAS/GPM - Prescription refill request ; [8/23/05 12:34am] + ;;1.0;My HealtheVet;;Aug 23, 2005 + ;;Per VHA Directive 2004-038, this routine should not be modified. + ; + Q + ; +REQUEST(QRY,ERR,DATAROOT) ; Entry point to extract appointment data + ; Retrieves requested appointment data and returns it in DATAROOT + ; + ; Integration Agreements: + ; 3768 : AP1^PSOPRA + ; + ; Input: + ; QRY - Query array + ; QRY(DFN) - (required) Pointer to PATIENT (#2) file + ; DATAROOT - Root of array to hold extract data + ; + ; Output: + ; DATAROOT - Populated data array, includes # of hits + ; ERR - Errors during extraction + ; + N CNT,RX,PORDERN,ORDERTM,STATUS,DIV,DFN,U + ; + D LOG^MHV7U("MHVXRXR","BEGIN","S",0) + S U="^" + S ERR=0 + K @DATAROOT + S DFN=$G(QRY("DFN")) + ; + F CNT=1:1 Q:'$D(QRY("RX",CNT)) D + . S RX=$G(QRY("RX",CNT)) + . S PORDERN=$P(RX,"^",2) + . S ORDERTM=$P(RX,"^",3) + . S RX=$P(RX,"^") + . S STATUS=$$AP1^PSOPRA(DFN,RX) + . S @DATAROOT@(CNT)=RX_U_STATUS_U_PORDERN_U_ORDERTM + . Q + ; + S @DATAROOT=CNT-1 + D LOG^MHV7U("MHVXRXR","END","S",0) + Q