- ORCXPND1 ; SLC/MKB - Expanded Display cont ; 04/25/2007
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215,243**;Dec 17, 1997;Build 242
- ;
- ; External References
- ; DBIA 2387 ^LAB(60
- ; DBIA 3420 ^DPT( file #2
- ; DBIA 10035 ^DPT( file #2
- ; DBIA 10037 EN^DGRPD
- ; DBIA 700 DIS^DGRPDB
- ; DBIA 2926 RT^GMRCGUIA
- ; DBIA 2925 DT^GMRCSLM2 ^TMP("GMRCR"
- ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR"
- ; DBIA 2951 EN1^LR7OSBR ^TMP("LRC"
- ; DBIA 2952 EN^LR7OSMZ0
- ; DBIA 2400 OEL^PSOORRL ^TMP("PS"
- ; DBIA 2877 EN3^RAO7PC3
- ; DBIA 2877 EN30^RAO7PC3
- ; DBIA 1252 $$OUTPTPR^SDUTL3
- ; DBIA 1252 $$OUTPTTM^SDUTL3
- ; DBIA 2832 RPC^TIUSRV
- ; DBIA 10061 DEM^VADPT
- ; DBIA 10061 KVAR^VADPT
- ; DBIA 10061 OAD^VADPT
- ; DBIA 10103 $$FMTE^XLFDT
- ; DBIA 4408 DISP^DGIBDSP
- ;
- COVER ; -- Cover Sheet
- N PKG S PKG=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
- D ALLERGY^ORCXPND2:PKG="GMRA",NOTES:PKG="TIU"
- Q
- NOTES ; -- Progress Notes
- N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
- D RPC^TIUSRV(.ORY,ID)
- 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))
- K @ORY
- Q
- PROBLEMS ; -- Problem List
- D PL^ORCXPND4
- Q
- MEDS ; -- Pharmacy
- ;N NODE,ORIFN
- K ^TMP("PS",$J)
- D OEL^PSOORRL(+ORVP,ID) ;S NODE=$G(^TMP("PS",$J,0)),ORIFN=+$P(NODE,U,11)
- S ID=+$P($G(^TMP("PS",$J,0)),U,11) D ORDERS ;DBIA 2400
- ;D @($S($P($G(^OR(100,ORIFN,0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)):"IV",1:"DRUG")_"^ORCXPND2")
- K ^TMP("PS",$J)
- Q
- LABS ; -- Laboratory [RESULTS ONLY for ID=OE order #]
- N ORIFN,X,SUB,TEST,NAME,SS,IDE,IVDT,TST,CCNT,ORCY,IG,TCNT
- K ^TMP("LRRR",$J) ;DBIA 2503
- 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
- S ORIFN=+ID,IDE=$G(^OR(100,+ID,4)) Q:'$L(IDE) ; OE# -> Lab#
- 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
- I '+IDE,$P(IDE,";",5) D RR^LR7OR1(+ORVP,,9999999-$P(IDE,";",5),9999999-$P(IDE,";",5),$P(IDE,";",4))
- K ORCY D TEXT^ORQ12(.ORCY,ORIFN,80)
- S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S X=ORCY(IG) D ITEM^ORCXPND(X)
- D BLANK^ORCXPND I '$D(^TMP("LRRR",$J,+ORVP)) S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
- M TEST=^TMP("LRRR",$J,+ORVP) S CCNT=0,SS=""
- F S SS=$O(TEST(SS)) Q:SS="" S IVDT=0 F S IVDT=$O(TEST(SS,IVDT)) Q:'IVDT D
- . I SS="BB" D
- .. 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
- ... K ^TMP("ORLRC",$J)
- ... D EN^ORWLR1(DFN)
- ... I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
- ... 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
- ... K ^TMP("ORLRC",$J)
- .. K ^TMP("LRC",$J) D EN1^LR7OSBR(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q ;DBIA 2951
- ... 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
- ... K ^TMP("LRC",$J)
- . I SS="MI" K ^TMP("LRC",$J) D EN^LR7OSMZ0(+ORVP) Q:'$D(^TMP("LRC",$J)) D Q
- .. 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
- .. K ^TMP("LRC",$J)
- . I SS="CH" D Q
- .. S (TCNT,TST)=0 F S TST=$O(TEST(SS,IVDT,TST)) Q:TST="" S CCNT=0,TCNT=TCNT+1 D
- ... I TCNT=1 D
- .... S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Collection time: "_$$FMTE^XLFDT(9999999-IVDT,1)
- .... 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)
- ... I TST S X=TEST(SS,IVDT,TST),CCNT=0 I +X D
- .... 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))
- .... I $L($P(X,U,3)),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOINHI,IOINORM)
- .... I $P(X,U,3)["*",$D(IOBON),$D(IOINHI) D SETVIDEO^ORCXPND(LCNT,26,8,IOBON_IOINHI,IOBOFF_IOINORM)
- ... I TST="N" S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=" Comments: " D
- .... 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)
- K ^TMP("LRRR",$J)
- Q
- ;
- DELAY ; -- Delayed Orders
- NEW ; -- New Orders
- ORDERS ; -- Orders
- I '$G(ORESULTS) D ORDERS^ORCXPND2 Q
- ; -- Results Display (Add more packages as available)
- N PKG,TAB,ORIFN
- S PKG=+$P($G(^OR(100,+ID,0)),"^",14),PKG=$$NMSP^ORCD(PKG)
- S TAB=$S(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"")
- I '$L(TAB)!(ID'>0) D Q ; no display available
- . N ORY,I D TEXT^ORQ12(.ORY,+ID,80)
- . S I=0 F S I=$O(ORY(I)) Q:I'>0 D ITEM^ORCXPND(ORY(I))
- . D BLANK^ORCXPND
- . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="There are no results to report."
- 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
- I '$O(^OR(100,+ID,2,0)) D @TAB
- Q
- REPORTS ; -- Patient Profiles
- D EN^ORCXPNDR ; Reports
- Q
- CONSULTS ; -- Consults
- N I,X,SUB,ORTX ;,VALMAR
- I $G(ORTAB)="CONSULTS" S X=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
- E D TEXT^ORQ12(.ORTX,+ID) S X=ORTX(1),ID=+$G(^OR(100,+ID,4)) ; OE->GMRC order#
- D ITEM^ORCXPND(X),BLANK^ORCXPND
- I ID'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="No data available." Q
- I '$G(ORESULTS) D ;DT action
- . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)="Consult No.: "_ID
- . N GMRCOER S GMRCOER=2 D DT^GMRCSLM2(ID) S SUB="DT" ;DBIA 2925
- I $G(ORESULTS) D RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")") S SUB="RT"
- 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
- K ^TMP("GMRCR",$J)
- Q
- XRAYS ; -- Radiology
- I '$G(ORESULTS) S ID=+ORVP_U_$TR(ID,"-","^") D EN3^RAO7PC3(ID)
- I $G(ORESULTS) S ID=+$G(^OR(100,+ID,4)) D EN30^RAO7PC3(ID)
- N CASE,PROC,PSET S PSET=$D(^TMP($J,"RAE3",+ORVP,"PRINT_SET"))
- S CASE=0 F S CASE=$O(^TMP($J,"RAE3",+ORVP,CASE)) Q:CASE'>0 D
- . I PSET S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,"")) D ITEM^ORCXPND(PROC) Q
- . S PROC="" F S PROC=$O(^TMP($J,"RAE3",+ORVP,CASE,PROC)) Q:PROC="" D ITEM^ORCXPND(PROC),BLANK^ORCXPND,XRPT,BLANK^ORCXPND
- 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
- K ^TMP($J,"RAE3",+ORVP),^UTILITY($J,"W")
- S VALM("RM")=81
- Q
- ;
- XRPT ; -- Body of Report for CASE, PROC
- N ORD,X,I
- 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
- 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
- Q
- ;
- SUMMRIES ; -- Discharge Summaries
- N I,ORY,DATE,AUTHOR,PTLOC,SUBJ K ^TMP("TIUAUDIT",$J)
- D RPC^TIUSRV(.ORY,ID)
- 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))
- K @ORY
- Q
- PTINQ ; Print Patient Inquiry in List Manager
- N DFN,ORI,X
- S DFN=+ORVP
- D DGINQ(DFN)
- S ORI=4,LCNT=0
- F S ORI=$O(^TMP("ORDATA",$J,1,ORI)) Q:'ORI S X=^(ORI) D
- . S LCNT=LCNT+1
- . S ^TMP("ORXPND",$J,LCNT,0)=X
- K ^TMP("ORDATA",$J,1)
- Q
- ;
- DGINQ(DFN) ; Patient Inquiry
- D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)")
- Q
- DGINQB(DFN) ; Build Patient Inquiry
- N CONTACT,ORDOC,ORTEAM,ORVP,XQORNOD,ORSSTRT,ORSSTOPT,VAOA
- S ORVP=DFN_";DPT(",XQORNOD=1
- D EN^DGRPD ; MAS Patient Inquiry
- ;
- S ORDOC=$$OUTPTPR^SDUTL3(DFN)
- S ORTEAM=$$OUTPTTM^SDUTL3(DFN)
- I ORDOC!ORTEAM D
- . W !!,"Primary Care Information:"
- . I ORDOC W !,"Primary Practitioner: ",$P(ORDOC,"^",2)
- . I ORTEAM W !,"Primary Care Team: ",$P(ORTEAM,"^",2)
- W !!,"Health Insurance Information:"
- D DISP^DGIBDSP ;DBIA #4408
- W !!,"Service Connection/Rated Disabilities:"
- D DIS^DGRPDB
- F CONTACT="N","S" D
- .S VAOA("A")=$S(CONTACT="N":"",1:3)
- .D OAD^VADPT ; Get NOK Information
- .I VAOA(9)]"" D
- .. W !!,$S(CONTACT="N":"Next of Kin Information:",1:"Secondary Next of Kin Information:")
- .. W !,"Name: ",VAOA(9) ; NOK Name
- .. I VAOA(10)]"" W " (",VAOA(10),")" ; Relationship
- .. I VAOA(1)]"" W !?7,VAOA(1) ; Address Line 1
- .. I VAOA(2)]"" W !?7,VAOA(2) ; Line 2
- .. I VAOA(3)]"" W !?7,VAOA(3) ; Line 3
- .. I VAOA(4)]"" D
- .. . W !?7,VAOA(4) ; City
- .. . I VAOA(5)]"" W ", "_$P(VAOA(5),"^",2) ; State
- .. . W " ",$P(VAOA(11),"^",2) ; Zip+4
- .. I VAOA(8)]"" W !!?7,"Phone number: ",VAOA(8) ; Phone
- .. I CONTACT="N",$P($G(^DPT(DFN,.21)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.21),U,11)
- .. I CONTACT="S",$P($G(^DPT(DFN,.211)),U,11)]"" W !?7,"Work phone number: ",$P(^DPT(DFN,.211),U,11)
- D KVAR^VADPT
- Q
- TRIM(X) ; Trim Spaces
- S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
- Q X
- S(X,Y,Z) ; Pad Over
- ; X=Column #
- ; Y=Current Length
- ; Z=Text
- ; SP=Text Sent
- ; CCNT=Line Position After Input Text
- I '$D(Z) Q ""
- N SP S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
- S CCNT=$$INC(CCNT,SP)
- Q SP
- INC(X,Y) ; Character Position Count
- ; X=Current Count
- ; Y=Text
- N INC S INC=X+$L(Y)
- Q INC
- ORCXPND1 ; SLC/MKB - Expanded Display cont ; 04/25/2007
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215,243**;Dec 17, 1997;Build 242
- +2 ;
- +3 ; External References
- +4 ; DBIA 2387 ^LAB(60
- +5 ; DBIA 3420 ^DPT( file #2
- +6 ; DBIA 10035 ^DPT( file #2
- +7 ; DBIA 10037 EN^DGRPD
- +8 ; DBIA 700 DIS^DGRPDB
- +9 ; DBIA 2926 RT^GMRCGUIA
- +10 ; DBIA 2925 DT^GMRCSLM2 ^TMP("GMRCR"
- +11 ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR"
- +12 ; DBIA 2951 EN1^LR7OSBR ^TMP("LRC"
- +13 ; DBIA 2952 EN^LR7OSMZ0
- +14 ; DBIA 2400 OEL^PSOORRL ^TMP("PS"
- +15 ; DBIA 2877 EN3^RAO7PC3
- +16 ; DBIA 2877 EN30^RAO7PC3
- +17 ; DBIA 1252 $$OUTPTPR^SDUTL3
- +18 ; DBIA 1252 $$OUTPTTM^SDUTL3
- +19 ; DBIA 2832 RPC^TIUSRV
- +20 ; DBIA 10061 DEM^VADPT
- +21 ; DBIA 10061 KVAR^VADPT
- +22 ; DBIA 10061 OAD^VADPT
- +23 ; DBIA 10103 $$FMTE^XLFDT
- +24 ; DBIA 4408 DISP^DGIBDSP
- +25 ;
- COVER ; -- Cover Sheet
- +1 NEW PKG
- SET PKG=$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",NUM)),U,4)
- +2 IF PKG="GMRA"
- DO ALLERGY^ORCXPND2
- IF PKG="TIU"
- DO NOTES
- +3 QUIT
- NOTES ; -- Progress Notes
- +1 NEW I,ORY,DATE,AUTHOR,PTLOC,SUBJ
- KILL ^TMP("TIUAUDIT",$JOB)
- +2 DO RPC^TIUSRV(.ORY,ID)
- +3 SET I=0
- FOR
- SET I=$ORDER(@ORY@(I))
- IF I'>0
- QUIT
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=$GET(@ORY@(I,0))
- +4 KILL @ORY
- +5 QUIT
- PROBLEMS ; -- Problem List
- +1 DO PL^ORCXPND4
- +2 QUIT
- MEDS ; -- Pharmacy
- +1 ;N NODE,ORIFN
- +2 KILL ^TMP("PS",$JOB)
- +3 ;S NODE=$G(^TMP("PS",$J,0)),ORIFN=+$P(NODE,U,11)
- DO OEL^PSOORRL(+ORVP,ID)
- +4 ;DBIA 2400
- SET ID=+$PIECE($GET(^TMP("PS",$JOB,0)),U,11)
- DO ORDERS
- +5 ;D @($S($P($G(^OR(100,ORIFN,0)),U,11)=$O(^ORD(100.98,"B","IV RX",0)):"IV",1:"DRUG")_"^ORCXPND2")
- +6 KILL ^TMP("PS",$JOB)
- +7 QUIT
- LABS ; -- Laboratory [RESULTS ONLY for ID=OE order #]
- +1 NEW ORIFN,X,SUB,TEST,NAME,SS,IDE,IVDT,TST,CCNT,ORCY,IG,TCNT
- +2 ;DBIA 2503
- KILL ^TMP("LRRR",$JOB)
- +3 ;ID=Accession #-Date/time specimen taken
- IF (ID?2.5U1" "2N1" "1.N1"-"7N1"."1.4N)!(ID?2.5U1" "2N1" "1.N1"-"7N)
- DO AP^ORCXPND3
- QUIT
- +4 ; OE# -> Lab#
- SET ORIFN=+ID
- SET IDE=$GET(^OR(100,+ID,4))
- IF '$LENGTH(IDE)
- QUIT
- +5 ;Order possibly purged, reset to lookup on file 63
- IF +IDE
- DO RR^LR7OR1(+ORVP,IDE)
- IF '$DATA(^TMP("LRRR",$JOB,+ORVP))
- SET $PIECE(IDE,";",1,3)=";;"
- +6 IF '+IDE
- IF $PIECE(IDE,";",5)
- DO RR^LR7OR1(+ORVP,,9999999-$PIECE(IDE,";",5),9999999-$PIECE(IDE,";",5),$PIECE(IDE,";",4))
- +7 KILL ORCY
- DO TEXT^ORQ12(.ORCY,ORIFN,80)
- +8 SET IG=0
- FOR
- SET IG=$ORDER(ORCY(IG))
- IF IG<1
- QUIT
- SET X=ORCY(IG)
- DO ITEM^ORCXPND(X)
- +9 DO BLANK^ORCXPND
- IF '$DATA(^TMP("LRRR",$JOB,+ORVP))
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)="No data available."
- QUIT
- +10 MERGE TEST=^TMP("LRRR",$JOB,+ORVP)
- SET CCNT=0
- SET SS=""
- +11 FOR
- SET SS=$ORDER(TEST(SS))
- IF SS=""
- QUIT
- SET IVDT=0
- FOR
- SET IVDT=$ORDER(TEST(SS,IVDT))
- IF 'IVDT
- QUIT
- Begin DoDot:1
- +12 IF SS="BB"
- Begin DoDot:2
- +13 ;Transition to VBEC's interface
- IF $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q")
- IF $LENGTH($TEXT(EN^ORWLR1))
- IF $LENGTH($TEXT(CPRS^VBECA3B))
- Begin DoDot:3
- +14 KILL ^TMP("ORLRC",$JOB)
- +15 DO EN^ORWLR1(DFN)
- +16 IF '$ORDER(^TMP("ORLRC",$JOB,0))
- SET ^TMP("ORLRC",$JOB,1,0)=""
- SET ^TMP("ORLRC",$JOB,2,0)="No Blood Bank report available..."
- +17 NEW I
- SET I=0
- FOR
- SET I=$ORDER(^TMP("ORLRC",$JOB,I))
- IF I<1
- QUIT
- SET X=^(I,0)
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=X
- +18 KILL ^TMP("ORLRC",$JOB)
- End DoDot:3
- QUIT
- +19 ;DBIA 2951
- KILL ^TMP("LRC",$JOB)
- DO EN1^LR7OSBR(+ORVP)
- IF '$DATA(^TMP("LRC",$JOB))
- QUIT
- Begin DoDot:3
- +20 NEW I
- SET I=0
- FOR
- SET I=$ORDER(^TMP("LRC",$JOB,I))
- IF I<1
- QUIT
- SET X=^(I,0)
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=X
- +21 KILL ^TMP("LRC",$JOB)
- End DoDot:3
- QUIT
- End DoDot:2
- +22 IF SS="MI"
- KILL ^TMP("LRC",$JOB)
- DO EN^LR7OSMZ0(+ORVP)
- IF '$DATA(^TMP("LRC",$JOB))
- QUIT
- Begin DoDot:2
- +23 NEW I
- SET I=0
- FOR
- SET I=$ORDER(^TMP("LRC",$JOB,I))
- IF I<1
- QUIT
- SET X=^(I,0)
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=X
- +24 KILL ^TMP("LRC",$JOB)
- End DoDot:2
- QUIT
- +25 IF SS="CH"
- Begin DoDot:2
- +26 SET (TCNT,TST)=0
- FOR
- SET TST=$ORDER(TEST(SS,IVDT,TST))
- IF TST=""
- QUIT
- SET CCNT=0
- SET TCNT=TCNT+1
- Begin DoDot:3
- +27 IF TCNT=1
- Begin DoDot:4
- +28 SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=" Collection time: "_$$FMTE^XLFDT(9999999-IVDT,1)
- +29 SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=$$S(1,CCNT," ")_$$S(3,CCNT,"Test Name")_$$S(29,CCNT,"Result")_$$S(39,CCNT,"Units")_$$S(55,CCNT,"Range")
- IF $DATA(IOUON)
- DO SETVIDEO^ORCXPND(LCNT,1,70,IOUON,IOUOFF)
- End DoDot:4
- +30 IF TST
- SET X=TEST(SS,IVDT,TST)
- SET CCNT=0
- IF +X
- Begin DoDot:4
- +31 SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=$$S(1,CCNT,$PIECE(^LAB(60,+X,0),U))_$$S(26,CCNT,$JUSTIFY($PIECE(X,U,2),7))_$$S(34,CCNT,$SELECT($LENGTH($PIECE(X,U,3)):$PIECE(X,U,3),1:""))_$$S(39,CCNT,$PIECE(X,U,4))_$$S(45,
- CCNT,$JUSTIFY($PIECE(X,U,5),15))
- +32 IF $LENGTH($PIECE(X,U,3))
- IF $DATA(IOINHI)
- DO SETVIDEO^ORCXPND(LCNT,26,8,IOINHI,IOINORM)
- +33 IF $PIECE(X,U,3)["*"
- IF $DATA(IOBON)
- IF $DATA(IOINHI)
- DO SETVIDEO^ORCXPND(LCNT,26,8,IOBON_IOINHI,IOBOFF_IOINORM)
- End DoDot:4
- +34 IF TST="N"
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=" Comments: "
- Begin DoDot:4
- +35 NEW CMT
- SET CMT=0
- FOR
- SET CMT=$ORDER(TEST(SS,IVDT,"N",CMT))
- IF 'CMT
- QUIT
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=" "_TEST(SS,IVDT,"N",CMT)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- QUIT
- End DoDot:1
- +36 KILL ^TMP("LRRR",$JOB)
- +37 QUIT
- +38 ;
- DELAY ; -- Delayed Orders
- NEW ; -- New Orders
- ORDERS ; -- Orders
- +1 IF '$GET(ORESULTS)
- DO ORDERS^ORCXPND2
- QUIT
- +2 ; -- Results Display (Add more packages as available)
- +3 NEW PKG,TAB,ORIFN
- +4 SET PKG=+$PIECE($GET(^OR(100,+ID,0)),"^",14)
- SET PKG=$$NMSP^ORCD(PKG)
- +5 SET TAB=$SELECT(PKG="LR":"LABS",PKG="GMRC":"CONSULTS",PKG="RA":"XRAYS",1:"")
- +6 ; no display available
- IF '$LENGTH(TAB)!(ID'>0)
- Begin DoDot:1
- +7 NEW ORY,I
- DO TEXT^ORQ12(.ORY,+ID,80)
- +8 SET I=0
- FOR
- SET I=$ORDER(ORY(I))
- IF I'>0
- QUIT
- DO ITEM^ORCXPND(ORY(I))
- +9 DO BLANK^ORCXPND
- +10 SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)="There are no results to report."
- End DoDot:1
- QUIT
- +11 IF $ORDER(^OR(100,+ID,2,0))
- SET ORIFN=+ID
- SET ID=0
- FOR
- SET ID=$ORDER(^OR(100,ORIFN,2,ID))
- IF ID<1
- QUIT
- IF $DATA(^OR(100,ID,0))
- DO @TAB
- +12 IF '$ORDER(^OR(100,+ID,2,0))
- DO @TAB
- +13 QUIT
- REPORTS ; -- Patient Profiles
- +1 ; Reports
- DO EN^ORCXPNDR
- +2 QUIT
- CONSULTS ; -- Consults
- +1 ;,VALMAR
- NEW I,X,SUB,ORTX
- +2 IF $GET(ORTAB)="CONSULTS"
- SET X=$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",NUM)),U,4)
- +3 ; OE->GMRC order#
- IF '$TEST
- DO TEXT^ORQ12(.ORTX,+ID)
- SET X=ORTX(1)
- SET ID=+$GET(^OR(100,+ID,4))
- +4 DO ITEM^ORCXPND(X)
- DO BLANK^ORCXPND
- +5 IF ID'>0
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)="No data available."
- QUIT
- +6 ;DT action
- IF '$GET(ORESULTS)
- Begin DoDot:1
- +7 SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)="Consult No.: "_ID
- +8 ;DBIA 2925
- NEW GMRCOER
- SET GMRCOER=2
- DO DT^GMRCSLM2(ID)
- SET SUB="DT"
- End DoDot:1
- +9 IF $GET(ORESULTS)
- DO RT^GMRCGUIA(ID,"^TMP(""GMRCR"",$J,""RT"")")
- SET SUB="RT"
- +10 ;DBIA 2925
- SET I=0
- FOR
- SET I=$ORDER(^TMP("GMRCR",$JOB,SUB,I))
- IF I'>0
- QUIT
- SET X=$GET(^(I,0))
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=X
- +11 KILL ^TMP("GMRCR",$JOB)
- +12 QUIT
- XRAYS ; -- Radiology
- +1 IF '$GET(ORESULTS)
- SET ID=+ORVP_U_$TRANSLATE(ID,"-","^")
- DO EN3^RAO7PC3(ID)
- +2 IF $GET(ORESULTS)
- SET ID=+$GET(^OR(100,+ID,4))
- DO EN30^RAO7PC3(ID)
- +3 NEW CASE,PROC,PSET
- SET PSET=$DATA(^TMP($JOB,"RAE3",+ORVP,"PRINT_SET"))
- +4 SET CASE=0
- FOR
- SET CASE=$ORDER(^TMP($JOB,"RAE3",+ORVP,CASE))
- IF CASE'>0
- QUIT
- Begin DoDot:1
- +5 IF PSET
- SET PROC=$ORDER(^TMP($JOB,"RAE3",+ORVP,CASE,""))
- DO ITEM^ORCXPND(PROC)
- QUIT
- +6 SET PROC=""
- FOR
- SET PROC=$ORDER(^TMP($JOB,"RAE3",+ORVP,CASE,PROC))
- IF PROC=""
- QUIT
- DO ITEM^ORCXPND(PROC)
- DO BLANK^ORCXPND
- DO XRPT
- DO BLANK^ORCXPND
- End DoDot:1
- +7 ;printset=list all procs, then one report
- IF PSET
- SET CASE=$ORDER(^TMP($JOB,"RAE3",+ORVP,0))
- SET PROC=$ORDER(^(CASE,""))
- DO BLANK^ORCXPND
- DO XRPT
- DO BLANK^ORCXPND
- +8 KILL ^TMP($JOB,"RAE3",+ORVP),^UTILITY($JOB,"W")
- +9 SET VALM("RM")=81
- +10 QUIT
- +11 ;
- XRPT ; -- Body of Report for CASE, PROC
- +1 NEW ORD,X,I
- +2 SET ORD=$SELECT($LENGTH($GET(^TMP($JOB,"RAE3",+ORVP,"ORD"))):^("ORD"),$LENGTH($GET(^("ORD",CASE))):^(CASE),1:"")
- IF $LENGTH(ORD)
- IF ORD'=PROC
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)="Proc Ord: "_ORD
- +3 ;Skip pt ID on line 1
- SET I=1
- FOR
- SET I=$ORDER(^TMP($JOB,"RAE3",+ORVP,CASE,PROC,I))
- IF I'>0
- QUIT
- SET X=^(I)
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=X
- +4 QUIT
- +5 ;
- SUMMRIES ; -- Discharge Summaries
- +1 NEW I,ORY,DATE,AUTHOR,PTLOC,SUBJ
- KILL ^TMP("TIUAUDIT",$JOB)
- +2 DO RPC^TIUSRV(.ORY,ID)
- +3 SET I=0
- FOR
- SET I=$ORDER(@ORY@(I))
- IF I'>0
- QUIT
- SET LCNT=LCNT+1
- SET ^TMP("ORXPND",$JOB,LCNT,0)=$GET(@ORY@(I,0))
- +4 KILL @ORY
- +5 QUIT
- PTINQ ; Print Patient Inquiry in List Manager
- +1 NEW DFN,ORI,X
- +2 SET DFN=+ORVP
- +3 DO DGINQ(DFN)
- +4 SET ORI=4
- SET LCNT=0
- +5 FOR
- SET ORI=$ORDER(^TMP("ORDATA",$JOB,1,ORI))
- IF 'ORI
- QUIT
- SET X=^(ORI)
- Begin DoDot:1
- +6 SET LCNT=LCNT+1
- +7 SET ^TMP("ORXPND",$JOB,LCNT,0)=X
- End DoDot:1
- +8 KILL ^TMP("ORDATA",$JOB,1)
- +9 QUIT
- +10 ;
- DGINQ(DFN) ; Patient Inquiry
- +1 DO START^ORWRP(80,"DGINQB^ORCXPND1(DFN)")
- +2 QUIT
- DGINQB(DFN) ; Build Patient Inquiry
- +1 NEW CONTACT,ORDOC,ORTEAM,ORVP,XQORNOD,ORSSTRT,ORSSTOPT,VAOA
- +2 SET ORVP=DFN_";DPT("
- SET XQORNOD=1
- +3 ; MAS Patient Inquiry
- DO EN^DGRPD
- +4 ;
- +5 SET ORDOC=$$OUTPTPR^SDUTL3(DFN)
- +6 SET ORTEAM=$$OUTPTTM^SDUTL3(DFN)
- +7 IF ORDOC!ORTEAM
- Begin DoDot:1
- +8 WRITE !!,"Primary Care Information:"
- +9 IF ORDOC
- WRITE !,"Primary Practitioner: ",$PIECE(ORDOC,"^",2)
- +10 IF ORTEAM
- WRITE !,"Primary Care Team: ",$PIECE(ORTEAM,"^",2)
- End DoDot:1
- +11 WRITE !!,"Health Insurance Information:"
- +12 ;DBIA #4408
- DO DISP^DGIBDSP
- +13 WRITE !!,"Service Connection/Rated Disabilities:"
- +14 DO DIS^DGRPDB
- +15 FOR CONTACT="N","S"
- Begin DoDot:1
- +16 SET VAOA("A")=$SELECT(CONTACT="N":"",1:3)
- +17 ; Get NOK Information
- DO OAD^VADPT
- +18 IF VAOA(9)]""
- Begin DoDot:2
- +19 WRITE !!,$SELECT(CONTACT="N":"Next of Kin Information:",1:"Secondary Next of Kin Information:")
- +20 ; NOK Name
- WRITE !,"Name: ",VAOA(9)
- +21 ; Relationship
- IF VAOA(10)]""
- WRITE " (",VAOA(10),")"
- +22 ; Address Line 1
- IF VAOA(1)]""
- WRITE !?7,VAOA(1)
- +23 ; Line 2
- IF VAOA(2)]""
- WRITE !?7,VAOA(2)
- +24 ; Line 3
- IF VAOA(3)]""
- WRITE !?7,VAOA(3)
- +25 IF VAOA(4)]""
- Begin DoDot:3
- +26 ; City
- WRITE !?7,VAOA(4)
- +27 ; State
- IF VAOA(5)]""
- WRITE ", "_$PIECE(VAOA(5),"^",2)
- +28 ; Zip+4
- WRITE " ",$PIECE(VAOA(11),"^",2)
- End DoDot:3
- +29 ; Phone
- IF VAOA(8)]""
- WRITE !!?7,"Phone number: ",VAOA(8)
- +30 IF CONTACT="N"
- IF $PIECE($GET(^DPT(DFN,.21)),U,11)]""
- WRITE !?7,"Work phone number: ",$PIECE(^DPT(DFN,.21),U,11)
- +31 IF CONTACT="S"
- IF $PIECE($GET(^DPT(DFN,.211)),U,11)]""
- WRITE !?7,"Work phone number: ",$PIECE(^DPT(DFN,.211),U,11)
- End DoDot:2
- End DoDot:1
- +32 DO KVAR^VADPT
- +33 QUIT
- TRIM(X) ; Trim Spaces
- +1 SET X=$GET(X)
- FOR
- IF $EXTRACT(X,1)'=" "
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 FOR
- IF $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +3 QUIT X
- S(X,Y,Z) ; Pad Over
- +1 ; X=Column #
- +2 ; Y=Current Length
- +3 ; Z=Text
- +4 ; SP=Text Sent
- +5 ; CCNT=Line Position After Input Text
- +6 IF '$DATA(Z)
- QUIT ""
- +7 NEW SP
- SET SP=Z
- IF X
- IF Y
- IF X>Y
- SET SP=$EXTRACT(" ",1,X-Y)_Z
- +8 SET CCNT=$$INC(CCNT,SP)
- +9 QUIT SP
- INC(X,Y) ; Character Position Count
- +1 ; X=Current Count
- +2 ; Y=Text
- +3 NEW INC
- SET INC=X+$LENGTH(Y)
- +4 QUIT INC
