ORRHCO ; SLC/KCM - CPRS Query Tools - Orders ; [4/4/02 2:07pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,242**;Dec 17, 1997;Build 6
;
NXT() ; Increment ILST
S ILST=ILST+1
Q ILST
;
ORDITM(Y,FROM,DIR,XREF) ; Return a subset of orderable items
; .Return Array, Starting Text, Direction, Cross Reference (B or S.x)
; ^ORD(101.43,"S.xxx",UpperCase,DA)=Mne^MixedCase^InactvDt^.01IfMne
; Y(n)=IEN^.01 Name^.01 Name -or- IEN^Synonym <.01 Name>^.01 Name
; similar to ORDITM^ORWDX but does not screen inactives
N I,X,IEN,CNT,SKIP S I=0,CNT=44,SKIP=0
F Q:I'<CNT S FROM=$O(^ORD(101.43,XREF,FROM),DIR) Q:FROM="" D
. S IEN="" F S IEN=$O(^ORD(101.43,XREF,FROM,IEN),DIR) Q:'IEN D
. . I XREF="B" D
. . . I $D(^ORD(101.43,XREF,FROM,IEN))=1 S X=FROM
. . . E S X=FROM_" <"_$P(^ORD(101.43,IEN,0),U,1)_">"
. . . S I=I+1,Y(I)=IEN_U_X
. . E D
. . . S X=^ORD(101.43,XREF,FROM,IEN)
. . . I 'X S X=$P(X,U,2)
. . . E S X=$P(X,U,2)_" <"_$P(X,U,4)_">"
. . . I (XREF="S.CSLT"),($$UP^XLFSTR(X)["ALL SERVICE") Q
. . . E S I=I+1,Y(I)=IEN_U_X
Q
CGRP(ORY) ;Return Consult Display Group
S ORY="ALL SERVICES"_U_$O(^ORD(100.98,"B","CSLT",0))
Q
OISETS(LST) ; Return a list of sets for orderable items
N DGNM,IEN,SHORT,IDX
S LST(1)="^(no limit)",IDX=1
S DGNM="" F S DGNM=$O(^ORD(100.98,"B",DGNM)) Q:DGNM="" D
. S IEN=0 F S IEN=$O(^ORD(100.98,"B",DGNM,IEN)) Q:'IEN D
. . I ^ORD(100.98,"B",DGNM,IEN)=1 Q
. . S SHORT=$P(^ORD(100.98,IEN,0),U,3)
. . I $D(^ORD(101.43,"S."_SHORT)) S IDX=IDX+1,LST(IDX)=SHORT_U_DGNM
Q
ORDSTS(LST) ; List order statuses
N ILST,X,IEN S ILST=0
S X="" F S X=$O(^ORD(100.01,"B",X)) Q:X="" D
. S IEN=0 F S IEN=$O(^ORD(100.01,"B",X,IEN)) Q:'IEN D
. . Q:$$SCREEN^XTID(100.01,,IEN_",") ;inactive VUID
. . S LST($$NXT)=IEN_U_X
Q
SIGNSTS(LST) ; List order signature statuses
S LST(1)="0^ON CHART w/written orders"
S LST(2)="1^ELECTRONIC"
S LST(3)="2^NOT SIGNED"
S LST(4)="3^NOT REQUIRED"
S LST(5)="4^ON CHART w/printed orders"
S LST(6)="5^NOT REQUIRED due to cancel"
S LST(7)="6^SERVICE CORRECTION to signed order"
S LST(8)="7^DIGITALLY SIGNED"
Q
ABSTRT(Y,NIL) ;Return abnormal result start date
S Y=$$GET^XPAR("SYS^PKG","ORHEPC ABNORMAL START",1,"I")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORRHCO 2269 printed Nov 22, 2024@17:43:54 Page 2
ORRHCO ; SLC/KCM - CPRS Query Tools - Orders ; [4/4/02 2:07pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,242**;Dec 17, 1997;Build 6
+2 ;
NXT() ; Increment ILST
+1 SET ILST=ILST+1
+2 QUIT ILST
+3 ;
ORDITM(Y,FROM,DIR,XREF) ; Return a subset of orderable items
+1 ; .Return Array, Starting Text, Direction, Cross Reference (B or S.x)
+2 ; ^ORD(101.43,"S.xxx",UpperCase,DA)=Mne^MixedCase^InactvDt^.01IfMne
+3 ; Y(n)=IEN^.01 Name^.01 Name -or- IEN^Synonym <.01 Name>^.01 Name
+4 ; similar to ORDITM^ORWDX but does not screen inactives
+5 NEW I,X,IEN,CNT,SKIP
SET I=0
SET CNT=44
SET SKIP=0
+6 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^ORD(101.43,XREF,FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+7 SET IEN=""
FOR
SET IEN=$ORDER(^ORD(101.43,XREF,FROM,IEN),DIR)
if 'IEN
QUIT
Begin DoDot:2
+8 IF XREF="B"
Begin DoDot:3
+9 IF $DATA(^ORD(101.43,XREF,FROM,IEN))=1
SET X=FROM
+10 IF '$TEST
SET X=FROM_" <"_$PIECE(^ORD(101.43,IEN,0),U,1)_">"
+11 SET I=I+1
SET Y(I)=IEN_U_X
End DoDot:3
+12 IF '$TEST
Begin DoDot:3
+13 SET X=^ORD(101.43,XREF,FROM,IEN)
+14 IF 'X
SET X=$PIECE(X,U,2)
+15 IF '$TEST
SET X=$PIECE(X,U,2)_" <"_$PIECE(X,U,4)_">"
+16 IF (XREF="S.CSLT")
IF ($$UP^XLFSTR(X)["ALL SERVICE")
QUIT
+17 IF '$TEST
SET I=I+1
SET Y(I)=IEN_U_X
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
CGRP(ORY) ;Return Consult Display Group
+1 SET ORY="ALL SERVICES"_U_$ORDER(^ORD(100.98,"B","CSLT",0))
+2 QUIT
OISETS(LST) ; Return a list of sets for orderable items
+1 NEW DGNM,IEN,SHORT,IDX
+2 SET LST(1)="^(no limit)"
SET IDX=1
+3 SET DGNM=""
FOR
SET DGNM=$ORDER(^ORD(100.98,"B",DGNM))
if DGNM=""
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(100.98,"B",DGNM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+5 IF ^ORD(100.98,"B",DGNM,IEN)=1
QUIT
+6 SET SHORT=$PIECE(^ORD(100.98,IEN,0),U,3)
+7 IF $DATA(^ORD(101.43,"S."_SHORT))
SET IDX=IDX+1
SET LST(IDX)=SHORT_U_DGNM
End DoDot:2
End DoDot:1
+8 QUIT
ORDSTS(LST) ; List order statuses
+1 NEW ILST,X,IEN
SET ILST=0
+2 SET X=""
FOR
SET X=$ORDER(^ORD(100.01,"B",X))
if X=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(100.01,"B",X,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 ;inactive VUID
if $$SCREEN^XTID(100.01,,IEN_",")
QUIT
+5 SET LST($$NXT)=IEN_U_X
End DoDot:2
End DoDot:1
+6 QUIT
SIGNSTS(LST) ; List order signature statuses
+1 SET LST(1)="0^ON CHART w/written orders"
+2 SET LST(2)="1^ELECTRONIC"
+3 SET LST(3)="2^NOT SIGNED"
+4 SET LST(4)="3^NOT REQUIRED"
+5 SET LST(5)="4^ON CHART w/printed orders"
+6 SET LST(6)="5^NOT REQUIRED due to cancel"
+7 SET LST(7)="6^SERVICE CORRECTION to signed order"
+8 SET LST(8)="7^DIGITALLY SIGNED"
+9 QUIT
ABSTRT(Y,NIL) ;Return abnormal result start date
+1 SET Y=$$GET^XPAR("SYS^PKG","ORHEPC ABNORMAL START",1,"I")
+2 QUIT
