- 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 Feb 18, 2025@23:58:21 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