ORMBLDP1 ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;10/01/2009
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,280**;Dec 17, 1997;Build 85
;
ADDFRQCV(STR,PATH) ;
N RESULT
S RESULT=""
I PATH="O" D Q RESULT
.S STR=$$UP^XLFSTR(STR)
.I STR="1 BAG/DAY" S RESULT=1 Q
.I STR="ALL BAGS" S RESULT="A" Q
.I STR="SEE COMMENTS" S RESULT="S"
.I STR["in bag" S RESULT=$P(STR," ",3)
I PATH="I" D
.I STR=1 S RESULT="1 Bag/Day" Q
.I STR="A" S RESULT="All Bags" Q
.I STR="" Q
.S RESULT="in bag "_STR
Q RESULT
;
MOB(ORIEN,DFN) ;
N IVTYPE,NODE,NUM,TYPE
S IVTYPE=""
D MOB^PSBAPIPM(DFN,ORIEN)
S NODE=$G(^TMP("PSB",$J,0)) I NODE=-1 Q IVTYPE
S TYPE=$P(NODE,U,3)
S NUM=+$P(NODE,U,4)
I TYPE="A" S IVTYPE="C" Q IVTYPE
I TYPE="P" S IVTYPE="I" Q IVTYPE
I TYPE="S",NUM=0 S IVTYPE="C" Q IVTYPE
I TYPE="S",NUM=1 S IVTYPE="I" Q IVTYPE
Q IVTYPE
;
HL7IVLMT(STR) ;
N LEN,VAL,UNIT,IVLMT,TVAL
S (UNIT,IVLMT)="",VAL=0
I $E($$LOW^XLFSTR(STR))="f" D
. I STR["for a total of" D Q
. .S VAL=$P(STR," ",5)
. .S UNIT=$P(STR," ",6)
. S VAL=$P(STR," ",2)
. S UNIT=$E($P(STR," ",3))
I $E($$LOW^XLFSTR(STR))="w" D
. S TVAL=$P(STR," ",4) ;pull data in total example 0.5ml
. S VAL=+TVAL ;this will strip out leading zero and alpha 00.5L becomes .5 or 05.5 becomes 5.5
. S LEN=$F(TVAL,VAL) ;get length up to alphas or trailing zeros
. I $P(VAL,".")="" S VAL=0_VAL ;make sure decimal values have only one leading zero .5 becomes 0.5.
. F S UNIT=$E(TVAL,LEN) Q:((UNIT'=0)&(UNIT'=".")) D ;get first alpha m or l
. . S LEN=LEN+1
I $L(UNIT),$L(VAL) S IVLMT=$$LOW^XLFSTR(UNIT)_VAL
Q IVLMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMBLDP1 1644 printed Dec 13, 2024@02:31:48 Page 2
ORMBLDP1 ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;10/01/2009
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,280**;Dec 17, 1997;Build 85
+2 ;
ADDFRQCV(STR,PATH) ;
+1 NEW RESULT
+2 SET RESULT=""
+3 IF PATH="O"
Begin DoDot:1
+4 SET STR=$$UP^XLFSTR(STR)
+5 IF STR="1 BAG/DAY"
SET RESULT=1
QUIT
+6 IF STR="ALL BAGS"
SET RESULT="A"
QUIT
+7 IF STR="SEE COMMENTS"
SET RESULT="S"
+8 IF STR["in bag"
SET RESULT=$PIECE(STR," ",3)
End DoDot:1
QUIT RESULT
+9 IF PATH="I"
Begin DoDot:1
+10 IF STR=1
SET RESULT="1 Bag/Day"
QUIT
+11 IF STR="A"
SET RESULT="All Bags"
QUIT
+12 IF STR=""
QUIT
+13 SET RESULT="in bag "_STR
End DoDot:1
+14 QUIT RESULT
+15 ;
MOB(ORIEN,DFN) ;
+1 NEW IVTYPE,NODE,NUM,TYPE
+2 SET IVTYPE=""
+3 DO MOB^PSBAPIPM(DFN,ORIEN)
+4 SET NODE=$GET(^TMP("PSB",$JOB,0))
IF NODE=-1
QUIT IVTYPE
+5 SET TYPE=$PIECE(NODE,U,3)
+6 SET NUM=+$PIECE(NODE,U,4)
+7 IF TYPE="A"
SET IVTYPE="C"
QUIT IVTYPE
+8 IF TYPE="P"
SET IVTYPE="I"
QUIT IVTYPE
+9 IF TYPE="S"
IF NUM=0
SET IVTYPE="C"
QUIT IVTYPE
+10 IF TYPE="S"
IF NUM=1
SET IVTYPE="I"
QUIT IVTYPE
+11 QUIT IVTYPE
+12 ;
HL7IVLMT(STR) ;
+1 NEW LEN,VAL,UNIT,IVLMT,TVAL
+2 SET (UNIT,IVLMT)=""
SET VAL=0
+3 IF $EXTRACT($$LOW^XLFSTR(STR))="f"
Begin DoDot:1
+4 IF STR["for a total of"
Begin DoDot:2
+5 SET VAL=$PIECE(STR," ",5)
+6 SET UNIT=$PIECE(STR," ",6)
End DoDot:2
QUIT
+7 SET VAL=$PIECE(STR," ",2)
+8 SET UNIT=$EXTRACT($PIECE(STR," ",3))
End DoDot:1
+9 IF $EXTRACT($$LOW^XLFSTR(STR))="w"
Begin DoDot:1
+10 ;pull data in total example 0.5ml
SET TVAL=$PIECE(STR," ",4)
+11 ;this will strip out leading zero and alpha 00.5L becomes .5 or 05.5 becomes 5.5
SET VAL=+TVAL
+12 ;get length up to alphas or trailing zeros
SET LEN=$FIND(TVAL,VAL)
+13 ;make sure decimal values have only one leading zero .5 becomes 0.5.
IF $PIECE(VAL,".")=""
SET VAL=0_VAL
+14 ;get first alpha m or l
FOR
SET UNIT=$EXTRACT(TVAL,LEN)
if ((UNIT'=0)&(UNIT'="."))
QUIT
Begin DoDot:2
+15 SET LEN=LEN+1
End DoDot:2
End DoDot:1
+16 IF $LENGTH(UNIT)
IF $LENGTH(VAL)
SET IVLMT=$$LOW^XLFSTR(UNIT)_VAL
+17 QUIT IVLMT
