- 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 Feb 18, 2025@23:05:48 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