Index: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND1.m
===================================================================
--- WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND1.m	(revision 623)
@@ -1,209 +1,206 @@
-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 ; 02/20/2003
+ ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,67,75,89,92,94,148,159,188,172,215**;Dec 17, 1997
+ ;
+ ; 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 10146  DISP^IBCNS
+ ;   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
+ 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
+ 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 $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 ORDOC,ORTEAM,ORVP,XQORNOD,ORSSTRT,ORSSTOP,X,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:"
+ I $L($T(DISP^DGIBDSP)) D DISP^DGIBDSP  ;DBIA #4408
+ E  D DISP^IBCNS
+ W !!,"Service Connection/Rated Disabilities:"
+ D DIS^DGRPDB
+ D OAD^VADPT ;   Get NOK Information
+ I VAOA(9)]"" D
+ . W !!,"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 $P($G(^DPT(DFN,.21)),U,11)]"" W !?7,"Work phone number:  ",$P(^DPT(DFN,.21),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
