ORWDPLM2.m

ORWDPLM2 ;PBM/RMS - OBJECT FOR DRUG-SPECIFIC LAB RESULTS ; 19 Apr 2017  10:37 AM

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;***420,454***;;Build 13

SL(DFN,ORQO,TARGET) ;

 N ORDDLG,ORGTX,ORSEQ,ORIEN

 N OR50,OR507,ORLNODE,ORRSLT,ORCRCL,FOUND,ILST,REFRANGE

 Q:'+DFN ""

 Q:ORQO']"" ""

 S ORDDLG=$O(^ORD(101.41,"B",ORQO,0)) Q:'+ORDDLG ""

 K @TARGET

 I '$$GET^XPAR("ALL","OR CPRS LAB DISPLAY ENABLED") Q " "

 S ILST=0

 S ORGTX=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))

 S ORSEQ=$O(^ORD(101.41,ORDDLG,6,"D",+ORGTX,0)) Q:'+ORSEQ ""

 S ORIEN=$G(^ORD(101.41,ORDDLG,6,ORSEQ,1)) Q:'+ORIEN ""

 S OR507=+$P($G(^ORD(101.43,ORIEN,0)),U,2) Q:'+OR507 ""

 S OR50=0 F  S OR50=$O(^PSDRUG("ASP",OR507,OR50)) Q:'+OR50!($G(FOUND))  D

 . S ORLNODE=$G(^PSDRUG(OR50,"CLOZ")) Q:'+ORLNODE

 . I +ORLNODE,$$SCRTEST^ORWDPLM1(+ORLNODE) S ORRSLT=$$GETSCR^ORWDPLM1(DFN) S ILST=ILST+1,@TARGET@(ILST,0)="LAST "_$$GET1^DIQ(60,+ORLNODE,.01)_": "_$P(ORRSLT,U)

 . I +ORLNODE,'$$SCRTEST^ORWDPLM1(+ORLNODE) S ORRSLT=$$GETLAB^ORWDPLM1(DFN,+ORLNODE,+$P(ORLNODE,U,3),$P(ORLNODE,U,2)) S ILST=ILST+1,@TARGET@(ILST,0)="LAST "_$$GET1^DIQ(60,+ORLNODE,.01)_":"_$P(ORRSLT,U)

 . I +$P(ORRSLT,U,2) S @TARGET@(ILST,0)=@TARGET@(ILST,0)_" "_$P(ORRSLT,U,4)_" ("_$$FMTE^XLFDT($P(ORRSLT,U,2))_")"

 . I $P(ORRSLT,U,5)]"" S ILST=ILST+1,@TARGET@(ILST,0)="REFERENCE RANGE: "_$P(ORRSLT,U,5)_" "_$P(ORRSLT,U,4)

 . I +$P(ORRSLT,U,2) I $$SCRTEST^ORWDPLM1(+ORLNODE) S ORCRCL=$$CRCL^PSOORUT2(DFN) I +$P(ORCRCL,U,2) S ILST=ILST+1,@TARGET@(ILST,0)="Estimated Creatinine Clearance: "_$P(ORCRCL,U,2)_" mL/min"

 . S FOUND=1

 I '$D(FOUND) Q ""

 Q "~@"_$NA(@TARGET)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORWDPLM2   1612     printed  Apr 09, 2024@21:38:34                                                                                                                                                                                                    Page 2

ORWDPLM2  ;PBM/RMS - OBJECT FOR DRUG-SPECIFIC LAB RESULTS ; 19 Apr 2017  10:37 AM

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;***420,454***;;Build 13

SL(DFN,ORQO,TARGET) ;

 +1        NEW ORDDLG,ORGTX,ORSEQ,ORIEN

 +2        NEW OR50,OR507,ORLNODE,ORRSLT,ORCRCL,FOUND,ILST,REFRANGE

 +3        if '+DFN

               QUIT ""

 +4        if ORQO']""

               QUIT ""

 +5        SET ORDDLG=$ORDER(^ORD(101.41,"B",ORQO,0))

           if '+ORDDLG

               QUIT ""

 +6        KILL @TARGET

 +7        IF '$$GET^XPAR("ALL","OR CPRS LAB DISPLAY ENABLED")

               QUIT " "

 +8        SET ILST=0

 +9        SET ORGTX=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))

 +10       SET ORSEQ=$ORDER(^ORD(101.41,ORDDLG,6,"D",+ORGTX,0))

           if '+ORSEQ

               QUIT ""

 +11       SET ORIEN=$GET(^ORD(101.41,ORDDLG,6,ORSEQ,1))

           if '+ORIEN

               QUIT ""

 +12       SET OR507=+$PIECE($GET(^ORD(101.43,ORIEN,0)),U,2)

           if '+OR507

               QUIT ""

 +13       SET OR50=0

           FOR 

               SET OR50=$ORDER(^PSDRUG("ASP",OR507,OR50))

               if '+OR50!($GET(FOUND))

                   QUIT 

               Begin DoDot:1

 +14               SET ORLNODE=$GET(^PSDRUG(OR50,"CLOZ"))

                   if '+ORLNODE

                       QUIT 

 +15               IF +ORLNODE

                       IF $$SCRTEST^ORWDPLM1(+ORLNODE)

                           SET ORRSLT=$$GETSCR^ORWDPLM1(DFN)

                           SET ILST=ILST+1

                           SET @TARGET@(ILST,0)="LAST "_$$GET1^DIQ(60,+ORLNODE,.01)_": "_$PIECE(ORRSLT,U)

 +16               IF +ORLNODE

                       IF '$$SCRTEST^ORWDPLM1(+ORLNODE)

                           SET ORRSLT=$$GETLAB^ORWDPLM1(DFN,+ORLNODE,+$PIECE(ORLNODE,U,3),$PIECE(ORLNODE,U,2))

                           SET ILST=ILST+1

                           SET @TARGET@(ILST,0)="LAST "_$$GET1^DIQ(60,+ORLNODE,.01)_":"_$PIECE(ORRSLT,U)

 +17               IF +$PIECE(ORRSLT,U,2)

                       SET @TARGET@(ILST,0)=@TARGET@(ILST,0)_" "_$PIECE(ORRSLT,U,4)_" ("_$$FMTE^XLFDT($PIECE(ORRSLT,U,2))_")"

 +18               IF $PIECE(ORRSLT,U,5)]""

                       SET ILST=ILST+1

                       SET @TARGET@(ILST,0)="REFERENCE RANGE: "_$PIECE(ORRSLT,U,5)_" "_$PIECE(ORRSLT,U,4)

 +19               IF +$PIECE(ORRSLT,U,2)

                       IF $$SCRTEST^ORWDPLM1(+ORLNODE)

                           SET ORCRCL=$$CRCL^PSOORUT2(DFN)

                           IF +$PIECE(ORCRCL,U,2)

                               SET ILST=ILST+1

                               SET @TARGET@(ILST,0)="Estimated Creatinine Clearance: "_$PIECE(ORCRCL,U,2)_" mL/min"

 +20               SET FOUND=1

               End DoDot:1

 +21       IF '$DATA(FOUND)

               QUIT ""

 +22       QUIT "~@"_$NAME(@TARGET)