- VIABMS4 ;AAC/JMC,AFS/PB - VIA BMS RPCs ;12/18/23 14:34
- ;;1.0;VISTA INTEGRATION ADAPTER;**15,20,24**;06-FEB-2014;Build 3
- ;Per VA Directive 6402, this routine should not be modified.
- ;Reference to ^OR(100 supported by IA 6475
- ;
- ; OLD 'AF' CODE modified. Evalute DTO between queue start/end times. Also, use only CURRENT ACTION item.
- ;
- 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 #, 5 Status, .02 Object of Order, 6 Patient Location
- N VIAOI,VIACNT,OITM,I,X,Y,Z,CNT,QFLG,MORE,TARRAY
- 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 $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
- . ;S Y=$S($P(VIAFROM,",",2)'="":$P(VIAFROM,",",2),1:0),$P(VIAFROM,",",2)=""
- . F S Y=$O(^OR(100,"AF",X,Y)) Q:'Y D I VIACNT>VIAMAX S MORE="MORE"_U_X,QFLG=1 Q
- . . I VIAVAL=1 S Z=$$ORDACT1()
- . . I VIAVAL=2 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
- ;
- 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,VIACA,VIADTO,VIALCNT
- 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,VIALCNT=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) S VIALCNT=VIALCNT+$L(J)"
- S VIAID=VIAID_" I VIALCNT>3675 S J=""<*NOTE: order text reached max length, please check appropriate system for full order text*>"" D EN^DDIOL(J) Q"
- I VIAVAL=1 D
- . S VIASCRN="S VIACA=$P($G(^OR(100,Y(1),3)),U,7),VIADTO=$P($G(^OR(100,Y(1),3)),U) S:VIACA>0 VIADTO=$P($G(^OR(100,Y(1),8,VIACA,0)),U) "
- . S VIASCRN=VIASCRN_"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 (VIACA=+Y1)&$$BETWEEN^VIABMS(VIADTO,VIASDT,VIAEDT)&$D(VIAOI(VIAV)) S VIAOK=1 Q"
- I VIAVAL=2 D
- . S VIASCRN="S VIACA=$P($G(^OR(100,Y(1),3)),U,7),VIADTO=$P($G(^OR(100,Y(1),3)),U) S:VIACA>0 VIADTO=$P($G(^OR(100,Y(1),8,VIACA,0)),U) "
- . S VIASCRN=VIASCRN_"S (VIAB,VIAC,VIAD,VIAX,VIAE)=0,VIAE=((VIACA=+Y1)&$$BETWEEN^VIABMS(VIADTO,VIASDT,VIAEDT)) I VIAE S VIAX=0 F S VIAX=$O(^OR(100,Y(1),8,VIACA,.1,VIAX)) Q:'VIAX S VIAR=$$UP^XLFSTR(^OR(100,Y(1),8,VIACA,.1,VIAX,0)) "
- . S VIASCRN=VIASCRN_"S VIAB=VIAB!(VIAR[""ANTICIPATE""),VIAC=VIAC!(VIAR[""PLANNED""),VIAD=VIAD!(VIAR[""DISCHARGE"") I 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:($L(RESULT(X),U)>6)&($P(RESULT(X),"^")) $P(RESULT(X),"^")=IEN ;avoid length<6, i.e. [Data],[Misc],[Errors] headers/error/misc results. Replaces (RESULT(X)'["[")
- . . S N=N+1,TRESULT(N)=RESULT(X)
- . K RESULT
- I N=0 S TRESULT(1)="[Data]"
- M RESULT=TRESULT
- Q
- ;
- ORDACT1() ; filters by status, date and orderable items
- ;Returns =OrderNumber_U_DTO_U_DLA_U_Status_U_ObjectOfOrder_U_PatLocation_U_OrderableItem
- N FND,VIA3,VIAV,VIAA,VIA8,VIA0,VIAPT,VIAX
- S FND=0
- 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 S VIA8=$P(^OR(100,Y,8,VIAA,0),U) I VIA8>=VIASDT,VIA8<VIAEDT S VIAX=0 D Q FND
- . F S VIAX=$O(^OR(100,Y,.1,VIAX)) Q:'VIAX I VIAX>0 S VIAV=$P(^OR(100,Y,.1,VIAX,0),U,1) I $D(VIAOI(VIAV)) D Q
- . . S FND=1,VIACNT=VIACNT+1,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_VIAV
- ;removed DATE OF LAST ACTIVITY from above criteria
- ;I VIAA>0,VIAV>=VIASDT,VIAV<VIAEDT S VIA8=$P(^OR(100,Y,8,VIAA,0),U) I VIA8>=VIASDT,VIA8<VIAEDT S VIAX=0 D Q FND
- ;. F S VIAX=$O(^OR(100,Y,.1,VIAX)) Q:'VIAX I VIAX>0 S VIAV=$P(^OR(100,Y,.1,VIAX,0),U,1) I $D(VIAOI(VIAV)) D Q
- ;. . S FND=1,VIACNT=VIACNT+1,RESULT(VIACNT)=Y_U_VIA8_U_$P(VIA3,U,3)_U_$P(VIA0,U,2)_U_$P(VIA0,U,10)_U_VIAV
- Q FND
- ;
- ORDACT2() ; filters by status, date and orderable actions
- N FND,VIA0,VIAA,VIAB,VIAC,VIAD,VIAE,VIAF,VIA3,VIAV,VIA8,VIAX
- 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 VIA3=$G(^OR(100,Y,3)),VIAA=$P(VIA3,U,7)
- I VIAA>0 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
- . 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[HVIABMS4 7312 printed Jan 18, 2025@03:46:26 Page 2
- VIABMS4 ;AAC/JMC,AFS/PB - VIA BMS RPCs ;12/18/23 14:34
- +1 ;;1.0;VISTA INTEGRATION ADAPTER;**15,20,24**;06-FEB-2014;Build 3
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;Reference to ^OR(100 supported by IA 6475
- +4 ;
- +5 ; OLD 'AF' CODE modified. Evalute DTO between queue start/end times. Also, use only CURRENT ACTION item.
- +6 ;
- 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 #, 5 Status, .02 Object of Order, 6 Patient Location
- +11 NEW VIAOI,VIACNT,OITM,I,X,Y,Z,CNT,QFLG,MORE,TARRAY
- +12 IF 'VIAVAL
- SET VIAER="Missing VALUE of 1 or 2"
- DO ERR^VIABMS(VIAER)
- QUIT
- +13 if VIASDT=""
- SET VIASDT=DT
- if VIAEDT=""
- SET VIAEDT=DT
- +14 DO DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT)
- IF $DATA(RESULT)
- QUIT
- +15 IF $GET(VIAOIEN)'=""
- FOR I=1:1:$LENGTH(VIAOIEN,",")
- SET OITM=$PIECE(VIAOIEN,",",I)
- IF OITM'=""
- SET VIAOI(OITM)=""
- +16 IF $GET(VIAPIEN)'=""
- FOR I=1:1:$LENGTH(VIAPIEN,",")
- SET OITM=$PIECE(VIAPIEN,",",I)
- IF OITM'=""
- SET VIAPIEN(OITM)=""
- +17 IF VIAVAL=1
- IF $ORDER(VIAOI(""))=""
- SET VIAER="Missing Orderable Items IEN"
- DO ERR^VIABMS(VIAER)
- QUIT
- +18 SET RESULT(1)="[Data]"
- SET VIACNT=1
- SET QFLG=0
- SET MORE=""
- +19 SET X=$SELECT($PIECE(VIAFROM,",")'="":$PIECE(VIAFROM,","),1:VIASDT)
- +20 FOR
- SET X=$ORDER(^OR(100,"AF",X))
- if ('X)!(X>VIAEDT)
- QUIT
- IF X>=VIASDT
- IF X<VIAEDT
- Begin DoDot:1
- +21 SET Y=0
- +22 ;S Y=$S($P(VIAFROM,",",2)'="":$P(VIAFROM,",",2),1:0),$P(VIAFROM,",",2)=""
- +23 FOR
- SET Y=$ORDER(^OR(100,"AF",X,Y))
- if 'Y
- QUIT
- Begin DoDot:2
- +24 IF VIAVAL=1
- SET Z=$$ORDACT1()
- +25 IF VIAVAL=2
- 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
- +26 ; re-structure results array when 'more' defined
- IF QFLG
- Begin DoDot:1
- +27 MERGE TARRAY=RESULT
- +28 KILL RESULT
- +29 SET CNT=3
- SET I=0
- SET RESULT(1)="[Misc]"
- SET RESULT(2)=MORE
- SET RESULT(3)="[Data]"
- +30 FOR
- SET I=$ORDER(TARRAY(I))
- if 'I
- QUIT
- Begin DoDot:2
- +31 IF TARRAY(I)["Data"
- QUIT
- +32 SET CNT=CNT+1
- SET RESULT(CNT)=TARRAY(I)
- End DoDot:2
- End DoDot:1
- +33 QUIT
- +34 ;
- 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,VIACA,VIADTO,VIALCNT
- +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,VIALCNT=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) S VIALCNT=VIALCNT+$L(J)"
- +18 SET VIAID=VIAID_" I VIALCNT>3675 S J=""<*NOTE: order text reached max length, please check appropriate system for full order text*>"" D EN^DDIOL(J) Q"
- +19 IF VIAVAL=1
- Begin DoDot:1
- +20 SET VIASCRN="S VIACA=$P($G(^OR(100,Y(1),3)),U,7),VIADTO=$P($G(^OR(100,Y(1),3)),U) S:VIACA>0 VIADTO=$P($G(^OR(100,Y(1),8,VIACA,0)),U) "
- +21 SET VIASCRN=VIASCRN_"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 (VIACA=+Y1)&$$BETWEEN^VIABMS(VIADTO,VIASDT,VIAEDT)&$D(VIAOI(VIAV)) S VIAOK=1 Q"
- End DoDot:1
- +22 IF VIAVAL=2
- Begin DoDot:1
- +23 SET VIASCRN="S VIACA=$P($G(^OR(100,Y(1),3)),U,7),VIADTO=$P($G(^OR(100,Y(1),3)),U) S:VIACA>0 VIADTO=$P($G(^OR(100,Y(1),8,VIACA,0)),U) "
- +24 SET VIASCRN=VIASCRN_"S (VIAB,VIAC,VIAD,VIAX,VIAE)=0,VIAE=((VIACA=+Y1)&$$BETWEEN^VIABMS(VIADTO,VIASDT,VIAEDT)) I VIAE S VIAX=0 F S VIAX=$O(^OR(100,Y(1),8,VIACA,.1,VIAX)) Q:'VIAX S VIAR=$$UP^XLFSTR(^OR(100,Y(1),8,VIACA,.1,VIAX,0)) "
- +25 SET VIASCRN=VIASCRN_"S VIAB=VIAB!(VIAR[""ANTICIPATE""),VIAC=VIAC!(VIAR[""PLANNED""),VIAD=VIAD!(VIAR[""DISCHARGE"") I VIAB!VIAC&VIAD Q"
- End DoDot:1
- +26 ; multiple IENs
- +27 SET VIATIEN=VIAIENS
- SET N=0
- SET DATAFLG=0
- +28 FOR I=1:1:$LENGTH(VIATIEN,",")
- SET IEN=$PIECE(VIATIEN,",",I)
- IF IEN'=""
- Begin DoDot:1
- +29 SET VIAIENS=","_IEN_","
- +30 KILL RESULT
- +31 DO LDIC^VIABMS
- +32 SET X=0
- FOR
- SET X=$ORDER(RESULT(X))
- if 'X
- QUIT
- Begin DoDot:2
- +33 ;list [Data] only once
- if (RESULT(X)["[Data]")&(DATAFLG)
- QUIT
- IF RESULT(X)["[Data]"
- SET DATAFLG=1
- +34 ;avoid length<6, i.e. [Data],[Misc],[Errors] headers/error/misc results. Replaces (RESULT(X)'["[")
- if ($LENGTH(RESULT(X),U)>6)&($PIECE(RESULT(X),"^"))
- SET $PIECE(RESULT(X),"^")=IEN
- +35 SET N=N+1
- SET TRESULT(N)=RESULT(X)
- End DoDot:2
- +36 KILL RESULT
- End DoDot:1
- +37 IF N=0
- SET TRESULT(1)="[Data]"
- +38 MERGE RESULT=TRESULT
- +39 QUIT
- +40 ;
- ORDACT1() ; filters by status, date and orderable items
- +1 ;Returns =OrderNumber_U_DTO_U_DLA_U_Status_U_ObjectOfOrder_U_PatLocation_U_OrderableItem
- +2 NEW FND,VIA3,VIAV,VIAA,VIA8,VIA0,VIAPT,VIAX
- +3 SET FND=0
- +4 IF '$DATA(^OR(100,Y,.1,0))
- QUIT FND
- +5 SET VIA0=$GET(^OR(100,Y,0))
- SET VIA3=$GET(^OR(100,Y,3))
- SET VIAPT=$PIECE(VIA0,U,2)
- +6 IF $PIECE(VIA3,U,3)'=6
- QUIT FND
- +7 IF VIAPIEN'=""
- IF (VIAPT'["DPT")!('$DATA(VIAPIEN(+VIAPT)))
- QUIT FND
- +8 SET VIAA=$PIECE(VIA3,U,7)
- SET VIAV=$PIECE(VIA3,U)
- +9 IF VIAA>0
- SET VIA8=$PIECE(^OR(100,Y,8,VIAA,0),U)
- IF VIA8>=VIASDT
- IF VIA8<VIAEDT
- SET VIAX=0
- Begin DoDot:1
- +10 FOR
- SET VIAX=$ORDER(^OR(100,Y,.1,VIAX))
- if 'VIAX
- QUIT
- IF VIAX>0
- SET VIAV=$PIECE(^OR(100,Y,.1,VIAX,0),U,1)
- IF $DATA(VIAOI(VIAV))
- Begin DoDot:2
- +11 SET FND=1
- SET VIACNT=VIACNT+1
- 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_VIAV
- End DoDot:2
- QUIT
- End DoDot:1
- QUIT FND
- +12 ;removed DATE OF LAST ACTIVITY from above criteria
- +13 ;I VIAA>0,VIAV>=VIASDT,VIAV<VIAEDT S VIA8=$P(^OR(100,Y,8,VIAA,0),U) I VIA8>=VIASDT,VIA8<VIAEDT S VIAX=0 D Q FND
- +14 ;. F S VIAX=$O(^OR(100,Y,.1,VIAX)) Q:'VIAX I VIAX>0 S VIAV=$P(^OR(100,Y,.1,VIAX,0),U,1) I $D(VIAOI(VIAV)) D Q
- +15 ;. . S FND=1,VIACNT=VIACNT+1,RESULT(VIACNT)=Y_U_VIA8_U_$P(VIA3,U,3)_U_$P(VIA0,U,2)_U_$P(VIA0,U,10)_U_VIAV
- +16 QUIT FND
- +17 ;
- ORDACT2() ; filters by status, date and orderable actions
- +1 NEW FND,VIA0,VIAA,VIAB,VIAC,VIAD,VIAE,VIAF,VIA3,VIAV,VIA8,VIAX
- +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 VIA3=$GET(^OR(100,Y,3))
- SET VIAA=$PIECE(VIA3,U,7)
- +7 IF VIAA>0
- 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
- +11 QUIT FND