| 1 | PSSHLU ;BIR/RLW-UTILITIES USED IN BUILDING HL7 SEGMENTS ;11/14/96
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**38,124,132**;9/30/97;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | INIT ; set up HL7 application variables
|
|---|
| 5 | ;I '$D(HLNDAP) S HLNDAP=0,HLNDAP=$O(^HL(770,"B","OE/RR",HLNDAP)),HLSDT="PS" D INIT^HLTRANS I $D(HLERR) W !!?7,"THE HL7 INITIALIZATION FAILED",!! Q
|
|---|
| 6 | S PSJI=1
|
|---|
| 7 | S PSSHINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^") S ^TMP("HLS",$J,"PS",PSJI)="MSH|^~\&|PHARMACY|"_$G(PSSHINST)_"|||||MFN" K PSSHINST
|
|---|
| 8 | S PSJCLEAR="F J=0:1:LIMIT S FIELD(J)="""""
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | SEGMENT(LIMIT) ;
|
|---|
| 12 | N SUBSEG,SEGLENGT S SUBSEG=0,SEGMENT(SUBSEG)="" F J=0:1:LIMIT D
|
|---|
| 13 | .I SEGMENT(SUBSEG)']"" S SEGMENT(SUBSEG)=FIELD(J) Q
|
|---|
| 14 | .S SEGLENGT=$L(SEGMENT(SUBSEG))+$L(FIELD(J))
|
|---|
| 15 | .I SEGLENGT<245 S SEGMENT(SUBSEG)=SEGMENT(SUBSEG)_"|"_FIELD(J) Q
|
|---|
| 16 | .I $L(SEGMENT(SUBSEG))=245 S SUBSEG=SUBSEG+1,SEGMENT(SUBSEG)="|"_FIELD(J) Q
|
|---|
| 17 | .S SEGMENT(SUBSEG)=SEGMENT(SUBSEG)_"|"_$E(FIELD(J),1,244-$L(SEGMENT(SUBSEG))),SUBSEG=SUBSEG+1,SEGMENT(SUBSEG)=$E(FIELD(J),SEGLENGT-245,SEGLENGT+1)
|
|---|
| 18 | S PSJI=PSJI+1,^TMP("HLS",$J,"PS",PSJI)=SEGMENT(0)
|
|---|
| 19 | F J=1:1 Q:'$D(SEGMENT(J)) S ^TMP("HLS",$J,"PS",PSJI,J)=SEGMENT(J)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | CALL(HLEVN) ; call DHCP HL7 package -or- protocol, to pass Orders
|
|---|
| 23 | ; HLEVN = number of segments in message
|
|---|
| 24 | ;D EN^HLTRANS W:$D(HLERR) !!?7,"***ERROR IN CREATING HL7 MAIL MESSAGE***"
|
|---|
| 25 | S MSG="^TMP(""HLS"",$J,""PS"")"
|
|---|
| 26 | D MSG^XQOR("PS EVSEND OR",.MSG)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | MF(HLEVN) ; call DHCP HL7 -or- protocol, to pass Master File transactions
|
|---|
| 30 | ; HLEVN = number of segments in message
|
|---|
| 31 | ;D EN^HLTRANS W:$D(HLERR) !!?7,"***ERROR IN CREATING HL7 MAIL MESSAGE***"
|
|---|
| 32 | S MSG="^TMP(""HLS"",$J,""PS"")"
|
|---|
| 33 | D MSG^XQOR("PS MFSEND OR",.MSG)
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | SCH(HLEVN) ; call to pass Schedule file to OE/RR
|
|---|
| 37 | S MSG="^TMP(""HLS"",$J,""PS"")"
|
|---|
| 38 | D MSG^XQOR("PS EVSEND SCH",.MSG)
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | USAGE(POI) ;
|
|---|
| 42 | N USAGE,PSSDDINX,I F I="O","I","B","A","V" S USAGE(I)=0
|
|---|
| 43 | I $P($G(^PS(50.7,POI,0)),"^",3) G IVFLAG
|
|---|
| 44 | S I="" F PSSDDINX=0:0 S PSSDDINX=$O(^PS(50.7,"A50",POI,PSSDDINX)) Q:'PSSDDINX D
|
|---|
| 45 | .I '$P($G(^PSDRUG(PSSDDINX,"I")),"^")!(+$P($G(^("I")),"^")>DT) D
|
|---|
| 46 | ..S USAGE=$P($G(^PSDRUG(PSSDDINX,2)),"^",3),USAGE=$TR(USAGE,"U","I") F I="O","I" S:USAGE[I USAGE(I)=USAGE(I)+1
|
|---|
| 47 | .N PSSOAD,PSSOSD
|
|---|
| 48 | .F PSSOAD=0:0 S PSSOAD=$O(^PSDRUG("A526",PSSDDINX,PSSOAD)) Q:'PSSOAD D
|
|---|
| 49 | ..Q:$P($G(^PS(52.6,PSSOAD,"I")),"^")&(+$P($G(^PS(52.6,PSSOAD,"I")),"^")'>DT)
|
|---|
| 50 | ..S USAGE("I")=USAGE("I")+1,USAGE("V")=USAGE("V")+1
|
|---|
| 51 | ..I $P($G(^PS(52.6,PSSOAD,0)),"^",13) S USAGE("A")=USAGE("A")+1
|
|---|
| 52 | .F PSSOSD=0:0 S PSSOSD=$O(^PSDRUG("A527",PSSDDINX,PSSOSD)) Q:'PSSOSD D
|
|---|
| 53 | ..Q:$P($G(^PS(52.7,PSSOSD,"I")),"^")&(+$P($G(^PS(52.7,PSSOSD,"I")),"^")'>DT)
|
|---|
| 54 | ..S USAGE("I")=USAGE("I")+1,USAGE("V")=USAGE("V")+1
|
|---|
| 55 | ..I $P($G(^PS(52.7,PSSOSD,0)),"^",13) S USAGE("B")=USAGE("B")+1
|
|---|
| 56 | IVFLAG ;
|
|---|
| 57 | S USAGE="" F I="O","I","B","A","V" S USAGE=USAGE_I_USAGE(I)
|
|---|
| 58 | Q USAGE
|
|---|
