VIABMS3 ;SGU/GJW - VIA BMS RPCs ;04/15/2016
;;1.0;VISTA INTEGRATION ADAPTER;**8,11,13**;06-FEB-2014;Build 7
;
ORDACT ; Returns a list of order actions from the ORDER file #100.008
;Input - VIA("PATH")="LISTORDERACTIONS" [required]
; VIA("ORDIEN")=list of orderable IEN separated by a comma (",") [required],if VIA("VALUE")=1
; VIA("SDATE")=Start Date for search [optional]. Defaults to today's date, if no date is passed in
; VIA("EDATE")=End Date for search [optional]. Defaults to today's date, if no date is passed in
; VIA("IENS")=Order IEN [required]
; VIA("VALUE")=1 or 2 required]. 1 to filter by orderable item(s), 2 to filter by orderable action
;Data returned
; .01 Date/Time Ordered,6 Date/Time Signed,16 Release Date/Time,5 Signed By,3 Provider,.1 Order Text
N VIAFILE,VIAFIELDS,VIAFLAGS,OITM,I,TRESULT,I,X,N,IEN,VIATIEN,DATAFLG
S VIAFILE=100.008,VIAFIELDS="@;.01;6;16;5;3",VIAFLAGS="IP"
I 'VIAVAL S VIAER="Missing VALUE of 1 or 2" D ERR^VIABMS(VIAER) Q
S:VIASDT="" VIASDT=DT S:VIAEDT="" VIAEDT=DT
D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
I VIAIENS="" S VIAER="Missing Order number" D ERR^VIABMS(VIAER) Q
I $G(VIAOIEN)'="" F I=1:1:$L(VIAOIEN,",") S OITM=$P(VIAOIEN,",",I) I OITM'="" S VIAOI(OITM)=""
I VIAVAL=1,$O(VIAOI(""))="" S VIAER="Missing Orderable Items IEN" D ERR^VIABMS(VIAER) Q
S VIAID="I $D(^OR(100,DA(1),8,Y,.1)) S I=0 F S I=$O(^OR(100,DA(1),8,Y,.1,I)) Q:'I S J=$P(^(I,0),U) D EN^DDIOL(J)"
I VIAVAL=1 D
. S VIASCRN="S VIAOK=0,VIADLA=$P($G(^OR(100,Y(1),3)),U) S VIAX=0 F S VIAX=$O(^OR(100,Y(1),.1,VIAX)) Q:'VIAX I VIAX>0 S VIAV=$P(^OR(100,Y(1),.1,VIAX,0),U,1) I $$BETWEEN^VIABMS(VIADLA,VIASDT,VIAEDT)&$D(VIAOI(VIAV)) S VIAOK=1 Q"
I VIAVAL=2 D
. S VIASCRN="S VIADLA=$P($G(^OR(100,Y(1),3)),U),VIAA=Y(1),(VIAB,VIAC,VIAD,VIAX,VIAE)=0,VIAE=$$BETWEEN^VIABMS(VIADLA,VIASDT,VIAEDT) F S VIAX=$O(^OR(100,VIAA,8,Y,.1,VIAX)) Q:'VIAX I VIAX>0 S VIAR=$$UP^XLFSTR(^OR(100,VIAA,8,Y,.1,VIAX,0)) "
. S VIASCRN=VIASCRN_"S VIAB=VIAB!(VIAR[""ANTICIPATE""),VIAC=VIAC!(VIAR[""PLANNED""),VIAD=VIAD!(VIAR[""DISCHARGE"") I VIAE&(VIAB!VIAC&VIAD) Q"
; multiple IENs
S VIATIEN=VIAIENS,N=0,DATAFLG=0
F I=1:1:$L(VIATIEN,",") S IEN=$P(VIATIEN,",",I) I IEN'="" D
. S VIAIENS=","_IEN_","
. K RESULT
. D LDIC^VIABMS
. S X=0 F S X=$O(RESULT(X)) Q:'X D
. . Q:(RESULT(X)["[Data]")&(DATAFLG) I RESULT(X)["[Data]" S DATAFLG=1 ;list [Data] only once
. . S:(RESULT(X)'["[")&($P(RESULT(X),"^")) $P(RESULT(X),"^")=IEN
. . S N=N+1,TRESULT(N)=RESULT(X)
. K RESULT
I N=0 S TRESULT(1)="[Data]"
M RESULT=TRESULT
Q
;
LSTORD ; Returns a list of orders from the ORDER file #100;ICR-6475
;Input - VIA("PATH")="LISTORDERS" [required]
; VIA("ORDIEN")=list of orderable IEN separated by a comma (",") [required]. For example, VIA("ORDIEN")="73,75,76,360,740"
; VIA("SDATE")=Start Date for search [optional]. Defaults to today's date, if no date is passed in
; VIA("EDATE")=End Date for search [optional]. Defaults to today's date, if no date is passed in
; VIA("PATIEN")=Patient IEN; multiple IENS separated by a comma [optional]
; VIA("VALUE")=1 or 2 required]. 1 to filter by orderable item(s), 2 to filter by orderable action
; VIA("FROM")=string/value to start list [optional]
; VIA("MAX")=n [optional]
;Data returned
; .01 Order #, 100.008,#.01 Date/Time Ordered, #31 Date of Last Activity, 5 Status, .02 Object of Order, 6 Patient Location
I 'VIAVAL S VIAER="Missing VALUE of 1 or 2" D ERR^VIABMS(VIAER) Q
I VIAVAL=1 G VALUE1
I VIAVAL=2 G VALUE2
;
VALUE1 ; value=1, using ^PXRMINDX
;Data returned
; .01 Order #, 100.008,#.01 Date/Time Ordered, #31 Date of Last Activity, 5 Status, .02 Object of Order, 6 Patient Location
N VIAOI,VIACNT,OITM,I,X,Y,Z,PT,STRT,STOP,DAS,CNT,FND,QFLG,MORE,TARRAY
S:VIASDT="" VIASDT=DT S:VIAEDT="" VIAEDT=DT
D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
I $G(VIAOIEN)'="" F I=1:1:$L(VIAOIEN,",") S OITM=$P(VIAOIEN,",",I) I OITM'="" S VIAOI(OITM)=""
I $G(VIAPIEN)'="" F I=1:1:$L(VIAPIEN,",") S OITM=$P(VIAPIEN,",",I) I OITM'="" S VIAPIEN(OITM)=""
I VIAVAL=1,$O(VIAOI(""))="" S VIAER="Missing Orderable Items IEN" D ERR^VIABMS(VIAER) Q
S RESULT(1)="[Data]",VIACNT=1,FND=0,QFLG=0,MORE=""
;
I $O(VIAOI("")) D
. S OITM=$S($P(VIAFROM,"~")'="":$P(VIAFROM,"~")-1,1:0)
. F S OITM=$O(VIAOI(OITM)) Q:OITM'>0 D PT I VIACNT>VIAMAX Q
;E D
;. S OITM=$S($P(VIAFROM,"~")'="":$P(VIAFROM,"~")-1,1:0)
;. F S OITM=$O(^PXRMINDX(100,"IP",OITM)) Q:OITM'>0 D PT I VIACNT>VIAMAX Q
I QFLG D ; re-structure results array when 'more' defined
. M TARRAY=RESULT
. K RESULT
. S CNT=3,I=0,RESULT(1)="[Misc]",RESULT(2)=MORE,RESULT(3)="[Data]"
. F S I=$O(TARRAY(I)) Q:'I D
. . I TARRAY(I)["Data" Q
. . S CNT=CNT+1,RESULT(CNT)=TARRAY(I)
Q
;
PT S PT=$S($P(VIAFROM,"~",2)'="":$P(VIAFROM,"~",2)-1,1:0)
F S PT=$O(^PXRMINDX(100,"IP",OITM,PT)) Q:PT'>0 D I VIACNT>VIAMAX Q
. S STRT=$S($P(VIAFROM,"~",3)'="":$P(VIAFROM,"~",3)-.0001,1:VIASDT)
. F S STRT=$O(^PXRMINDX(100,"IP",OITM,PT,STRT)) Q:(STRT'>0)!(STRT>VIAEDT) D I VIACNT>VIAMAX Q
. . S STOP=$S($P(VIAFROM,"~",4)'="":$P(VIAFROM,"~",4),1:"") S VIAFROM=""
. . F S STOP=$O(^PXRMINDX(100,"IP",OITM,PT,STRT,STOP)) Q:STOP="" D I VIACNT>VIAMAX S MORE="MORE"_U_OITM_"~"_PT_"~"_STRT_"~"_STOP,QFLG=1 Q
. . . ;I +STOP>0,STOP'<VIAEDT Q
. . . ; EDATE of 3180408.1249 equates to VIAEDT of 3180408.124901
. . . ; EDATE=3180430,STOP=3180501 STOP entry would quit
. . . S DAS=$O(^PXRMINDX(100,"IP",OITM,PT,STRT,STOP,"")) Q:DAS=""
. . . S Y=+DAS
. . . S Z=$$ORDACT1()
Q
;
ORDACT1() ; value=1, filters by status, date and orderable items
N VIA3,VIAV,VIAA,VIA8,VIA0,VIAPT,VIAX
I '$D(^OR(100,Y,.1,0)) Q FND
S VIA0=$G(^OR(100,Y,0)),VIA3=$G(^OR(100,Y,3)),VIAPT=$P(VIA0,U,2)
I $P(VIA3,U,3)'=6 Q FND
I VIAPIEN'="",(VIAPT'["DPT")!('$D(VIAPIEN(+VIAPT))) Q FND
S VIAA=$P(VIA3,U,7),VIAV=$P(VIA3,U)
I VIAA>0,VIAV>=VIASDT,VIAV<=VIAEDT S VIA8=$P(^OR(100,Y,8,VIAA,0),U),VIAX=0 D Q FND
. S FND=1,VIACNT=VIACNT+1
. S RESULT(VIACNT)=Y_U_VIA8_U_$P(VIA3,U)_U_$P(VIA3,U,3)_U_$P(VIA0,U,2)_U_$P(VIA0,U,10)_U_OITM
Q FND
;
VALUE2 ; value=2, using the 'AF' xref
;Data returned
; .01 Order #, 5 Status, .02 Object of Order, 6 Patient Location
N VIAOI,VIACNT,OITM,I,X,Y,Z,CNT,QFLG,MORE,TARRAY
S:VIASDT="" VIASDT=DT S:VIAEDT="" VIAEDT=DT
D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
I $G(VIAOIEN)'="" F I=1:1:$L(VIAOIEN,",") S OITM=$P(VIAOIEN,",",I) I OITM'="" S VIAOI(OITM)=""
I $G(VIAPIEN)'="" F I=1:1:$L(VIAPIEN,",") S OITM=$P(VIAPIEN,",",I) I OITM'="" S VIAPIEN(OITM)=""
I VIAVAL=1,$O(VIAOI(""))="" S VIAER="Missing Orderable Items IEN" D ERR^VIABMS(VIAER) Q
S RESULT(1)="[Data]",VIACNT=1,QFLG=0,MORE=""
S X=$S($P(VIAFROM,",")'="":$P(VIAFROM,","),1:VIASDT)
F S X=$O(^OR(100,"AF",X)) Q:('X)!(X>VIAEDT) I X>=VIASDT,X<VIAEDT D I VIACNT>VIAMAX Q
. S Y=0
. F S Y=$O(^OR(100,"AF",X,Y)) Q:'Y D I VIACNT>VIAMAX S MORE="MORE"_U_X,QFLG=1 Q
. . S Z=$$ORDACT2()
I QFLG D ; re-structure results array when 'more' defined
. M TARRAY=RESULT
. K RESULT
. S CNT=3,I=0,RESULT(1)="[Misc]",RESULT(2)=MORE,RESULT(3)="[Data]"
. F S I=$O(TARRAY(I)) Q:'I D
. . I TARRAY(I)["Data" Q
. . S CNT=CNT+1,RESULT(CNT)=TARRAY(I)
Q
;
ORDACT2() ; value=2, filters by status, date and orderable actions
N FND,VIA0,VIAA,VIAB,VIAC,VIAD,VIA3,VIAV,VIA8
S FND=0
S VIA0=$G(^OR(100,Y,0))
I $P($G(^OR(100,Y,3)),U,3)'=6 Q FND
S (VIAA,VIAB,VIAC,VIAD)=0
S VIA0=$G(^OR(100,Y,0)),VIA3=$G(^OR(100,Y,3))
I $D(^OR(100,Y,8)) F S VIAA=$O(^OR(100,Y,8,VIAA)) Q:'VIAA S VIA8=$P(^OR(100,Y,8,VIAA,0),U,1) I VIA8>=VIASDT,VIA8<VIAEDT,$D(^OR(100,Y,8,VIAA,.1)) S VIAX=0 D I FND Q
. F S VIAX=$O(^OR(100,Y,8,VIAA,.1,VIAX)) Q:'VIAX S VIAR=$G(^OR(100,Y,8,VIAA,.1,VIAX,0)),VIAR=$$UP^XLFSTR(VIAR) S VIAB=VIAB!(VIAR["ANTICIPATE"),VIAC=VIAC!(VIAR["PLANNED"),VIAD=VIAD!(VIAR["DISCHARGE") I VIAB!VIAC&VIAD D Q
. . S FND=1,VIACNT=VIACNT+1
. . S RESULT(VIACNT)=Y_U_VIA8_U_$P(VIA3,U)_U_$P(VIA3,U,3)_U_$P(VIA0,U,2)_U_$P(VIA0,U,10)_U
Q FND
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIABMS3 8095 printed Nov 22, 2024@17:55:10 Page 2
VIABMS3 ;SGU/GJW - VIA BMS RPCs ;04/15/2016
+1 ;;1.0;VISTA INTEGRATION ADAPTER;**8,11,13**;06-FEB-2014;Build 7
+2 ;
ORDACT ; Returns a list of order actions from the ORDER file #100.008
+1 ;Input - VIA("PATH")="LISTORDERACTIONS" [required]
+2 ; VIA("ORDIEN")=list of orderable IEN separated by a comma (",") [required],if VIA("VALUE")=1
+3 ; VIA("SDATE")=Start Date for search [optional]. Defaults to today's date, if no date is passed in
+4 ; VIA("EDATE")=End Date for search [optional]. Defaults to today's date, if no date is passed in
+5 ; VIA("IENS")=Order IEN [required]
+6 ; VIA("VALUE")=1 or 2 required]. 1 to filter by orderable item(s), 2 to filter by orderable action
+7 ;Data returned
+8 ; .01 Date/Time Ordered,6 Date/Time Signed,16 Release Date/Time,5 Signed By,3 Provider,.1 Order Text
+9 NEW VIAFILE,VIAFIELDS,VIAFLAGS,OITM,I,TRESULT,I,X,N,IEN,VIATIEN,DATAFLG
+10 SET VIAFILE=100.008
SET VIAFIELDS="@;.01;6;16;5;3"
SET VIAFLAGS="IP"
+11 IF 'VIAVAL
SET VIAER="Missing VALUE of 1 or 2"
DO ERR^VIABMS(VIAER)
QUIT
+12 if VIASDT=""
SET VIASDT=DT
if VIAEDT=""
SET VIAEDT=DT
+13 DO DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT)
IF $DATA(RESULT)
QUIT
+14 IF VIAIENS=""
SET VIAER="Missing Order number"
DO ERR^VIABMS(VIAER)
QUIT
+15 IF $GET(VIAOIEN)'=""
FOR I=1:1:$LENGTH(VIAOIEN,",")
SET OITM=$PIECE(VIAOIEN,",",I)
IF OITM'=""
SET VIAOI(OITM)=""
+16 IF VIAVAL=1
IF $ORDER(VIAOI(""))=""
SET VIAER="Missing Orderable Items IEN"
DO ERR^VIABMS(VIAER)
QUIT
+17 SET VIAID="I $D(^OR(100,DA(1),8,Y,.1)) S I=0 F S I=$O(^OR(100,DA(1),8,Y,.1,I)) Q:'I S J=$P(^(I,0),U) D EN^DDIOL(J)"
+18 IF VIAVAL=1
Begin DoDot:1
+19 SET VIASCRN="S VIAOK=0,VIADLA=$P($G(^OR(100,Y(1),3)),U) S VIAX=0 F S VIAX=$O(^OR(100,Y(1),.1,VIAX)) Q:'VIAX I VIAX>0 S VIAV=$P(^OR(100,Y(1),.1,VIAX,0),U,1) I $$BETWEEN^VIABMS(VIADLA,VIASDT,VIAEDT)&$D(VIAOI(VIAV)) S VIAOK=1 Q"
End DoDot:1
+20 IF VIAVAL=2
Begin DoDot:1
+21 SET VIASCRN="S VIADLA=$P($G(^OR(100,Y(1),3)),U),VIAA=Y(1),(VIAB,VIAC,VIAD,VIAX,VIAE)=0,VIAE=$$BETWEEN^VIABMS(VIADLA,VIASDT,VIAEDT) F S VIAX=$O(^OR(100,VIAA,8,Y,.1,VIAX)) Q:'VIAX I VIAX>0 S VIAR=$$UP^XLFSTR(^OR(100,VIAA,8,Y,.1,VIAX,0))
"
+22 SET VIASCRN=VIASCRN_"S VIAB=VIAB!(VIAR[""ANTICIPATE""),VIAC=VIAC!(VIAR[""PLANNED""),VIAD=VIAD!(VIAR[""DISCHARGE"") I VIAE&(VIAB!VIAC&VIAD) Q"
End DoDot:1
+23 ; multiple IENs
+24 SET VIATIEN=VIAIENS
SET N=0
SET DATAFLG=0
+25 FOR I=1:1:$LENGTH(VIATIEN,",")
SET IEN=$PIECE(VIATIEN,",",I)
IF IEN'=""
Begin DoDot:1
+26 SET VIAIENS=","_IEN_","
+27 KILL RESULT
+28 DO LDIC^VIABMS
+29 SET X=0
FOR
SET X=$ORDER(RESULT(X))
if 'X
QUIT
Begin DoDot:2
+30 ;list [Data] only once
if (RESULT(X)["[Data]")&(DATAFLG)
QUIT
IF RESULT(X)["[Data]"
SET DATAFLG=1
+31 if (RESULT(X)'["[")&($PIECE(RESULT(X),"^"))
SET $PIECE(RESULT(X),"^")=IEN
+32 SET N=N+1
SET TRESULT(N)=RESULT(X)
End DoDot:2
+33 KILL RESULT
End DoDot:1
+34 IF N=0
SET TRESULT(1)="[Data]"
+35 MERGE RESULT=TRESULT
+36 QUIT
+37 ;
LSTORD ; Returns a list of orders from the ORDER file #100;ICR-6475
+1 ;Input - VIA("PATH")="LISTORDERS" [required]
+2 ; VIA("ORDIEN")=list of orderable IEN separated by a comma (",") [required]. For example, VIA("ORDIEN")="73,75,76,360,740"
+3 ; VIA("SDATE")=Start Date for search [optional]. Defaults to today's date, if no date is passed in
+4 ; VIA("EDATE")=End Date for search [optional]. Defaults to today's date, if no date is passed in
+5 ; VIA("PATIEN")=Patient IEN; multiple IENS separated by a comma [optional]
+6 ; VIA("VALUE")=1 or 2 required]. 1 to filter by orderable item(s), 2 to filter by orderable action
+7 ; VIA("FROM")=string/value to start list [optional]
+8 ; VIA("MAX")=n [optional]
+9 ;Data returned
+10 ; .01 Order #, 100.008,#.01 Date/Time Ordered, #31 Date of Last Activity, 5 Status, .02 Object of Order, 6 Patient Location
+11 IF 'VIAVAL
SET VIAER="Missing VALUE of 1 or 2"
DO ERR^VIABMS(VIAER)
QUIT
+12 IF VIAVAL=1
GOTO VALUE1
+13 IF VIAVAL=2
GOTO VALUE2
+14 ;
VALUE1 ; value=1, using ^PXRMINDX
+1 ;Data returned
+2 ; .01 Order #, 100.008,#.01 Date/Time Ordered, #31 Date of Last Activity, 5 Status, .02 Object of Order, 6 Patient Location
+3 NEW VIAOI,VIACNT,OITM,I,X,Y,Z,PT,STRT,STOP,DAS,CNT,FND,QFLG,MORE,TARRAY
+4 if VIASDT=""
SET VIASDT=DT
if VIAEDT=""
SET VIAEDT=DT
+5 DO DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT)
IF $DATA(RESULT)
QUIT
+6 IF $GET(VIAOIEN)'=""
FOR I=1:1:$LENGTH(VIAOIEN,",")
SET OITM=$PIECE(VIAOIEN,",",I)
IF OITM'=""
SET VIAOI(OITM)=""
+7 IF $GET(VIAPIEN)'=""
FOR I=1:1:$LENGTH(VIAPIEN,",")
SET OITM=$PIECE(VIAPIEN,",",I)
IF OITM'=""
SET VIAPIEN(OITM)=""
+8 IF VIAVAL=1
IF $ORDER(VIAOI(""))=""
SET VIAER="Missing Orderable Items IEN"
DO ERR^VIABMS(VIAER)
QUIT
+9 SET RESULT(1)="[Data]"
SET VIACNT=1
SET FND=0
SET QFLG=0
SET MORE=""
+10 ;
+11 IF $ORDER(VIAOI(""))
Begin DoDot:1
+12 SET OITM=$SELECT($PIECE(VIAFROM,"~")'="":$PIECE(VIAFROM,"~")-1,1:0)
+13 FOR
SET OITM=$ORDER(VIAOI(OITM))
if OITM'>0
QUIT
DO PT
IF VIACNT>VIAMAX
QUIT
End DoDot:1
+14 ;E D
+15 ;. S OITM=$S($P(VIAFROM,"~")'="":$P(VIAFROM,"~")-1,1:0)
+16 ;. F S OITM=$O(^PXRMINDX(100,"IP",OITM)) Q:OITM'>0 D PT I VIACNT>VIAMAX Q
+17 ; re-structure results array when 'more' defined
IF QFLG
Begin DoDot:1
+18 MERGE TARRAY=RESULT
+19 KILL RESULT
+20 SET CNT=3
SET I=0
SET RESULT(1)="[Misc]"
SET RESULT(2)=MORE
SET RESULT(3)="[Data]"
+21 FOR
SET I=$ORDER(TARRAY(I))
if 'I
QUIT
Begin DoDot:2
+22 IF TARRAY(I)["Data"
QUIT
+23 SET CNT=CNT+1
SET RESULT(CNT)=TARRAY(I)
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
PT SET PT=$SELECT($PIECE(VIAFROM,"~",2)'="":$PIECE(VIAFROM,"~",2)-1,1:0)
+1 FOR
SET PT=$ORDER(^PXRMINDX(100,"IP",OITM,PT))
if PT'>0
QUIT
Begin DoDot:1
+2 SET STRT=$SELECT($PIECE(VIAFROM,"~",3)'="":$PIECE(VIAFROM,"~",3)-.0001,1:VIASDT)
+3 FOR
SET STRT=$ORDER(^PXRMINDX(100,"IP",OITM,PT,STRT))
if (STRT'>0)!(STRT>VIAEDT)
QUIT
Begin DoDot:2
+4 SET STOP=$SELECT($PIECE(VIAFROM,"~",4)'="":$PIECE(VIAFROM,"~",4),1:"")
SET VIAFROM=""
+5 FOR
SET STOP=$ORDER(^PXRMINDX(100,"IP",OITM,PT,STRT,STOP))
if STOP=""
QUIT
Begin DoDot:3
+6 ;I +STOP>0,STOP'<VIAEDT Q
+7 ; EDATE of 3180408.1249 equates to VIAEDT of 3180408.124901
+8 ; EDATE=3180430,STOP=3180501 STOP entry would quit
+9 SET DAS=$ORDER(^PXRMINDX(100,"IP",OITM,PT,STRT,STOP,""))
if DAS=""
QUIT
+10 SET Y=+DAS
+11 SET Z=$$ORDACT1()
End DoDot:3
IF VIACNT>VIAMAX
SET MORE="MORE"_U_OITM_"~"_PT_"~"_STRT_"~"_STOP
SET QFLG=1
QUIT
End DoDot:2
IF VIACNT>VIAMAX
QUIT
End DoDot:1
IF VIACNT>VIAMAX
QUIT
+12 QUIT
+13 ;
ORDACT1() ; value=1, filters by status, date and orderable items
+1 NEW VIA3,VIAV,VIAA,VIA8,VIA0,VIAPT,VIAX
+2 IF '$DATA(^OR(100,Y,.1,0))
QUIT FND
+3 SET VIA0=$GET(^OR(100,Y,0))
SET VIA3=$GET(^OR(100,Y,3))
SET VIAPT=$PIECE(VIA0,U,2)
+4 IF $PIECE(VIA3,U,3)'=6
QUIT FND
+5 IF VIAPIEN'=""
IF (VIAPT'["DPT")!('$DATA(VIAPIEN(+VIAPT)))
QUIT FND
+6 SET VIAA=$PIECE(VIA3,U,7)
SET VIAV=$PIECE(VIA3,U)
+7 IF VIAA>0
IF VIAV>=VIASDT
IF VIAV<=VIAEDT
SET VIA8=$PIECE(^OR(100,Y,8,VIAA,0),U)
SET VIAX=0
Begin DoDot:1
+8 SET FND=1
SET VIACNT=VIACNT+1
+9 SET RESULT(VIACNT)=Y_U_VIA8_U_$PIECE(VIA3,U)_U_$PIECE(VIA3,U,3)_U_$PIECE(VIA0,U,2)_U_$PIECE(VIA0,U,10)_U_OITM
End DoDot:1
QUIT FND
+10 QUIT FND
+11 ;
VALUE2 ; value=2, using the 'AF' xref
+1 ;Data returned
+2 ; .01 Order #, 5 Status, .02 Object of Order, 6 Patient Location
+3 NEW VIAOI,VIACNT,OITM,I,X,Y,Z,CNT,QFLG,MORE,TARRAY
+4 if VIASDT=""
SET VIASDT=DT
if VIAEDT=""
SET VIAEDT=DT
+5 DO DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT)
IF $DATA(RESULT)
QUIT
+6 IF $GET(VIAOIEN)'=""
FOR I=1:1:$LENGTH(VIAOIEN,",")
SET OITM=$PIECE(VIAOIEN,",",I)
IF OITM'=""
SET VIAOI(OITM)=""
+7 IF $GET(VIAPIEN)'=""
FOR I=1:1:$LENGTH(VIAPIEN,",")
SET OITM=$PIECE(VIAPIEN,",",I)
IF OITM'=""
SET VIAPIEN(OITM)=""
+8 IF VIAVAL=1
IF $ORDER(VIAOI(""))=""
SET VIAER="Missing Orderable Items IEN"
DO ERR^VIABMS(VIAER)
QUIT
+9 SET RESULT(1)="[Data]"
SET VIACNT=1
SET QFLG=0
SET MORE=""
+10 SET X=$SELECT($PIECE(VIAFROM,",")'="":$PIECE(VIAFROM,","),1:VIASDT)
+11 FOR
SET X=$ORDER(^OR(100,"AF",X))
if ('X)!(X>VIAEDT)
QUIT
IF X>=VIASDT
IF X<VIAEDT
Begin DoDot:1
+12 SET Y=0
+13 FOR
SET Y=$ORDER(^OR(100,"AF",X,Y))
if 'Y
QUIT
Begin DoDot:2
+14 SET Z=$$ORDACT2()
End DoDot:2
IF VIACNT>VIAMAX
SET MORE="MORE"_U_X
SET QFLG=1
QUIT
End DoDot:1
IF VIACNT>VIAMAX
QUIT
+15 ; re-structure results array when 'more' defined
IF QFLG
Begin DoDot:1
+16 MERGE TARRAY=RESULT
+17 KILL RESULT
+18 SET CNT=3
SET I=0
SET RESULT(1)="[Misc]"
SET RESULT(2)=MORE
SET RESULT(3)="[Data]"
+19 FOR
SET I=$ORDER(TARRAY(I))
if 'I
QUIT
Begin DoDot:2
+20 IF TARRAY(I)["Data"
QUIT
+21 SET CNT=CNT+1
SET RESULT(CNT)=TARRAY(I)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
ORDACT2() ; value=2, filters by status, date and orderable actions
+1 NEW FND,VIA0,VIAA,VIAB,VIAC,VIAD,VIA3,VIAV,VIA8
+2 SET FND=0
+3 SET VIA0=$GET(^OR(100,Y,0))
+4 IF $PIECE($GET(^OR(100,Y,3)),U,3)'=6
QUIT FND
+5 SET (VIAA,VIAB,VIAC,VIAD)=0
+6 SET VIA0=$GET(^OR(100,Y,0))
SET VIA3=$GET(^OR(100,Y,3))
+7 IF $DATA(^OR(100,Y,8))
FOR
SET VIAA=$ORDER(^OR(100,Y,8,VIAA))
if 'VIAA
QUIT
SET VIA8=$PIECE(^OR(100,Y,8,VIAA,0),U,1)
IF VIA8>=VIASDT
IF VIA8<VIAEDT
IF $DATA(^OR(100,Y,8,VIAA,.1))
SET VIAX=0
Begin DoDot:1
+8 FOR
SET VIAX=$ORDER(^OR(100,Y,8,VIAA,.1,VIAX))
if 'VIAX
QUIT
SET VIAR=$GET(^OR(100,Y,8,VIAA,.1,VIAX,0))
SET VIAR=$$UP^XLFSTR(VIAR)
SET VIAB=VIAB!(VIAR["ANTICIPATE")
SET VIAC=VIAC!(VIAR["PLANNED")
SET VIAD=VIAD!(VIAR["DISCHARGE")
IF VIAB!VIAC&VIAD
Begin DoDot:2
+9 SET FND=1
SET VIACNT=VIACNT+1
+10 SET RESULT(VIACNT)=Y_U_VIA8_U_$PIECE(VIA3,U)_U_$PIECE(VIA3,U,3)_U_$PIECE(VIA0,U,2)_U_$PIECE(VIA0,U,10)_U
End DoDot:2
QUIT
End DoDot:1
IF FND
QUIT
+11 QUIT FND
+12 ;
