source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCHTAB2.m@ 861

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1ORCHTAB2 ;SLC/MKB/REV-Add item to tab listing cont ;03/11/03 14:01
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,58,181**;Dec 17, 1997
3GMRA ; -- allergies
4 N ORY,ORI,ALLG,SEV,ID,SIGNS,J,ORIFN,DATA,X,ORTX
5 D SUBHDR^ORCHTAB("Allergies/Adverse Reactions")
6 D EN1^GMRAOR1(+ORVP,"ORY")
7 I '$G(ORY) S X=$S($G(ORY)="":"No assessment available",1:"No known allergies") D LINE^ORCHTAB Q
8 S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D
9 . S ALLG=$P(ORY(ORI),U),SEV=$P(ORY(ORI),U,2),ID=$P(ORY(ORI),U,3)
10 . S X=$S($L(SEV):$$LOWER^VALM1(SEV)_" reaction to ",1:"")_ALLG
11 . S SIGNS="",J=0 F S J=$O(ORY(ORI,"S",J)) Q:J'>0 S SIGNS=SIGNS_$S($L(SIGNS):", ",1:"")_$$LOW^XLFSTR(ORY(ORI,"S",J))
12 . S:$L(SIGNS) X=X_" ("_SIGNS_")"
13 . S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
14 . S DATA(1)=$$DATE^ORCHTAB($P(^GMR(120.8,ID,0),U,4)),DATA=1,ORIFN="GMRA"
15 . D ADD^ORCHTAB
16 Q
17 ;
18GMRV ; -- Vitals
19 N ORY,ORI,X,Y,DATA
20 D SUBHDR^ORCHTAB("Recent Vitals"),FASTVIT^ORQQVI(.ORY,+ORVP)
21 I '$O(ORY(0)) S X="No data available" D LINE^ORCHTAB Q
22 S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D
23 . S Y=$P(ORY(ORI),U,5)_" "_$P(ORY(ORI),U,6) S:$L(Y)'>1 Y=$P(ORY(ORI),U,3)
24 . S X=$P(ORY(ORI),U,2),X=$S(X="BP":"B/P: ",X="HT":"Ht: ",X="P":"Pulse: ",X="R":"Resp: ",X="T":"Temp: ",X="WT":"Wt: ",X="PN":"Pain: ",1:$$LJ^XLFSTR(X_":",7))_Y
25 . S DATA=$$DATETIME^ORCHTAB($P(ORY(ORI),U,4))
26 . D LINE^ORCHTAB
27 Q
28 ;
29IMM ; -- Immunizations
30 N ORIMM,ORIDT,ORI,X,Y,DATA K ^TMP("PXI",$J)
31 D SUBHDR^ORCHTAB("Recent Immunizations"),IMMUN^PXRHS03(+ORVP)
32 S ORIMM=0 F S ORIMM=$O(^TMP("PXI",$J,ORIMM)) Q:ORIMM="" D
33 . S ORIDT=$O(^TMP("PXI",$J,ORIMM,0)),ORI=$O(^(ORIDT,0)),Y=$G(^(ORI,0))
34 . S X=ORIMM_$S($L($P(Y,U,6)):" ("_$P(Y,U,6)_")",1:"")
35 . S DATA=$S('ORI:"",1:$$DATETIME^ORCHTAB($P(Y,U,3)))
36 . D LINE^ORCHTAB
37 Q
38 ;
39SC ; -- Service Connected data
40 N DFN,VAEL,VASV,VAERR,X,DATA
41 S DFN=+ORVP D 7^VADPT,SUBHDR^ORCHTAB("Eligibility")
42 I VAEL(3) S X="Service Connected "_$P(VAEL(3),U,2)_"%"
43 E S X="Not Service Connected"
44 D LINE^ORCHTAB
45 I VASV(2) S X="Agent Orange Exposure" D LINE^ORCHTAB
46 I VASV(3) S X="Radiation Exposure" D LINE^ORCHTAB
47 I $P($G(^DPT(+ORVP,.322)),U,10) S X="Environmental Contaminants exposure" D LINE^ORCHTAB
48 Q
49 ;
50CWAD ; -- postings
51 N ORI,ORX,MSG,CNT,X,ID,DATA,ORIFN,ORTX K ^TMP("TIUPPCV",$J)
52 D SUBHDR^ORCHTAB("Patient Postings")
53 D ENCOVER^TIUPP3(+ORVP)
54 S CNT=0,ORIFN="TIU"
55 S ORI=0 F S ORI=$O(^TMP("TIUPPCV",$J,ORI)) Q:ORI'>0 S ORX=$G(^(ORI)) D
56 . S ID=$P(ORX,U) Q:'$L(ID)
57 . S X=$P(ORX,U,3),DATA(1)=$$DATETIME^ORCHTAB($P(ORX,U,5)),DATA=1
58 . S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
59 . D ADD^ORCHTAB S CNT=CNT+1
60 I 'CNT S LCNT=LCNT+1,^TMP("OR",$J,ORTAB,LCNT,0)=" "_$$PAD^ORCHTAB("<None>",40)_"|"
61 K ^TMP("TIUPPCV",$J)
62 Q
63 ;
64PROB ; -- problem
65 N ID,DATA,X,ORTX,FIRST,ORJ,ORIFN
66 S ID=$P(ORX,U),ORIFN=$P(ORX,U,2) ;problem ptr, status
67 ;I $E(ORX,1,3)=" " S X=ORX D TXT^ORCHTAB Q ;comment line only ??
68 S X=$P(ORX,U,3)_$S($L($P(ORX,U,4)):" ("_$P(ORX,U,4)_")",1:"")
69 S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
70 S DATA(1)=$$PAD^ORCHTAB($$DATE^ORCHTAB($P(ORX,U,5)),10)_$$PAD^ORCHTAB($$DATE^ORCHTAB($P(ORX,U,6)),10)_$S($P(ORX,U,2)="I":"inactive",1:"active "_$P(ORX,U,9)),DATA=1
71 I COMM,$O(ORY(ORI,0)) S ORJ=0 F S ORJ=$O(ORY(ORI,ORJ)) Q:ORJ'>0 S X=" "_ORY(ORI,ORJ) I $L(X)>1 S ORTX=ORTX+1,ORTX(ORTX)="" D TXT^ORCHTAB ;add comments
72 S FIRST=LCNT+1 D ADD^ORCHTAB
73 I $L($P(ORX,U,10)) S $E(^TMP("OR",$J,ORTAB,FIRST,0),5)=$P(ORX,U,10) ; unverified flag ($)
74 ; CSV change - check for active code, for active problem list only
75 ; Inactive code flag (#) takes precedence and replaces unverified flag ($)
76 I $P(ORX,U,2)="A",'$$CODESTS^GMPLX(ID,DT) S $E(^TMP("OR",$J,ORTAB,FIRST,0),5)="#"
77 Q
78 ;
79NOTE ; -- progress note
80 N ID,DATA,X,ORTX
81 S DATA(1)=$$PAD^ORCHTAB($$DATETIME^ORCHTAB($P(ORX,U,3)),16)_$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(+$P(ORX,U,5)),12)_$E($P(ORX,U,7),1,5),DATA=1
82 S ID=$P(ORX,U),X=$P(ORX,U,2)
83 S:$L(X)'>ORMAX ORTX=1,ORTX(1)=X I $L(X)>ORMAX D TXT^ORCHTAB
84 I SUBJ,$L($P(ORX,U,12)) S X=" "_$P(ORX,U,12),ORTX=ORTX+1,ORTX(ORTX)="" D TXT^ORCHTAB ;add note subject
85 D ADD^ORCHTAB
86 Q
87 ;
88SUMM ; -- discharge summary
89 N ID,DATA,ORTX
90 S DATA(1)=$$DATE^ORCHTAB($P(ORX,U,3))_" "_$$PAD^ORCHTAB($$LNAMEF^ORCHTAB(+$P(ORX,U,5)),15)_$E($P(ORX,U,7),1,5)_$P($P(ORX,U,8)," ",2)_" "_$P($P(ORX,U,9)," ",2)
91 S ID=$P(ORX,U),ORTX=1,ORTX(1)=$P(ORX,U,2),DATA=1
92 D ADD^ORCHTAB
93 Q
94 ;
95INITIALS(USER) ; -- Return initials of USER
96 N X,Y S X=$G(^VA(200,+$G(USER),0)),Y=$P(X,U,2)
97 S:'$L(Y) Y=" x "
98 Q Y
Note: See TracBrowser for help on using the repository browser.