- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND1.m
r613 r623 1 ORCXPND1 ; SLC/MKB - Expanded Display cont ; 04/25/2007 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215,243**;Dec 17, 1997;Build 242 3 ; 4 ; External References 5 ; DBIA 2387 ^LAB(60 6 ; DBIA 3420 ^DPT( file #2 7 ; DBIA 10035 ^DPT( file #2 8 ; DBIA 10037 EN^DGRPD 9 ; DBIA 700 DIS^DGRPDB 10 ; DBIA 2926 RT^GMRCGUIA 11 ; DBIA 2925 DT^GMRCSLM2 ^TMP("GMRCR" 12 ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR" 13 ; DBIA 2951 EN1^LR7OSBR ^TMP("LRC" 14 ; DBIA 2952 EN^LR7OSMZ0 15 ; DBIA 2400 OEL^PSOORRL ^TMP("PS" 16 ; DBIA 2877 EN3^RAO7PC3 17 ; DBIA 2877 EN30^RAO7PC3 18 ; DBIA 1252 $$OUTPTPR^SDUTL3 19 ; DBIA 1252 $$OUTPTTM^SDUTL3 20 ; DBIA 2832 RPC^TIUSRV 21 ; DBIA 10061 DEM^VADPT 22 ; DBIA 10061 KVAR^VADPT 23 ; DBIA 10061 OAD^VADPT 24 ; DBIA 10103 $$FMTE^XLFDT 25 ; DBIA 4408 DISP^DGIBDSP 26 ; 27 COVER ; -- Cover Sheet 28 N PKG S PKG=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4) 29 D ALLERGY^ORCXPND2:PKG="GMRA",NOTES:PKG="TIU" 30 Q 31 NOTES ; -- Progress Notes 32 N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J) 33 D RPC^TIUSRV(.ORY,ID) 34 S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0)) 35 K @ORY 36 Q 37 PROBLEMS ; -- Problem List 38 D PL^ORCXPND4 39 Q 40 MEDS ; -- Pharmacy 41 ;N NODE,ORIFN 42 K ^TMP("PS",$J) 43 D OEL^PSOORRL(+ORVP,ID) ;S NODE=$G(^TMP("PS",$J,0)),ORIFN=+$P(NODE,U,11) 44 S ID=+$P($G(^TMP("PS",$J,0)),U,11) D ORDERS ;DBIA 2400 45 ;D @($S($P($G(^OR(100,ORIFN,0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)):"IV",1:"DRUG")_"^ORCXPND2") 46 K ^TMP("PS",$J) 47 Q 48 LABS ; -- Laboratory [RESULTS ONLY for ID=OE order #] 49 N ORIFN,X,SUB,TEST,NAME,SS,IDE,IVDT,TST,CCNT,ORCY,IG,TCNT 50 K ^TMP("LRRR",$J) ;DBIA 2503 51 I (ID?2.5U1" "2N1" "1.N1"-"7N1"."1.4N)!(ID?2.5U1" "2N1" "1.N1"-"7N) D AP^ORCXPND3 Q ;ID=Accession #-Date/time specimen taken 52 S ORIFN=+ID,IDE=$G(^OR(100,+ID,4)) Q:'$L(IDE) ; OE# -> Lab# 53 I +IDE D RR^LR7OR1(+ORVP,IDE) I '$D(^TMP("LRRR",$J,+ORVP)) S $P(IDE,";",1,3)=";;" ;Order possibly purged, reset to lookup on file 63 54 I '+IDE,$P(IDE,";",5) D RR^LR7OR1(+ORVP,,9999999-$P(IDE,";",5),9999999-$P(IDE,";",5),$P(IDE,";",4)) 55 K ORCY D TEXT^ORQ12(.ORCY,ORIFN,80) 56 S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S X=ORCY(IG) D ITEM^ORCXPND(X) 57 D BLANK^ORCXPND I '$D(^TMP("LRRR",$J,+ORVP)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q 58 M TEST=^TMP("LRRR",$J,+ORVP) S CCNT=0,SS="" 59 F S SS=$O(TEST(SS)) Q:SS="" S IVDT=0 F S IVDT=$O(TEST(SS,IVDT)) Q:'IVDT D 60 . I SS="BB" D 61 .. I $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q"),$L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface 62 ... K ^TMP("ORLRC",$J) 63 ... D EN^ORWLR1(DFN) 64 ... I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..." 65 ... N I S I=0 F S I=$O(^TMP("ORLRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X 66 ... K ^TMP("ORLRC",$J) 67 .. K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q ;DBIA 2951 68 ... N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X 69 ... K ^TMP("LRC",$J) 70 . I SS="MI" K ^TMP("LRC",$J) D EN^LR7OSMZ0(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q 71 .. N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X 72 .. K ^TMP("LRC",$J) 73 . I SS="CH" D Q 74 .. S (TCNT,TST)=0 F S TST=$O(TEST(SS,IVDT,TST)) Q:TST="" S CCNT=0,TCNT=TCNT+1 D 75 ... I TCNT=1 D 76 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Collection time: "_$$FMTE^XLFDT(9999999-IVDT,1) 77 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT," ")_$$S(3,CCNT,"Test Name")_$$S(29,CCNT,"Result")_$$S(39,CCNT,"Units")_$$S(55,CCNT,"Range") D:$D(IOUON) SETVIDEO^ORCXPND(LCNT,1,70,IOUON,IOUOFF) 78 ... I TST S X=TEST(SS,IVDT,TST),CCNT=0 I +X D 79 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT,$P(^LAB(60,+X,0),U))_$$S(26,CCNT,$J($P(X,U,2),7))_$$S(34,CCNT,$S($L($P(X,U,3)):$P(X,U,3),1:""))_$$S(39,CCNT,$P(X,U,4))_$$S(45,CCNT,$J($P(X,U,5),15)) 80 .... I $L($P(X,U,3)),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOINHI,IOINORM) 81 .... I $P(X,U,3)["*",$D(IOBON),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOBON_IOINHI,IOBOFF_IOINORM) 82 ... I TST="N" S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Comments: " D 83 .... N CMT S CMT=0 F S CMT=$O(TEST(SS,IVDT,"N",CMT)) Q:'CMT S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" "_TEST(SS,IVDT,"N",CMT) 84 K ^TMP("LRRR",$J) 85 Q 86 ; 87 DELAY ; -- Delayed Orders 88 NEW ; -- New Orders 89 ORDERS ; -- Orders 90 I '$G(ORESULTS) D ORDERS^ORCXPND2 Q 91 ; -- Results Display (Add more packages as available) 92 N PKG,TAB,ORIFN 93 S PKG=+$P($G(^OR(100,+ID,0)),"^",14),PKG=$$NMSP^ORCD(PKG) 94 S TAB=$S(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"") 95 I '$L(TAB)!(ID'>0) D Q ; no display available 96 . N ORY,I D TEXT^ORQ12(.ORY,+ID,80) 97 . S I=0 F S I=$O(ORY(I)) Q:I'>0 D ITEM^ORCXPND(ORY(I)) 98 . D BLANK^ORCXPND 99 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="There are no results to report." 100 I $O(^OR(100,+ID,2,0)) S ORIFN=+ID,ID=0 F S ID=$O(^OR(100,ORIFN,2,ID)) Q:ID<1 I $D(^OR(100,ID,0)) D @TAB 101 I '$O(^OR(100,+ID,2,0)) D @TAB 102 Q 103 REPORTS ; -- Patient Profiles 104 D EN^ORCXPNDR ; Reports 105 Q 106 CONSULTS ; -- Consults 107 N I,X,SUB,ORTX ;,VALMAR 108 I $G(ORTAB)="CONSULTS" S X=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4) 109 E D TEXT^ORQ12(.ORTX,+ID) S X=ORTX(1),ID=+$G(^OR(100,+ID,4)) ; OE->GMRC order# 110 D ITEM^ORCXPND(X),BLANK^ORCXPND 111 I ID'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q 112 I '$G(ORESULTS) D ;DT action 113 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Consult No.: "_ID 114 . N GMRCOER S GMRCOER=2 D DT^GMRCSLM2(ID) S SUB="DT" ;DBIA 2925 115 I $G(ORESULTS) D RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")") S SUB="RT" 116 S I=0 F S I=$O(^TMP("GMRCR",$J,SUB,I)) Q:I'>0 S X=$G(^(I,0)),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;DBIA 2925 117 K ^TMP("GMRCR",$J) 118 Q 119 XRAYS ; -- Radiology 120 I '$G(ORESULTS) S ID=+ORVP_U_$TR(ID,"-","^") D EN3^RAO7PC3(ID) 121 I $G(ORESULTS) S ID=+$G(^OR(100,+ID,4)) D EN30^RAO7PC3(ID) 122 N CASE,PROC,PSET S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET")) 123 S CASE=0 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D 124 . I PSET S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC) Q 125 . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND 126 I PSET S CASE=$O(^TMP($J,"RAE3",+ORVP,0)),PROC=$O(^(CASE,"")) D BLANK^ORCXPND,XRPT,BLANK^ORCXPND ;printset=list all procs, then one report 127 K ^TMP($J,"RAE3",+ORVP),^UTILITY($J,"W") 128 S VALM("RM")=81 129 Q 130 ; 131 XRPT ; -- Body of Report for CASE, PROC 132 N ORD,X,I 133 S ORD=$S($L($G(^TMP($J,"RAE3",+ORVP,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"") I $L(ORD),ORD'=PROC S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Proc Ord: "_ORD 134 S I=1 F S I=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC,I)) Q:I'>0 S X=^(I),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;Skip pt ID on line 1 135 Q 136 ; 137 SUMMRIES ; -- Discharge Summaries 138 N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J) 139 D RPC^TIUSRV(.ORY,ID) 140 S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0)) 141 K @ORY 142 Q 143 PTINQ ; Print Patient Inquiry in List Manager 144 N DFN,ORI,X 145 S DFN=+ORVP 146 D DGINQ(DFN) 147 S ORI=4,LCNT=0 148 F S ORI=$O(^TMP("ORDATA",$J,1,ORI)) Q:'ORI S X=^(ORI) D 149 . S LCNT=LCNT+1 150 . S ^TMP("ORXPND",$J,LCNT,0)=X 151 K ^TMP("ORDATA",$J,1) 152 Q 153 ; 154 DGINQ(DFN) ; Patient Inquiry 155 D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)") 156 Q 157 DGINQB(DFN) ; Build Patient Inquiry 158 N CONTACT,ORDOC,ORTEAM,ORVP,XQORNOD,ORSSTRT,ORSSTOPT,VAOA 159 S ORVP=DFN_";DPT(",XQORNOD=1 160 D EN^DGRPD ; MAS Patient Inquiry 161 ; 162 S ORDOC=$$OUTPTPR^SDUTL3(DFN) 163 S ORTEAM=$$OUTPTTM^SDUTL3(DFN) 164 I ORDOC!ORTEAM D 165 . W !!,"Primary Care Information:" 166 . I ORDOC W !,"Primary Practitioner: ",$P(ORDOC,"^",2) 167 . I ORTEAM W !,"Primary Care Team: ",$P(ORTEAM,"^",2) 168 W !!,"Health Insurance Information:" 169 D DISP^DGIBDSP ;DBIA #4408 170 W !!,"Service Connection/Rated Disabilities:" 171 D DIS^DGRPDB 172 F CONTACT="N","S" D 173 .S VAOA("A")=$S(CONTACT="N":"",1:3) 174 .D OAD^VADPT ; Get NOK Information 175 .I VAOA(9)]"" D 176 .. W !!,$S(CONTACT="N":"Next of Kin Information:",1:"Secondary Next of Kin Information:") 177 .. W !,"Name: ",VAOA(9) ; NOK Name 178 .. I VAOA(10)]"" W " (",VAOA(10),")" ; Relationship 179 .. I VAOA(1)]"" W !?7,VAOA(1) ; Address Line 1 180 .. I VAOA(2)]"" W !?7,VAOA(2) ; Line 2 181 .. I VAOA(3)]"" W !?7,VAOA(3) ; Line 3 182 .. I VAOA(4)]"" D 183 .. . W !?7,VAOA(4) ; City 184 .. . I VAOA(5)]"" W ", "_$P(VAOA(5),"^",2) ; State 185 .. . W " ",$P(VAOA(11),"^",2) ; Zip+4 186 .. I VAOA(8)]"" W !!?7,"Phone number: ",VAOA(8) ; Phone 187 .. I CONTACT="N",$P($G(^DPT(DFN,.21)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.21),U,11) 188 .. I CONTACT="S",$P($G(^DPT(DFN,.211)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.211),U,11) 189 D KVAR^VADPT 190 Q 191 TRIM(X) ; Trim Spaces 192 S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X)) 193 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1)) 194 Q X 195 S(X,Y,Z) ; Pad Over 196 ; X=Column # 197 ; Y=Current Length 198 ; Z=Text 199 ; SP=Text Sent 200 ; CCNT=Line Position After Input Text 201 I '$D(Z) Q "" 202 N SP S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z 203 S CCNT=$$INC(CCNT,SP) 204 Q SP 205 INC(X,Y) ; Character Position Count 206 ; X=Current Count 207 ; Y=Text 208 N INC S INC=X+$L(Y) 209 Q INC 1 ORCXPND1 ; SLC/MKB - Expanded Display cont ; 02/20/2003 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215**;Dec 17, 1997 3 ; 4 ; External References 5 ; DBIA 2387 ^LAB(60 6 ; DBIA 3420 ^DPT( file #2 7 ; DBIA 10035 ^DPT( file #2 8 ; DBIA 10037 EN^DGRPD 9 ; DBIA 700 DIS^DGRPDB 10 ; DBIA 2926 RT^GMRCGUIA 11 ; DBIA 2925 DT^GMRCSLM2 ^TMP("GMRCR" 12 ; DBIA 10146 DISP^IBCNS 13 ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR" 14 ; DBIA 2951 EN1^LR7OSBR ^TMP("LRC" 15 ; DBIA 2952 EN^LR7OSMZ0 16 ; DBIA 2400 OEL^PSOORRL ^TMP("PS" 17 ; DBIA 2877 EN3^RAO7PC3 18 ; DBIA 2877 EN30^RAO7PC3 19 ; DBIA 1252 $$OUTPTPR^SDUTL3 20 ; DBIA 1252 $$OUTPTTM^SDUTL3 21 ; DBIA 2832 RPC^TIUSRV 22 ; DBIA 10061 DEM^VADPT 23 ; DBIA 10061 KVAR^VADPT 24 ; DBIA 10061 OAD^VADPT 25 ; DBIA 10103 $$FMTE^XLFDT 26 ; DBIA 4408 DISP^DGIBDSP 27 ; 28 COVER ; -- Cover Sheet 29 N PKG S PKG=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4) 30 D ALLERGY^ORCXPND2:PKG="GMRA",NOTES:PKG="TIU" 31 Q 32 NOTES ; -- Progress Notes 33 N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J) 34 D RPC^TIUSRV(.ORY,ID) 35 S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0)) 36 K @ORY 37 Q 38 PROBLEMS ; -- Problem List 39 D PL^ORCXPND4 40 Q 41 MEDS ; -- Pharmacy 42 ;N NODE,ORIFN 43 D OEL^PSOORRL(+ORVP,ID) ;S NODE=$G(^TMP("PS",$J,0)),ORIFN=+$P(NODE,U,11) 44 S ID=+$P($G(^TMP("PS",$J,0)),U,11) D ORDERS ;DBIA 2400 45 ;D @($S($P($G(^OR(100,ORIFN,0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)):"IV",1:"DRUG")_"^ORCXPND2") 46 K ^TMP("PS",$J) 47 Q 48 LABS ; -- Laboratory [RESULTS ONLY for ID=OE order #] 49 N ORIFN,X,SUB,TEST,NAME,SS,IDE,IVDT,TST,CCNT,ORCY,IG,TCNT 50 K ^TMP("LRRR",$J) ;DBIA 2503 51 S ORIFN=+ID,IDE=$G(^OR(100,+ID,4)) Q:'$L(IDE) ; OE# -> Lab# 52 I +IDE D RR^LR7OR1(+ORVP,IDE) I '$D(^TMP("LRRR",$J,+ORVP)) S $P(IDE,";",1,3)=";;" ;Order possibly purged, reset to lookup on file 63 53 I '+IDE,$P(IDE,";",5) D RR^LR7OR1(+ORVP,,9999999-$P(IDE,";",5),9999999-$P(IDE,";",5),$P(IDE,";",4)) 54 K ORCY D TEXT^ORQ12(.ORCY,ORIFN,80) 55 S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S X=ORCY(IG) D ITEM^ORCXPND(X) 56 D BLANK^ORCXPND I '$D(^TMP("LRRR",$J,+ORVP)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q 57 M TEST=^TMP("LRRR",$J,+ORVP) S CCNT=0,SS="" 58 F S SS=$O(TEST(SS)) Q:SS="" S IVDT=0 F S IVDT=$O(TEST(SS,IVDT)) Q:'IVDT D 59 . I SS="BB" D 60 .. I $L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface 61 ... K ^TMP("ORLRC",$J) 62 ... D EN^ORWLR1(DFN) 63 ... I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..." 64 ... N I S I=0 F S I=$O(^TMP("ORLRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X 65 ... K ^TMP("ORLRC",$J) 66 .. K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q ;DBIA 2951 67 ... N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X 68 ... K ^TMP("LRC",$J) 69 . I SS="MI" K ^TMP("LRC",$J) D EN^LR7OSMZ0(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q 70 .. N I S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X 71 .. K ^TMP("LRC",$J) 72 . I SS="CH" D Q 73 .. S (TCNT,TST)=0 F S TST=$O(TEST(SS,IVDT,TST)) Q:TST="" S CCNT=0,TCNT=TCNT+1 D 74 ... I TCNT=1 D 75 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Collection time: "_$$FMTE^XLFDT(9999999-IVDT,1) 76 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT," ")_$$S(3,CCNT,"Test Name")_$$S(29,CCNT,"Result")_$$S(39,CCNT,"Units")_$$S(55,CCNT,"Range") D:$D(IOUON) SETVIDEO^ORCXPND(LCNT,1,70,IOUON,IOUOFF) 77 ... I TST S X=TEST(SS,IVDT,TST),CCNT=0 I +X D 78 .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$$S(1,CCNT,$P(^LAB(60,+X,0),U))_$$S(26,CCNT,$J($P(X,U,2),7))_$$S(34,CCNT,$S($L($P(X,U,3)):$P(X,U,3),1:""))_$$S(39,CCNT,$P(X,U,4))_$$S(45,CCNT,$J($P(X,U,5),15)) 79 .... I $L($P(X,U,3)),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOINHI,IOINORM) 80 .... I $P(X,U,3)["*",$D(IOBON),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOBON_IOINHI,IOBOFF_IOINORM) 81 ... I TST="N" S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Comments: " D 82 .... N CMT S CMT=0 F S CMT=$O(TEST(SS,IVDT,"N",CMT)) Q:'CMT S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" "_TEST(SS,IVDT,"N",CMT) 83 K ^TMP("LRRR",$J) 84 Q 85 ; 86 DELAY ; -- Delayed Orders 87 NEW ; -- New Orders 88 ORDERS ; -- Orders 89 I '$G(ORESULTS) D ORDERS^ORCXPND2 Q 90 ; -- Results Display (Add more packages as available) 91 N PKG,TAB,ORIFN 92 S PKG=+$P($G(^OR(100,+ID,0)),"^",14),PKG=$$NMSP^ORCD(PKG) 93 S TAB=$S(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"") 94 I '$L(TAB)!(ID'>0) D Q ; no display available 95 . N ORY,I D TEXT^ORQ12(.ORY,+ID,80) 96 . S I=0 F S I=$O(ORY(I)) Q:I'>0 D ITEM^ORCXPND(ORY(I)) 97 . D BLANK^ORCXPND 98 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="There are no results to report." 99 I $O(^OR(100,+ID,2,0)) S ORIFN=+ID,ID=0 F S ID=$O(^OR(100,ORIFN,2,ID)) Q:ID<1 I $D(^OR(100,ID,0)) D @TAB 100 I '$O(^OR(100,+ID,2,0)) D @TAB 101 Q 102 REPORTS ; -- Patient Profiles 103 D EN^ORCXPNDR ; Reports 104 Q 105 CONSULTS ; -- Consults 106 N I,X,SUB,ORTX ;,VALMAR 107 I $G(ORTAB)="CONSULTS" S X=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4) 108 E D TEXT^ORQ12(.ORTX,+ID) S X=ORTX(1),ID=+$G(^OR(100,+ID,4)) ; OE->GMRC order# 109 D ITEM^ORCXPND(X),BLANK^ORCXPND 110 I ID'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q 111 I '$G(ORESULTS) D ;DT action 112 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Consult No.: "_ID 113 . N GMRCOER S GMRCOER=2 D DT^GMRCSLM2(ID) S SUB="DT" ;DBIA 2925 114 I $G(ORESULTS) D RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")") S SUB="RT" 115 S I=0 F S I=$O(^TMP("GMRCR",$J,SUB,I)) Q:I'>0 S X=$G(^(I,0)),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;DBIA 2925 116 K ^TMP("GMRCR",$J) 117 Q 118 XRAYS ; -- Radiology 119 I '$G(ORESULTS) S ID=+ORVP_U_$TR(ID,"-","^") D EN3^RAO7PC3(ID) 120 I $G(ORESULTS) S ID=+$G(^OR(100,+ID,4)) D EN30^RAO7PC3(ID) 121 N CASE,PROC,PSET S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET")) 122 S CASE=0 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D 123 . I PSET S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC) Q 124 . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND 125 I PSET S CASE=$O(^TMP($J,"RAE3",+ORVP,0)),PROC=$O(^(CASE,"")) D BLANK^ORCXPND,XRPT,BLANK^ORCXPND ;printset=list all procs, then one report 126 K ^TMP($J,"RAE3",+ORVP),^UTILITY($J,"W") 127 S VALM("RM")=81 128 Q 129 ; 130 XRPT ; -- Body of Report for CASE, PROC 131 N ORD,X,I 132 S ORD=$S($L($G(^TMP($J,"RAE3",+ORVP,"ORD"))):^("ORD"),$L($G(^("ORD",CASE))):^(CASE),1:"") I $L(ORD),ORD'=PROC S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Proc Ord: "_ORD 133 S I=1 F S I=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC,I)) Q:I'>0 S X=^(I),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X ;Skip pt ID on line 1 134 Q 135 ; 136 SUMMRIES ; -- Discharge Summaries 137 N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J) 138 D RPC^TIUSRV(.ORY,ID) 139 S I=0 F S I=$O(@ORY@(I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$G(@ORY@(I,0)) 140 K @ORY 141 Q 142 PTINQ ; Print Patient Inquiry in List Manager 143 N DFN,ORI,X 144 S DFN=+ORVP 145 D DGINQ(DFN) 146 S ORI=4,LCNT=0 147 F S ORI=$O(^TMP("ORDATA",$J,1,ORI)) Q:'ORI S X=^(ORI) D 148 . S LCNT=LCNT+1 149 . S ^TMP("ORXPND",$J,LCNT,0)=X 150 K ^TMP("ORDATA",$J,1) 151 Q 152 ; 153 DGINQ(DFN) ; Patient Inquiry 154 D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)") 155 Q 156 DGINQB(DFN) ; Build Patient Inquiry 157 N ORDOC,ORTEAM,ORVP,XQORNOD,ORSSTRT,ORSSTOP,X,VAOA 158 S ORVP=DFN_";DPT(",XQORNOD=1 159 D EN^DGRPD ; MAS Patient Inquiry 160 ; 161 S ORDOC=$$OUTPTPR^SDUTL3(DFN) 162 S ORTEAM=$$OUTPTTM^SDUTL3(DFN) 163 I ORDOC!ORTEAM D 164 . W !!,"Primary Care Information:" 165 . I ORDOC W !,"Primary Practitioner: ",$P(ORDOC,"^",2) 166 . I ORTEAM W !,"Primary Care Team: ",$P(ORTEAM,"^",2) 167 W !!,"Health Insurance Information:" 168 I $L($T(DISP^DGIBDSP)) D DISP^DGIBDSP ;DBIA #4408 169 E D DISP^IBCNS 170 W !!,"Service Connection/Rated Disabilities:" 171 D DIS^DGRPDB 172 D OAD^VADPT ; Get NOK Information 173 I VAOA(9)]"" D 174 . W !!,"Next of Kin Information:" 175 . W !,"Name: ",VAOA(9) ; NOK Name 176 . I VAOA(10)]"" W " (",VAOA(10),")" ; Relationship 177 . I VAOA(1)]"" W !?7,VAOA(1) ; Address Line 1 178 . I VAOA(2)]"" W !?7,VAOA(2) ; Line 2 179 . I VAOA(3)]"" W !?7,VAOA(3) ; Line 3 180 . I VAOA(4)]"" D 181 . . W !?7,VAOA(4) ; City 182 . . I VAOA(5)]"" W ", "_$P(VAOA(5),"^",2) ; State 183 . . W " ",$P(VAOA(11),"^",2) ; Zip+4 184 . I VAOA(8)]"" W !!?7,"Phone number: ",VAOA(8) ; Phone 185 . I $P($G(^DPT(DFN,.21)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.21),U,11) 186 D KVAR^VADPT 187 Q 188 TRIM(X) ; Trim Spaces 189 S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X)) 190 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1)) 191 Q X 192 S(X,Y,Z) ; Pad Over 193 ; X=Column # 194 ; Y=Current Length 195 ; Z=Text 196 ; SP=Text Sent 197 ; CCNT=Line Position After Input Text 198 I '$D(Z) Q "" 199 N SP S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z 200 S CCNT=$$INC(CCNT,SP) 201 Q SP 202 INC(X,Y) ; Character Position Count 203 ; X=Current Count 204 ; Y=Text 205 N INC S INC=X+$L(Y) 206 Q INC
Note:
See TracChangeset
for help on using the changeset viewer.
