ORQ2 ; SLC/MKB/GSS - Detailed Order Report ;Aug 9, 2021@13:40:01
;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,56,75,94,141,213,195,243,282,293,280,346,361,471,453,405**;Dec 17, 1997;Build 211
;
;
;Reference to ^DIC(45.7 supported by IA #519
;Reference to OERR^VADPT supported by IA #4325
;Reference to CODECS^ICDEX supported by ICR #5747
;
DETAIL(ORY,ORIFN) ; -- Returns details of order ORIFN in ORY(#)
N X,X2,I,CNT,ORDIALOG,OR0,OR3,OR6,SEQ,ITEM,PRMT,MULT,FIRST,TITLE,INST,DIWL,DIWR,DIWF,ACTION,VAIN,ORIGVIEW,ORNMSP,ORYT,ORCRACT
N ORTRANS ; OR*3*453 rbd Var needed for ORDER TRANSFERS logic below
; p 471 added ORCACT to use action if passed in
S CNT=0,ORCRACT=+$P(ORIFN,";",2),ORIFN=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6))
S ORNMSP=$$NMSP^ORCD($P(OR0,U,14))
; p 471 if no action, default to CURRENT ACTION..or if not $O(<The action subfile>, -1)
S:'ORCRACT ORCRACT=$S(+$P(OR3,U,7):+$P(OR3,U,7),1:+$O(^OR(100,ORIFN,8,":"),-1))
K @ORY,ORYT S ORIGVIEW=1 D TEXT^ORQ12(.ORYT,+ORIFN_";"_ORCRACT,80) ;CurrTx
M @ORY=ORYT ;Move text to global
S I=0 F CNT=1:1 S I=$O(ORYT(I)) Q:I'>0 D:$D(IORVON) SETVIDEO(I,1,$L(ORYT(I)),IORVON,IORVOFF)
S CNT=CNT+1,@ORY@(CNT)=" " ;blank
D1 I $O(^OR(100,+ORIFN,2,0)) D
. S CNT=CNT+1,@ORY@(CNT)="Sub Orders:"
. D:$D(IOUON) SETVIDEO(CNT,1,11,IOUON,IOUOFF)
. N IFN S IFN=0
. F S IFN=+$O(^OR(100,+ORIFN,2,IFN)) Q:IFN<1 I $D(^OR(100,IFN,0)) D SUB(IFN)
. S CNT=CNT+1,@ORY@(CNT)=" " ;blank
I $P(OR3,U,9),$D(^OR(100,+$P(OR3,U,9),0)) D
. S CNT=CNT+1,@ORY@(CNT)="Parent Order:"
. D:$D(IOUON) SETVIDEO(CNT,1,12,IOUON,IOUOFF)
. D SUB(+$P(OR3,U,9))
. S CNT=CNT+1,@ORY@(CNT)=" " ;blank
I $P(OR3,U,11)=1,$P(OR3,U,5) D ;Changed - show previous order
. S CNT=CNT+1,@ORY@(CNT)="Previous Order:"
. D:$D(IOUON) SETVIDEO(CNT,1,15,IOUON,IOUOFF) ;prev order original text
. N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,+$P(OR3,U,5),55)
. S CNT=CNT+1,@ORY@(CNT)=" Order Text: "_$G(ORZ(1))
. S I=1 F S I=$O(ORZ(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
D2 S CNT=CNT+1,@ORY@(CNT)="Activity:"
D:$D(IOUON) SETVIDEO(CNT,1,9,IOUON,IOUOFF)
S DIWL=1,DIWR=64,DIWF="C64",ORI=0 K ^UTILITY($J,"W")
F S ORI=$O(^OR(100,ORIFN,8,ORI)) Q:ORI'>0 S ACTION=$G(^(ORI,0)) D ACT^ORQ20
; RBD OR*3.0*453 Add ORDER TRANSFERS information
S ORI=0 F S ORI=$O(^OR(100,ORIFN,11,ORI)) Q:ORI'>0 D
. I ORI=1 D
.. S CNT=CNT+1,@ORY@(CNT)=" ",CNT=CNT+1,@ORY@(CNT)="Reassignments (Transfers):"
. S ORTRANS=$G(^OR(100,ORIFN,11,ORI,0))
. S CNT=CNT+1,@ORY@(CNT)="Transferred from "_$$USER^ORQ20($P(ORTRANS,U,2))_" to "_$$USER^ORQ20($P(ORTRANS,U,3))
. S CNT=CNT+1,@ORY@(CNT)=" by "_$$USER^ORQ20($P(ORTRANS,U,4))_" Effective From "_$$DATE^ORQ20($P(ORTRANS,U))
I $D(^OR(100,ORIFN,11)) S CNT=CNT+1,@ORY@(CNT)=" "
I "^1^12^13^"[(U_$P(OR3,U,3)_U),$L(OR6),$P(ACTION,U,2)'="DC" D DC^ORQ20
I $P(OR3,U,3)=2,$P(OR6,U,6) S CNT=CNT+1,@ORY@(CNT)=$$DATE^ORQ20($P(OR6,U,6))_" Completed"_$S($P(OR6,U,7):" by "_$$USER^ORQ20($P(OR6,U,7)),1:"")
S CNT=CNT+1,@ORY@(CNT)=" " ;blank
D3 S CNT=CNT+1,@ORY@(CNT)="Current Data:"
D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF)
D VA I $G(VAIN(2)) S CNT=CNT+1,@ORY@(CNT)="Current Primary Provider: "_$P(VAIN(2),"^",2)
I $G(VAIN(11)) S CNT=CNT+1,@ORY@(CNT)="Current Attending Physician: "_$P(VAIN(11),"^",2)
S CNT=CNT+1,@ORY@(CNT)="Treating Specialty: "_$P($G(^DIC(45.7,+$P(OR0,U,13),0)),U)
S CNT=CNT+1,@ORY@(CNT)="Ordering Location: "_$P($G(^SC(+$P(OR0,U,10),0)),U)
S CNT=CNT+1,@ORY@(CNT)="Start Date/Time: "_$S($P(OR0,U,8):$$DATE^ORQ20($P(OR0,U,8)),1:"")
I $P(OR3,U,5),$P(OR3,U,11)=2 S X=$$ORIG(ORIFN),@ORY@(CNT)=@ORY@(CNT)_" (originally "_$$DATE^ORQ20(X)_")"
S CNT=CNT+1,@ORY@(CNT)="Stop Date/Time: "_$S($P(OR0,U,9):$$DATE^ORQ20($P(OR0,U,9)),1:"")
I $P(OR3,U,3)=1,$P(OR6,U,6) S @ORY@(CNT)=@ORY@(CNT)_" (expired "_$$DATE^ORQ20($P(OR6,U,6))_")"
S CNT=CNT+1,@ORY@(CNT)="Current Status: "_$S($D(^ORD(100.01,+$P(OR3,U,3),0)):$P(^(0),"^"),1:"-")
I $$GET^XPAR("ALL","ORPF SHOW STATUS DESCRIPTION",1,"I"),$P(OR3,U,3),$D(^ORD(100.01,$P(OR3,U,3),0)) N J S J=0 F S J=$O(^ORD(100.01,$P(OR3,U,3),1,J)) Q:J<1 S CNT=CNT+1,@ORY@(CNT)=" "_^(J,0)
S CNT=CNT+1,@ORY@(CNT)="Order #"_ORIFN
S CNT=CNT+1,@ORY@(CNT)=" " ;blank
D4 S CNT=CNT+1,@ORY@(CNT)="Order:" D:$D(IOUON) SETVIDEO(CNT,1,6,IOUON,IOUOFF)
I '$O(^OR(100,ORIFN,4.5,0)),ORNMSP="RA" D RAD^ORQ21("") Q
S ORDIALOG=$P(OR0,U,5) Q:$P(ORDIALOG,";",2)="ORD(101," ; 2.5 order
D GETDLG^ORCD(+ORDIALOG),GETORDER^ORCD(ORIFN)
I ORNMSP="GMRC" D GMRCXTRA
S DIWL=1,DIWR=50,DIWF="C50"
S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D
. S ITEM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(ITEM,U,11) ; child
. S PRMT=$P(ITEM,U,2),MULT=$P(ITEM,U,7) Q:$P(ITEM,U,9)["*" ;hide
. S FIRST=$O(ORDIALOG(PRMT,0)) Q:'FIRST ; no values
. S TITLE=$S(MULT&$L($G(ORDIALOG(PRMT,"TTL"))):ORDIALOG(PRMT,"TTL"),1:ORDIALOG(PRMT,"A"))
. S TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$L(TITLE))
. S INST=0 F S INST=$O(ORDIALOG(PRMT,INST)) Q:INST'>0 D
. . I $E(ORDIALOG(PRMT,0))="W" D WP Q
. . K ^UTILITY($J,"W") S X=$$EXT^ORCD(PRMT,INST) I TITLE["Infusion Rate"&(X'="")&(X'["ml/hr") S TITLE="Infuse Over Time:",TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$L(TITLE))
. . D ^DIWP
. . D:$D(^ORD(101.41,+ORDIALOG,10,"DAD",PRMT)) CHILDREN(PRMT)
. . S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$S((INST=FIRST)&(I=1):TITLE,1:$$REPEAT^XLFSTR(" ",30))_^(I,0)
I ORNMSP="GMRC",$G(^OR(100,ORIFN,4)) S CNT=CNT+1,@ORY@(CNT)="Consult No.: "_+^(4)
S CNT=CNT+1,@ORY@(CNT)=" " ;blank
D RAD^ORQ21(1):ORNMSP="RA",MED^ORQ21:ORNMSP="PS" ;add'l data
D BA^ORQ21 ;call for CIDC data
D5 K ^TMP($J,"OCDATA") I $$OCAPI^ORCHECK(+ORIFN,"OCDATA") D
. N CK,OK,X0,X,CDL,I,ACK,ALLGYDRG,HDR S HDR=0
. D:$D(IOUON) SETVIDEO(CNT,1,13,IOUON,IOUOFF)
. S ACK=0
. D ALLERGY ;405
. S:$D(OK) OK="" ;405
. S CK=0 F S CK=$O(^TMP($J,"OCDATA",CK)) Q:CK'>0 D
.. Q:$D(ALLGYDRG(CK)) ;405
.. S:HDR=0 CNT=CNT+1,@ORY@(CNT)=" ",CNT=CNT+1,@ORY@(CNT)="Order Checks:",HDR=1
.. S X0=^TMP($J,"OCDATA",CK,"OC NUMBER")_U_^TMP($J,"OCDATA",CK,"OC LEVEL")_U_U_^TMP($J,"OCDATA",CK,"OR REASON")_U_^TMP($J,"OCDATA",CK,"OR PROVIDER")_U_^TMP($J,"OCDATA",CK,"OR DT")
.. S X=^TMP($J,"OCDATA",CK,"OC TEXT",1,0)
.. S CDL=$$CDL($P(X0,U,2)) I $P(X0,U,6),'$D(OK) S OK=$P(X0,U,4,6)
.. I $L(X)'>68 S CNT=CNT+1,@ORY@(CNT)=CDL_X D XTRA Q
.. S DIWL=1,DIWR=68,DIWF="C68" K ^UTILITY($J,"W") D ^DIWP
.. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=CDL_^(I,0),CDL=" "
.. D XTRA
. K ^TMP($J,"OCDATA")
. Q:(HDR=0) ;405 quit if only allergy-drug interactions
. Q:'$L($G(OK)) S CNT=CNT+1,@ORY@(CNT)="Override: "_$S($P(OK,U,2):$$USER^ORQ20($P(OK,U,2))_" on ",1:"")_$$DATE^ORQ20($P(OK,U,3))
. I $L($P(OK,U))'>68 S CNT=CNT+1,@ORY@(CNT)=" "_$P(OK,U) Q
. S DIWL=1,DIWR=68,DIWF="C68",X=$P(OK,U) K ^UTILITY($J,"W") D ^DIWP
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^(I,0)
K ^TMP("ORWORD",$J),^UTILITY($J,"W"),ALLGYDRG
Q
;
XTRA ;
I $O(^TMP($J,"OCDATA",CK,"OC TEXT",1)) N ORXT S ORXT=1 F S ORXT=$O(^TMP($J,"OCDATA",CK,"OC TEXT",ORXT)) Q:'ORXT D
. S X=^TMP($J,"OCDATA",CK,"OC TEXT",ORXT,0),CDL=" "
. I $L(X)'>68 S CNT=CNT+1,@ORY@(CNT)=CDL_X Q
. S DIWL=1,DIWR=68,DIWF="C68" K ^UTILITY($J,"W") D ^DIWP
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=CDL_^(I,0),CDL=" "
I $O(^TMP($J,"OCDATA",CK,"OC TEXT",1)) S X="",CNT=CNT+1,@ORY@(CNT)=" "
Q
;
SUB(IFN) ; -- add suborder or parent
N ORCY,STS,STRT,IG,A,STOP,SCHED D TEXT^ORQ12(.ORCY,IFN,58)
S STS=$G(^ORD(100.01,+$P($G(^OR(100,IFN,3)),U,3),.1))
S A=^OR(100,IFN,0),STRT=$P(A,U,8),STOP=$P(A,U,9)
S SCHED=$$VALUE^ORX8(IFN,"SCHEDULE",1,"E")
S:STRT'="" STRT=$$DATE^ORQ20(STRT) I ORNMSP="LR" S:STOP]"" STOP=$$DATE^ORQ20(STOP)
S IG=0 F S IG=$O(ORCY(IG)) Q:IG<1 S CNT=CNT+1,@ORY@(CNT)=$J(STS,4)_" "_ORCY(IG)_" "_STRT,(STS,STRT)=" "
I ORNMSP="LR",STOP]"" S CNT=CNT+1,@ORY@(CNT)=$J("How often: ",16)_SCHED_" Stops: "_STOP
Q
;
WP ; -- add word-processing
N WP,ORI,X M WP=@ORDIALOG(PRMT,INST)
S CNT=CNT+1,@ORY@(CNT)=TITLE
S ORI=0 F S ORI=$O(WP(ORI)) Q:ORI'>0 S X=WP(ORI,0) S:X'="" CNT=CNT+1,@ORY@(CNT)=" "_X
Q
;
CHILDREN(PARENT) ; -- add children
N SEQ,DA,ITM,PRMT,TYPE,X
S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,SEQ)) Q:SEQ'>0 S DA=$O(^(SEQ,0)) D
. S ITM=$G(^ORD(101.41,+ORDIALOG,10,DA,0)),PRMT=$P(ITM,U,2)
. Q:$G(ORDIALOG(PRMT,INST))="" Q:$P(ITM,U,9)["*" ;no value or hide
. S TYPE=$E(ORDIALOG(PRMT,0)) D:TYPE="W" WP
. I TYPE'="W" D
. . S X=$$EXT^ORCD(PRMT,INST)
. . I $L(X,"|")=2 S X=$$REPLACE^ORHLESC(X,"|","||")
. . D ^DIWP
Q
;
SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes
S ORY("VIDEO",LINE,COL,WIDTH)=ON
S ORY("VIDEO",LINE,COL+WIDTH,0)=OFF
Q
;
VA ; -- Call VADPT
N ORY,DFN,Y S DFN=+$P(OR0,"^",2) D OERR^VADPT
Q
;
CDL(X) ; -- Returns Clinical Danger Level X
N Y S Y=$S(X=1:"HIGH:",X=2:"MODERATE:",X=3:"LOW:",1:"NONE:")
S Y=$E(Y_" ",1,12)
Q Y
;
ORIG(IFN) ; -- Return original start date of [renewal] order
N I,Y,X3,DONE
S I=IFN,Y=$P($G(^OR(100,IFN,0)),U,8),DONE=0
F S X3=$G(^OR(100,I,3)) D Q:DONE
. I $P(X3,U,11)=2,$P(X3,U,5) S I=$P(X3,U,5) Q ;loop
. S Y=$P($G(^OR(100,I,0)),U,8),DONE=1
Q Y
GMRCXTRA ; expects ORDIALOG to be populated and ORIFN to be present
N ORGMROUT,ORDGDA,ORGMRICD,ORCODE,ORISCODE,ORCODSYS
I '$G(^OR(100,ORIFN,4)) D
. S ORISCODE=ORDIALOG("B","CODE"),ORISCODE=$P(ORISCODE,U,2)
. I +$G(ORISCODE)>0 D
.. Q:'$D(ORDIALOG(ORISCODE,1))
.. S ORCODE=ORDIALOG(ORISCODE,1)
.. S ORCODSYS=$$CODECS^ICDEX(ORCODE,"80")
.. S ORGMROUT=$P($G(ORCODSYS),U,2)
I $G(^OR(100,ORIFN,4)) D
. S ORGMROUT="ICD-9-CM"
. Q:'$D(^GMR(123,+^OR(100,+ORIFN,4),30.1))
. S ORGMRICD=^GMR(123,+^OR(100,+ORIFN,4),30.1)
. I $P(ORGMRICD,U,3)="10D" S ORGMROUT="ICD-10-CM"
S ORDGDA=$G(ORDIALOG("B","CODE"))
Q:'$P(ORDGDA,U,2)
S ORDGDA=$P(ORDGDA,U,2)
Q:'$D(ORDIALOG(ORDGDA,1))
S ORDIALOG(ORDGDA,1)="("_ORGMROUT_" "_ORDIALOG(ORDGDA,1)_")"
Q
ALLERGY ;separate the ALLERGY-DRUG INTERACTION Order Checks (405)
N ORRET,ORINSTAN,ORSAVINS
S ORRET=1
S (ACK,CK)=0 F S CK=$O(^TMP($J,"OCDATA",CK)) Q:CK'>0 D
. I $G(^TMP($J,"OCDATA",CK,"OC NUMBER"))'=3 Q
. S ALLGYDRG(CK)=" "
. I ACK=0 S CNT=CNT+1,@ORY@(CNT)=" ",CNT=CNT+1,@ORY@(CNT)="Allergy Order Checks:",CNT=CNT+1,ACK=1
. S X0=^TMP($J,"OCDATA",CK,"OC NUMBER")_U_^TMP($J,"OCDATA",CK,"OC LEVEL")_U_U_^TMP($J,"OCDATA",CK,"OR REASON")_U_^TMP($J,"OCDATA",CK,"OR PROVIDER")_U_^TMP($J,"OCDATA",CK,"OR DT")
. S X=^TMP($J,"OCDATA",CK,"OC TEXT",1,0)
. S CDL=$$CDL($P(X0,U,2)) I $P(X0,U,6),'$D(OK) S OK=$P(X0,U,4,6)
. I $L(X)'>68 S CNT=CNT+1,@ORY@(CNT)=CDL_X D XTRA Q
. S DIWL=1,DIWR=68,DIWF="C68" K ^UTILITY($J,"W") D ^DIWP
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=CDL_^UTILITY($J,"W",DIWL,I,0),CDL=" "
. S ORINSTAN=$G(^TMP($J,"OCDATA",CK,"OC INSTANCE"))
. I ORINSTAN>0 D
.. I $$GET1^DIQ(100.517,ORRET_","_ORINSTAN_",",11)'="" D
... S:'$D(ORSAVINS) ORSAVINS=ORINSTAN
. D XTRA
I ACK=1 D
. Q:'$L($G(OK)) S CNT=CNT+1,@ORY@(CNT)="Override: "_$S($P(OK,U,2):$$USER^ORQ20($P(OK,U,2))_" on ",1:"")_$$DATE^ORQ20($P(OK,U,3))
. I $L($P(OK,U))'>68 S CNT=CNT+1,@ORY@(CNT)=" "_$P(OK,U),CNT=CNT+1 Q
. S DIWL=1,DIWR=68,DIWF="C68",X=$P(OK,U) K ^UTILITY($J,"W") D ^DIWP
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=" "_^UTILITY($J,"W",DIWL,I,0)
I $D(ORSAVINS) D
. S CNT=CNT+1,@ORY@(CNT)=" "
. S CNT=CNT+1,@ORY@(CNT)="Remote Comment: "_$$GET1^DIQ(100.517,ORRET_","_ORSAVINS_",",11)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQ2 12027 printed Apr 09, 2024@21:41:18 Page 2
ORQ2 ; SLC/MKB/GSS - Detailed Order Report ;Aug 9, 2021@13:40:01
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,56,75,94,141,213,195,243,282,293,280,346,361,471,453,405**;Dec 17, 1997;Build 211
+2 ;
+3 ;
+4 ;Reference to ^DIC(45.7 supported by IA #519
+5 ;Reference to OERR^VADPT supported by IA #4325
+6 ;Reference to CODECS^ICDEX supported by ICR #5747
+7 ;
DETAIL(ORY,ORIFN) ; -- Returns details of order ORIFN in ORY(#)
+1 NEW X,X2,I,CNT,ORDIALOG,OR0,OR3,OR6,SEQ,ITEM,PRMT,MULT,FIRST,TITLE,INST,DIWL,DIWR,DIWF,ACTION,VAIN,ORIGVIEW,ORNMSP,ORYT,ORCRACT
+2 ; OR*3*453 rbd Var needed for ORDER TRANSFERS logic below
NEW ORTRANS
+3 ; p 471 added ORCACT to use action if passed in
+4 SET CNT=0
SET ORCRACT=+$PIECE(ORIFN,";",2)
SET ORIFN=+ORIFN
SET OR0=$GET(^OR(100,ORIFN,0))
SET OR3=$GET(^(3))
SET OR6=$GET(^(6))
+5 SET ORNMSP=$$NMSP^ORCD($PIECE(OR0,U,14))
+6 ; p 471 if no action, default to CURRENT ACTION..or if not $O(<The action subfile>, -1)
+7 if 'ORCRACT
SET ORCRACT=$SELECT(+$PIECE(OR3,U,7):+$PIECE(OR3,U,7),1:+$ORDER(^OR(100,ORIFN,8,":"),-1))
+8 ;CurrTx
KILL @ORY,ORYT
SET ORIGVIEW=1
DO TEXT^ORQ12(.ORYT,+ORIFN_";"_ORCRACT,80)
+9 ;Move text to global
MERGE @ORY=ORYT
+10 SET I=0
FOR CNT=1:1
SET I=$ORDER(ORYT(I))
if I'>0
QUIT
if $DATA(IORVON)
DO SETVIDEO(I,1,$LENGTH(ORYT(I)),IORVON,IORVOFF)
+11 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
D1 IF $ORDER(^OR(100,+ORIFN,2,0))
Begin DoDot:1
+1 SET CNT=CNT+1
SET @ORY@(CNT)="Sub Orders:"
+2 if $DATA(IOUON)
DO SETVIDEO(CNT,1,11,IOUON,IOUOFF)
+3 NEW IFN
SET IFN=0
+4 FOR
SET IFN=+$ORDER(^OR(100,+ORIFN,2,IFN))
if IFN<1
QUIT
IF $DATA(^OR(100,IFN,0))
DO SUB(IFN)
+5 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
End DoDot:1
+6 IF $PIECE(OR3,U,9)
IF $DATA(^OR(100,+$PIECE(OR3,U,9),0))
Begin DoDot:1
+7 SET CNT=CNT+1
SET @ORY@(CNT)="Parent Order:"
+8 if $DATA(IOUON)
DO SETVIDEO(CNT,1,12,IOUON,IOUOFF)
+9 DO SUB(+$PIECE(OR3,U,9))
+10 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
End DoDot:1
+11 ;Changed - show previous order
IF $PIECE(OR3,U,11)=1
IF $PIECE(OR3,U,5)
Begin DoDot:1
+12 SET CNT=CNT+1
SET @ORY@(CNT)="Previous Order:"
+13 ;prev order original text
if $DATA(IOUON)
DO SETVIDEO(CNT,1,15,IOUON,IOUOFF)
+14 NEW ORZ,I,ORIGVIEW
SET ORIGVIEW=2
DO TEXT^ORQ12(.ORZ,+$PIECE(OR3,U,5),55)
+15 SET CNT=CNT+1
SET @ORY@(CNT)=" Order Text: "_$GET(ORZ(1))
+16 SET I=1
FOR
SET I=$ORDER(ORZ(I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$GET(ORZ(I))
End DoDot:1
D2 SET CNT=CNT+1
SET @ORY@(CNT)="Activity:"
+1 if $DATA(IOUON)
DO SETVIDEO(CNT,1,9,IOUON,IOUOFF)
+2 SET DIWL=1
SET DIWR=64
SET DIWF="C64"
SET ORI=0
KILL ^UTILITY($JOB,"W")
+3 FOR
SET ORI=$ORDER(^OR(100,ORIFN,8,ORI))
if ORI'>0
QUIT
SET ACTION=$GET(^(ORI,0))
DO ACT^ORQ20
+4 ; RBD OR*3.0*453 Add ORDER TRANSFERS information
+5 SET ORI=0
FOR
SET ORI=$ORDER(^OR(100,ORIFN,11,ORI))
if ORI'>0
QUIT
Begin DoDot:1
+6 IF ORI=1
Begin DoDot:2
+7 SET CNT=CNT+1
SET @ORY@(CNT)=" "
SET CNT=CNT+1
SET @ORY@(CNT)="Reassignments (Transfers):"
End DoDot:2
+8 SET ORTRANS=$GET(^OR(100,ORIFN,11,ORI,0))
+9 SET CNT=CNT+1
SET @ORY@(CNT)="Transferred from "_$$USER^ORQ20($PIECE(ORTRANS,U,2))_" to "_$$USER^ORQ20($PIECE(ORTRANS,U,3))
+10 SET CNT=CNT+1
SET @ORY@(CNT)=" by "_$$USER^ORQ20($PIECE(ORTRANS,U,4))_" Effective From "_$$DATE^ORQ20($PIECE(ORTRANS,U))
End DoDot:1
+11 IF $DATA(^OR(100,ORIFN,11))
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+12 IF "^1^12^13^"[(U_$PIECE(OR3,U,3)_U)
IF $LENGTH(OR6)
IF $PIECE(ACTION,U,2)'="DC"
DO DC^ORQ20
+13 IF $PIECE(OR3,U,3)=2
IF $PIECE(OR6,U,6)
SET CNT=CNT+1
SET @ORY@(CNT)=$$DATE^ORQ20($PIECE(OR6,U,6))_" Completed"_$SELECT($PIECE(OR6,U,7):" by "_$$USER^ORQ20($PIECE(OR6,U,7)),1:"")
+14 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
D3 SET CNT=CNT+1
SET @ORY@(CNT)="Current Data:"
+1 if $DATA(IOUON)
DO SETVIDEO(CNT,1,13,IOUON,IOUOFF)
+2 DO VA
IF $GET(VAIN(2))
SET CNT=CNT+1
SET @ORY@(CNT)="Current Primary Provider: "_$PIECE(VAIN(2),"^",2)
+3 IF $GET(VAIN(11))
SET CNT=CNT+1
SET @ORY@(CNT)="Current Attending Physician: "_$PIECE(VAIN(11),"^",2)
+4 SET CNT=CNT+1
SET @ORY@(CNT)="Treating Specialty: "_$PIECE($GET(^DIC(45.7,+$PIECE(OR0,U,13),0)),U)
+5 SET CNT=CNT+1
SET @ORY@(CNT)="Ordering Location: "_$PIECE($GET(^SC(+$PIECE(OR0,U,10),0)),U)
+6 SET CNT=CNT+1
SET @ORY@(CNT)="Start Date/Time: "_$SELECT($PIECE(OR0,U,8):$$DATE^ORQ20($PIECE(OR0,U,8)),1:"")
+7 IF $PIECE(OR3,U,5)
IF $PIECE(OR3,U,11)=2
SET X=$$ORIG(ORIFN)
SET @ORY@(CNT)=@ORY@(CNT)_" (originally "_$$DATE^ORQ20(X)_")"
+8 SET CNT=CNT+1
SET @ORY@(CNT)="Stop Date/Time: "_$SELECT($PIECE(OR0,U,9):$$DATE^ORQ20($PIECE(OR0,U,9)),1:"")
+9 IF $PIECE(OR3,U,3)=1
IF $PIECE(OR6,U,6)
SET @ORY@(CNT)=@ORY@(CNT)_" (expired "_$$DATE^ORQ20($PIECE(OR6,U,6))_")"
+10 SET CNT=CNT+1
SET @ORY@(CNT)="Current Status: "_$SELECT($DATA(^ORD(100.01,+$PIECE(OR3,U,3),0)):$PIECE(^(0),"^"),1:"-")
+11 IF $$GET^XPAR("ALL","ORPF SHOW STATUS DESCRIPTION",1,"I")
IF $PIECE(OR3,U,3)
IF $DATA(^ORD(100.01,$PIECE(OR3,U,3),0))
NEW J
SET J=0
FOR
SET J=$ORDER(^ORD(100.01,$PIECE(OR3,U,3),1,J))
if J<1
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=" "_^(J,0)
+12 SET CNT=CNT+1
SET @ORY@(CNT)="Order #"_ORIFN
+13 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
D4 SET CNT=CNT+1
SET @ORY@(CNT)="Order:"
if $DATA(IOUON)
DO SETVIDEO(CNT,1,6,IOUON,IOUOFF)
+1 IF '$ORDER(^OR(100,ORIFN,4.5,0))
IF ORNMSP="RA"
DO RAD^ORQ21("")
QUIT
+2 ; 2.5 order
SET ORDIALOG=$PIECE(OR0,U,5)
if $PIECE(ORDIALOG,";",2)="ORD(101,"
QUIT
+3 DO GETDLG^ORCD(+ORDIALOG)
DO GETORDER^ORCD(ORIFN)
+4 IF ORNMSP="GMRC"
DO GMRCXTRA
+5 SET DIWL=1
SET DIWR=50
SET DIWF="C50"
+6 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ))
if SEQ'>0
QUIT
SET DA=0
FOR
SET DA=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA))
if 'DA
QUIT
Begin DoDot:1
+7 ; child
SET ITEM=$GET(^ORD(101.41,+ORDIALOG,10,DA,0))
if $PIECE(ITEM,U,11)
QUIT
+8 ;hide
SET PRMT=$PIECE(ITEM,U,2)
SET MULT=$PIECE(ITEM,U,7)
if $PIECE(ITEM,U,9)["*"
QUIT
+9 ; no values
SET FIRST=$ORDER(ORDIALOG(PRMT,0))
if 'FIRST
QUIT
+10 SET TITLE=$SELECT(MULT&$LENGTH($GET(ORDIALOG(PRMT,"TTL"))):ORDIALOG(PRMT,"TTL"),1:ORDIALOG(PRMT,"A"))
+11 SET TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$LENGTH(TITLE))
+12 SET INST=0
FOR
SET INST=$ORDER(ORDIALOG(PRMT,INST))
if INST'>0
QUIT
Begin DoDot:2
+13 IF $EXTRACT(ORDIALOG(PRMT,0))="W"
DO WP
QUIT
+14 KILL ^UTILITY($JOB,"W")
SET X=$$EXT^ORCD(PRMT,INST)
IF TITLE["Infusion Rate"&(X'="")&(X'["ml/hr")
SET TITLE="Infuse Over Time:"
SET TITLE=TITLE_$$REPEAT^XLFSTR(" ",30-$LENGTH(TITLE))
+15 DO ^DIWP
+16 if $DATA(^ORD(101.41,+ORDIALOG,10,"DAD",PRMT))
DO CHILDREN(PRMT)
+17 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$SELECT((INST=FIRST)&(I=1):TITLE,1:$$REPEAT^XLFSTR(" ",30))_^(I,0)
End DoDot:2
End DoDot:1
+18 IF ORNMSP="GMRC"
IF $GET(^OR(100,ORIFN,4))
SET CNT=CNT+1
SET @ORY@(CNT)="Consult No.: "_+^(4)
+19 ;blank
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+20 ;add'l data
if ORNMSP="RA"
DO RAD^ORQ21(1)
if ORNMSP="PS"
DO MED^ORQ21
+21 ;call for CIDC data
DO BA^ORQ21
D5 KILL ^TMP($JOB,"OCDATA")
IF $$OCAPI^ORCHECK(+ORIFN,"OCDATA")
Begin DoDot:1
+1 NEW CK,OK,X0,X,CDL,I,ACK,ALLGYDRG,HDR
SET HDR=0
+2 if $DATA(IOUON)
DO SETVIDEO(CNT,1,13,IOUON,IOUOFF)
+3 SET ACK=0
+4 ;405
DO ALLERGY
+5 ;405
if $DATA(OK)
SET OK=""
+6 SET CK=0
FOR
SET CK=$ORDER(^TMP($JOB,"OCDATA",CK))
if CK'>0
QUIT
Begin DoDot:2
+7 ;405
if $DATA(ALLGYDRG(CK))
QUIT
+8 if HDR=0
SET CNT=CNT+1
SET @ORY@(CNT)=" "
SET CNT=CNT+1
SET @ORY@(CNT)="Order Checks:"
SET HDR=1
+9 SET X0=^TMP($JOB,"OCDATA",CK,"OC NUMBER")_U_^TMP($JOB,"OCDATA",CK,"OC LEVEL")_U_U_^TMP($JOB,"OCDATA",CK,"OR REASON")_U_^TMP($JOB,"OCDATA",CK,"OR PROVIDER")_U_^TMP($JOB,"OCDATA",CK,"OR DT")
+10 SET X=^TMP($JOB,"OCDATA",CK,"OC TEXT",1,0)
+11 SET CDL=$$CDL($PIECE(X0,U,2))
IF $PIECE(X0,U,6)
IF '$DATA(OK)
SET OK=$PIECE(X0,U,4,6)
+12 IF $LENGTH(X)'>68
SET CNT=CNT+1
SET @ORY@(CNT)=CDL_X
DO XTRA
QUIT
+13 SET DIWL=1
SET DIWR=68
SET DIWF="C68"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+14 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=CDL_^(I,0)
SET CDL=" "
+15 DO XTRA
End DoDot:2
+16 KILL ^TMP($JOB,"OCDATA")
+17 ;405 quit if only allergy-drug interactions
if (HDR=0)
QUIT
+18 if '$LENGTH($GET(OK))
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)="Override: "_$SELECT($PIECE(OK,U,2):$$USER^ORQ20($PIECE(OK,U,2))_" on ",1:"")_$$DATE^ORQ20($PIECE(OK,U,3))
+19 IF $LENGTH($PIECE(OK,U))'>68
SET CNT=CNT+1
SET @ORY@(CNT)=" "_$PIECE(OK,U)
QUIT
+20 SET DIWL=1
SET DIWR=68
SET DIWF="C68"
SET X=$PIECE(OK,U)
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+21 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=" "_^(I,0)
End DoDot:1
+22 KILL ^TMP("ORWORD",$JOB),^UTILITY($JOB,"W"),ALLGYDRG
+23 QUIT
+24 ;
XTRA ;
+1 IF $ORDER(^TMP($JOB,"OCDATA",CK,"OC TEXT",1))
NEW ORXT
SET ORXT=1
FOR
SET ORXT=$ORDER(^TMP($JOB,"OCDATA",CK,"OC TEXT",ORXT))
if 'ORXT
QUIT
Begin DoDot:1
+2 SET X=^TMP($JOB,"OCDATA",CK,"OC TEXT",ORXT,0)
SET CDL=" "
+3 IF $LENGTH(X)'>68
SET CNT=CNT+1
SET @ORY@(CNT)=CDL_X
QUIT
+4 SET DIWL=1
SET DIWR=68
SET DIWF="C68"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+5 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=CDL_^(I,0)
SET CDL=" "
End DoDot:1
+6 IF $ORDER(^TMP($JOB,"OCDATA",CK,"OC TEXT",1))
SET X=""
SET CNT=CNT+1
SET @ORY@(CNT)=" "
+7 QUIT
+8 ;
SUB(IFN) ; -- add suborder or parent
+1 NEW ORCY,STS,STRT,IG,A,STOP,SCHED
DO TEXT^ORQ12(.ORCY,IFN,58)
+2 SET STS=$GET(^ORD(100.01,+$PIECE($GET(^OR(100,IFN,3)),U,3),.1))
+3 SET A=^OR(100,IFN,0)
SET STRT=$PIECE(A,U,8)
SET STOP=$PIECE(A,U,9)
+4 SET SCHED=$$VALUE^ORX8(IFN,"SCHEDULE",1,"E")
+5 if STRT'=""
SET STRT=$$DATE^ORQ20(STRT)
IF ORNMSP="LR"
if STOP]""
SET STOP=$$DATE^ORQ20(STOP)
+6 SET IG=0
FOR
SET IG=$ORDER(ORCY(IG))
if IG<1
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$JUSTIFY(STS,4)_" "_ORCY(IG)_" "_STRT
SET (STS,STRT)=" "
+7 IF ORNMSP="LR"
IF STOP]""
SET CNT=CNT+1
SET @ORY@(CNT)=$JUSTIFY("How often: ",16)_SCHED_" Stops: "_STOP
+8 QUIT
+9 ;
WP ; -- add word-processing
+1 NEW WP,ORI,X
MERGE WP=@ORDIALOG(PRMT,INST)
+2 SET CNT=CNT+1
SET @ORY@(CNT)=TITLE
+3 SET ORI=0
FOR
SET ORI=$ORDER(WP(ORI))
if ORI'>0
QUIT
SET X=WP(ORI,0)
if X'=""
SET CNT=CNT+1
SET @ORY@(CNT)=" "_X
+4 QUIT
+5 ;
CHILDREN(PARENT) ; -- add children
+1 NEW SEQ,DA,ITM,PRMT,TYPE,X
+2 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,+ORDIALOG,10,"DAD",PARENT,SEQ))
if SEQ'>0
QUIT
SET DA=$ORDER(^(SEQ,0))
Begin DoDot:1
+3 SET ITM=$GET(^ORD(101.41,+ORDIALOG,10,DA,0))
SET PRMT=$PIECE(ITM,U,2)
+4 ;no value or hide
if $GET(ORDIALOG(PRMT,INST))=""
QUIT
if $PIECE(ITM,U,9)["*"
QUIT
+5 SET TYPE=$EXTRACT(ORDIALOG(PRMT,0))
if TYPE="W"
DO WP
+6 IF TYPE'="W"
Begin DoDot:2
+7 SET X=$$EXT^ORCD(PRMT,INST)
+8 IF $LENGTH(X,"|")=2
SET X=$$REPLACE^ORHLESC(X,"|","||")
+9 DO ^DIWP
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes
+1 SET ORY("VIDEO",LINE,COL,WIDTH)=ON
+2 SET ORY("VIDEO",LINE,COL+WIDTH,0)=OFF
+3 QUIT
+4 ;
VA ; -- Call VADPT
+1 NEW ORY,DFN,Y
SET DFN=+$PIECE(OR0,"^",2)
DO OERR^VADPT
+2 QUIT
+3 ;
CDL(X) ; -- Returns Clinical Danger Level X
+1 NEW Y
SET Y=$SELECT(X=1:"HIGH:",X=2:"MODERATE:",X=3:"LOW:",1:"NONE:")
+2 SET Y=$EXTRACT(Y_" ",1,12)
+3 QUIT Y
+4 ;
ORIG(IFN) ; -- Return original start date of [renewal] order
+1 NEW I,Y,X3,DONE
+2 SET I=IFN
SET Y=$PIECE($GET(^OR(100,IFN,0)),U,8)
SET DONE=0
+3 FOR
SET X3=$GET(^OR(100,I,3))
Begin DoDot:1
+4 ;loop
IF $PIECE(X3,U,11)=2
IF $PIECE(X3,U,5)
SET I=$PIECE(X3,U,5)
QUIT
+5 SET Y=$PIECE($GET(^OR(100,I,0)),U,8)
SET DONE=1
End DoDot:1
if DONE
QUIT
+6 QUIT Y
GMRCXTRA ; expects ORDIALOG to be populated and ORIFN to be present
+1 NEW ORGMROUT,ORDGDA,ORGMRICD,ORCODE,ORISCODE,ORCODSYS
+2 IF '$GET(^OR(100,ORIFN,4))
Begin DoDot:1
+3 SET ORISCODE=ORDIALOG("B","CODE")
SET ORISCODE=$PIECE(ORISCODE,U,2)
+4 IF +$GET(ORISCODE)>0
Begin DoDot:2
+5 if '$DATA(ORDIALOG(ORISCODE,1))
QUIT
+6 SET ORCODE=ORDIALOG(ORISCODE,1)
+7 SET ORCODSYS=$$CODECS^ICDEX(ORCODE,"80")
+8 SET ORGMROUT=$PIECE($GET(ORCODSYS),U,2)
End DoDot:2
End DoDot:1
+9 IF $GET(^OR(100,ORIFN,4))
Begin DoDot:1
+10 SET ORGMROUT="ICD-9-CM"
+11 if '$DATA(^GMR(123,+^OR(100,+ORIFN,4),30.1))
QUIT
+12 SET ORGMRICD=^GMR(123,+^OR(100,+ORIFN,4),30.1)
+13 IF $PIECE(ORGMRICD,U,3)="10D"
SET ORGMROUT="ICD-10-CM"
End DoDot:1
+14 SET ORDGDA=$GET(ORDIALOG("B","CODE"))
+15 if '$PIECE(ORDGDA,U,2)
QUIT
+16 SET ORDGDA=$PIECE(ORDGDA,U,2)
+17 if '$DATA(ORDIALOG(ORDGDA,1))
QUIT
+18 SET ORDIALOG(ORDGDA,1)="("_ORGMROUT_" "_ORDIALOG(ORDGDA,1)_")"
+19 QUIT
ALLERGY ;separate the ALLERGY-DRUG INTERACTION Order Checks (405)
+1 NEW ORRET,ORINSTAN,ORSAVINS
+2 SET ORRET=1
+3 SET (ACK,CK)=0
FOR
SET CK=$ORDER(^TMP($JOB,"OCDATA",CK))
if CK'>0
QUIT
Begin DoDot:1
+4 IF $GET(^TMP($JOB,"OCDATA",CK,"OC NUMBER"))'=3
QUIT
+5 SET ALLGYDRG(CK)=" "
+6 IF ACK=0
SET CNT=CNT+1
SET @ORY@(CNT)=" "
SET CNT=CNT+1
SET @ORY@(CNT)="Allergy Order Checks:"
SET CNT=CNT+1
SET ACK=1
+7 SET X0=^TMP($JOB,"OCDATA",CK,"OC NUMBER")_U_^TMP($JOB,"OCDATA",CK,"OC LEVEL")_U_U_^TMP($JOB,"OCDATA",CK,"OR REASON")_U_^TMP($JOB,"OCDATA",CK,"OR PROVIDER")_U_^TMP($JOB,"OCDATA",CK,"OR DT")
+8 SET X=^TMP($JOB,"OCDATA",CK,"OC TEXT",1,0)
+9 SET CDL=$$CDL($PIECE(X0,U,2))
IF $PIECE(X0,U,6)
IF '$DATA(OK)
SET OK=$PIECE(X0,U,4,6)
+10 IF $LENGTH(X)'>68
SET CNT=CNT+1
SET @ORY@(CNT)=CDL_X
DO XTRA
QUIT
+11 SET DIWL=1
SET DIWR=68
SET DIWF="C68"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+12 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=CDL_^UTILITY($JOB,"W",DIWL,I,0)
SET CDL=" "
+13 SET ORINSTAN=$GET(^TMP($JOB,"OCDATA",CK,"OC INSTANCE"))
+14 IF ORINSTAN>0
Begin DoDot:2
+15 IF $$GET1^DIQ(100.517,ORRET_","_ORINSTAN_",",11)'=""
Begin DoDot:3
+16 if '$DATA(ORSAVINS)
SET ORSAVINS=ORINSTAN
End DoDot:3
End DoDot:2
+17 DO XTRA
End DoDot:1
+18 IF ACK=1
Begin DoDot:1
+19 if '$LENGTH($GET(OK))
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)="Override: "_$SELECT($PIECE(OK,U,2):$$USER^ORQ20($PIECE(OK,U,2))_" on ",1:"")_$$DATE^ORQ20($PIECE(OK,U,3))
+20 IF $LENGTH($PIECE(OK,U))'>68
SET CNT=CNT+1
SET @ORY@(CNT)=" "_$PIECE(OK,U)
SET CNT=CNT+1
QUIT
+21 SET DIWL=1
SET DIWR=68
SET DIWF="C68"
SET X=$PIECE(OK,U)
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+22 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=" "_^UTILITY($JOB,"W",DIWL,I,0)
End DoDot:1
+23 IF $DATA(ORSAVINS)
Begin DoDot:1
+24 SET CNT=CNT+1
SET @ORY@(CNT)=" "
+25 SET CNT=CNT+1
SET @ORY@(CNT)="Remote Comment: "_$$GET1^DIQ(100.517,ORRET_","_ORSAVINS_",",11)
End DoDot:1
+26 QUIT
