Routine: ORCHTAB4

ORCHTAB4 ;SLC/MKB,dcm-Add item to tab listing ;4/17/97  11:08

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997

LABS ; -- lab tests by section

 N HDR,IDT,SEQ,TEST,CMMT,X,DATA,ORTX

 Q:'$D(^TMP("LRRR",$J,+ORVP,SUB))  ; no data

 S HDR=$S(SUB="MI":"MICROBIOLOGY",SUB="BB":"BLOOD BANK",SUB="AP":"ANATOMIC PATHOLOGY",1:"CHEMISTRY/HEMATOLOGY")

 D BLANK^ORCHTAB:LCNT,SUBHDR^ORCHTAB(HDR)

 S IDT=0 F  S IDT=$O(^TMP("LRRR",$J,+ORVP,SUB,IDT)) Q:IDT'>0  D

 . S SEQ=0 F  S SEQ=$O(^TMP("LRRR",$J,+ORVP,SUB,IDT,SEQ)) Q:SEQ'>0  S TEST=^(SEQ) D

 . . S X=9999999-IDT,X=$$DATETIME^ORCHTAB(X) ; MM/DD/YY or MM/DD HH:MM

 . . S DATA=$$PAD^ORCHTAB(X,16)_$$PAD^ORCHTAB($P(TEST,U,16),15)_$P(TEST,U,6),X="" ;$P(TEST,U,17)

 . . I SUB="MI" S X=$$PAD^ORCHTAB($P(TEST,U,15),10)_" "_$P(TEST,U,2)

 . . I SUB="CH" S X=$$PAD^ORCHTAB($P(TEST,U,15),7)_" "_$J($P(TEST,U,2),9)_" "_$$PAD^ORCHTAB($P(TEST,U,3),2)_" "_$$PAD^ORCHTAB($P(TEST,U,4),10)_" "_$E($P(TEST,U,5),1,8)

 . . I $L(X) D LINE^ORCHTAB,SETVIDEO^ORCHTAB(LCNT,24,2,IOINHI,IOINORM):SUB="CH"

 . . I $L($P(TEST,U,5))>8 S X=$$REPEAT^XLFSTR(" ",32)_$E($P(TEST,U,5),9,16),DATA="" D LINE^ORCHTAB

LR1 . I SEQ="N" D  ; add comments

 . . K ORTX,DATA S SEQ=0,ORTX=1,ORTX(1)="Comment: "

 . . F  S SEQ=$O(^TMP("LRRR",$J,+ORVP,SUB,IDT,"N",SEQ)) Q:SEQ'>0  S X=^(SEQ) D TXT^ORCHTAB

 . . S SEQ=0 F  S SEQ=$O(ORTX(SEQ)) Q:SEQ'>0  S X=ORTX(SEQ) D:$L(X) LINE^ORCHTAB

LRCUM ; -- Lab cumulative report

 N ORY D EN^LR7OSUM(.ORY,+ORVP,$G(BEG),$G(END))

 S LCNT=$O(^TMP("LRC",$J,"?"),-1)

 M:LCNT ^TMP("OR",$J,"LABS")=^TMP("LRC",$J) ; report

 M:LCNT ^TMP("OR",$J,"LABS","HDR")=^TMP("LRH",$J) ; subhdrs

 S ORTITLE="Lab Cumulative Display"

 S ORCAPTN("ITEM")="",ORCAPTN("DATA")=""

 S ORCHANGE="ORCHANGE LAB CUM",ORMENU="ORCHART LABS MENU"

 K ^TMP("LRC",$J),^TMP("LRH",$J)

XRAY ; -- radiology

 N X,ID,DATE,STATUS,DATA,ORTX,ORIFN

 S DATE=$$DATETIME^ORCHTAB(9999999.9999-$P(ORI,"-")),STATUS=$P(ORX,U,3)

 S:$$UP^XLFSTR(STATUS)="RELEASED/NOT VERIFIED" STATUS="Rel/Not Ver"

 S X=$P(ORX,U)_$S($P(ORX,U,4)="Y":" *ABNORMAL*",1:""),ORIFN=$P(ORX,U,2)

 S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB

 S DATA(1)=$$PAD^ORCHTAB(DATE,16)_$J(ORIFN,4)_"  "_STATUS,DATA=1

 S ID=ORI D ADD^ORCHTAB

 I $P(ORX,U,4)="Y" S I=$F(^TMP("OR",$J,ORTAB,LCNT,0),"*ABNORMAL*") D:I SETVIDEO^ORCHTAB(LCNT,I-10,10,IOINHI,IOINORM)

