source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCHTAB4.m@ 776

Last change on this file since 776 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1ORCHTAB4 ;SLC/MKB,dcm-Add item to tab listing ;4/17/97 11:08
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997
3 ;
4LABS ; -- lab tests by section
5 N HDR,IDT,SEQ,TEST,CMMT,X,DATA,ORTX
6 Q:'$D(^TMP("LRRR",$J,+ORVP,SUB)) ; no data
7 S HDR=$S(SUB="MI":"MICROBIOLOGY",SUB="BB":"BLOOD BANK",SUB="AP":"ANATOMIC PATHOLOGY",1:"CHEMISTRY/HEMATOLOGY")
8 D BLANK^ORCHTAB:LCNT,SUBHDR^ORCHTAB(HDR)
9 S IDT=0 F S IDT=$O(^TMP("LRRR",$J,+ORVP,SUB,IDT)) Q:IDT'>0 D
10 . S SEQ=0 F S SEQ=$O(^TMP("LRRR",$J,+ORVP,SUB,IDT,SEQ)) Q:SEQ'>0 S TEST=^(SEQ) D
11 . . S X=9999999-IDT,X=$$DATETIME^ORCHTAB(X) ; MM/DD/YY or MM/DD HH:MM
12 . . S DATA=$$PAD^ORCHTAB(X,16)_$$PAD^ORCHTAB($P(TEST,U,16),15)_$P(TEST,U,6),X="" ;$P(TEST,U,17)
13 . . I SUB="MI" S X=$$PAD^ORCHTAB($P(TEST,U,15),10)_" "_$P(TEST,U,2)
14 . . 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)
15 . . I $L(X) D LINE^ORCHTAB,SETVIDEO^ORCHTAB(LCNT,24,2,IOINHI,IOINORM):SUB="CH"
16 . . I $L($P(TEST,U,5))>8 S X=$$REPEAT^XLFSTR(" ",32)_$E($P(TEST,U,5),9,16),DATA="" D LINE^ORCHTAB
17LR1 . I SEQ="N" D ; add comments
18 . . K ORTX,DATA S SEQ=0,ORTX=1,ORTX(1)="Comment: "
19 . . F S SEQ=$O(^TMP("LRRR",$J,+ORVP,SUB,IDT,"N",SEQ)) Q:SEQ'>0 S X=^(SEQ) D TXT^ORCHTAB
20 . . S SEQ=0 F S SEQ=$O(ORTX(SEQ)) Q:SEQ'>0 S X=ORTX(SEQ) D:$L(X) LINE^ORCHTAB
21 Q
22 ;
23LRCUM ; -- Lab cumulative report
24 N ORY D EN^LR7OSUM(.ORY,+ORVP,$G(BEG),$G(END))
25 S LCNT=$O(^TMP("LRC",$J,"?"),-1)
26 M:LCNT ^TMP("OR",$J,"LABS")=^TMP("LRC",$J) ; report
27 M:LCNT ^TMP("OR",$J,"LABS","HDR")=^TMP("LRH",$J) ; subhdrs
28 S ORTITLE="Lab Cumulative Display"
29 S ORCAPTN("ITEM")="",ORCAPTN("DATA")=""
30 S ORCHANGE="ORCHANGE LAB CUM",ORMENU="ORCHART LABS MENU"
31 K ^TMP("LRC",$J),^TMP("LRH",$J)
32 Q
33 ;
34XRAY ; -- radiology
35 N X,ID,DATE,STATUS,DATA,ORTX,ORIFN
36 S DATE=$$DATETIME^ORCHTAB(9999999.9999-$P(ORI,"-")),STATUS=$P(ORX,U,3)
37 S:$$UP^XLFSTR(STATUS)="RELEASED/NOT VERIFIED" STATUS="Rel/Not Ver"
38 S X=$P(ORX,U)_$S($P(ORX,U,4)="Y":" *ABNORMAL*",1:""),ORIFN=$P(ORX,U,2)
39 S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
40 S DATA(1)=$$PAD^ORCHTAB(DATE,16)_$J(ORIFN,4)_" "_STATUS,DATA=1
41 S ID=ORI D ADD^ORCHTAB
42 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)
43 Q
44 ;
45CSLT ; -- consult
46 N I,X,ID,DATA,ORIFN,ORTX S X=$P(ORX,U,7)
47 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
48 S ORIFN=X S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
49 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
50 D ADD^ORCHTAB I $L($P(ORX,U,6)) D ;Sig Findings indicator
51 . S I=+$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,2) Q:'I
52 . S $E(^TMP("OR",$J,ORTAB,I,0),5)="*"
53 Q
54 ;
55RPT ; -- reports
56 N ORJG,ID,DATA,ORIFN,I,X S ID=+ORVP
57 S ORJG="Health Summary^GMTSS" D BLD
58 S ORJG="Adhoc Health Summary^GMTSA" D BLD
59 S ORJG="Vitals Cumulative^GMRVC" D BLD
60 D BLANK^ORCHTAB,SUBHDR^ORCHTAB("Lab")
61 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
62 D BLANK^ORCHTAB,SUBHDR^ORCHTAB("Orders")
63 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
64 D BLANK^ORCHTAB,SUBHDR^ORCHTAB("Dietetics")
65 S ORJG="Dietetic Profile^FHP" D BLD
66 Q:$$FHWORADT^FHWORA(+ORVP)'>0
67 S I=0 F S I=$O(^TMP($J,"FHADT",+ORVP,I)) Q:I'>0 S X=$G(^(I)) D
68 . S ID=+ORVP_";"_X,DATA=1,DATA(1)=X
69 . S ORJG="Nutritional Assessment^FHA" D BLD
70 Q
71BLD ;
72 S ORTX=1,ORTX(1)=$P(ORJG,U),ORIFN=$P(ORJG,U,2)
73 D ADD^ORCHTAB
74 Q
Note: See TracBrowser for help on using the repository browser.