LA7SM ;DALOI/JMC - Shipping Manifest Options ;05/10/12 12:07
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,74**;Sep 27, 1994;Build 229
;
CLSHIP ; Close/ship a shipping manifest
D INIT
I LA7QUIT D CLEANUP Q
S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
I LA7SM<0 D Q
. D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
. D CLEANUP
D LOCKSM
I LA7QUIT D Q
. D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
. D UNLOCKSM,CLEANUP
S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
I $P(LA7SM(0),"^",3)=1 D
. S DIR(0)="SO^1:Close manifest;2:Ship manifest"
. S DIR("A")="Select action to perform",DIR("B")=1
I $P(LA7SM(0),"^",3)=3 D
. S DIR(0)="YO"
. S DIR("A")="Do you want to ship this manifest",DIR("B")="NO"
D ^DIR
I $D(DIRUT) D UNLOCKSM,CLEANUP Q
S LA7ST=+Y
I $P(LA7SM(0),"^",3)=3,LA7ST S LA7ST=2
I $P(LA7SM(0),"^",3)=1 D SMSUP^LA7SMU(LA7SM,3,"SM04") ; Close manifest
I LA7ST=2 D SHIP^LA7SM1 ; Ask for shipping date/time
I 'LA7QUIT!$D(LA7ERR) S LA7CHK=0 D ASK^LA7SMP(LA7SM) ; Ask if want to print manifest.
D UNLOCKSM,CLEANUP
Q
;
;
SMET ; Edit a test on a shipping manifest
; Used to add/remove a test.
D INIT
I LA7QUIT D CLEANUP Q
S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
I LA7SM<0 D Q
. D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
. D CLEANUP
D LOCKSM
I LA7QUIT D Q
. D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
. D UNLOCKSM,CLEANUP
S LA7SM(0)=$G(^LAHM(62.8,LA7SM,0))
S DIR(0)="SO^1:Add test to manifest;2:Remove test from manifest"
S DIR("A")="Select action to perform",DIR("B")=1
D ^DIR
I $D(DIRUT) D CLEANUP Q
S LA7ACTON=+Y
I LA7ACTON=1 F D ADDTEST Q:LA7QUIT>.9 I $P(LA7QUIT,"^",2)'="" D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
I LA7ACTON=2 F D REMVTST Q:LA7QUIT>.9 I $P(LA7QUIT,"^",2)'="" D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
I LA7QUIT>.9,$P(LA7QUIT,"^",2)'="" D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
E D ASK^LA7SMP(LA7SM)
D CLEANUP
Q
;
;
ADDTEST ; Add individual test to an existing manifest
;
N LA760,LA762,LA76805,LA7AA,LA7AD,LA7AN,LA7BY,LA7DIV,LA7I,LA7UID,LA7X
;
S LA7QUIT=""
D SEL
I LA7QUIT Q
;
S DIC="^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,",DIC(0)="AEMQ",DIC("A")="Select TEST to Add: "
S DA=LA7AN,DA(1)=LA7AD,DA(2)=LA7AA
D ^DIC
I Y<1 D Q
. S LA7QUIT=1
. I $D(DUOUT) S $P(LA7QUIT,"^",2)="User aborted"
. I $D(DTOUT) S $P(LA7QUIT,"^",2)="User timeout"
S LA760=+Y
;
; Test's zeroth node.
S LA760(0)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0))
;
; Test completed - skip
I $P(LA760(0),"^",5) S LA7QUIT=".5^Test already completed" Q
;
; Don't build if configuration has specific ordering locations and accession's ordering location is not on list.
I $$CHKOLOC^LA7SM1(LA7AA,LA7AD,LA7AN,+LA7SCFG)<1 S LA7QUIT=".5^Accession's ordering location not on this configuration's list" Q
;
; Test urgency
S LA76205=+$P(LA760(0),"^",2)
I LA76205>49 S LA76205=$S(LA76205=50:9,1:LA76205-50)
;
; Don't build controls
I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",2)=62.3 S LA7QUIT=".5^Cannot select controls" Q
;
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=".5^Test already on this shipping manifest"
I LA7QUIT Q
;
; Build TMP global with test profile
D SCBLD^LA7SM1(+LA7SCFG)
;
; Test already on shipping manifest - skip
I $$SHIPCK^LA7SMU1(LA7UID,LA7AA,LA760,$P(LA760(0),"^",10)) D Q
. S LA7QUIT=".5^Test already on manifest "_$P($G(^LAHM(62.8,+$P(LA760(0),"^",10),0)),"^")
;
; Accession's division
S LA7DIV=+$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.4)),"^")
;
; Check if test eligible for manifest
D SCHK^LA7SM1
I 'LA7FLAG S LA7QUIT=".5^Test not selectable for this configuration" Q
;
D LOCK68^LA7SMB
I '$T D Q
. I $D(ZTQUEUED) Q
. D EN^DDIOL("Unable to obtain lock for accession "_LA7UID_" test "_$$GET1^DIQ(60,LA760_",",.01),"","!?5")
;
D ADD^LA7SMB1,EN^DDIOL("Test added to manifest","","!?5")
D UNLOCK68^LA7SMB
Q
;
;
REMVTST ; Remove a test from manifest - actually flags test as "removed".
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7I,LA7TCNT,LA7Y,LA760,X,Y
S LA7QUIT=""
D SEL
I LA7QUIT Q
S (LA7I,LA7TCNT)=0
F S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I D
. S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
. I $P(LA7I(0),"^",8)=0 Q ; Previously "removed".
. I $P(LA7I(0),"^",8),$P(LA7I(0),"^",8)'=1 S LA7QUIT=".5^Accession not pending shipment" Q
. S LA7TCNT=LA7TCNT+1,LA760(LA7TCNT)=LA7I_"^"_LA7I(0)
I 'LA7TCNT,'LA7QUIT S LA7QUIT=".5^Accession is not on this shipping manifest"
I LA7QUIT Q
S LA7I=0
F S LA7I=$O(LA760(LA7I)) Q:'LA7I D EN^DDIOL(LA7I_" "_$P($G(^LAB(60,+$P(LA760(LA7I),"^",3),0)),"^"),"","!?5")
S DIR(0)="LO^1:"_LA7TCNT,DIR("A")="Select test(s) to remove"
D ^DIR
I $D(DIRUT) S LA7QUIT=1 Q
M LA7YARRY=Y
S LA7Y=""
F S LA7Y=$O(LA7YARRY(LA7Y)) Q:LA7Y="" D
. F LA7I=1:1 Q:'$P(LA7YARRY(LA7Y),",",LA7I) D
. . S LA7X=$P(LA7YARRY(LA7Y),",",LA7I)
. . N FDA,LA7628,LA768,LA7DATA
. . S LA762801=+(LA760(LA7X))_","_+LA7SM_","
. . S FDA(62.8,62.801,LA762801,.08)=0
. . D FILE^DIE("","FDA(62.8)","LA7DIE(2)") ; "Remove" test from shipping manifest
. . D EN^DDIOL($P($G(^LAB(60,+$P(LA760(LA7X),"^",3),0)),"^")_" removed from manifest...","","!?5")
. . ; Update event file
. . S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA760(LA7X),"^",3)_"^"_$P(LA7SM,"^",2)
. . D SEUP^LA7SMU(LA7UID,2,LA7DATA)
. . ; Update accession
. . D ACCSUP^LA7SMU(LA7UID,$P(LA760(LA7X),"^",3),"@")
Q
;
;
CANC ; Cancel a shipping manifest
D INIT
I LA7QUIT D CLEANUP Q
S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
I LA7SM<0 D Q
. D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
. D CLEANUP
D LOCKSM
I LA7QUIT D Q
. D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
. D UNLOCKSM,CLEANUP
S LA7SM(0)=$G(^LAHM(62.8,LA7SM,0))
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO"
S DIR("A")="Do you want to cancel this manifest",DIR("B")="NO"
D ^DIR
I $D(DIRUT) D UNLOCKSM,CLEANUP Q
S LA7ST=+Y
I LA7ST=1 D
. 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)=0 Q ; Previously "removed".
. . ; "Remove" test from shipping manifest
. . S LA762801=LA7I_","_+LA7SM_","
. . S FDA(62.8,62.801,LA762801,.08)=0
. . D FILE^DIE("","FDA(62.8)","LA7DIE(2)")
. . ; Update event file
. . S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$P(LA7SM,"^",2)
. . D SEUP^LA7SMU($P(LA7I(0),"^",5),2,LA7DATA)
. . ; Update accession
. . D ACCSUP^LA7SMU($P(LA7I(0),"^",5),$P(LA7I(0),"^",2),"@")
. D SMSUP^LA7SMU(LA7SM,0,"SM00") ; Cancel manifest
D UNLOCKSM,CLEANUP
Q
;
;
SEL ; Select accession
;
N LRAA,LRACC,LRAD,LRAN,X
;
; Select by accession, ^LRWU4 needs variable LRACC.
S LRACC=""
D ^LRWU4
I $D(DUOUT) S LA7QUIT="1^User aborted" Q
I $D(DTOUT) S LA7QUIT="1^User timeout" Q
I (LRAA*LRAD*LRAN)<1 S LA7QUIT="1" Q
;
S LA7AA=LRAA,LA7AD=LRAD,LA7AN=LRAN
;
S LA7UID=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")
I LA7UID="" S LA7QUIT="2^Database error - accession missing UID" Q
;
; Specimen type
S (LA762,LA76805)=0
S X=+$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0))
I X D
. S X=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
. S LA76805=+$P(X,"^"),LA762=+$P(X,"^",2)
Q
;
;
INIT ; Initialize variables
S DT=$$DT^XLFDT
S LA7QUIT=0
S LA7SCFG=$$SSCFG^LA7SUTL(1) ; Select shipping configuration
I LA7SCFG<1 S LA7QUIT=1 Q
S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
K ^TMP("LA7ERR",$J)
Q
;
;
LOCKSM ; Lock entry in file 62.8
;L +^LAHM(62.8,+LA7SM):1 ; Set lock.
D LOCK^DILF("^LAHM(62.8,+LA7SM)")
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,LA7DATA,LA7EV,LA7FLAG,LA7I,LA7QUIT,LA7SCFG,LA7SDT,LA7SM,LA7SMCNT,LA7ST,LA7UID,LA7X,LA7YARRY
K LA760,LA76205,LA762801,LA76805
K ^TMP("LA7ERR",$J)
D CLEANUP^LA7SMB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SM 8213 printed Oct 16, 2024@17:40:16 Page 2
LA7SM ;DALOI/JMC - Shipping Manifest Options ;05/10/12 12:07
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,74**;Sep 27, 1994;Build 229
+2 ;
CLSHIP ; Close/ship a shipping manifest
+1 DO INIT
+2 IF LA7QUIT
DO CLEANUP
QUIT
+3 SET LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
+4 IF LA7SM<0
Begin DoDot:1
+5 DO EN^DDIOL($PIECE(LA7SM,"^",2),"","!?5")
+6 DO CLEANUP
End DoDot:1
QUIT
+7 DO LOCKSM
+8 IF LA7QUIT
Begin DoDot:1
+9 DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+10 DO UNLOCKSM
DO CLEANUP
End DoDot:1
QUIT
+11 SET LA7SM(0)=$GET(^LAHM(62.8,+LA7SM,0))
+12 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+13 IF $PIECE(LA7SM(0),"^",3)=1
Begin DoDot:1
+14 SET DIR(0)="SO^1:Close manifest;2:Ship manifest"
+15 SET DIR("A")="Select action to perform"
SET DIR("B")=1
End DoDot:1
+16 IF $PIECE(LA7SM(0),"^",3)=3
Begin DoDot:1
+17 SET DIR(0)="YO"
+18 SET DIR("A")="Do you want to ship this manifest"
SET DIR("B")="NO"
End DoDot:1
+19 DO ^DIR
+20 IF $DATA(DIRUT)
DO UNLOCKSM
DO CLEANUP
QUIT
+21 SET LA7ST=+Y
+22 IF $PIECE(LA7SM(0),"^",3)=3
IF LA7ST
SET LA7ST=2
+23 ; Close manifest
IF $PIECE(LA7SM(0),"^",3)=1
DO SMSUP^LA7SMU(LA7SM,3,"SM04")
+24 ; Ask for shipping date/time
IF LA7ST=2
DO SHIP^LA7SM1
+25 ; Ask if want to print manifest.
IF 'LA7QUIT!$DATA(LA7ERR)
SET LA7CHK=0
DO ASK^LA7SMP(LA7SM)
+26 DO UNLOCKSM
DO CLEANUP
+27 QUIT
+28 ;
+29 ;
SMET ; Edit a test on a shipping manifest
+1 ; Used to add/remove a test.
+2 DO INIT
+3 IF LA7QUIT
DO CLEANUP
QUIT
+4 SET LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
+5 IF LA7SM<0
Begin DoDot:1
+6 DO EN^DDIOL($PIECE(LA7SM,"^",2),"","!?5")
+7 DO CLEANUP
End DoDot:1
QUIT
+8 DO LOCKSM
+9 IF LA7QUIT
Begin DoDot:1
+10 DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+11 DO UNLOCKSM
DO CLEANUP
End DoDot:1
QUIT
+12 SET LA7SM(0)=$GET(^LAHM(62.8,LA7SM,0))
+13 SET DIR(0)="SO^1:Add test to manifest;2:Remove test from manifest"
+14 SET DIR("A")="Select action to perform"
SET DIR("B")=1
+15 DO ^DIR
+16 IF $DATA(DIRUT)
DO CLEANUP
QUIT
+17 SET LA7ACTON=+Y
+18 IF LA7ACTON=1
FOR
DO ADDTEST
if LA7QUIT>.9
QUIT
IF $PIECE(LA7QUIT,"^",2)'=""
DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+19 IF LA7ACTON=2
FOR
DO REMVTST
if LA7QUIT>.9
QUIT
IF $PIECE(LA7QUIT,"^",2)'=""
DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+20 IF LA7QUIT>.9
IF $PIECE(LA7QUIT,"^",2)'=""
DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+21 IF '$TEST
DO ASK^LA7SMP(LA7SM)
+22 DO CLEANUP
+23 QUIT
+24 ;
+25 ;
ADDTEST ; Add individual test to an existing manifest
+1 ;
+2 NEW LA760,LA762,LA76805,LA7AA,LA7AD,LA7AN,LA7BY,LA7DIV,LA7I,LA7UID,LA7X
+3 ;
+4 SET LA7QUIT=""
+5 DO SEL
+6 IF LA7QUIT
QUIT
+7 ;
+8 SET DIC="^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select TEST to Add: "
+9 SET DA=LA7AN
SET DA(1)=LA7AD
SET DA(2)=LA7AA
+10 DO ^DIC
+11 IF Y<1
Begin DoDot:1
+12 SET LA7QUIT=1
+13 IF $DATA(DUOUT)
SET $PIECE(LA7QUIT,"^",2)="User aborted"
+14 IF $DATA(DTOUT)
SET $PIECE(LA7QUIT,"^",2)="User timeout"
End DoDot:1
QUIT
+15 SET LA760=+Y
+16 ;
+17 ; Test's zeroth node.
+18 SET LA760(0)=$GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0))
+19 ;
+20 ; Test completed - skip
+21 IF $PIECE(LA760(0),"^",5)
SET LA7QUIT=".5^Test already completed"
QUIT
+22 ;
+23 ; Don't build if configuration has specific ordering locations and accession's ordering location is not on list.
+24 IF $$CHKOLOC^LA7SM1(LA7AA,LA7AD,LA7AN,+LA7SCFG)<1
SET LA7QUIT=".5^Accession's ordering location not on this configuration's list"
QUIT
+25 ;
+26 ; Test urgency
+27 SET LA76205=+$PIECE(LA760(0),"^",2)
+28 IF LA76205>49
SET LA76205=$SELECT(LA76205=50:9,1:LA76205-50)
+29 ;
+30 ; Don't build controls
+31 IF $PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",2)=62.3
SET LA7QUIT=".5^Cannot select controls"
QUIT
+32 ;
+33 SET LA7I=0
+34 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I))
if 'LA7I
QUIT
Begin DoDot:1
+35 NEW X
+36 SET X(0)=$GET(^LAHM(62.8,+LA7SM,10,LA7I,0))
+37 IF $PIECE(X(0),"^",2)=LA760
IF $PIECE(X(0),"^",8)'=0
SET LA7QUIT=".5^Test already on this shipping manifest"
End DoDot:1
if LA7QUIT
QUIT
+38 IF LA7QUIT
QUIT
+39 ;
+40 ; Build TMP global with test profile
+41 DO SCBLD^LA7SM1(+LA7SCFG)
+42 ;
+43 ; Test already on shipping manifest - skip
+44 IF $$SHIPCK^LA7SMU1(LA7UID,LA7AA,LA760,$PIECE(LA760(0),"^",10))
Begin DoDot:1
+45 SET LA7QUIT=".5^Test already on manifest "_$PIECE($GET(^LAHM(62.8,+$PIECE(LA760(0),"^",10),0)),"^")
End DoDot:1
QUIT
+46 ;
+47 ; Accession's division
+48 SET LA7DIV=+$PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.4)),"^")
+49 ;
+50 ; Check if test eligible for manifest
+51 DO SCHK^LA7SM1
+52 IF 'LA7FLAG
SET LA7QUIT=".5^Test not selectable for this configuration"
QUIT
+53 ;
+54 DO LOCK68^LA7SMB
+55 IF '$TEST
Begin DoDot:1
+56 IF $DATA(ZTQUEUED)
QUIT
+57 DO EN^DDIOL("Unable to obtain lock for accession "_LA7UID_" test "_$$GET1^DIQ(60,LA760_",",.01),"","!?5")
End DoDot:1
QUIT
+58 ;
+59 DO ADD^LA7SMB1
DO EN^DDIOL("Test added to manifest","","!?5")
+60 DO UNLOCK68^LA7SMB
+61 QUIT
+62 ;
+63 ;
REMVTST ; Remove a test from manifest - actually flags test as "removed".
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7I,LA7TCNT,LA7Y,LA760,X,Y
+2 SET LA7QUIT=""
+3 DO SEL
+4 IF LA7QUIT
QUIT
+5 SET (LA7I,LA7TCNT)=0
+6 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I))
if 'LA7I
QUIT
Begin DoDot:1
+7 SET LA7I(0)=$GET(^LAHM(62.8,+LA7SM,10,LA7I,0))
+8 ; Previously "removed".
IF $PIECE(LA7I(0),"^",8)=0
QUIT
+9 IF $PIECE(LA7I(0),"^",8)
IF $PIECE(LA7I(0),"^",8)'=1
SET LA7QUIT=".5^Accession not pending shipment"
QUIT
+10 SET LA7TCNT=LA7TCNT+1
SET LA760(LA7TCNT)=LA7I_"^"_LA7I(0)
End DoDot:1
+11 IF 'LA7TCNT
IF 'LA7QUIT
SET LA7QUIT=".5^Accession is not on this shipping manifest"
+12 IF LA7QUIT
QUIT
+13 SET LA7I=0
+14 FOR
SET LA7I=$ORDER(LA760(LA7I))
if 'LA7I
QUIT
DO EN^DDIOL(LA7I_" "_$PIECE($GET(^LAB(60,+$PIECE(LA760(LA7I),"^",3),0)),"^"),"","!?5")
+15 SET DIR(0)="LO^1:"_LA7TCNT
SET DIR("A")="Select test(s) to remove"
+16 DO ^DIR
+17 IF $DATA(DIRUT)
SET LA7QUIT=1
QUIT
+18 MERGE LA7YARRY=Y
+19 SET LA7Y=""
+20 FOR
SET LA7Y=$ORDER(LA7YARRY(LA7Y))
if LA7Y=""
QUIT
Begin DoDot:1
+21 FOR LA7I=1:1
if '$PIECE(LA7YARRY(LA7Y),",",LA7I)
QUIT
Begin DoDot:2
+22 SET LA7X=$PIECE(LA7YARRY(LA7Y),",",LA7I)
+23 NEW FDA,LA7628,LA768,LA7DATA
+24 SET LA762801=+(LA760(LA7X))_","_+LA7SM_","
+25 SET FDA(62.8,62.801,LA762801,.08)=0
+26 ; "Remove" test from shipping manifest
DO FILE^DIE("","FDA(62.8)","LA7DIE(2)")
+27 DO EN^DDIOL($PIECE($GET(^LAB(60,+$PIECE(LA760(LA7X),"^",3),0)),"^")_" removed from manifest...","","!?5")
+28 ; Update event file
+29 SET LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA760(LA7X),"^",3)_"^"_$PIECE(LA7SM,"^",2)
+30 DO SEUP^LA7SMU(LA7UID,2,LA7DATA)
+31 ; Update accession
+32 DO ACCSUP^LA7SMU(LA7UID,$PIECE(LA760(LA7X),"^",3),"@")
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
+35 ;
CANC ; Cancel a shipping manifest
+1 DO INIT
+2 IF LA7QUIT
DO CLEANUP
QUIT
+3 SET LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
+4 IF LA7SM<0
Begin DoDot:1
+5 DO EN^DDIOL($PIECE(LA7SM,"^",2),"","!?5")
+6 DO CLEANUP
End DoDot:1
QUIT
+7 DO LOCKSM
+8 IF LA7QUIT
Begin DoDot:1
+9 DO EN^DDIOL($PIECE(LA7QUIT,"^",2),"","!?5")
+10 DO UNLOCKSM
DO CLEANUP
End DoDot:1
QUIT
+11 SET LA7SM(0)=$GET(^LAHM(62.8,LA7SM,0))
+12 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+13 SET DIR(0)="YO"
+14 SET DIR("A")="Do you want to cancel this manifest"
SET DIR("B")="NO"
+15 DO ^DIR
+16 IF $DATA(DIRUT)
DO UNLOCKSM
DO CLEANUP
QUIT
+17 SET LA7ST=+Y
+18 IF LA7ST=1
Begin DoDot:1
+19 SET LA7I=0
+20 FOR
SET LA7I=$ORDER(^LAHM(62.8,+LA7SM,10,LA7I))
if 'LA7I
QUIT
Begin DoDot:2
+21 SET LA7I(0)=$GET(^LAHM(62.8,+LA7SM,10,LA7I,0))
+22 ; Previously "removed".
IF $PIECE(LA7I(0),"^",8)=0
QUIT
+23 ; "Remove" test from shipping manifest
+24 SET LA762801=LA7I_","_+LA7SM_","
+25 SET FDA(62.8,62.801,LA762801,.08)=0
+26 DO FILE^DIE("","FDA(62.8)","LA7DIE(2)")
+27 ; Update event file
+28 SET LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$PIECE(LA7SM,"^",2)
+29 DO SEUP^LA7SMU($PIECE(LA7I(0),"^",5),2,LA7DATA)
+30 ; Update accession
+31 DO ACCSUP^LA7SMU($PIECE(LA7I(0),"^",5),$PIECE(LA7I(0),"^",2),"@")
End DoDot:2
+32 ; Cancel manifest
DO SMSUP^LA7SMU(LA7SM,0,"SM00")
End DoDot:1
+33 DO UNLOCKSM
DO CLEANUP
+34 QUIT
+35 ;
+36 ;
SEL ; Select accession
+1 ;
+2 NEW LRAA,LRACC,LRAD,LRAN,X
+3 ;
+4 ; Select by accession, ^LRWU4 needs variable LRACC.
+5 SET LRACC=""
+6 DO ^LRWU4
+7 IF $DATA(DUOUT)
SET LA7QUIT="1^User aborted"
QUIT
+8 IF $DATA(DTOUT)
SET LA7QUIT="1^User timeout"
QUIT
+9 IF (LRAA*LRAD*LRAN)<1
SET LA7QUIT="1"
QUIT
+10 ;
+11 SET LA7AA=LRAA
SET LA7AD=LRAD
SET LA7AN=LRAN
+12 ;
+13 SET LA7UID=$PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")
+14 IF LA7UID=""
SET LA7QUIT="2^Database error - accession missing UID"
QUIT
+15 ;
+16 ; Specimen type
+17 SET (LA762,LA76805)=0
+18 SET X=+$ORDER(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0))
+19 IF X
Begin DoDot:1
+20 SET X=$GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
+21 SET LA76805=+$PIECE(X,"^")
SET LA762=+$PIECE(X,"^",2)
End DoDot:1
+22 QUIT
+23 ;
+24 ;
INIT ; Initialize variables
+1 SET DT=$$DT^XLFDT
+2 SET LA7QUIT=0
+3 ; Select shipping configuration
SET LA7SCFG=$$SSCFG^LA7SUTL(1)
+4 IF LA7SCFG<1
SET LA7QUIT=1
QUIT
+5 SET LA7SCFG(0)=$GET(^LAHM(62.9,+LA7SCFG,0))
+6 KILL ^TMP("LA7ERR",$JOB)
+7 QUIT
+8 ;
+9 ;
LOCKSM ; Lock entry in file 62.8
+1 ;L +^LAHM(62.8,+LA7SM):1 ; Set lock.
+2 DO LOCK^DILF("^LAHM(62.8,+LA7SM)")
+3 IF '$TEST
SET LA7QUIT="1^Someone else is editing this shipping manifest"
+4 QUIT
+5 ;
+6 ;
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,LA7DATA,LA7EV,LA7FLAG,LA7I,LA7QUIT,LA7SCFG,LA7SDT,LA7SM,LA7SMCNT,LA7ST,LA7UID,LA7X,LA7YARRY
+4 KILL LA760,LA76205,LA762801,LA76805
+5 KILL ^TMP("LA7ERR",$JOB)
+6 DO CLEANUP^LA7SMB
+7 QUIT