CSLT ; -- consult

 N I,X,ID,DATA,ORIFN,ORTX S X=$P(ORX,U,7)

 I X'?.E1" Cons",X'?.E1" Proc" S I=$P(ORX,U,5) S:I="Consult"&'$L($P(ORX,U,7)) X=$P(ORX,U,4)_" Consult" S:I'="Consult" X=I ;old format

 S ORIFN=X S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB

 S ID=$P(ORX,U),DATA(1)=$$PAD^ORCHTAB($$DATE^ORCHTAB($P(ORX,U,2)),10)_$J(ID,6)_"  "_$$LOW^XLFSTR($P(ORX,U,3)),DATA=1

 D ADD^ORCHTAB I $L($P(ORX,U,6)) D  ;Sig Findings indicator

 . S I=+$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,2) Q:'I

 . S $E(^TMP("OR",$J,ORTAB,I,0),5)="*"

RPT ; -- reports

 N ORJG,ID,DATA,ORIFN,I,X S ID=+ORVP

 S ORJG="Health Summary^GMTSS" D BLD

 S ORJG="Adhoc Health Summary^GMTSA" D BLD

 S ORJG="Vitals Cumulative^GMRVC" D BLD

 D BLANK^ORCHTAB,SUBHDR^ORCHTAB("Lab")

 F ORJG="Lab Cumulative^LRC","Lab Results by Day^LRI","Lab Results by Test^LRGEN","Lab Test Status^STAT","Lab Graph^LRG","Blood Bank Report^LRB","Anatomic Path Report^LRAA" D BLD

 D BLANK^ORCHTAB,SUBHDR^ORCHTAB("Orders")

 F ORJG="Daily Order Summary^ORS","Order Summary for Date Range^ORD","Custom Order Summary^ORC","Chart Copy Summary^ORP","Outpatient RX Profile^PSO" D BLD

 D BLANK^ORCHTAB,SUBHDR^ORCHTAB("Dietetics")

 S ORJG="Dietetic Profile^FHP" D BLD

 Q:$$FHWORADT^FHWORA(+ORVP)'>0

 S I=0 F  S I=$O(^TMP($J,"FHADT",+ORVP,I)) Q:I'>0  S X=$G(^(I)) D

 . S ID=+ORVP_";"_X,DATA=1,DATA(1)=X

 . S ORJG="Nutritional Assessment^FHA" D BLD

BLD ;

 S ORTX=1,ORTX(1)=$P(ORJG,U),ORIFN=$P(ORJG,U,2)

 D ADD^ORCHTAB

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHTAB4   3869     printed  Mar 13, 2025@21:33:26                                                                                                                                                                                                    Page 2

ORCHTAB4  ;SLC/MKB,dcm-Add item to tab listing ;4/17/97  11:08

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997

 +2       ;

LABS      ; -- lab tests by section

 +1        NEW HDR,IDT,SEQ,TEST,CMMT,X,DATA,ORTX

 +2       ; no data

           if '$DATA(^TMP("LRRR",$JOB,+ORVP,SUB))

               QUIT

 +3        SET HDR=$SELECT(SUB="MI":"MICROBIOLOGY",SUB="BB":"BLOOD BANK",SUB="AP":"ANATOMIC PATHOLOGY",1:"CHEMISTRY/HEMATOLOGY")

 +4        if LCNT

               DO BLANK^ORCHTAB

           DO SUBHDR^ORCHTAB(HDR)

 +5        SET IDT=0

FOR

               SET IDT=$ORDER(^TMP("LRRR",$JOB,+ORVP,SUB,IDT))

               if IDT'>0

                   QUIT

               Begin DoDot:1

 +6                SET SEQ=0

