Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7SM

LA7SM.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. CLSHIP ; Close/ship a shipping manifest
  1. D INIT
  1. I LA7QUIT D CLEANUP Q
  1. S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
  1. I LA7SM<0 D Q
  1. . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
  1. . D CLEANUP
  1. D LOCKSM
  1. I LA7QUIT D Q
  1. . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1. . D UNLOCKSM,CLEANUP
  1. S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. I $P(LA7SM(0),"^",3)=1 D
  1. . S DIR(0)="SO^1:Close manifest;2:Ship manifest"
  1. . S DIR("A")="Select action to perform",DIR("B")=1
  1. I $P(LA7SM(0),"^",3)=3 D
  1. . S DIR(0)="YO"
  1. . S DIR("A")="Do you want to ship this manifest",DIR("B")="NO"
  1. D ^DIR
  1. I $D(DIRUT) D UNLOCKSM,CLEANUP Q
  1. S LA7ST=+Y
  1. I $P(LA7SM(0),"^",3)=3,LA7ST S LA7ST=2
  1. I $P(LA7SM(0),"^",3)=1 D SMSUP^LA7SMU(LA7SM,3,"SM04") ; Close manifest
  1. I LA7ST=2 D SHIP^LA7SM1 ; Ask for shipping date/time
  1. I 'LA7QUIT!$D(LA7ERR) S LA7CHK=0 D ASK^LA7SMP(LA7SM) ; Ask if want to print manifest.
  1. D UNLOCKSM,CLEANUP
  1. Q
  1. ;
  1. ;
  1. SMET ; Edit a test on a shipping manifest
  1. ; Used to add/remove a test.
  1. D INIT
  1. I LA7QUIT D CLEANUP Q
  1. S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
  1. I LA7SM<0 D Q
  1. . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
  1. . D CLEANUP
  1. D LOCKSM
  1. I LA7QUIT D Q
  1. . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1. . D UNLOCKSM,CLEANUP
  1. S LA7SM(0)=$G(^LAHM(62.8,LA7SM,0))
  1. S DIR(0)="SO^1:Add test to manifest;2:Remove test from manifest"
  1. S DIR("A")="Select action to perform",DIR("B")=1
  1. D ^DIR
  1. I $D(DIRUT) D CLEANUP Q
  1. S LA7ACTON=+Y
  1. I LA7ACTON=1 F D ADDTEST Q:LA7QUIT>.9 I $P(LA7QUIT,"^",2)'="" D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1. I LA7ACTON=2 F D REMVTST Q:LA7QUIT>.9 I $P(LA7QUIT,"^",2)'="" D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1. I LA7QUIT>.9,$P(LA7QUIT,"^",2)'="" D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1. E D ASK^LA7SMP(LA7SM)
  1. D CLEANUP
  1. Q
  1. ;
  1. ;
  1. ADDTEST ; Add individual test to an existing manifest
  1. ;
  1. N LA760,LA762,LA76805,LA7AA,LA7AD,LA7AN,LA7BY,LA7DIV,LA7I,LA7UID,LA7X
  1. ;
  1. S LA7QUIT=""
  1. D SEL
  1. I LA7QUIT Q
  1. ;
  1. S DIC="^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,",DIC(0)="AEMQ",DIC("A")="Select TEST to Add: "
  1. S DA=LA7AN,DA(1)=LA7AD,DA(2)=LA7AA
  1. D ^DIC
  1. I Y<1 D Q
  1. . S LA7QUIT=1
  1. . I $D(DUOUT) S $P(LA7QUIT,"^",2)="User aborted"
  1. . I $D(DTOUT) S $P(LA7QUIT,"^",2)="User timeout"
  1. S LA760=+Y
  1. ;
  1. ; Test's zeroth node.
  1. S LA760(0)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0))
  1. ;
  1. ; Test completed - skip
  1. I $P(LA760(0),"^",5) S LA7QUIT=".5^Test already completed" Q
  1. ;
  1. ; Don't build if configuration has specific ordering locations and accession's ordering location is not on list.
  1. I $$CHKOLOC^LA7SM1(LA7AA,LA7AD,LA7AN,+LA7SCFG)<1 S LA7QUIT=".5^Accession's ordering location not on this configuration's list" Q
  1. ;
  1. ; Test urgency
  1. S LA76205=+$P(LA760(0),"^",2)
  1. I LA76205>49 S LA76205=$S(LA76205=50:9,1:LA76205-50)
  1. ;
  1. ; Don't build controls
  1. I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",2)=62.3 S LA7QUIT=".5^Cannot select controls" Q
  1. ;
  1. S LA7I=0
  1. F S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I D Q:LA7QUIT
  1. . N X
  1. . S X(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
  1. . I $P(X(0),"^",2)=LA760,$P(X(0),"^",8)'=0 S LA7QUIT=".5^Test already on this shipping manifest"
  1. I LA7QUIT Q
  1. ;
  1. ; Build TMP global with test profile
  1. D SCBLD^LA7SM1(+LA7SCFG)
  1. ;
  1. ; Test already on shipping manifest - skip
  1. I $$SHIPCK^LA7SMU1(LA7UID,LA7AA,LA760,$P(LA760(0),"^",10)) D Q
  1. . S LA7QUIT=".5^Test already on manifest "_$P($G(^LAHM(62.8,+$P(LA760(0),"^",10),0)),"^")
  1. ;
  1. ; Accession's division
  1. S LA7DIV=+$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.4)),"^")
  1. ;
  1. ; Check if test eligible for manifest
  1. D SCHK^LA7SM1
  1. I 'LA7FLAG S LA7QUIT=".5^Test not selectable for this configuration" Q
  1. ;
  1. D LOCK68^LA7SMB
  1. I '$T D Q
  1. . I $D(ZTQUEUED) Q
  1. . D EN^DDIOL("Unable to obtain lock for accession "_LA7UID_" test "_$$GET1^DIQ(60,LA760_",",.01),"","!?5")
  1. ;
  1. D ADD^LA7SMB1,EN^DDIOL("Test added to manifest","","!?5")
  1. D UNLOCK68^LA7SMB
  1. Q
  1. ;
  1. ;
  1. REMVTST ; Remove a test from manifest - actually flags test as "removed".
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7I,LA7TCNT,LA7Y,LA760,X,Y
  1. S LA7QUIT=""
  1. D SEL
  1. I LA7QUIT Q
  1. S (LA7I,LA7TCNT)=0
  1. F S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I D
  1. . S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
  1. . I $P(LA7I(0),"^",8)=0 Q ; Previously "removed".
  1. . I $P(LA7I(0),"^",8),$P(LA7I(0),"^",8)'=1 S LA7QUIT=".5^Accession not pending shipment" Q
  1. . S LA7TCNT=LA7TCNT+1,LA760(LA7TCNT)=LA7I_"^"_LA7I(0)
  1. I 'LA7TCNT,'LA7QUIT S LA7QUIT=".5^Accession is not on this shipping manifest"
  1. I LA7QUIT Q
  1. S LA7I=0
  1. F S LA7I=$O(LA760(LA7I)) Q:'LA7I D EN^DDIOL(LA7I_" "_$P($G(^LAB(60,+$P(LA760(LA7I),"^",3),0)),"^"),"","!?5")
  1. S DIR(0)="LO^1:"_LA7TCNT,DIR("A")="Select test(s) to remove"
  1. D ^DIR
  1. I $D(DIRUT) S LA7QUIT=1 Q
  1. M LA7YARRY=Y
  1. S LA7Y=""
  1. F S LA7Y=$O(LA7YARRY(LA7Y)) Q:LA7Y="" D
  1. . F LA7I=1:1 Q:'$P(LA7YARRY(LA7Y),",",LA7I) D
  1. . . S LA7X=$P(LA7YARRY(LA7Y),",",LA7I)
  1. . . N FDA,LA7628,LA768,LA7DATA
  1. . . S LA762801=+(LA760(LA7X))_","_+LA7SM_","
  1. . . S FDA(62.8,62.801,LA762801,.08)=0
  1. . . D FILE^DIE("","FDA(62.8)","LA7DIE(2)") ; "Remove" test from shipping manifest
  1. . . D EN^DDIOL($P($G(^LAB(60,+$P(LA760(LA7X),"^",3),0)),"^")_" removed from manifest...","","!?5")
  1. . . ; Update event file
  1. . . S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA760(LA7X),"^",3)_"^"_$P(LA7SM,"^",2)
  1. . . D SEUP^LA7SMU(LA7UID,2,LA7DATA)
  1. . . ; Update accession
  1. . . D ACCSUP^LA7SMU(LA7UID,$P(LA760(LA7X),"^",3),"@")
  1. Q
  1. ;
  1. ;
  1. CANC ; Cancel a shipping manifest
  1. D INIT
  1. I LA7QUIT D CLEANUP Q
  1. S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
  1. I LA7SM<0 D Q
  1. . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
  1. . D CLEANUP
  1. D LOCKSM
  1. I LA7QUIT D Q
  1. . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
  1. . D UNLOCKSM,CLEANUP
  1. S LA7SM(0)=$G(^LAHM(62.8,LA7SM,0))
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO"
  1. S DIR("A")="Do you want to cancel this manifest",DIR("B")="NO"
  1. D ^DIR
  1. I $D(DIRUT) D UNLOCKSM,CLEANUP Q
  1. S LA7ST=+Y
  1. I LA7ST=1 D
  1. . S LA7I=0
  1. . F S LA7I=$O(^LAHM(62.8,+LA7SM,10,LA7I)) Q:'LA7I D
  1. . . S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
  1. . . I $P(LA7I(0),"^",8)=0 Q ; Previously "removed".
  1. . . ; "Remove" test from shipping manifest
  1. . . S LA762801=LA7I_","_+LA7SM_","
  1. . . S FDA(62.8,62.801,LA762801,.08)=0
  1. . . D FILE^DIE("","FDA(62.8)","LA7DIE(2)")
  1. . . ; Update event file
  1. . . S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$P(LA7SM,"^",2)
  1. . . D SEUP^LA7SMU($P(LA7I(0),"^",5),2,LA7DATA)
  1. . . ; Update accession
  1. . . D ACCSUP^LA7SMU($P(LA7I(0),"^",5),$P(LA7I(0),"^",2),"@")
  1. . D SMSUP^LA7SMU(LA7SM,0,"SM00") ; Cancel manifest
  1. D UNLOCKSM,CLEANUP
  1. Q
  1. ;
  1. ;
  1. SEL ; Select accession
  1. ;
  1. N LRAA,LRACC,LRAD,LRAN,X
  1. ;
  1. ; Select by accession, ^LRWU4 needs variable LRACC.
  1. S LRACC=""
  1. D ^LRWU4
  1. I $D(DUOUT) S LA7QUIT="1^User aborted" Q
  1. I $D(DTOUT) S LA7QUIT="1^User timeout" Q
  1. I (LRAA*LRAD*LRAN)<1 S LA7QUIT="1" Q
  1. ;
  1. S LA7AA=LRAA,LA7AD=LRAD,LA7AN=LRAN
  1. ;
  1. S LA7UID=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")
  1. I LA7UID="" S LA7QUIT="2^Database error - accession missing UID" Q
  1. ;
  1. ; Specimen type
  1. S (LA762,LA76805)=0
  1. S X=+$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0))
  1. I X D
  1. . S X=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
  1. . S LA76805=+$P(X,"^"),LA762=+$P(X,"^",2)
  1. Q
  1. ;
  1. ;
  1. INIT ; Initialize variables
  1. S DT=$$DT^XLFDT
  1. S LA7QUIT=0
  1. S LA7SCFG=$$SSCFG^LA7SUTL(1) ; Select shipping configuration
  1. I LA7SCFG<1 S LA7QUIT=1 Q
  1. S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
  1. K ^TMP("LA7ERR",$J)
  1. Q
  1. ;
  1. ;
  1. LOCKSM ; Lock entry in file 62.8
  1. ;L +^LAHM(62.8,+LA7SM):1 ; Set lock.
  1. D LOCK^DILF("^LAHM(62.8,+LA7SM)")
  1. I '$T S LA7QUIT="1^Someone else is editing this shipping manifest"
  1. Q
  1. ;
  1. ;
  1. UNLOCKSM ; Unlock entry in file 62.8
  1. L -^LAHM(62.8,+LA7SM) ; Release lock.
  1. Q
  1. ;
  1. ;
  1. CLEANUP ; Cleanup variables
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. K DA,DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. K LA7AA,LA7ACTON,LA7AD,LA7AN,LA7DATA,LA7EV,LA7FLAG,LA7I,LA7QUIT,LA7SCFG,LA7SDT,LA7SM,LA7SMCNT,LA7ST,LA7UID,LA7X,LA7YARRY
  1. K LA760,LA76205,LA762801,LA76805
  1. K ^TMP("LA7ERR",$J)
  1. D CLEANUP^LA7SMB
  1. Q