VBECRPCW ; HOIFO/BNT-VBECS Workload Code Lookup RPC ;18 May 2004
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
; Reference to ^LAM suppored by IA #4779
;
QUIT
;
WKLD(RESULTS) ;
; Get Workload data for use case 29
;
S VBECCNT=0
S RESULTS=$NA(^TMP("VBECWKLD",$J))
K @RESULTS
N WKLD0,CNT,X,Y,LRSEC,PROC,COST,CPT
S (CNT,X)=0
D BEGROOT^VBECRPC("Workload")
F S X=$O(^LAM(X)) Q:'+X D
. S WKLD0=^LAM(X,0)
. S WGHT=$P(WKLD0,"^",3)
. S:'WGHT WGHT=1
. ; Round weight multiplier decimal value to nearest integer.
. I WGHT["." D
. . S X1=$P(WGHT,"."),X2=$P(WGHT,".",2)
. . S WGHT=$S(X2>4:X1+1,1:X1)
. ; Set weight multiplier to 1 if undefined or 0.
. S WGHT=$S(WGHT']"":1,WGHT=0:1,1:WGHT)
. S LRSEC=$P(WKLD0,"^",15) Q:LRSEC=""
. Q:'$D(^LAB(64.21,"B","Blood Bank",LRSEC))
. D BEGROOT^VBECRPC("Code")
. D ADD^VBECRPC("<LMIP>"_$$CHARCHK^XOBVLIB($P(WKLD0,"^",2))_"</LMIP>")
. D ADD^VBECRPC("<Procedure>"_$$CHARCHK^XOBVLIB($P(WKLD0,"^"))_"</Procedure>")
. D ADD^VBECRPC("<Cost>"_$$CHARCHK^XOBVLIB($P(WKLD0,"^",10))_"</Cost>")
. D ADD^VBECRPC("<WeightMultiplier>"_$$CHARCHK^XOBVLIB(WGHT)_"</WeightMultiplier>")
. I $D(^LAM("AD",X,"CPT")) D
. . S Y=0
. . F S Y=$O(^LAM("AD",X,"CPT",Y)) Q:Y']"" D
. . . I $P(^LAM(X,4,Y,0),"^",4)]"" Q
. . . D ADD^VBECRPC("<CPTCode>"_$$CHARCHK^XOBVLIB(+^LAM(X,4,Y,0))_"</CPTCode>")
. D ENDROOT^VBECRPC("Code")
. Q
D ENDROOT^VBECRPC("Workload")
Q
;
KILL ;
K VBECCNT,CNT,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECRPCW 1760 printed Nov 22, 2024@17:54:29 Page 2
VBECRPCW ; HOIFO/BNT-VBECS Workload Code Lookup RPC ;18 May 2004
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
+9 ; Reference to ^LAM suppored by IA #4779
+10 ;
+11 QUIT
+12 ;
WKLD(RESULTS) ;
+1 ; Get Workload data for use case 29
+2 ;
+3 SET VBECCNT=0
+4 SET RESULTS=$NAME(^TMP("VBECWKLD",$JOB))
+5 KILL @RESULTS
+6 NEW WKLD0,CNT,X,Y,LRSEC,PROC,COST,CPT
+7 SET (CNT,X)=0
+8 DO BEGROOT^VBECRPC("Workload")
+9 FOR
SET X=$ORDER(^LAM(X))
if '+X
QUIT
Begin DoDot:1
+10 SET WKLD0=^LAM(X,0)
+11 SET WGHT=$PIECE(WKLD0,"^",3)
+12 if 'WGHT
SET WGHT=1
+13 ; Round weight multiplier decimal value to nearest integer.
+14 IF WGHT["."
Begin DoDot:2
+15 SET X1=$PIECE(WGHT,".")
SET X2=$PIECE(WGHT,".",2)
+16 SET WGHT=$SELECT(X2>4:X1+1,1:X1)
End DoDot:2
+17 ; Set weight multiplier to 1 if undefined or 0.
+18 SET WGHT=$SELECT(WGHT']"":1,WGHT=0:1,1:WGHT)
+19 SET LRSEC=$PIECE(WKLD0,"^",15)
if LRSEC=""
QUIT
+20 if '$DATA(^LAB(64.21,"B","Blood Bank",LRSEC))
QUIT
+21 DO BEGROOT^VBECRPC("Code")
+22 DO ADD^VBECRPC("<LMIP>"_$$CHARCHK^XOBVLIB($PIECE(WKLD0,"^",2))_"</LMIP>")
+23 DO ADD^VBECRPC("<Procedure>"_$$CHARCHK^XOBVLIB($PIECE(WKLD0,"^"))_"</Procedure>")
+24 DO ADD^VBECRPC("<Cost>"_$$CHARCHK^XOBVLIB($PIECE(WKLD0,"^",10))_"</Cost>")
+25 DO ADD^VBECRPC("<WeightMultiplier>"_$$CHARCHK^XOBVLIB(WGHT)_"</WeightMultiplier>")
+26 IF $DATA(^LAM("AD",X,"CPT"))
Begin DoDot:2
+27 SET Y=0
+28 FOR
SET Y=$ORDER(^LAM("AD",X,"CPT",Y))
if Y']""
QUIT
Begin DoDot:3
+29 IF $PIECE(^LAM(X,4,Y,0),"^",4)]""
QUIT
+30 DO ADD^VBECRPC("<CPTCode>"_$$CHARCHK^XOBVLIB(+^LAM(X,4,Y,0))_"</CPTCode>")
End DoDot:3
End DoDot:2
+31 DO ENDROOT^VBECRPC("Code")
+32 QUIT
End DoDot:1
+33 DO ENDROOT^VBECRPC("Workload")
+34 QUIT
+35 ;
KILL ;
+1 KILL VBECCNT,CNT,X
+2 QUIT