FOR

                       SET SEQ=$ORDER(^TMP("LRRR",$JOB,+ORVP,SUB,IDT,SEQ))

                       if SEQ'>0

                           QUIT

                       SET TEST=^(SEQ)

                       Begin DoDot:2

 +7       ; MM/DD/YY or MM/DD HH:MM

                           SET X=9999999-IDT

                           SET X=$$DATETIME^ORCHTAB(X)

 +8       ;$P(TEST,U,17)

                           SET DATA=$$PAD^ORCHTAB(X,16)_$$PAD^ORCHTAB($PIECE(TEST,U,16),15)_$PIECE(TEST,U,6)

                           SET X=""

 +9                        IF SUB="MI"

                               SET X=$$PAD^ORCHTAB($PIECE(TEST,U,15),10)_" "_$PIECE(TEST,U,2)

 +10                       IF SUB="CH"

                               SET X=$$PAD^ORCHTAB($PIECE(TEST,U,15),7)_" "_$JUSTIFY($PIECE(TEST,U,2),9)_" "_$$PAD^ORCHTAB($PIECE(TEST,U,3),2)_" "_$$PAD^ORCHTAB($PIECE(TEST,U,4),10)_" "_$EXTRACT($PIECE(TEST,U,5),1,8)

 +11                       IF $LENGTH(X)

                               DO LINE^ORCHTAB

                               if SUB="CH"

                                   DO SETVIDEO^ORCHTAB(LCNT,24,2,IOINHI,IOINORM)

 +12                       IF $LENGTH($PIECE(TEST,U,5))>8

                               SET X=$$REPEAT^XLFSTR(" ",32)_$EXTRACT($PIECE(TEST,U,5),9,16)

                               SET DATA=""

                               DO LINE^ORCHTAB

                       End DoDot:2

LR1       ; add comments

                   IF SEQ="N"

                       Begin DoDot:2

 +1                        KILL ORTX,DATA

                           SET SEQ=0

                           SET ORTX=1

                           SET ORTX(1)="Comment: "

 +2                        FOR

                               SET SEQ=$ORDER(^TMP("LRRR",$JOB,+ORVP,SUB,IDT,"N",SEQ))

                               if SEQ'>0

                                   QUIT

                               SET X=^(SEQ)

                               DO TXT^ORCHTAB

 +3                        SET SEQ=0

FOR

                               SET SEQ=$ORDER(ORTX(SEQ))

                               if SEQ'>0

                                   QUIT

                               SET X=ORTX(SEQ)

                               if $LENGTH(X)

                                   DO LINE^ORCHTAB

                       End DoDot:2

               End DoDot:1

 +4        QUIT

 +5       ;

LRCUM     ; -- Lab cumulative report

 +1        NEW ORY

           DO EN^LR7OSUM(.ORY,+ORVP,$GET(BEG),$GET(END))

 +2        SET LCNT=$ORDER(^TMP("LRC",$JOB,"?"),-1)

 +3       ; report

           if LCNT

               MERGE ^TMP("OR",$JOB,"LABS")=^TMP("LRC",$JOB)

 +4       ; subhdrs

           if LCNT

               MERGE ^TMP("OR",$JOB,"LABS","HDR")=^TMP("LRH",$JOB)

 +5        SET ORTITLE="Lab Cumulative Display"

 +6        SET ORCAPTN("ITEM")=""

           SET ORCAPTN("DATA")=""

 +7        SET ORCHANGE="ORCHANGE LAB CUM"

           SET ORMENU="ORCHART LABS MENU"

 +8        KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB)

 +9        QUIT

 +10      ;

XRAY      ; -- radiology

 +1        NEW X,ID,DATE,STATUS,DATA,ORTX,ORIFN

 +2        SET DATE=$$DATETIME^ORCHTAB(9999999.9999-$PIECE(ORI,"-"))

           SET STATUS=$PIECE(ORX,U,3)

 +3        if $$UP^XLFSTR(STATUS)="RELEASED/NOT VERIFIED"

               SET STATUS="Rel/Not Ver"

 +4        SET X=$PIECE(ORX,U)_$SELECT($PIECE(ORX,U,4)="Y":" *ABNORMAL*",1:"")

           SET ORIFN=$PIECE(ORX,U,2)

 +5        if $LENGTH(X)'>ORMAX

               SET ORTX=1

               SET ORTX(1)=X

           IF $LENGTH(X)>ORMAX

               DO TXT^ORCHTAB

 +6        SET DATA(1)=$$PAD^ORCHTAB(DATE,16)_$JUSTIFY(ORIFN,4)_"  "_STATUS

           SET DATA=1

 +7        SET ID=ORI

           DO ADD^ORCHTAB

 +8        IF $PIECE(ORX,U,4)="Y"

               SET I=$FIND(^TMP("OR",$JOB,ORTAB,LCNT,0),"*ABNORMAL*")

               if I

                   DO SETVIDEO^ORCHTAB(LCNT,I-10,10,IOINHI,IOINORM)

 +9        QUIT

 +10      ;

