LA7SMU ;DALOI/JMC - Shipping Manifest Utility ; 26 Oct 2014 9:51 PM
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,64,74,86**;Sep 27, 1994;Build 6
;
Q
;
CHKSM(X) ; Shipping manifest status check
; Call with X = ien of file #62.9 LAB SHIPPING CONFIGURATION
; Returns -1 = error^reason
; 0 = no active shipping manifest exists
; >0 = ien of active shipping manifest in file #62.8, LAB SHIPPING MANIFEST
;
; No value passed
I '$G(X) Q "-1^No configuration passed"
; Bad pointer passed
I '$D(^LAHM(62.9,X,0)) Q "-1^Bad configuration pointer"
; Get ien of active shipping manifest.
S Y=+$O(^LAHM(62.8,"AC1",X,0))
I Y S Y=Y_"^"_$P(^LAHM(62.8,Y,0),"^")
Q Y
;
;
CSM(LA7SCFG) ; Creates a new shipping manifest
; Call with X = ien of file #62.9 LAB SHIPPING CONFIGURATION
; Returns -1 = error^reason
; 0 = no active shipping manifest exists
; >0 = ien of active shipping manifest in file #62.8, LAB SHIPPING MANIFEST
;
N DATA,FDA,I,LA7CF,LA7DIE,LA7DT,LA7IEN,LA7SM,X,X4
;
; No value passed
I '$G(LA7SCFG) Q "-1^No configuration passed"
;
; Bad pointer passed
I '$D(^LAHM(62.9,LA7SCFG,0)) Q "-1^Bad configuration pointer"
;
S LA7SCFG(0)=$G(^LAHM(62.9,LA7SCFG,0))
; ien of collecting facility
S LA7CF=$P(LA7SCFG(0),"^",2)
; file #4 INSTITUTION information
F I=.01,.05,99 S X4(I)=$$GET1^DIQ(4,LA7CF_",",I)
;
; Get station number else use short name
S LA7SM=""
I $L(X4(99)) S LA7SM=X4(99)
E S LA7SM=X4(.05)
; Failsafe value
I LA7SM="" S LA7SM="INST:"_LA7CF
S DT=$$DT^XLFDT,LA7DT=$E($$FMTHL7^XLFDT(DT),1,8)
S LA7SM=LA7SM_"-"_LA7DT_"-"
;
;L +^LAHM(62.8,0):5 ; Set lock
D LOCK^DILF("^LAHM(62.8,0)")
I '$T Q "-1^Unable to obtain lock on file LAB SHIPPING MANIFEST #62.8"
S X=0
F S X=X+1 Q:'$D(^LAHM(62.8,"B",LA7SM_X))
S LA7SM=LA7SM_X
;
S FDA(1,62.8,"+1,",.01)=LA7SM
S FDA(1,62.8,"+1,",.02)=LA7SCFG
S FDA(1,62.8,"+1,",.03)=1
I $P(LA7SCFG(0),"^",8) S FDA(1,62.8,"+1,",.04)=$P(LA7SCFG(0),"^",8)
S FDA(1,62.8,"+1,",.05)=+$P(LA7SCFG(0),"^",15)
S FDA(1,62.8,"+1,",.06)=+$P(LA7SCFG(0),"^",16)
D UPDATE^DIE("","FDA(1)","LA7IEN","LA7DIE(1)")
D RECALL^DILFD(62.8,LA7IEN(1)_",",DUZ)
;
S DATA="SM01^"_$$NOW^XLFDT
D SEUP(LA7SM,1,DATA)
;
S DATA="SM02^"_$$NOW^XLFDT
D SEUP(LA7SM,1,DATA)
;
; Release lock
L -^LAHM(62.8,0)
Q LA7IEN(1)_"^"_LA7SM
;
;
SMSUP(LA7SM,LA7ST,LA7EVNC) ; Shipping manifest status update.
; Call with LA7SM = ien of entry in file #62.8 LAB SHIPPING MAINFEST^.01 field
; LA7ST = status to update
; LA7EVNC = event code^event date/time (default=NOW)
;
N DATA,LA7DIE,LA7FDA,LA7IEN
;
S LA7IEN(1)=+LA7SM
S LA7FDA(2,62.8,+LA7SM_",",.03)=LA7ST
D UPDATE^DIE("","LA7FDA(2)","LA7IEN","LA7DIE(2)")
S DATA=$P(LA7EVNC,"^")_"^"_$S($P(LA7EVNC,"^",2):$P(LA7EVNC,"^",2),1:$$NOW^XLFDT)
D SEUP($P(LA7SM,"^",2),1,DATA)
Q
;
;
STSUP(LA7SM,LA762801,LA7DATA) ; Shipping test status update
; Call with LA7SM = ien of shipping manifest (#62.8)
; LA762801 = ien of test entry on shipping manifest
; LA7DATA = data to be filed
N LA7FDA,LA7DIE
S LA762801=LA762801_","_+LA7SM_","
S LA7FDA(62.8,62.801,LA762801,.08)=LA7DATA
D FILE^DIE("","LA7FDA(62.8)","LA7DIE(2)")
Q
;
;
SEUP(LA7ID,LA7EVN,LA7DATA) ; Shipping event update
; Call with LA7ID = shipping identifier (manifest invoice # or UID)
; LA7EVN = event type (1=shipping manifest/2=test)
; LA7DATA = data to be filed
N FDA,I,LA7IEN,X
;L +^LAHM(62.85,0) ; Set lock
D LOCK^DILF("^LAHM(62.85,0)")
I '$T Q
S FDA(3,62.85,"+1,",.01)=LA7ID
S FDA(3,62.85,"+1,",.02)=$S($G(DUZ)>0:DUZ,1:.5)
S FDA(3,62.85,"+1,",.03)=$$NOW^XLFDT
S FDA(3,62.85,"+1,",.04)=LA7EVN
I $P(LA7DATA,"^")'="" D
. S X=$$EVNC($P(LA7DATA,"^"))
. I X S FDA(3,62.85,"+1,",.05)=+X
F I=2:1:4 I $P(LA7DATA,"^",I)'="" S FDA(3,62.85,"+1,",$P("^.07^.08^.09","^",I))=$P(LA7DATA,"^",I)
;
; Add event to lab shipping event.
D UPDATE^DIE("","FDA(3)","LA7IEN","LA7DIE(3)")
; Release lock
L -^LAHM(62.85,0)
;
Q
;
;
ACCSUP(LA7UID,LA760,LA7DATA) ; Accession status update
; Call with LA7UID = UID of accession to update
; LA7DATA = value to update (pointer to file #62.8, LAB SHIPPING MANIFEST or "@" to delete
;
N FDA,LA7AA,LA7AD,LA7AN,LA7CAD,LA768,X
S X=$Q(^LRO(68,"C",LA7UID))
S LA7AA=$QS(X,4),LA7AD=$QS(X,5),LA7AN=$QS(X,6)
S LA7AD=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),U,3) ; Start with original accession date in case roll over accession.
S LA7CAD=$$AD^LA7SUTL(LA7AA) ; Get current accession date for this accession area.
S LA7AD=$S(LA7AD>0:LA7AD-.000000001,1:0)
F S LA7AD=$O(^LRO(68,LA7AA,1,LA7AD)) Q:'LA7AD!(LA7AD>LA7CAD) D
. I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN)) Q
. I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")'=LA7UID Q
. I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760)) Q ; Test not on accession.
. S LA768=LA760_","_LA7AN_","_LA7AD_","_LA7AA_","
. S FDA(68,68.04,LA768,9)=LA7DATA
. D FILE^DIE("","FDA(68)","LA7DIE(68)")
Q
;
;
SELSM(LA7SCFG,LA7SCR) ; Select shipping manifest
; Call with LA7SCFG = ien of file #62.9 LAB SHIPPING CONFIGURATION
; LA7SCR = comma delimited list of status screen - only allow selection of manifests with matching status
; Returns LA7Y = pointer to shipping manifest or error
N D,DIC,DTOUT,DUOUT,LA7Y,X,Y
S DIC="^LAHM(62.8,",DIC(0)="AEQ",DIC("A")="Select Shipping Manifest: "
S DIC("S")="I $P(^LAHM(62.8,Y,0),U,2)=LA7SCFG"
S DIC("W")="D SMW^LA7SMU1(Y)"
I $G(LA7SCR)'="" S DIC("S")=DIC("S")_","""_LA7SCR_"""[$P(^LAHM(62.8,Y,0),U,3)"
S D="C"
D MIX^DIC1
I Y<1 S LA7Y="-1^"
E S LA7Y=Y
Q LA7Y
;
;
SMED(LA7SM,LA7EVC) ; Determine shipping manifest's event date
; Call with LA7SM = ien of entry in file #62.8 LAB SHIPPING MANIFEST
; LA7EVC = event type code
; Returns LA7Y = internal event date^external event date
N LA7I,LA7X,LA7Y
I '$G(LA7SM) Q "-1^No shipping manifest passed"
S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
S LA7EV=+$$EVNC(LA7EVC)
I LA7EVC="SM05",$P(LA7SM(0),"^",3)'>2 Q "0^Shipping manifest has not been shipped"
S LA7I=0,LA7Y=""
F S LA7I=$O(^LAHM(62.85,"B",$P(LA7SM(0),"^"),LA7I)) Q:'LA7I D Q:$L(LA7Y)
. I $P($G(^LAHM(62.85,LA7I,0)),"^",5)'=LA7EV Q
. S LA7Y=$P(^LAHM(62.85,LA7I,0),"^",7)_"^"_$$FMTE^XLFDT($P(^LAHM(62.85,LA7I,0),"^",7),"M") ; Event date/time
I $G(LA7Y)="" S LA7Y="-2^No event date found"
Q LA7Y
;
;
EVNC(LA7EVC) ; Resolve an event code to it's pointer/text(.01) value
; Call with LA7EVC = Code to lookup, i.e. SM01, SM50
; Returns Y = ien of code in file #64.061, LAB ELECTRONIC CODES.
N X,Y
S (X,Y)=0
F S X=$O(^LAB(64.061,"F",LA7EVC,X)) Q:'X D Q:Y
. S X(0)=$G(^LAB(64.061,X,0))
. I $P(X(0),"^",7)="E" S Y=X_"^"_$P(X(0),"^")
I 'Y S Y="0^Code not on file"
Q Y
;
;
CHKTST(LA7SM,LA762801) ; Check and update if test is still valid.
; Call with LA7SM = ien of shipping manifest in file #62.8
; LA762801 = ien of entry on test multiple in file #62.8
;
; Returns LA7SKIP = 0 (Test still on accession).
; 1 (Test not on accession).
; 2 (Accession deleted/purged).
; 3 (Test not on accession - already shipped)
; 4 (Accession deleted/purged - already shipped)
;
N LA7AA,LA7AD,LA7AN,LA7DATA,LA7SKIP,LA7UID,X,Y
S LA7SKIP=0
S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
S LA762801(0)=$G(^LAHM(62.8,+LA7SM,10,+LA762801,0))
S LA7UID=$P(LA762801(0),"^",5)
S X=$Q(^LRO(68,"C",LA7UID))
S LA7AA=+$QS(X,4),LA7AD=+$QS(X,5),LA7AN=+$QS(X,6)
;
; Test found.
I $D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,+$P(LA762801(0),"^",2),0)) Q LA7SKIP
; Accession missing.
I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)) D
. ; Already shipped
. I $P(LA7SM(0),"^",3)>4 S LA7SKIP=4 Q
. S LA7SKIP=2,LA7DATA="SM62"
;
; Test missing.
I 'LA7SKIP,'$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,+$P(LA762801(0),"^",2),0)) D
. ; Already shipped
. I $P(LA7SM(0),"^",3)>4 S LA7SKIP=3 Q
. S LA7SKIP=1,LA7DATA="SM61"
;
; Update manifest/event file if test has not shipped.
I LA7SKIP,LA7SKIP<3 D
. ; Update test on manifest
. D STSUP^LA7SMU(+LA7SM,LA762801,0)
. ; Update event file
. S LA7DATA=LA7DATA_"^"_$$NOW^XLFDT_"^"_$P(LA762801(0),"^",2)_"^"_$P(LA7SM(0),"^")
. D SEUP^LA7SMU(LA7UID,2,LA7DATA)
Q LA7SKIP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SMU 8416 printed Dec 13, 2024@01:39:34 Page 2
LA7SMU ;DALOI/JMC - Shipping Manifest Utility ; 26 Oct 2014 9:51 PM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,64,74,86**;Sep 27, 1994;Build 6
+2 ;
+3 QUIT
+4 ;
CHKSM(X) ; Shipping manifest status check
+1 ; Call with X = ien of file #62.9 LAB SHIPPING CONFIGURATION
+2 ; Returns -1 = error^reason
+3 ; 0 = no active shipping manifest exists
+4 ; >0 = ien of active shipping manifest in file #62.8, LAB SHIPPING MANIFEST
+5 ;
+6 ; No value passed
+7 IF '$GET(X)
QUIT "-1^No configuration passed"
+8 ; Bad pointer passed
+9 IF '$DATA(^LAHM(62.9,X,0))
QUIT "-1^Bad configuration pointer"
+10 ; Get ien of active shipping manifest.
+11 SET Y=+$ORDER(^LAHM(62.8,"AC1",X,0))
+12 IF Y
SET Y=Y_"^"_$PIECE(^LAHM(62.8,Y,0),"^")
+13 QUIT Y
+14 ;
+15 ;
CSM(LA7SCFG) ; Creates a new shipping manifest
+1 ; Call with X = ien of file #62.9 LAB SHIPPING CONFIGURATION
+2 ; Returns -1 = error^reason
+3 ; 0 = no active shipping manifest exists
+4 ; >0 = ien of active shipping manifest in file #62.8, LAB SHIPPING MANIFEST
+5 ;
+6 NEW DATA,FDA,I,LA7CF,LA7DIE,LA7DT,LA7IEN,LA7SM,X,X4
+7 ;
+8 ; No value passed
+9 IF '$GET(LA7SCFG)
QUIT "-1^No configuration passed"
+10 ;
+11 ; Bad pointer passed
+12 IF '$DATA(^LAHM(62.9,LA7SCFG,0))
QUIT "-1^Bad configuration pointer"
+13 ;
+14 SET LA7SCFG(0)=$GET(^LAHM(62.9,LA7SCFG,0))
+15 ; ien of collecting facility
+16 SET LA7CF=$PIECE(LA7SCFG(0),"^",2)
+17 ; file #4 INSTITUTION information
+18 FOR I=.01,.05,99
SET X4(I)=$$GET1^DIQ(4,LA7CF_",",I)
+19 ;
+20 ; Get station number else use short name
+21 SET LA7SM=""
+22 IF $LENGTH(X4(99))
SET LA7SM=X4(99)
+23 IF '$TEST
SET LA7SM=X4(.05)
+24 ; Failsafe value
+25 IF LA7SM=""
SET LA7SM="INST:"_LA7CF
+26 SET DT=$$DT^XLFDT
SET LA7DT=$EXTRACT($$FMTHL7^XLFDT(DT),1,8)
+27 SET LA7SM=LA7SM_"-"_LA7DT_"-"
+28 ;
+29 ;L +^LAHM(62.8,0):5 ; Set lock
+30 DO LOCK^DILF("^LAHM(62.8,0)")
+31 IF '$TEST
QUIT "-1^Unable to obtain lock on file LAB SHIPPING MANIFEST #62.8"
+32 SET X=0
+33 FOR
SET X=X+1
if '$DATA(^LAHM(62.8,"B",LA7SM_X))
QUIT
+34 SET LA7SM=LA7SM_X
+35 ;
+36 SET FDA(1,62.8,"+1,",.01)=LA7SM
+37 SET FDA(1,62.8,"+1,",.02)=LA7SCFG
+38 SET FDA(1,62.8,"+1,",.03)=1
+39 IF $PIECE(LA7SCFG(0),"^",8)
SET FDA(1,62.8,"+1,",.04)=$PIECE(LA7SCFG(0),"^",8)
+40 SET FDA(1,62.8,"+1,",.05)=+$PIECE(LA7SCFG(0),"^",15)
+41 SET FDA(1,62.8,"+1,",.06)=+$PIECE(LA7SCFG(0),"^",16)
+42 DO UPDATE^DIE("","FDA(1)","LA7IEN","LA7DIE(1)")
+43 DO RECALL^DILFD(62.8,LA7IEN(1)_",",DUZ)
+44 ;
+45 SET DATA="SM01^"_$$NOW^XLFDT
+46 DO SEUP(LA7SM,1,DATA)
+47 ;
+48 SET DATA="SM02^"_$$NOW^XLFDT
+49 DO SEUP(LA7SM,1,DATA)
+50 ;
+51 ; Release lock
+52 LOCK -^LAHM(62.8,0)
+53 QUIT LA7IEN(1)_"^"_LA7SM
+54 ;
+55 ;
SMSUP(LA7SM,LA7ST,LA7EVNC) ; Shipping manifest status update.
+1 ; Call with LA7SM = ien of entry in file #62.8 LAB SHIPPING MAINFEST^.01 field
+2 ; LA7ST = status to update
+3 ; LA7EVNC = event code^event date/time (default=NOW)
+4 ;
+5 NEW DATA,LA7DIE,LA7FDA,LA7IEN
+6 ;
+7 SET LA7IEN(1)=+LA7SM
+8 SET LA7FDA(2,62.8,+LA7SM_",",.03)=LA7ST
+9 DO UPDATE^DIE("","LA7FDA(2)","LA7IEN","LA7DIE(2)")
+10 SET DATA=$PIECE(LA7EVNC,"^")_"^"_$SELECT($PIECE(LA7EVNC,"^",2):$PIECE(LA7EVNC,"^",2),1:$$NOW^XLFDT)
+11 DO SEUP($PIECE(LA7SM,"^",2),1,DATA)
+12 QUIT
+13 ;
+14 ;
STSUP(LA7SM,LA762801,LA7DATA) ; Shipping test status update
+1 ; Call with LA7SM = ien of shipping manifest (#62.8)
+2 ; LA762801 = ien of test entry on shipping manifest
+3 ; LA7DATA = data to be filed
+4 NEW LA7FDA,LA7DIE
+5 SET LA762801=LA762801_","_+LA7SM_","
+6 SET LA7FDA(62.8,62.801,LA762801,.08)=LA7DATA
+7 DO FILE^DIE("","LA7FDA(62.8)","LA7DIE(2)")
+8 QUIT
+9 ;
+10 ;
SEUP(LA7ID,LA7EVN,LA7DATA) ; Shipping event update
+1 ; Call with LA7ID = shipping identifier (manifest invoice # or UID)
+2 ; LA7EVN = event type (1=shipping manifest/2=test)
+3 ; LA7DATA = data to be filed
+4 NEW FDA,I,LA7IEN,X
+5 ;L +^LAHM(62.85,0) ; Set lock
+6 DO LOCK^DILF("^LAHM(62.85,0)")
+7 IF '$TEST
QUIT
+8 SET FDA(3,62.85,"+1,",.01)=LA7ID
+9 SET FDA(3,62.85,"+1,",.02)=$SELECT($GET(DUZ)>0:DUZ,1:.5)
+10 SET FDA(3,62.85,"+1,",.03)=$$NOW^XLFDT
+11 SET FDA(3,62.85,"+1,",.04)=LA7EVN
+12 IF $PIECE(LA7DATA,"^")'=""
Begin DoDot:1
+13 SET X=$$EVNC($PIECE(LA7DATA,"^"))
+14 IF X
SET FDA(3,62.85,"+1,",.05)=+X
End DoDot:1
+15 FOR I=2:1:4
IF $PIECE(LA7DATA,"^",I)'=""
SET FDA(3,62.85,"+1,",$PIECE("^.07^.08^.09","^",I))=$PIECE(LA7DATA,"^",I)
+16 ;
+17 ; Add event to lab shipping event.
+18 DO UPDATE^DIE("","FDA(3)","LA7IEN","LA7DIE(3)")
+19 ; Release lock
+20 LOCK -^LAHM(62.85,0)
+21 ;
+22 QUIT
+23 ;
+24 ;
ACCSUP(LA7UID,LA760,LA7DATA) ; Accession status update
+1 ; Call with LA7UID = UID of accession to update
+2 ; LA7DATA = value to update (pointer to file #62.8, LAB SHIPPING MANIFEST or "@" to delete
+3 ;
+4 NEW FDA,LA7AA,LA7AD,LA7AN,LA7CAD,LA768,X
+5 SET X=$QUERY(^LRO(68,"C",LA7UID))
+6 SET LA7AA=$QSUBSCRIPT(X,4)
SET LA7AD=$QSUBSCRIPT(X,5)
SET LA7AN=$QSUBSCRIPT(X,6)
+7 ; Start with original accession date in case roll over accession.
SET LA7AD=$PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),U,3)
+8 ; Get current accession date for this accession area.
SET LA7CAD=$$AD^LA7SUTL(LA7AA)
+9 SET LA7AD=$SELECT(LA7AD>0:LA7AD-.000000001,1:0)
+10 FOR
SET LA7AD=$ORDER(^LRO(68,LA7AA,1,LA7AD))
if 'LA7AD!(LA7AD>LA7CAD)
QUIT
Begin DoDot:1
+11 IF '$DATA(^LRO(68,LA7AA,1,LA7AD,1,LA7AN))
QUIT
+12 IF $PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")'=LA7UID
QUIT
+13 ; Test not on accession.
IF '$DATA(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760))
QUIT
+14 SET LA768=LA760_","_LA7AN_","_LA7AD_","_LA7AA_","
+15 SET FDA(68,68.04,LA768,9)=LA7DATA
+16 DO FILE^DIE("","FDA(68)","LA7DIE(68)")
End DoDot:1
+17 QUIT
+18 ;
+19 ;
SELSM(LA7SCFG,LA7SCR) ; Select shipping manifest
+1 ; Call with LA7SCFG = ien of file #62.9 LAB SHIPPING CONFIGURATION
+2 ; LA7SCR = comma delimited list of status screen - only allow selection of manifests with matching status
+3 ; Returns LA7Y = pointer to shipping manifest or error
+4 NEW D,DIC,DTOUT,DUOUT,LA7Y,X,Y
+5 SET DIC="^LAHM(62.8,"
SET DIC(0)="AEQ"
SET DIC("A")="Select Shipping Manifest: "
+6 SET DIC("S")="I $P(^LAHM(62.8,Y,0),U,2)=LA7SCFG"
+7 SET DIC("W")="D SMW^LA7SMU1(Y)"
+8 IF $GET(LA7SCR)'=""
SET DIC("S")=DIC("S")_","""_LA7SCR_"""[$P(^LAHM(62.8,Y,0),U,3)"
+9 SET D="C"
+10 DO MIX^DIC1
+11 IF Y<1
SET LA7Y="-1^"
+12 IF '$TEST
SET LA7Y=Y
+13 QUIT LA7Y
+14 ;
+15 ;
SMED(LA7SM,LA7EVC) ; Determine shipping manifest's event date
+1 ; Call with LA7SM = ien of entry in file #62.8 LAB SHIPPING MANIFEST
+2 ; LA7EVC = event type code
+3 ; Returns LA7Y = internal event date^external event date
+4 NEW LA7I,LA7X,LA7Y
+5 IF '$GET(LA7SM)
QUIT "-1^No shipping manifest passed"
+6 SET LA7SM(0)=$GET(^LAHM(62.8,+LA7SM,0))
+7 SET LA7EV=+$$EVNC(LA7EVC)
+8 IF LA7EVC="SM05"
IF $PIECE(LA7SM(0),"^",3)'>2
QUIT "0^Shipping manifest has not been shipped"
+9 SET LA7I=0
SET LA7Y=""
+10 FOR
SET LA7I=$ORDER(^LAHM(62.85,"B",$PIECE(LA7SM(0),"^"),LA7I))
if 'LA7I
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^LAHM(62.85,LA7I,0)),"^",5)'=LA7EV
QUIT
+12 ; Event date/time
SET LA7Y=$PIECE(^LAHM(62.85,LA7I,0),"^",7)_"^"_$$FMTE^XLFDT($PIECE(^LAHM(62.85,LA7I,0),"^",7),"M")
End DoDot:1
if $LENGTH(LA7Y)
QUIT
+13 IF $GET(LA7Y)=""
SET LA7Y="-2^No event date found"
+14 QUIT LA7Y
+15 ;
+16 ;
EVNC(LA7EVC) ; Resolve an event code to it's pointer/text(.01) value
+1 ; Call with LA7EVC = Code to lookup, i.e. SM01, SM50
+2 ; Returns Y = ien of code in file #64.061, LAB ELECTRONIC CODES.
+3 NEW X,Y
+4 SET (X,Y)=0
+5 FOR
SET X=$ORDER(^LAB(64.061,"F",LA7EVC,X))
if 'X
QUIT
Begin DoDot:1
+6 SET X(0)=$GET(^LAB(64.061,X,0))
+7 IF $PIECE(X(0),"^",7)="E"
SET Y=X_"^"_$PIECE(X(0),"^")
End DoDot:1
if Y
QUIT
+8 IF 'Y
SET Y="0^Code not on file"
+9 QUIT Y
+10 ;
+11 ;
CHKTST(LA7SM,LA762801) ; Check and update if test is still valid.
+1 ; Call with LA7SM = ien of shipping manifest in file #62.8
+2 ; LA762801 = ien of entry on test multiple in file #62.8
+3 ;
+4 ; Returns LA7SKIP = 0 (Test still on accession).
+5 ; 1 (Test not on accession).
+6 ; 2 (Accession deleted/purged).
+7 ; 3 (Test not on accession - already shipped)
+8 ; 4 (Accession deleted/purged - already shipped)
+9 ;
+10 NEW LA7AA,LA7AD,LA7AN,LA7DATA,LA7SKIP,LA7UID,X,Y
+11 SET LA7SKIP=0
+12 SET LA7SM(0)=$GET(^LAHM(62.8,+LA7SM,0))
+13 SET LA762801(0)=$GET(^LAHM(62.8,+LA7SM,10,+LA762801,0))
+14 SET LA7UID=$PIECE(LA762801(0),"^",5)
+15 SET X=$QUERY(^LRO(68,"C",LA7UID))
+16 SET LA7AA=+$QSUBSCRIPT(X,4)
SET LA7AD=+$QSUBSCRIPT(X,5)
SET LA7AN=+$QSUBSCRIPT(X,6)
+17 ;
+18 ; Test found.
+19 IF $DATA(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,+$PIECE(LA762801(0),"^",2),0))
QUIT LA7SKIP
+20 ; Accession missing.
+21 IF '$DATA(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0))
Begin DoDot:1
+22 ; Already shipped
+23 IF $PIECE(LA7SM(0),"^",3)>4
SET LA7SKIP=4
QUIT
+24 SET LA7SKIP=2
SET LA7DATA="SM62"
End DoDot:1
+25 ;
+26 ; Test missing.
+27 IF 'LA7SKIP
IF '$DATA(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,+$PIECE(LA762801(0),"^",2),0))
Begin DoDot:1
+28 ; Already shipped
+29 IF $PIECE(LA7SM(0),"^",3)>4
SET LA7SKIP=3
QUIT
+30 SET LA7SKIP=1
SET LA7DATA="SM61"
End DoDot:1
+31 ;
+32 ; Update manifest/event file if test has not shipped.
+33 IF LA7SKIP
IF LA7SKIP<3
Begin DoDot:1
+34 ; Update test on manifest
+35 DO STSUP^LA7SMU(+LA7SM,LA762801,0)
+36 ; Update event file
+37 SET LA7DATA=LA7DATA_"^"_$$NOW^XLFDT_"^"_$P(LA762801(0),"^",2)_"^"_$PIECE(LA7SM(0),"^")
+38 DO SEUP^LA7SMU(LA7UID,2,LA7DATA)
End DoDot:1
+39 QUIT LA7SKIP
