- 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 Feb 19, 2025@00:11:06 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