- 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 Mar 13, 2025@21:36:15 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