CSLT      ; -- consult

 +1        NEW I,X,ID,DATA,ORIFN,ORTX

           SET X=$PIECE(ORX,U,7)

 +2       ;old format

           IF X'?.E1" Cons"

               IF X'?.E1" Proc"

                   SET I=$PIECE(ORX,U,5)

                   if I="Consult"&'$LENGTH($PIECE(ORX,U,7))

                       SET X=$PIECE(ORX,U,4)_" Consult"

                   if I'="Consult"

                       SET X=I

 +3        SET ORIFN=X

           if $LENGTH(X)'>ORMAX

               SET ORTX=1

               SET ORTX(1)=X

           IF $LENGTH(X)>ORMAX

               DO TXT^ORCHTAB

 +4        SET ID=$PIECE(ORX,U)

           SET DATA(1)=$$PAD^ORCHTAB($$DATE^ORCHTAB($PIECE(ORX,U,2)),10)_$JUSTIFY(ID,6)_"  "_$$LOW^XLFSTR($PIECE(ORX,U,3))

           SET DATA=1

 +5       ;Sig Findings indicator

           DO ADD^ORCHTAB

           IF $LENGTH($PIECE(ORX,U,6))

               Begin DoDot:1

 +6                SET I=+$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",NUM)),U,2)

                   if 'I

                       QUIT

 +7                SET $EXTRACT(^TMP("OR",$JOB,ORTAB,I,0),5)="*"

               End DoDot:1

 +8        QUIT

 +9       ;

RPT       ; -- reports

 +1        NEW ORJG,ID,DATA,ORIFN,I,X

           SET ID=+ORVP

 +2        SET ORJG="Health Summary^GMTSS"

           DO BLD

 +3        SET ORJG="Adhoc Health Summary^GMTSA"

           DO BLD

 +4        SET ORJG="Vitals Cumulative^GMRVC"

           DO BLD

 +5        DO BLANK^ORCHTAB

           DO SUBHDR^ORCHTAB("Lab")

 +6        FOR ORJG="Lab Cumulative^LRC","Lab Results by Day^LRI","Lab Results by Test^LRGEN","Lab Test Status^STAT","Lab Graph^LRG","Blood Bank Report^LRB","Anatomic Path Report^LRAA"

               DO BLD

 +7        DO BLANK^ORCHTAB

           DO SUBHDR^ORCHTAB("Orders")

 +8        FOR ORJG="Daily Order Summary^ORS","Order Summary for Date Range^ORD","Custom Order Summary^ORC","Chart Copy Summary^ORP","Outpatient RX Profile^PSO"

               DO BLD

 +9        DO BLANK^ORCHTAB

           DO SUBHDR^ORCHTAB("Dietetics")

 +10       SET ORJG="Dietetic Profile^FHP"

           DO BLD

 +11       if $$FHWORADT^FHWORA(+ORVP)'>0

               QUIT

 +12       SET I=0

FOR

               SET I=$ORDER(^TMP($JOB,"FHADT",+ORVP,I))

               if I'>0

                   QUIT

               SET X=$GET(^(I))

               Begin DoDot:1

 +13               SET ID=+ORVP_";"_X

                   SET DATA=1

                   SET DATA(1)=X

 +14               SET ORJG="Nutritional Assessment^FHA"

                   DO BLD

               End DoDot:1

 +15       QUIT

BLD       ;

 +1        SET ORTX=1

           SET ORTX(1)=$PIECE(ORJG,U)

           SET ORIFN=$PIECE(ORJG,U,2)

 +2        DO ADD^ORCHTAB

 +3        QUIT

ORCHTAB4.m