Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VIABMS4

VIABMS4.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;Reference to ^OR(100 supported by IA 6475
  1. ;
  1. ; OLD 'AF' CODE modified. Evalute DTO between queue start/end times. Also, use only CURRENT ACTION item.
  1. ;
  1. LSTORD ; Returns a list of orders from the ORDER file #100;ICR-6475
  1. ;Input - VIA("PATH")="LISTORDERS" [required]
  1. ; VIA("ORDIEN")=list of orderable IEN separated by a comma (",") [required]. For example, VIA("ORDIEN")="73,75,76,360,740"
  1. ; VIA("SDATE")=Start Date for search [optional]. Defaults to today's date, if no date is passed in
  1. ; VIA("EDATE")=End Date for search [optional]. Defaults to today's date, if no date is passed in
  1. ; VIA("PATIEN")=Patient IEN; multiple IENS separated by a comma [optional]
  1. ; VIA("VALUE")=1 or 2 required]. 1 to filter by orderable item(s), 2 to filter by orderable action
  1. ; VIA("FROM")=string/value to start list [optional]
  1. ; VIA("MAX")=n [optional]
  1. ;Data returned
  1. ; .01 Order #, 5 Status, .02 Object of Order, 6 Patient Location
  1. N VIAOI,VIACNT,OITM,I,X,Y,Z,CNT,QFLG,MORE,TARRAY
  1. I 'VIAVAL S VIAER="Missing VALUE of 1 or 2" D ERR^VIABMS(VIAER) Q
  1. S:VIASDT="" VIASDT=DT S:VIAEDT="" VIAEDT=DT
  1. D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
  1. I $G(VIAOIEN)'="" F I=1:1:$L(VIAOIEN,",") S OITM=$P(VIAOIEN,",",I) I OITM'="" S VIAOI(OITM)=""
  1. I $G(VIAPIEN)'="" F I=1:1:$L(VIAPIEN,",") S OITM=$P(VIAPIEN,",",I) I OITM'="" S VIAPIEN(OITM)=""
  1. I VIAVAL=1,$O(VIAOI(""))="" S VIAER="Missing Orderable Items IEN" D ERR^VIABMS(VIAER) Q
  1. S RESULT(1)="[Data]",VIACNT=1,QFLG=0,MORE=""
  1. S X=$S($P(VIAFROM,",")'="":$P(VIAFROM,","),1:VIASDT)
  1. F S X=$O(^OR(100,"AF",X)) Q:('X)!(X>VIAEDT) I X>=VIASDT,X<VIAEDT D I VIACNT>VIAMAX Q
  1. . S Y=0
  1. . ;S Y=$S($P(VIAFROM,",",2)'="":$P(VIAFROM,",",2),1:0),$P(VIAFROM,",",2)=""
  1. . F S Y=$O(^OR(100,"AF",X,Y)) Q:'Y D I VIACNT>VIAMAX S MORE="MORE"_U_X,QFLG=1 Q
  1. . . I VIAVAL=1 S Z=$$ORDACT1()
  1. . . I VIAVAL=2 S Z=$$ORDACT2()
  1. I QFLG D ; re-structure results array when 'more' defined
  1. . M TARRAY=RESULT
  1. . K RESULT
  1. . S CNT=3,I=0,RESULT(1)="[Misc]",RESULT(2)=MORE,RESULT(3)="[Data]"
  1. . F S I=$O(TARRAY(I)) Q:'I D
  1. . . I TARRAY(I)["Data" Q
  1. . . S CNT=CNT+1,RESULT(CNT)=TARRAY(I)
  1. Q
  1. ;
  1. ORDACT ; Returns a list of order actions from the ORDER file #100.008
  1. ;Input - VIA("PATH")="LISTORDERACTIONS" [required]
  1. ; VIA("ORDIEN")=list of orderable IEN separated by a comma (",") [required],if VIA("VALUE")=1
  1. ; VIA("SDATE")=Start Date for search [optional]. Defaults to today's date, if no date is passed in
  1. ; VIA("EDATE")=End Date for search [optional]. Defaults to today's date, if no date is passed in
  1. ; VIA("IENS")=Order IEN [required]
  1. ; VIA("VALUE")=1 or 2 required]. 1 to filter by orderable item(s), 2 to filter by orderable action
  1. ;Data returned
  1. ; .01 Date/Time Ordered,6 Date/Time Signed,16 Release Date/Time,5 Signed By,3 Provider,.1 Order Text
  1. N VIAFILE,VIAFIELDS,VIAFLAGS,OITM,I,TRESULT,I,X,N,IEN,VIATIEN,DATAFLG,VIACA,VIADTO,VIALCNT
  1. S VIAFILE=100.008,VIAFIELDS="@;.01;6;16;5;3",VIAFLAGS="IP"
  1. I 'VIAVAL S VIAER="Missing VALUE of 1 or 2" D ERR^VIABMS(VIAER) Q
  1. S:VIASDT="" VIASDT=DT S:VIAEDT="" VIAEDT=DT
  1. D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
  1. I VIAIENS="" S VIAER="Missing Order number" D ERR^VIABMS(VIAER) Q
  1. I $G(VIAOIEN)'="" F I=1:1:$L(VIAOIEN,",") S OITM=$P(VIAOIEN,",",I) I OITM'="" S VIAOI(OITM)=""
  1. I VIAVAL=1,$O(VIAOI(""))="" S VIAER="Missing Orderable Items IEN" D ERR^VIABMS(VIAER) Q
  1. 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)"
  1. 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"
  1. I VIAVAL=1 D
  1. . 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) "
  1. . 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"
  1. I VIAVAL=2 D
  1. . 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) "
  1. . 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)) "
  1. . S VIASCRN=VIASCRN_"S VIAB=VIAB!(VIAR[""ANTICIPATE""),VIAC=VIAC!(VIAR[""PLANNED""),VIAD=VIAD!(VIAR[""DISCHARGE"") I VIAB!VIAC&VIAD Q"
  1. ; multiple IENs
  1. S VIATIEN=VIAIENS,N=0,DATAFLG=0
  1. F I=1:1:$L(VIATIEN,",") S IEN=$P(VIATIEN,",",I) I IEN'="" D
  1. . S VIAIENS=","_IEN_","
  1. . K RESULT
  1. . D LDIC^VIABMS
  1. . S X=0 F S X=$O(RESULT(X)) Q:'X D
  1. . . Q:(RESULT(X)["[Data]")&(DATAFLG) I RESULT(X)["[Data]" S DATAFLG=1 ;list [Data] only once
  1. . . 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)'["[")
  1. . . S N=N+1,TRESULT(N)=RESULT(X)
  1. . K RESULT
  1. I N=0 S TRESULT(1)="[Data]"
  1. M RESULT=TRESULT
  1. Q
  1. ;
  1. ORDACT1() ; filters by status, date and orderable items
  1. ;Returns =OrderNumber_U_DTO_U_DLA_U_Status_U_ObjectOfOrder_U_PatLocation_U_OrderableItem
  1. N FND,VIA3,VIAV,VIAA,VIA8,VIA0,VIAPT,VIAX
  1. S FND=0
  1. I '$D(^OR(100,Y,.1,0)) Q FND
  1. S VIA0=$G(^OR(100,Y,0)),VIA3=$G(^OR(100,Y,3)),VIAPT=$P(VIA0,U,2)
  1. I $P(VIA3,U,3)'=6 Q FND
  1. I VIAPIEN'="",(VIAPT'["DPT")!('$D(VIAPIEN(+VIAPT))) Q FND
  1. S VIAA=$P(VIA3,U,7),VIAV=$P(VIA3,U)
  1. I VIAA>0 S VIA8=$P(^OR(100,Y,8,VIAA,0),U) I VIA8>=VIASDT,VIA8<VIAEDT S VIAX=0 D Q FND
  1. . 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
  1. . . 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
  1. ;removed DATE OF LAST ACTIVITY from above criteria
  1. ;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
  1. ;. 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
  1. ;. . 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
  1. Q FND
  1. ;
  1. ORDACT2() ; filters by status, date and orderable actions
  1. N FND,VIA0,VIAA,VIAB,VIAC,VIAD,VIAE,VIAF,VIA3,VIAV,VIA8,VIAX
  1. S FND=0
  1. S VIA0=$G(^OR(100,Y,0))
  1. I $P($G(^OR(100,Y,3)),U,3)'=6 Q FND
  1. S (VIAA,VIAB,VIAC,VIAD)=0
  1. S VIA3=$G(^OR(100,Y,3)),VIAA=$P(VIA3,U,7)
  1. 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
  1. . 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
  1. . . S FND=1,VIACNT=VIACNT+1
  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
  1. Q FND