PSSHLU ;BIR/RLW-UTILITIES USED IN BUILDING HL7 SEGMENTS ;11/14/96
;;1.0;PHARMACY DATA MANAGEMENT;**38,124,132**;9/30/97;Build 1
;
INIT ; set up HL7 application variables
;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
S PSJI=1
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
S PSJCLEAR="F J=0:1:LIMIT S FIELD(J)="""""
Q
;
SEGMENT(LIMIT) ;
N SUBSEG,SEGLENGT S SUBSEG=0,SEGMENT(SUBSEG)="" F J=0:1:LIMIT D
.I SEGMENT(SUBSEG)']"" S SEGMENT(SUBSEG)=FIELD(J) Q
.S SEGLENGT=$L(SEGMENT(SUBSEG))+$L(FIELD(J))
.I SEGLENGT<245 S SEGMENT(SUBSEG)=SEGMENT(SUBSEG)_"|"_FIELD(J) Q
.I $L(SEGMENT(SUBSEG))=245 S SUBSEG=SUBSEG+1,SEGMENT(SUBSEG)="|"_FIELD(J) Q
.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)
S PSJI=PSJI+1,^TMP("HLS",$J,"PS",PSJI)=SEGMENT(0)
F J=1:1 Q:'$D(SEGMENT(J)) S ^TMP("HLS",$J,"PS",PSJI,J)=SEGMENT(J)
Q
;
CALL(HLEVN) ; call DHCP HL7 package -or- protocol, to pass Orders
; HLEVN = number of segments in message
;D EN^HLTRANS W:$D(HLERR) !!?7,"***ERROR IN CREATING HL7 MAIL MESSAGE***"
S MSG="^TMP(""HLS"",$J,""PS"")"
D MSG^XQOR("PS EVSEND OR",.MSG)
Q
;
MF(HLEVN) ; call DHCP HL7 -or- protocol, to pass Master File transactions
; HLEVN = number of segments in message
;D EN^HLTRANS W:$D(HLERR) !!?7,"***ERROR IN CREATING HL7 MAIL MESSAGE***"
S MSG="^TMP(""HLS"",$J,""PS"")"
D MSG^XQOR("PS MFSEND OR",.MSG)
Q
;
SCH(HLEVN) ; call to pass Schedule file to OE/RR
S MSG="^TMP(""HLS"",$J,""PS"")"
D MSG^XQOR("PS EVSEND SCH",.MSG)
Q
;
USAGE(POI) ;
N USAGE,PSSDDINX,I F I="O","I","B","A","V" S USAGE(I)=0
I $P($G(^PS(50.7,POI,0)),"^",3) G IVFLAG
S I="" F PSSDDINX=0:0 S PSSDDINX=$O(^PS(50.7,"A50",POI,PSSDDINX)) Q:'PSSDDINX D
.I '$P($G(^PSDRUG(PSSDDINX,"I")),"^")!(+$P($G(^("I")),"^")>DT) D
..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
.N PSSOAD,PSSOSD
.F PSSOAD=0:0 S PSSOAD=$O(^PSDRUG("A526",PSSDDINX,PSSOAD)) Q:'PSSOAD D
..Q:$P($G(^PS(52.6,PSSOAD,"I")),"^")&(+$P($G(^PS(52.6,PSSOAD,"I")),"^")'>DT)
..S USAGE("I")=USAGE("I")+1,USAGE("V")=USAGE("V")+1
..I $P($G(^PS(52.6,PSSOAD,0)),"^",13) S USAGE("A")=USAGE("A")+1
.F PSSOSD=0:0 S PSSOSD=$O(^PSDRUG("A527",PSSDDINX,PSSOSD)) Q:'PSSOSD D
..Q:$P($G(^PS(52.7,PSSOSD,"I")),"^")&(+$P($G(^PS(52.7,PSSOSD,"I")),"^")'>DT)
..S USAGE("I")=USAGE("I")+1,USAGE("V")=USAGE("V")+1
..I $P($G(^PS(52.7,PSSOSD,0)),"^",13) S USAGE("B")=USAGE("B")+1
IVFLAG ;
S USAGE="" F I="O","I","B","A","V" S USAGE=USAGE_I_USAGE(I)
Q USAGE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHLU 2838 printed Apr 09, 2024@21:32:38 Page 2
PSSHLU ;BIR/RLW-UTILITIES USED IN BUILDING HL7 SEGMENTS ;11/14/96
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38,124,132**;9/30/97;Build 1
+2 ;
INIT ; set up HL7 application variables
+1 ;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
+2 SET PSJI=1
+3 SET PSSHINST=$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),"^",17),99)),"^")
SET ^TMP("HLS",$JOB,"PS",PSJI)="MSH|^~\&|PHARMACY|"_$GET(PSSHINST)_"|||||MFN"
KILL PSSHINST
+4 SET PSJCLEAR="F J=0:1:LIMIT S FIELD(J)="""""
+5 QUIT
+6 ;
SEGMENT(LIMIT) ;
+1 NEW SUBSEG,SEGLENGT
SET SUBSEG=0
SET SEGMENT(SUBSEG)=""
FOR J=0:1:LIMIT
Begin DoDot:1
+2 IF SEGMENT(SUBSEG)']""
SET SEGMENT(SUBSEG)=FIELD(J)
QUIT
+3 SET SEGLENGT=$LENGTH(SEGMENT(SUBSEG))+$LENGTH(FIELD(J))
+4 IF SEGLENGT<245
SET SEGMENT(SUBSEG)=SEGMENT(SUBSEG)_"|"_FIELD(J)
QUIT
+5 IF $LENGTH(SEGMENT(SUBSEG))=245
SET SUBSEG=SUBSEG+1
SET SEGMENT(SUBSEG)="|"_FIELD(J)
QUIT
+6 SET SEGMENT(SUBSEG)=SEGMENT(SUBSEG)_"|"_$EXTRACT(FIELD(J),1,244-$LENGTH(SEGMENT(SUBSEG)))
SET SUBSEG=SUBSEG+1
SET SEGMENT(SUBSEG)=$EXTRACT(FIELD(J),SEGLENGT-245,SEGLENGT+1)
End DoDot:1
+7 SET PSJI=PSJI+1
SET ^TMP("HLS",$JOB,"PS",PSJI)=SEGMENT(0)
+8 FOR J=1:1
if '$DATA(SEGMENT(J))
QUIT
SET ^TMP("HLS",$JOB,"PS",PSJI,J)=SEGMENT(J)
+9 QUIT
+10 ;
CALL(HLEVN) ; call DHCP HL7 package -or- protocol, to pass Orders
+1 ; HLEVN = number of segments in message
+2 ;D EN^HLTRANS W:$D(HLERR) !!?7,"***ERROR IN CREATING HL7 MAIL MESSAGE***"
+3 SET MSG="^TMP(""HLS"",$J,""PS"")"
+4 DO MSG^XQOR("PS EVSEND OR",.MSG)
+5 QUIT
+6 ;
MF(HLEVN) ; call DHCP HL7 -or- protocol, to pass Master File transactions
+1 ; HLEVN = number of segments in message
+2 ;D EN^HLTRANS W:$D(HLERR) !!?7,"***ERROR IN CREATING HL7 MAIL MESSAGE***"
+3 SET MSG="^TMP(""HLS"",$J,""PS"")"
+4 DO MSG^XQOR("PS MFSEND OR",.MSG)
+5 QUIT
+6 ;
SCH(HLEVN) ; call to pass Schedule file to OE/RR
+1 SET MSG="^TMP(""HLS"",$J,""PS"")"
+2 DO MSG^XQOR("PS EVSEND SCH",.MSG)
+3 QUIT
+4 ;
USAGE(POI) ;
+1 NEW USAGE,PSSDDINX,I
FOR I="O","I","B","A","V"
SET USAGE(I)=0
+2 IF $PIECE($GET(^PS(50.7,POI,0)),"^",3)
GOTO IVFLAG
+3 SET I=""
FOR PSSDDINX=0:0
SET PSSDDINX=$ORDER(^PS(50.7,"A50",POI,PSSDDINX))
if 'PSSDDINX
QUIT
Begin DoDot:1
+4 IF '$PIECE($GET(^PSDRUG(PSSDDINX,"I")),"^")!(+$PIECE($GET(^("I")),"^")>DT)
Begin DoDot:2
+5 SET USAGE=$PIECE($GET(^PSDRUG(PSSDDINX,2)),"^",3)
SET USAGE=$TRANSLATE(USAGE,"U","I")
FOR I="O","I"
if USAGE[I
SET USAGE(I)=USAGE(I)+1
End DoDot:2
+6 NEW PSSOAD,PSSOSD
+7 FOR PSSOAD=0:0
SET PSSOAD=$ORDER(^PSDRUG("A526",PSSDDINX,PSSOAD))
if 'PSSOAD
QUIT
Begin DoDot:2
+8 if $PIECE($GET(^PS(52.6,PSSOAD,"I")),"^")&(+$PIECE($GET(^PS(52.6,PSSOAD,"I")),"^")'>DT)
QUIT
+9 SET USAGE("I")=USAGE("I")+1
SET USAGE("V")=USAGE("V")+1
+10 IF $PIECE($GET(^PS(52.6,PSSOAD,0)),"^",13)
SET USAGE("A")=USAGE("A")+1
End DoDot:2
+11 FOR PSSOSD=0:0
SET PSSOSD=$ORDER(^PSDRUG("A527",PSSDDINX,PSSOSD))
if 'PSSOSD
QUIT
Begin DoDot:2
+12 if $PIECE($GET(^PS(52.7,PSSOSD,"I")),"^")&(+$PIECE($GET(^PS(52.7,PSSOSD,"I")),"^")'>DT)
QUIT
+13 SET USAGE("I")=USAGE("I")+1
SET USAGE("V")=USAGE("V")+1
+14 IF $PIECE($GET(^PS(52.7,PSSOSD,0)),"^",13)
SET USAGE("B")=USAGE("B")+1
End DoDot:2
End DoDot:1
IVFLAG ;
+1 SET USAGE=""
FOR I="O","I","B","A","V"
SET USAGE=USAGE_I_USAGE(I)
+2 QUIT USAGE
