- ORCACT02 ;SLC/MKB-Validation dose conversion for POE
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
- ;
- DOSES(IFN) ; -- Convert outpt doses, if needed
- N ORIT,ORPSOI,ORDRUG,ORDOSE,CONJ,DOSE,ORP,ORI,ORX,UD,UNT,IDX,X,Y,DA,DIK,MATCH,DRUG,STR,MED
- S ORIT=+$$VALUE^ORX8(+IFN,"ORDERABLE"),ORDRUG=+$$VALUE^ORX8(+IFN,"DRUG")
- S ORPSOI=+$P($G(^ORD(101.43,ORIT,0)),U,2),DOSE=$$PTR^ORCD("OR GTX DOSE")
- D DOSE^PSSORUTL(.ORDOSE,ORPSOI,"O",+ORVP)
- S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
- F ORP="INSTR","MISC" S ORI=0 D ;setup ORX(instance,ID)=DA ^ value
- . F S ORI=$O(^OR(100,+IFN,4.5,"ID",ORP,ORI)) Q:ORI'>0 D
- .. S X=$G(^OR(100,+IFN,4.5,ORI,0)),ORX($P(X,U,3),ORP)=ORI_U_$G(^(1))
- ;
- D1 S ORI=0 F S ORI=$O(ORX(ORI)) Q:ORI'>0 D
- . S UD=$P($G(ORX(ORI,"INSTR")),U,2),UNT=$P($G(ORX(ORI,"MISC")),U,2)
- . S:UD="1/2" UD=.5 S:UD="1/3" UD=.33 S:UD="1/4" UD=.25 S:UD="3/4" UD=.75
- . S:UNT?1.U1"(S)" UNT=$P(UNT,"(")_$S(UD>1:"S",1:"") ;strip trailing (s)
- . K MATCH S MATCH=0,IDX="ORDOSE(0)"
- . F S IDX=$Q(@IDX) Q:IDX'?1"ORDOSE("1.N.",".N1")" D
- .. S Y=@IDX I $P(Y,U,3)?1"0."1.N,UD?1"."1.N S UD="0"_UD ;add leading 0 ;134
- .. S X=UD_$S('$L(UNT):"",$P(Y,U,3):U_UNT,1:" "_UNT) S X=$$UP^XLFSTR(X)
- .. I $P(Y,U,3,4)'=X,$P(Y,U,5)'=X Q ;no match
- .. I ORDRUG,$P(Y,U,6)'=ORDRUG Q ;diff disp drug - no match
- .. S MATCH=MATCH+1,MATCH(MATCH)=Y
- . ;save re-formatted instructions
- . I MATCH=1 D Q
- .. S Y=MATCH(1),X=$P(Y,U,5),DRUG=$G(ORDOSE("DD",+$P(Y,U,6)))
- .. S:'Y X=X_CONJ_" "_$S($P(DRUG,U,5):$TR($P(DRUG,U,5,6),"^"),1:$P(DRUG,U))
- .. S DA=+$G(ORX(ORI,"INSTR")) S:DA ^OR(100,+IFN,4.5,DA,1)=X
- .. S Y=$P(Y,U,1,6)_U_$P(DRUG,U,5,6),Y=$TR(Y,"^","&")
- .. S DA=+$G(ORX(ORI,"MISC")) Q:'DA K ^OR(100,+IFN,4.5,"ID","MISC",DA)
- .. S ^OR(100,+IFN,4.5,DA,0)="15^"_DOSE_U_ORI_"^DOSE",^(1)=Y
- .. S ^OR(100,+IFN,4.5,"ID","DOSE",DA)=""
- . S X=UD_$S($L(UNT):" "_UNT,1:""),Y=""
- . S DA=+$G(ORX(ORI,"INSTR")) S:DA ^OR(100,+IFN,4.5,DA,1)=X
- . S DA=+$G(ORX(ORI,"MISC")),DIK="^OR(100,"_+IFN_",4.5,",DA(1)=+IFN
- . D:DA ^DIK ;remove old units prompt
- D2 ; -- set STR or DRUGNAME, convert DAYS
- I ORDRUG D
- . S DRUG=$G(ORDOSE("DD",+ORDRUG)),STR=$P(DRUG,U,5)_$P(DRUG,U,6)
- . I STR'>0 D:'$G(ORDOSE(1)) ADD("DRUG NAME",18,$P(DRUG,U)) Q
- . S MED=$P($G(^ORD(101.43,+$G(ORIT),0)),U)
- . I MED'[STR D ADD("STRENGTH",7,STR)
- S ORI=+$O(^OR(100,+IFN,4.5,"ID","DAYS",0)),X=$G(^OR(100,+IFN,4.5,ORI,1))
- S:+X=X ^OR(100,+IFN,4.5,ORI,1)=+X_" DAYS"
- Q
- ;
- ADD(PRMT,DA,VAL) ; -- Add new value to Responses
- N HDR,TOT,I,ID,PTR
- S HDR=$G(^OR(100,+IFN,4.5,0)),TOT=+$P(HDR,U,4)+1
- S I=+$O(^OR(100,+IFN,4.5,"ID"),-1),I=I+1,$P(HDR,U,3,4)=I_U_TOT
- S PTR=+$$PTR^ORCD("OR GTX "_PRMT),ID=$P($G(^ORD(101.41,PTR,1)),U,3)
- S ^OR(100,+IFN,4.5,0)=HDR,^(I,0)=DA_U_PTR_"^1^"_ID,^(1)=VAL
- S:$L(ID) ^OR(100,+IFN,4.5,"ID",ID,I)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCACT02 2848 printed Feb 18, 2025@23:54:21 Page 2
- ORCACT02 ;SLC/MKB-Validation dose conversion for POE
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
- +2 ;
- DOSES(IFN) ; -- Convert outpt doses, if needed
- +1 NEW ORIT,ORPSOI,ORDRUG,ORDOSE,CONJ,DOSE,ORP,ORI,ORX,UD,UNT,IDX,X,Y,DA,DIK,MATCH,DRUG,STR,MED
- +2 SET ORIT=+$$VALUE^ORX8(+IFN,"ORDERABLE")
- SET ORDRUG=+$$VALUE^ORX8(+IFN,"DRUG")
- +3 SET ORPSOI=+$PIECE($GET(^ORD(101.43,ORIT,0)),U,2)
- SET DOSE=$$PTR^ORCD("OR GTX DOSE")
- +4 DO DOSE^PSSORUTL(.ORDOSE,ORPSOI,"O",+ORVP)
- +5 SET CONJ=$PIECE($GET(ORDOSE("MISC")),U,3)
- if $LENGTH(CONJ)
- SET CONJ=" "_CONJ
- +6 ;setup ORX(instance,ID)=DA ^ value
- FOR ORP="INSTR","MISC"
- SET ORI=0
- Begin DoDot:1
- +7 FOR
- SET ORI=$ORDER(^OR(100,+IFN,4.5,"ID",ORP,ORI))
- if ORI'>0
- QUIT
- Begin DoDot:2
- +8 SET X=$GET(^OR(100,+IFN,4.5,ORI,0))
- SET ORX($PIECE(X,U,3),ORP)=ORI_U_$GET(^(1))
- End DoDot:2
- End DoDot:1
- +9 ;
- D1 SET ORI=0
- FOR
- SET ORI=$ORDER(ORX(ORI))
- if ORI'>0
- QUIT
- Begin DoDot:1
- +1 SET UD=$PIECE($GET(ORX(ORI,"INSTR")),U,2)
- SET UNT=$PIECE($GET(ORX(ORI,"MISC")),U,2)
- +2 if UD="1/2"
- SET UD=.5
- if UD="1/3"
- SET UD=.33
- if UD="1/4"
- SET UD=.25
- if UD="3/4"
- SET UD=.75
- +3 ;strip trailing (s)
- if UNT?1.U1"(S)"
- SET UNT=$PIECE(UNT,"(")_$SELECT(UD>1:"S",1:"")
- +4 KILL MATCH
- SET MATCH=0
- SET IDX="ORDOSE(0)"
- +5 FOR
- SET IDX=$QUERY(@IDX)
- if IDX'?1"ORDOSE("1.N.",".N1")"
- QUIT
- Begin DoDot:2
- +6 ;add leading 0 ;134
- SET Y=@IDX
- IF $PIECE(Y,U,3)?1"0."1.N
- IF UD?1"."1.N
- SET UD="0"_UD
- +7 SET X=UD_$SELECT('$LENGTH(UNT):"",$PIECE(Y,U,3):U_UNT,1:" "_UNT)
- SET X=$$UP^XLFSTR(X)
- +8 ;no match
- IF $PIECE(Y,U,3,4)'=X
- IF $PIECE(Y,U,5)'=X
- QUIT
- +9 ;diff disp drug - no match
- IF ORDRUG
- IF $PIECE(Y,U,6)'=ORDRUG
- QUIT
- +10 SET MATCH=MATCH+1
- SET MATCH(MATCH)=Y
- End DoDot:2
- +11 ;save re-formatted instructions
- +12 IF MATCH=1
- Begin DoDot:2
- +13 SET Y=MATCH(1)
- SET X=$PIECE(Y,U,5)
- SET DRUG=$GET(ORDOSE("DD",+$PIECE(Y,U,6)))
- +14 if 'Y
- SET X=X_CONJ_" "_$SELECT($PIECE(DRUG,U,5):$TRANSLATE($PIECE(DRUG,U,5,6),"^"),1:$PIECE(DRUG,U))
- +15 SET DA=+$GET(ORX(ORI,"INSTR"))
- if DA
- SET ^OR(100,+IFN,4.5,DA,1)=X
- +16 SET Y=$PIECE(Y,U,1,6)_U_$PIECE(DRUG,U,5,6)
- SET Y=$TRANSLATE(Y,"^","&")
- +17 SET DA=+$GET(ORX(ORI,"MISC"))
- if 'DA
- QUIT
- KILL ^OR(100,+IFN,4.5,"ID","MISC",DA)
- +18 SET ^OR(100,+IFN,4.5,DA,0)="15^"_DOSE_U_ORI_"^DOSE"
- SET ^(1)=Y
- +19 SET ^OR(100,+IFN,4.5,"ID","DOSE",DA)=""
- End DoDot:2
- QUIT
- +20 SET X=UD_$SELECT($LENGTH(UNT):" "_UNT,1:"")
- SET Y=""
- +21 SET DA=+$GET(ORX(ORI,"INSTR"))
- if DA
- SET ^OR(100,+IFN,4.5,DA,1)=X
- +22 SET DA=+$GET(ORX(ORI,"MISC"))
- SET DIK="^OR(100,"_+IFN_",4.5,"
- SET DA(1)=+IFN
- +23 ;remove old units prompt
- if DA
- DO ^DIK
- End DoDot:1
- D2 ; -- set STR or DRUGNAME, convert DAYS
- +1 IF ORDRUG
- Begin DoDot:1
- +2 SET DRUG=$GET(ORDOSE("DD",+ORDRUG))
- SET STR=$PIECE(DRUG,U,5)_$PIECE(DRUG,U,6)
- +3 IF STR'>0
- if '$GET(ORDOSE(1))
- DO ADD("DRUG NAME",18,$PIECE(DRUG,U))
- QUIT
- +4 SET MED=$PIECE($GET(^ORD(101.43,+$GET(ORIT),0)),U)
- +5 IF MED'[STR
- DO ADD("STRENGTH",7,STR)
- End DoDot:1
- +6 SET ORI=+$ORDER(^OR(100,+IFN,4.5,"ID","DAYS",0))
- SET X=$GET(^OR(100,+IFN,4.5,ORI,1))
- +7 if +X=X
- SET ^OR(100,+IFN,4.5,ORI,1)=+X_" DAYS"
- +8 QUIT
- +9 ;
- ADD(PRMT,DA,VAL) ; -- Add new value to Responses
- +1 NEW HDR,TOT,I,ID,PTR
- +2 SET HDR=$GET(^OR(100,+IFN,4.5,0))
- SET TOT=+$PIECE(HDR,U,4)+1
- +3 SET I=+$ORDER(^OR(100,+IFN,4.5,"ID"),-1)
- SET I=I+1
- SET $PIECE(HDR,U,3,4)=I_U_TOT
- +4 SET PTR=+$$PTR^ORCD("OR GTX "_PRMT)
- SET ID=$PIECE($GET(^ORD(101.41,PTR,1)),U,3)
- +5 SET ^OR(100,+IFN,4.5,0)=HDR
- SET ^(I,0)=DA_U_PTR_"^1^"_ID
- SET ^(1)=VAL
- +6 if $LENGTH(ID)
- SET ^OR(100,+IFN,4.5,"ID",ID,I)=""
- +7 QUIT
