- BLRAG05G ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCS ;03 MAY 2013 1200;SAT
- ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
- ;
- Q
- ;
- ;RPC to return Ask at Order Entry questions for the lab tests that go with the passed in Lab Order Entry file pointers.
- ; BLRAG05G AOE
- ;Input:
- ; BLRTSTL = (required) The "TEST POINTERS" portion of this data comes
- ; element 39 in the return from BLR ALL NON-ACCESSIONED.
- ; List of test pointers for each
- ; test/procedure being accessioned separated by ^.
- ; Each ^ piece is made up of these pipe pieces:
- ; TEST POINTERS | [ICD9_LIST_(not_used)] ^ ...
- ; Test pointers = pointers to the LAB ORDER ENTRY
- ; file 69 - DATE:SPECIMEN:TEST
- ; Note that these are the same pointers that are passed into BLR ACCESSION
- ;Output: BLRAOE=Count of items in array
- ; BLRAOE(<test ien>,<counter>)=Question prompt^Result Code^Lab Name
- AOE(BLRAOE,BLRTSTL) ;EP-
- N BLRDT,BLRJ,BLRSP,BLRTST
- N CNT,IEN,X
- D ^XBKVAR ;setup minimum KERNEL variables
- S X="ERROR^BLRAG05G",@^%ZOSF("TRAP") ;setup error trap
- S BLRAOE=0
- S CNT=0
- I $G(BLRTSTL)'="" D
- .F BLRJ=1:1:$L(BLRTSTL,U) D
- ..S BLRDT=$P($P($P(BLRTSTL,U,BLRJ),"|",1),":",1)
- ..S BLRSP=$P($P($P(BLRTSTL,U,BLRJ),"|",1),":",2)
- ..S BLRTST=$P($P($P(BLRTSTL,U,BLRJ),"|",1),":",3)
- ..S BLRTST60=$P($G(^LRO(69,+$G(BLRDT),1,+$G(BLRSP),2,+$G(BLRTST),0)),U,1) ;get test
- ..D GETPMT(BLRTST60)
- S BLRAOE=CNT
- Q
- ;
- ; Add prompts to return array for a given test
- GETPMT(TST) ;EP-
- N RL,RC,RI,N0,PC,TI,SC,LN
- S RL=$P($G(^BLRSITE(DUZ(2),"RL")),U)
- Q:'RL
- S RI=$O(^BLRRL("ALP",TST,RL,0))
- Q:'RI
- S LN=$P($G(^LAB(60,+$G(TST),0)),U,1)
- S RC=0 F S RC=$O(^BLRRL(RL,1,RI,1,RC)) Q:'RC D
- .S PC=$G(^BLRRL(RL,1,RI,1,RC,0))
- .S TP=$O(^BLRRL("BRES",PC,RL,0))
- .Q:'TP
- .S N0=^BLRRL(RL,1,TP,0)
- .S TI=$P(N0,U,7)
- .S SC=$P(N0,U,4)
- .S CNT=CNT+1
- .S BLRAOE(TST,CNT)=TI_U_SC_U_LN
- Q
- ;
- ERROR ;
- D ENTRYAUD^BLRUTIL("ERROR^BLRAG05G 0.0") ; Store Error data
- NEW ERRORMSG
- S ERRORMSG="$"_"Z"_"E=""ERROR^BLRAG05G""" ; BYPASS SAC Checker
- S @ERRORMSG D ^%ZTER
- D ERR("RPMS Error")
- Q
- ;
- ERR(BLRERR) ;Error processing
- ; BLRERR = Error text OR error code
- ; BLRAGI = pointer into return global array
- I +BLRERR S BLRERR=BLRERR+134234112 ;vbObjectError
- S BLRAOE=-1
- Q
- BLRAG05G ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCS ;03 MAY 2013 1200;SAT
- +1 ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;RPC to return Ask at Order Entry questions for the lab tests that go with the passed in Lab Order Entry file pointers.
- +6 ; BLRAG05G AOE
- +7 ;Input:
- +8 ; BLRTSTL = (required) The "TEST POINTERS" portion of this data comes
- +9 ; element 39 in the return from BLR ALL NON-ACCESSIONED.
- +10 ; List of test pointers for each
- +11 ; test/procedure being accessioned separated by ^.
- +12 ; Each ^ piece is made up of these pipe pieces:
- +13 ; TEST POINTERS | [ICD9_LIST_(not_used)] ^ ...
- +14 ; Test pointers = pointers to the LAB ORDER ENTRY
- +15 ; file 69 - DATE:SPECIMEN:TEST
- +16 ; Note that these are the same pointers that are passed into BLR ACCESSION
- +17 ;Output: BLRAOE=Count of items in array
- +18 ; BLRAOE(<test ien>,<counter>)=Question prompt^Result Code^Lab Name
- AOE(BLRAOE,BLRTSTL) ;EP-
- +1 NEW BLRDT,BLRJ,BLRSP,BLRTST
- +2 NEW CNT,IEN,X
- +3 ;setup minimum KERNEL variables
- DO ^XBKVAR
- +4 ;setup error trap
- SET X="ERROR^BLRAG05G"
- SET @^%ZOSF("TRAP")
- +5 SET BLRAOE=0
- +6 SET CNT=0
- +7 IF $GET(BLRTSTL)'=""
- Begin DoDot:1
- +8 FOR BLRJ=1:1:$LENGTH(BLRTSTL,U)
- Begin DoDot:2
- +9 SET BLRDT=$PIECE($PIECE($PIECE(BLRTSTL,U,BLRJ),"|",1),":",1)
- +10 SET BLRSP=$PIECE($PIECE($PIECE(BLRTSTL,U,BLRJ),"|",1),":",2)
- +11 SET BLRTST=$PIECE($PIECE($PIECE(BLRTSTL,U,BLRJ),"|",1),":",3)
- +12 ;get test
- SET BLRTST60=$PIECE($GET(^LRO(69,+$GET(BLRDT),1,+$GET(BLRSP),2,+$GET(BLRTST),0)),U,1)
- +13 DO GETPMT(BLRTST60)
- End DoDot:2
- End DoDot:1
- +14 SET BLRAOE=CNT
- +15 QUIT
- +16 ;
- +17 ; Add prompts to return array for a given test
- GETPMT(TST) ;EP-
- +1 NEW RL,RC,RI,N0,PC,TI,SC,LN
- +2 SET RL=$PIECE($GET(^BLRSITE(DUZ(2),"RL")),U)
- +3 IF 'RL
- QUIT
- +4 SET RI=$ORDER(^BLRRL("ALP",TST,RL,0))
- +5 IF 'RI
- QUIT
- +6 SET LN=$PIECE($GET(^LAB(60,+$GET(TST),0)),U,1)
- +7 SET RC=0
- FOR
- SET RC=$ORDER(^BLRRL(RL,1,RI,1,RC))
- IF 'RC
- QUIT
- Begin DoDot:1
- +8 SET PC=$GET(^BLRRL(RL,1,RI,1,RC,0))
- +9 SET TP=$ORDER(^BLRRL("BRES",PC,RL,0))
- +10 IF 'TP
- QUIT
- +11 SET N0=^BLRRL(RL,1,TP,0)
- +12 SET TI=$PIECE(N0,U,7)
- +13 SET SC=$PIECE(N0,U,4)
- +14 SET CNT=CNT+1
- +15 SET BLRAOE(TST,CNT)=TI_U_SC_U_LN
- End DoDot:1
- +16 QUIT
- +17 ;
- ERROR ;
- +1 ; Store Error data
- DO ENTRYAUD^BLRUTIL("ERROR^BLRAG05G 0.0")
- +2 NEW ERRORMSG
- +3 ; BYPASS SAC Checker
- SET ERRORMSG="$"_"Z"_"E=""ERROR^BLRAG05G"""
- +4 SET @ERRORMSG
- DO ^%ZTER
- +5 DO ERR("RPMS Error")
- +6 QUIT
- +7 ;
- ERR(BLRERR) ;Error processing
- +1 ; BLRERR = Error text OR error code
- +2 ; BLRAGI = pointer into return global array
- +3 ;vbObjectError
- IF +BLRERR
- SET BLRERR=BLRERR+134234112
- +4 SET BLRAOE=-1
- +5 QUIT
