BLRAG09C ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCS ; NOV 20, 2012
;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
;from LA7SM
; BLR REF LAB USING LEDI - UL^BLRAG02 = return the value of the 'REF LAB USING LEDI?' field in the BLR MASTER CONTROL file
; BLR ICD LOOKUP - ICDLKUP^BLRAG07 = ICD code lookup
; BLR ORDER REASON LKUP - ORL^BLRAG07 = return order reasons from file 100.03
; BLR PATIENT LOOKUP - PTLK^BLRAG04 = Patient Lookup
; BLR PRINTERS AVAILABLE - DEVICE^BLRAG10 = return available printers from the DEVICE file
; BLR USER LOOKUP - NP^BLRAG06 = return entries from the NEW PERSON table 200 that are 'active'
;
; BLR ACCESSION - ACC^BLRAG05 = lab accession processor
; BLR ACCESSION PRINT - ABR^BLRAG02 = reprint accession label or manifest
; BLR ALL NON-ACCESSIONED - ANA^BLRAG01 = return all non-accessioned lab records
; BLR ALL-ACCESSIONED - ABD^BLRAG02 = return all accessioned records for given date range
; BLR COLLECTION INFO - BLC^BLRAG06 = check BLR PT CONFIRM parameter and return insurances for patient
; BLR DELETE TEST - DELTST^BLRAG08 = Cancel tests - Test are no longer deleted, instead the status is changed to Not Performed.
; BLR ORDER/TEST STATUS - LROS^BLRAG03 = return order/test status for given patient and date range
;
; BLR SHIP CONF - SC^BLRAG09A = select a shipping configuration
; BLR MANIFEST BUILD - BM^BLRAG09B = build a shipping manifest
; BLR MANIFEST CLOSE/SHIP - CLSHIP^BLRAG09C = Close/ship a shipping manifest
; BLR MANIFEST DISPLAY - DISP^BLRAG09G = screen formatted text for manifest display
; BLR MANIFEST START - SMONLY^BLRAG09C = Start a shipping manifest only, no building
; BLR MANIFEST TEST ADD - ADDTEST^BLRAG09C= Add tests to an existing manifest\
; BLR MANIFEST TEST REMOVE - REMVTST^BLRAG09C= Remove a test from manifest - actually flags test as "removed".
; BLR MANIFEST TESTS TO ADD- TARPC^BLRAG09B = return tests that can be added to a manifest
;
CLSHIP(BLRY,BLRSCFG,BLRSM,BLRCSF,BLRSHTIM,BLRDEV) ; Close/ship a shipping manifest
; BLR MANIFEST CLOSE/SHIP rpc
;INPUT:
; BLRSCFG = (required) Shipping Configuration pointer to the
; LAB SHIPPING CONFIGURATION file 62.9
; BLRSM = (required) Shipping Manifest pointer to the
; LAB SHIPPING MANIFEST file 62.8
; BLRCSF = (optional) close/ship manifest flag
; 0=print manifest only (default)
; 1=close manifest
; 2=ship manifest
; if manifest status=3 (closed), only ship or print manifest is allowed
; BLRSHTIM = Manifest Ship date/time in external format
; BLRDEV = Printer for Manifest printing - IEN pointer to the DEVICE file
; No printing will occur if null or undefined in the DEVICE file
;
;RETURNS:
; MESSAGE
;
N BLRI
D ^XBKVAR S X="ERROR^BLRAG09C",@^%ZOSF("TRAP")
S BLRI=0
K ^TMP("BLRAG",$J)
S BLRY=$$TMPGLB^BLRAGUT()
; 0
S @BLRY@(0)="ERROR_ID"
;
N BLREF,BLRTXT
S BLRTXT=""
S (BLREF,BLREFF)=0
D INIT
;I LA7QUIT D CLEANUP Q
S LA7SM=BLRSM ;manifest
D LOCKSM
I LA7QUIT D Q
. D UNLOCKSM,CLEANUP
S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MSG,X,Y
S LA7ST=+$G(BLRCSF)
I BLRCSF=1 D
.D SMSUP^LA7SMU(LA7SM_U_$P(LA7SM(0),U,1),3,"SM04") ; Close manifest
.S BLRTXT="MANIFEST "_$P(LA7SM(0),U,1)_" has been closed."
I BLRCSF=2 D
.D SHIP ; Ship Manifest
.I MSG'="" S BLRTXT=$S(BLRTXT'="":BLRTXT_" ",1:"")_MSG ;LA7QUIT
.S BLREFF=+BLREF
;print manifest
I ('BLRCSF)!$G(BLRDEV) D DEV^BLRAG09F($G(BLRDEV)) ;print manifest
I $P($G(BLREF),U,1)=-1 S BLRTXT=$S(BLRTXT'="":BLRTXT_" ",1:"")_" Error printing manifest# "_$P(LA7SM(0),U,1)_"." S BLREFF=1
S:$G(BLREFF)'=1 @BLRY@(0)="MESSAGE"
S BLRI=BLRI+1 S @BLRY@(BLRI)=BLRTXT
D UNLOCKSM,CLEANUP
Q
;
SHIP ; Ship a manifest only called from CLSHIP
; Used to flag shipping manifest for shipping
; If electronically connected -> transmit shipping manifest in HL7 message.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA7I,LA7TCNT,X,Y
;
S (LA7I,LA7TCNT)=0
F S LA7I=$O(^LAHM(62.8,+LA7SM,10,LA7I)) Q:'LA7I D
. I $$CHKTST^LA7SMU(+LA7SM,LA7I) Q
. I $P($G(^LAHM(62.8,+LA7SM,10,LA7I,0)),"^",8)'=1 Q
. S LA7TCNT=LA7TCNT+1 ; Test ready to ship.
. D CHKREQI^LA7SM2(+LA7SM,LA7I)
;
I 'LA7TCNT D Q
. S LA7QUIT=1
. S MSG="No tests on shipping manifest - Shipping Aborted"
. S BLREF=1
;
I $G(LA7ERR) D Q
. S LA7QUIT=1
. S MSG="Print shipping manifest for complete listing of errors"
. S BLREF=1
. ;D EN^DDIOL("The following errors were found - Shipping Aborted","","!?5")
. ;S LA7X=""
. ;F S LA7X=$O(LA7ERR(LA7X)) Q:LA7X="" D EN^DDIOL(LA7ERR(LA7X),"","!?5")
. ;D EN^DDIOL("","","!")
;
;S DIR(0)="D^::EFRX",DIR("A")="Enter Manifest Shipping Date",DIR("B")="NOW"
;D ^DIR
;I $D(DIRUT) S LA7QUIT=1 Q
S LA7SDT=$G(BLRSHTIM)
D SMSUP^LA7SMU(LA7SM_U_$P(LA7SM(0),U,1),4,"SM05^"_LA7SDT)
;
K LA7I
S LA7I=0
F S LA7I=$O(^LAHM(62.8,+LA7SM,10,LA7I)) Q:'LA7I D
. S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
. I $P(LA7I(0),"^",8)'=1 Q ; Not "pending shipment".
. ; Change status to "shipped".
. S LA762801=LA7I_","_+LA7SM_","
. S FDA(62.8,62.801,LA762801,.08)=2
. D FILE^DIE("","FDA(62.8)","LA7DIE(2)")
. ; Update event file
. S LA7DATA="SM53^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$P(LA7SM,"^",2)
. D SEUP^LA7SMU($P(LA7I(0),"^",5),2,LA7DATA)
;
; Do tasking of transmission
I $P($G(^LAHM(62.9,+LA7SCFG,0)),"^",7) D TASKSM
;
Q
;
TASKSM ; Task electronic transmission of manifest called from SHIP
;
N ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
;
S ZTRTN="BUILD^LA7VORM1("""_+$P(LA7SM,"^")_""")",ZTDESC="E-Transmission of Lab Shipping Manifest"
S ZTSAVE("LA7SM")="",ZTIO="",ZTDTH=$$NOW^XLFDT
D ^%ZTLOAD
;
S MSG="Electronic Transmission of Shipping Manifest "_$S($G(ZTSK):"queued as task# "_ZTSK,1:"NOT queued!")
;D EN^DDIOL(MSG,"","!?5")
Q
;
ERR(BLRERR) ;Error processing
; BLRERR = Error text OR error code
; BLRI = pointer into return global array
D UNLOCKSM,CLEANUP
S BLRI=BLRI+1
S ^TMP("BLRAG",$J,BLRI)=BLRERR_$C(30)
;S BLRI=BLRI+1
;S ^TMP("BLRAG",$J,BLRI)=$C(31)
Q
;
ERROR ;
D ENTRYAUD^BLRUTIL("ERROR^BLRAG09C 0.0") ; Store Error data
NEW ERRORMSG
S ERRORMSG="$"_"Z"_"E=""ERROR^BLRAG09C""" ; BYPASS SAC Checker
S @ERRORMSG D ^%ZTER
D ERR("RPMS Error")
Q
;
ADDTEST(BLRY,BLRSCFG,BLRSM,BLRTAL) ; Add tests to an existing manifest
; BLR MANIFEST TEST ADD rpc
;INPUT:
; BLRSCFG = Shipping Configuration pointer to the
; LAB SHIPPING CONFIGURATION file 62.9
; BLRSM = Shipping Manifest pointer to the LAB SHIPPING MANIFEST
; file 62.8
; BLRTAL = List of tests to be added to manifest separated by pipe:
; TEST_IEN_":"_TEST_NAME_":"_UID_":"_EXT_ACC_#_":"_AREA_":"_DATE_":"
; _ACC_#|...
; TEST_IEN = pointer to LABORATORY TEST file 60
; TEST_NAME = Text from NAME field in LABORATORY TEST file 60
; UID = Test Unique ID
; EXT_ACC_# = External accession number
; AREA = area pointer into file 68
; DATE = date pointer into file 68
; ACC_# = accession # pointer into file 68
; PAT_DFN = Patient IEN pointer to the VA Patient file 2
; PAT_NAM = Patient name
; CONFIG_NAM = Shipping Configuration Name
;RETURNS:
; TEST_ON_MANIF ^ ADDABLE_TESTS
; TESTS_ON_MANIF = List of tests on manifest separated by pipe:
; See MTL^BLRAG09A
; ADDABLE_TESTS = List of tests that can be added separated by pipe:
; See TA^BLRAG9B
N BLRI
D ^XBKVAR S X="ERROR^BLRAGUT",@^%ZOSF("TRAP")
S BLRI=0
K ^TMP("BLRAG",$J)
S BLRY=$$TMPGLB^BLRAGUT()
S @BLRY@(0)="ERROR_ID"
;
N BLRJ,BLRTSTL
N LA760,LA7AA,LA7AD,LA7AN,LA7BY,LA7DIV,LA7I,LA7UID,LA7X
S LA7SCFG=BLRSCFG
S LA7SM=BLRSM
S BLRTSTL=""
S LA7QUIT=0
;
F BLRJ=1:1:$L(BLRTAL,"|") D
.S LA760=$P($P(BLRTAL,"|",BLRJ),":",1) ;test pointer to file 60
.S LA7UID=$P($P(BLRTAL,"|",BLRJ),":",3) ;UID
.S LA7AA=$P($P(BLRTAL,"|",BLRJ),":",5) ;accession area
.S LA7AD=$P($P(BLRTAL,"|",BLRJ),":",6) ;accession date
.S LA7AN=$P($P(BLRTAL,"|",BLRJ),":",7) ;accession number (internal)
.S LA760(0)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0)) ;Test's zeroth node
.I $P(LA760(0),"^",5) S LA7QUIT="1^Test already completed" Q ; Test completed - skip
.S LA76205=+$P(LA760(0),"^",2) ; Test urgency
.I LA76205>49 S LA76205=$S(LA76205=50:9,1:LA76205-50)
.; Specimen type
.S LA76805=0 S X=+$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0)) I X S LA76805=+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
.I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",2)=62.3 S LA7QUIT="1^Cannot select controls" Q ; Don't build controls
.S LA7I=0
.F S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I D Q:LA7QUIT
.. N X
.. S X(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
.. I $P(X(0),"^",2)=LA760,$P(X(0),"^",8)'=0 S LA7QUIT="1^Test already on shipping manifest"
.I LA7QUIT Q
.D SCBLD^LA7SM1(+LA7SCFG) ; Build TMP global with test profile
.S LA7DIV=+$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.4)),"^") ; Accession's division
.D SCHK^LA7SM1 ; Check if test eligible for manifest
.I 'LA7FLAG S LA7QUIT="1^Test not selectable for this configuration" Q
.D LOCK68^LA7SMB
.S LA7I=0
.F S LA7I=$O(LA7X(LA7I)) Q:'LA7I D ADD^LA7SMB
.D UNLOCK68^LA7SMB
D MTL^BLRAG09A(.BLRTSTL,BLRSM) ;get tests already on manifest
S BLRNTAL=$$TA^BLRAG09B(BLRSCFG,BLRSM) ;get test that can be added to manifest
; 0 1
S @BLRY@(0)="TESTS_ON_MANIF^ADDABLE_TESTS"
S BLRI=BLRI+1 S @BLRY@(BLRI)=BLRTSTL_U_BLRNTAL
Q
;
;
REMVTST(BLRY,BLRSM,BLRMTL) ; Remove a test from manifest - actually flags test as "removed".
; BLR MANIFEST TEST REMOVE rpc
;INPUT:
; BLRSM = Manifest IEN pointer to LAB SHIPPING MANIFEST file 62.8
; BLRMTL = List of manifest tests separated by pipe:
; TEST_IEN:TEST_NAME:TEST_SPEC_PTR|...
; TEST_IEN = pointer to LABORATORY TEST file 60
; TEST_NAME = Text from NAME field in
; LABORATORY TEST file 60
; TEST_SPECIMEN_PTR = Specimen pointer
; pointer to SPECIMENS multiple of
; LAB SHIPPING MANIFEST file 62.8
;RETURNS:
; ERROR_ID ^ MESSAGE ^ MANIFEST_TESTL ^ ADDABLE_TESTS
; ERROR_ID = 0=test removed
; 1=error removing test
; MESSAGE = Text message describing error
; MANIFEST_TESTL = Remaining List of manifest tests separated by pipe:
; See MTL^BLRAG09A
; ADDABLE_TESTS = List of tests that can be added separated by pipe:
; See TA^BLRAG09B
N BLRI
D ^XBKVAR S X="ERROR^BLRAGUT",@^%ZOSF("TRAP")
S BLRI=0
K ^TMP("BLRAG",$J)
S BLRY=$$TMPGLB^BLRAGUT()
S @BLRY@(0)="ERROR_ID"
;
N BLRCNT,BLRJ,BLRTSTL
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7I,LA7TCNT,LA7Y,LA760,X,Y
S BLRTSTL=""
S LA7SM=BLRSM
;build LA760 array
K LA760
S BLRCNT=0
F BLRJ=1:1:$L(BLRMTL,"|") D
.S BLRCNT=BLRCNT+1
.S LA760(BLRCNT)=$P($P(BLRMTL,"|",BLRJ),":",3)_U_$G(^LAHM(62.8,+$G(BLRSM),10,$P($P(BLRMTL,"|",BLRJ),":",3),0))
;
S LA7X="" F S LA7X=$O(LA760(LA7X)) Q:LA7X="" D
.N FDA,LA7628,LA768,LA7DATA
.S LA762801="" F S LA762801=$O(^LAHM(62.8,+LA7SM,10,"UID",+(LA760(LA7X)),LA762801)) Q:LA762801="" Q:$P($G(^LAHM(62.8,LA7SM,10,LA762801,0)),U,8)'=0
.I LA762801'="" D
..S LA762801=LA762801_","_+LA7SM_","
..S FDA(62.8,62.801,LA762801,.08)=0
..D FILE^DIE("","FDA(62.8)","LA7DIE(2)") ; "Remove" test from shipping manifest
..; Update event file
..S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA760(LA7X),"^",3)_"^"_"" ;$P(LA7SM,"^",2) no associated manifest for GUI
..S LA7UID=$P(LA760(LA7X),"^",6) ;get SPECIMEN ID (UID) (add 1 to piece number)
..D SEUP^LA7SMU(LA7UID,2,LA7DATA)
..; Update accession
..D ACCSUP^LA7SMU(LA7UID,$P(LA760(LA7X),"^",3),"@")
D MTL^BLRAG09A(.BLRTSTL,BLRSM) ;get tests on Manifest
S BLRSCFG=$P($G(^LAHM(62.8,BLRSM,0)),U,2)
S BLRNTAL=$$TA^BLRAG09B(BLRSCFG,BLRSM) ;get test that can be added to manifest
; 0 1 2 3
S @BLRY@(0)="CLEAN^MESSAGE^MANIFEST_TESTL^ADDABLE_TESTS"
; 0 1 2 3
S BLRI=BLRI+1 S @BLRY@(BLRI)=0_U_""_U_BLRTSTL_U_BLRNTAL
Q
;
INIT ; Initialize variables
S DT=$$DT^XLFDT
S LA7QUIT=0
S LA7SCFG=BLRSCFG ;shipping configuration
;I LA7SCFG<1 S LA7QUIT=1 Q
S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
S MSG=""
K ^TMP("LA7ERR",$J)
Q
;
;
LOCKSM ; Lock entry in file 62.8
L +^LAHM(62.8,+LA7SM):1 ; Set lock.
I '$T S LA7QUIT="1^Someone else is editing this shipping manifest"
Q
;
;
UNLOCKSM ; Unlock entry in file 62.8
L -^LAHM(62.8,+LA7SM) ; Release lock.
Q
;
;
CLEANUP ; Cleanup variables
I $D(ZTQUEUED) S ZTREQ="@"
K DA,DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
K LA7AA,LA7ACTON,LA7AD,LA7AN,LA7EV,LA7FLAG,LA7I,LA7QUIT,LA7SCFG,LA7SDT,LA7SM,LA7ST,LA7UID,LA7X,LA7YARRY
K LA760,LA76205,LA762801,LA76805
K ^TMP("LA7ERR",$J)
Q
BLRAG09C ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCS ; NOV 20, 2012
+1 ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
+2 ;from LA7SM
+3 ; BLR REF LAB USING LEDI - UL^BLRAG02 = return the value of the 'REF LAB USING LEDI?' field in the BLR MASTER CONTROL file
+4 ; BLR ICD LOOKUP - ICDLKUP^BLRAG07 = ICD code lookup
+5 ; BLR ORDER REASON LKUP - ORL^BLRAG07 = return order reasons from file 100.03
+6 ; BLR PATIENT LOOKUP - PTLK^BLRAG04 = Patient Lookup
+7 ; BLR PRINTERS AVAILABLE - DEVICE^BLRAG10 = return available printers from the DEVICE file
+8 ; BLR USER LOOKUP - NP^BLRAG06 = return entries from the NEW PERSON table 200 that are 'active'
+9 ;
+10 ; BLR ACCESSION - ACC^BLRAG05 = lab accession processor
+11 ; BLR ACCESSION PRINT - ABR^BLRAG02 = reprint accession label or manifest
+12 ; BLR ALL NON-ACCESSIONED - ANA^BLRAG01 = return all non-accessioned lab records
+13 ; BLR ALL-ACCESSIONED - ABD^BLRAG02 = return all accessioned records for given date range
+14 ; BLR COLLECTION INFO - BLC^BLRAG06 = check BLR PT CONFIRM parameter and return insurances for patient
+15 ; BLR DELETE TEST - DELTST^BLRAG08 = Cancel tests - Test are no longer deleted, instead the status is changed to Not Performed.
+16 ; BLR ORDER/TEST STATUS - LROS^BLRAG03 = return order/test status for given patient and date range
+17 ;
+18 ; BLR SHIP CONF - SC^BLRAG09A = select a shipping configuration
+19 ; BLR MANIFEST BUILD - BM^BLRAG09B = build a shipping manifest
+20 ; BLR MANIFEST CLOSE/SHIP - CLSHIP^BLRAG09C = Close/ship a shipping manifest
+21 ; BLR MANIFEST DISPLAY - DISP^BLRAG09G = screen formatted text for manifest display
+22 ; BLR MANIFEST START - SMONLY^BLRAG09C = Start a shipping manifest only, no building
+23 ; BLR MANIFEST TEST ADD - ADDTEST^BLRAG09C= Add tests to an existing manifest\
+24 ; BLR MANIFEST TEST REMOVE - REMVTST^BLRAG09C= Remove a test from manifest - actually flags test as "removed".
+25 ; BLR MANIFEST TESTS TO ADD- TARPC^BLRAG09B = return tests that can be added to a manifest
+26 ;
CLSHIP(BLRY,BLRSCFG,BLRSM,BLRCSF,BLRSHTIM,BLRDEV) ; Close/ship a shipping manifest
+1 ; BLR MANIFEST CLOSE/SHIP rpc
+2 ;INPUT:
+3 ; BLRSCFG = (required) Shipping Configuration pointer to the
+4 ; LAB SHIPPING CONFIGURATION file 62.9
+5 ; BLRSM = (required) Shipping Manifest pointer to the
+6 ; LAB SHIPPING MANIFEST file 62.8
+7 ; BLRCSF = (optional) close/ship manifest flag
+8 ; 0=print manifest only (default)
+9 ; 1=close manifest
+10 ; 2=ship manifest
+11 ; if manifest status=3 (closed), only ship or print manifest is allowed
+12 ; BLRSHTIM = Manifest Ship date/time in external format
+13 ; BLRDEV = Printer for Manifest printing - IEN pointer to the DEVICE file
+14 ; No printing will occur if null or undefined in the DEVICE file
+15 ;
+16 ;RETURNS:
+17 ; MESSAGE
+18 ;
+19 NEW BLRI
+20 DO ^XBKVAR
SET X="ERROR^BLRAG09C"
SET @^%ZOSF("TRAP")
+21 SET BLRI=0
+22 KILL ^TMP("BLRAG",$JOB)
+23 SET BLRY=$$TMPGLB^BLRAGUT()
+24 ; 0
+25 SET @BLRY@(0)="ERROR_ID"
+26 ;
+27 NEW BLREF,BLRTXT
+28 SET BLRTXT=""
+29 SET (BLREF,BLREFF)=0
+30 DO INIT
+31 ;I LA7QUIT D CLEANUP Q
+32 ;manifest
SET LA7SM=BLRSM
+33 DO LOCKSM
+34 IF LA7QUIT
Begin DoDot:1
+35 DO UNLOCKSM
DO CLEANUP
End DoDot:1
QUIT
+36 SET LA7SM(0)=$GET(^LAHM(62.8,+LA7SM,0))
+37 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,MSG,X,Y
+38 SET LA7ST=+$GET(BLRCSF)
+39 IF BLRCSF=1
Begin DoDot:1
+40 ; Close manifest
DO SMSUP^LA7SMU(LA7SM_U_$PIECE(LA7SM(0),U,1),3,"SM04")
+41 SET BLRTXT="MANIFEST "_$PIECE(LA7SM(0),U,1)_" has been closed."
End DoDot:1
+42 IF BLRCSF=2
Begin DoDot:1
+43 ; Ship Manifest
DO SHIP
+44 ;LA7QUIT
IF MSG'=""
SET BLRTXT=$SELECT(BLRTXT'="":BLRTXT_" ",1:"")_MSG
+45 SET BLREFF=+BLREF
End DoDot:1
+46 ;print manifest
+47 ;print manifest
IF ('BLRCSF)!$GET(BLRDEV)
DO DEV^BLRAG09F($GET(BLRDEV))
+48 IF $PIECE($GET(BLREF),U,1)=-1
SET BLRTXT=$SELECT(BLRTXT'="":BLRTXT_" ",1:"")_" Error printing manifest# "_$PIECE(LA7SM(0),U,1)_"."
SET BLREFF=1
+49 IF $GET(BLREFF)'=1
SET @BLRY@(0)="MESSAGE"
+50 SET BLRI=BLRI+1
SET @BLRY@(BLRI)=BLRTXT
+51 DO UNLOCKSM
DO CLEANUP
+52 QUIT
+53 ;
SHIP ; Ship a manifest only called from CLSHIP
+1 ; Used to flag shipping manifest for shipping
+2 ; If electronically connected -> transmit shipping manifest in HL7 message.
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA7I,LA7TCNT,X,Y
+4 ;
+5 SET (LA7I,LA7TCNT)=0
+6 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+7 IF $$CHKTST^LA7SMU(+LA7SM,LA7I)
QUIT
+8 IF $PIECE($GET(^LAHM(62.8,+LA7SM,10,LA7I,0)),"^",8)'=1
QUIT
+9 ; Test ready to ship.
SET LA7TCNT=LA7TCNT+1
+10 DO CHKREQI^LA7SM2(+LA7SM,LA7I)
End DoDot:1
+11 ;
+12 IF 'LA7TCNT
Begin DoDot:1
+13 SET LA7QUIT=1
+14 SET MSG="No tests on shipping manifest - Shipping Aborted"
+15 SET BLREF=1
End DoDot:1
QUIT
+16 ;
+17 IF $GET(LA7ERR)
Begin DoDot:1
+18 SET LA7QUIT=1
+19 SET MSG="Print shipping manifest for complete listing of errors"
+20 SET BLREF=1
+21 ;D EN^DDIOL("The following errors were found - Shipping Aborted","","!?5")
+22 ;S LA7X=""
+23 ;F S LA7X=$O(LA7ERR(LA7X)) Q:LA7X="" D EN^DDIOL(LA7ERR(LA7X),"","!?5")
+24 ;D EN^DDIOL("","","!")
End DoDot:1
QUIT
+25 ;
+26 ;S DIR(0)="D^::EFRX",DIR("A")="Enter Manifest Shipping Date",DIR("B")="NOW"
+27 ;D ^DIR
+28 ;I $D(DIRUT) S LA7QUIT=1 Q
+29 SET LA7SDT=$GET(BLRSHTIM)
+30 DO SMSUP^LA7SMU(LA7SM_U_$PIECE(LA7SM(0),U,1),4,"SM05^"_LA7SDT)
+31 ;
+32 KILL LA7I
+33 SET LA7I=0
+34 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+35 SET LA7I(0)=$GET(^LAHM(62.8,+LA7SM,10,LA7I,0))
+36 ; Not "pending shipment".
IF $PIECE(LA7I(0),"^",8)'=1
QUIT
+37 ; Change status to "shipped".
+38 SET LA762801=LA7I_","_+LA7SM_","
+39 SET FDA(62.8,62.801,LA762801,.08)=2
+40 DO FILE^DIE("","FDA(62.8)","LA7DIE(2)")
+41 ; Update event file
+42 SET LA7DATA="SM53^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$PIECE(LA7SM,"^",2)
+43 DO SEUP^LA7SMU($PIECE(LA7I(0),"^",5),2,LA7DATA)
End DoDot:1
+44 ;
+45 ; Do tasking of transmission
+46 IF $PIECE($GET(^LAHM(62.9,+LA7SCFG,0)),"^",7)
DO TASKSM
+47 ;
+48 QUIT
+49 ;
TASKSM ; Task electronic transmission of manifest called from SHIP
+1 ;
+2 NEW ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+3 ;
+4 SET ZTRTN="BUILD^LA7VORM1("""_+$PIECE(LA7SM,"^")_""")"
SET ZTDESC="E-Transmission of Lab Shipping Manifest"
+5 SET ZTSAVE("LA7SM")=""
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
+6 DO ^%ZTLOAD
+7 ;
+8 SET MSG="Electronic Transmission of Shipping Manifest "_$SELECT($GET(ZTSK):"queued as task# "_ZTSK,1:"NOT queued!")
+9 ;D EN^DDIOL(MSG,"","!?5")
+10 QUIT
+11 ;
ERR(BLRERR) ;Error processing
+1 ; BLRERR = Error text OR error code
+2 ; BLRI = pointer into return global array
+3 DO UNLOCKSM
DO CLEANUP
+4 SET BLRI=BLRI+1
+5 SET ^TMP("BLRAG",$JOB,BLRI)=BLRERR_$CHAR(30)
+6 ;S BLRI=BLRI+1
+7 ;S ^TMP("BLRAG",$J,BLRI)=$C(31)
+8 QUIT
+9 ;
ERROR ;
+1 ; Store Error data
DO ENTRYAUD^BLRUTIL("ERROR^BLRAG09C 0.0")
+2 NEW ERRORMSG
+3 ; BYPASS SAC Checker
SET ERRORMSG="$"_"Z"_"E=""ERROR^BLRAG09C"""
+4 SET @ERRORMSG
DO ^%ZTER
+5 DO ERR("RPMS Error")
+6 QUIT
+7 ;
ADDTEST(BLRY,BLRSCFG,BLRSM,BLRTAL) ; Add tests to an existing manifest
+1 ; BLR MANIFEST TEST ADD rpc
+2 ;INPUT:
+3 ; BLRSCFG = Shipping Configuration pointer to the
+4 ; LAB SHIPPING CONFIGURATION file 62.9
+5 ; BLRSM = Shipping Manifest pointer to the LAB SHIPPING MANIFEST
+6 ; file 62.8
+7 ; BLRTAL = List of tests to be added to manifest separated by pipe:
+8 ; TEST_IEN_":"_TEST_NAME_":"_UID_":"_EXT_ACC_#_":"_AREA_":"_DATE_":"
+9 ; _ACC_#|...
+10 ; TEST_IEN = pointer to LABORATORY TEST file 60
+11 ; TEST_NAME = Text from NAME field in LABORATORY TEST file 60
+12 ; UID = Test Unique ID
+13 ; EXT_ACC_# = External accession number
+14 ; AREA = area pointer into file 68
+15 ; DATE = date pointer into file 68
+16 ; ACC_# = accession # pointer into file 68
+17 ; PAT_DFN = Patient IEN pointer to the VA Patient file 2
+18 ; PAT_NAM = Patient name
+19 ; CONFIG_NAM = Shipping Configuration Name
+20 ;RETURNS:
+21 ; TEST_ON_MANIF ^ ADDABLE_TESTS
+22 ; TESTS_ON_MANIF = List of tests on manifest separated by pipe:
+23 ; See MTL^BLRAG09A
+24 ; ADDABLE_TESTS = List of tests that can be added separated by pipe:
+25 ; See TA^BLRAG9B
+26 NEW BLRI
+27 DO ^XBKVAR
SET X="ERROR^BLRAGUT"
SET @^%ZOSF("TRAP")
+28 SET BLRI=0
+29 KILL ^TMP("BLRAG",$JOB)
+30 SET BLRY=$$TMPGLB^BLRAGUT()
+31 SET @BLRY@(0)="ERROR_ID"
+32 ;
+33 NEW BLRJ,BLRTSTL
+34 NEW LA760,LA7AA,LA7AD,LA7AN,LA7BY,LA7DIV,LA7I,LA7UID,LA7X
+35 SET LA7SCFG=BLRSCFG
+36 SET LA7SM=BLRSM
+37 SET BLRTSTL=""
+38 SET LA7QUIT=0
+39 ;
+40 FOR BLRJ=1:1:$LENGTH(BLRTAL,"|")
Begin DoDot:1
+41 ;test pointer to file 60
SET LA760=$PIECE($PIECE(BLRTAL,"|",BLRJ),":",1)
+42 ;UID
SET LA7UID=$PIECE($PIECE(BLRTAL,"|",BLRJ),":",3)
+43 ;accession area
SET LA7AA=$PIECE($PIECE(BLRTAL,"|",BLRJ),":",5)
+44 ;accession date
SET LA7AD=$PIECE($PIECE(BLRTAL,"|",BLRJ),":",6)
+45 ;accession number (internal)
SET LA7AN=$PIECE($PIECE(BLRTAL,"|",BLRJ),":",7)
+46 ;Test's zeroth node
SET LA760(0)=$GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0))
+47 ; Test completed - skip
IF $PIECE(LA760(0),"^",5)
SET LA7QUIT="1^Test already completed"
QUIT
+48 ; Test urgency
SET LA76205=+$PIECE(LA760(0),"^",2)
+49 IF LA76205>49
SET LA76205=$SELECT(LA76205=50:9,1:LA76205-50)
+50 ; Specimen type
+51 SET LA76805=0
SET X=+$ORDER(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0))
IF X
SET LA76805=+$GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
+52 ; Don't build controls
IF $PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",2)=62.3
SET LA7QUIT="1^Cannot select controls"
QUIT
+53 SET LA7I=0
+54 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I))
IF 'LA7I
QUIT
Begin DoDot:2
+55 NEW X
+56 SET X(0)=$GET(^LAHM(62.8,+LA7SM,10,LA7I,0))
+57 IF $PIECE(X(0),"^",2)=LA760
IF $PIECE(X(0),"^",8)'=0
SET LA7QUIT="1^Test already on shipping manifest"
End DoDot:2
IF LA7QUIT
QUIT
+58 IF LA7QUIT
QUIT
+59 ; Build TMP global with test profile
DO SCBLD^LA7SM1(+LA7SCFG)
+60 ; Accession's division
SET LA7DIV=+$PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.4)),"^")
+61 ; Check if test eligible for manifest
DO SCHK^LA7SM1
+62 IF 'LA7FLAG
SET LA7QUIT="1^Test not selectable for this configuration"
QUIT
+63 DO LOCK68^LA7SMB
+64 SET LA7I=0
+65 FOR
SET LA7I=$ORDER(LA7X(LA7I))
IF 'LA7I
QUIT
DO ADD^LA7SMB
+66 DO UNLOCK68^LA7SMB
End DoDot:1
+67 ;get tests already on manifest
DO MTL^BLRAG09A(.BLRTSTL,BLRSM)
+68 ;get test that can be added to manifest
SET BLRNTAL=$$TA^BLRAG09B(BLRSCFG,BLRSM)
+69 ; 0 1
+70 SET @BLRY@(0)="TESTS_ON_MANIF^ADDABLE_TESTS"
+71 SET BLRI=BLRI+1
SET @BLRY@(BLRI)=BLRTSTL_U_BLRNTAL
+72 QUIT
+73 ;
+74 ;
REMVTST(BLRY,BLRSM,BLRMTL) ; Remove a test from manifest - actually flags test as "removed".
+1 ; BLR MANIFEST TEST REMOVE rpc
+2 ;INPUT:
+3 ; BLRSM = Manifest IEN pointer to LAB SHIPPING MANIFEST file 62.8
+4 ; BLRMTL = List of manifest tests separated by pipe:
+5 ; TEST_IEN:TEST_NAME:TEST_SPEC_PTR|...
+6 ; TEST_IEN = pointer to LABORATORY TEST file 60
+7 ; TEST_NAME = Text from NAME field in
+8 ; LABORATORY TEST file 60
+9 ; TEST_SPECIMEN_PTR = Specimen pointer
+10 ; pointer to SPECIMENS multiple of
+11 ; LAB SHIPPING MANIFEST file 62.8
+12 ;RETURNS:
+13 ; ERROR_ID ^ MESSAGE ^ MANIFEST_TESTL ^ ADDABLE_TESTS
+14 ; ERROR_ID = 0=test removed
+15 ; 1=error removing test
+16 ; MESSAGE = Text message describing error
+17 ; MANIFEST_TESTL = Remaining List of manifest tests separated by pipe:
+18 ; See MTL^BLRAG09A
+19 ; ADDABLE_TESTS = List of tests that can be added separated by pipe:
+20 ; See TA^BLRAG09B
+21 NEW BLRI
+22 DO ^XBKVAR
SET X="ERROR^BLRAGUT"
SET @^%ZOSF("TRAP")
+23 SET BLRI=0
+24 KILL ^TMP("BLRAG",$JOB)
+25 SET BLRY=$$TMPGLB^BLRAGUT()
+26 SET @BLRY@(0)="ERROR_ID"
+27 ;
+28 NEW BLRCNT,BLRJ,BLRTSTL
+29 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7I,LA7TCNT,LA7Y,LA760,X,Y
+30 SET BLRTSTL=""
+31 SET LA7SM=BLRSM
+32 ;build LA760 array
+33 KILL LA760
+34 SET BLRCNT=0
+35 FOR BLRJ=1:1:$LENGTH(BLRMTL,"|")
Begin DoDot:1
+36 SET BLRCNT=BLRCNT+1
+37 SET LA760(BLRCNT)=$PIECE($PIECE(BLRMTL,"|",BLRJ),":",3)_U_$GET(^LAHM(62.8,+$GET(BLRSM),10,$PIECE($PIECE(BLRMTL,"|",BLRJ),":",3),0))
End DoDot:1
+38 ;
+39 SET LA7X=""
FOR
SET LA7X=$ORDER(LA760(LA7X))
IF LA7X=""
QUIT
Begin DoDot:1
+40 NEW FDA,LA7628,LA768,LA7DATA
+41 SET LA762801=""
FOR
SET LA762801=$ORDER(^LAHM(62.8,+LA7SM,10,"UID",+(LA760(LA7X)),LA762801))
IF LA762801=""
QUIT
IF $PIECE($GET(^LAHM(62.8,LA7SM,10,LA762801,0)),U,8)'=0
QUIT
+42 IF LA762801'=""
Begin DoDot:2
+43 SET LA762801=LA762801_","_+LA7SM_","
+44 SET FDA(62.8,62.801,LA762801,.08)=0
+45 ; "Remove" test from shipping manifest
DO FILE^DIE("","FDA(62.8)","LA7DIE(2)")
+46 ; Update event file
+47 ;$P(LA7SM,"^",2) no associated manifest for GUI
SET LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA760(LA7X),"^",3)_"^"_""
+48 ;get SPECIMEN ID (UID) (add 1 to piece number)
SET LA7UID=$PIECE(LA760(LA7X),"^",6)
+49 DO SEUP^LA7SMU(LA7UID,2,LA7DATA)
+50 ; Update accession
+51 DO ACCSUP^LA7SMU(LA7UID,$PIECE(LA760(LA7X),"^",3),"@")
End DoDot:2
End DoDot:1
+52 ;get tests on Manifest
DO MTL^BLRAG09A(.BLRTSTL,BLRSM)
+53 SET BLRSCFG=$PIECE($GET(^LAHM(62.8,BLRSM,0)),U,2)
+54 ;get test that can be added to manifest
SET BLRNTAL=$$TA^BLRAG09B(BLRSCFG,BLRSM)
+55 ; 0 1 2 3
+56 SET @BLRY@(0)="CLEAN^MESSAGE^MANIFEST_TESTL^ADDABLE_TESTS"
+57 ; 0 1 2 3
+58 SET BLRI=BLRI+1
SET @BLRY@(BLRI)=0_U_""_U_BLRTSTL_U_BLRNTAL
+59 QUIT
+60 ;
INIT ; Initialize variables
+1 SET DT=$$DT^XLFDT
+2 SET LA7QUIT=0
+3 ;shipping configuration
SET LA7SCFG=BLRSCFG
+4 ;I LA7SCFG<1 S LA7QUIT=1 Q
+5 SET LA7SCFG(0)=$GET(^LAHM(62.9,+LA7SCFG,0))
+6 SET MSG=""
+7 KILL ^TMP("LA7ERR",$JOB)
+8 QUIT
+9 ;
+10 ;
LOCKSM ; Lock entry in file 62.8
+1 ; Set lock.
LOCK +^LAHM(62.8,+LA7SM):1
+2 IF '$TEST
SET LA7QUIT="1^Someone else is editing this shipping manifest"
+3 QUIT
+4 ;
+5 ;
UNLOCKSM ; Unlock entry in file 62.8
+1 ; Release lock.
LOCK -^LAHM(62.8,+LA7SM)
+2 QUIT
+3 ;
+4 ;
CLEANUP ; Cleanup variables
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL DA,DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 KILL LA7AA,LA7ACTON,LA7AD,LA7AN,LA7EV,LA7FLAG,LA7I,LA7QUIT,LA7SCFG,LA7SDT,LA7SM,LA7ST,LA7UID,LA7X,LA7YARRY
+4 KILL LA760,LA76205,LA762801,LA76805
+5 KILL ^TMP("LA7ERR",$JOB)
+6 QUIT
